Context Navigation

defrun.F @ 5017

Last change on this file since 5017 was 1999, checked in by Laurent Fairhead, 11 years ago
Merged trunk changes r1920:1997 into testing branch
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 14.2 KB

Line
1	!
2	! $Id: defrun.F 1999 2014-03-20 09:57:19Z dcugnet $
3	!
4	c
5	c
6	SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7	c
8	USE control_mod
9
10	IMPLICIT NONE
11	c-----------------------------------------------------------------------
12	c Auteurs : L. Fairhead , P. Le Van .
13	c
14	c Arguments :
15	c
16	c tapedef :
17	c etatinit : = TRUE , on ne compare pas les valeurs des para-
18	c -metres du zoom avec celles lues sur le fichier start .
19	c clesphy0 : sortie .
20	c
21	LOGICAL etatinit
22	INTEGER tapedef
23
24	INTEGER longcles
25	PARAMETER( longcles = 20 )
26	REAL clesphy0( longcles )
27	c
28	c Declarations :
29	c --------------
30	#include "dimensions.h"
31	#include "paramet.h"
32	#include "logic.h"
33	#include "serre.h"
34	#include "comdissnew.h"
35	#include "clesph0.h"
36	c
37	c
38	c local:
39	c ------
40
41	CHARACTER ch172,ch272,ch372,ch412
42	INTEGER tapeout
43	REAL clonn,clatt,grossismxx,grossismyy
44	REAL dzoomxx,dzoomyy,tauxx,tauyy
45	LOGICAL fxyhypbb, ysinuss
46	INTEGER i
47
48	c
49	c -------------------------------------------------------------------
50	c
51	c ......... Version du 29/04/97 ..........
52	c
53	c Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
54	c tetatemp ajoutes pour la dissipation .
55	c
56	c Autre parametre ajoute en fin de liste de tapedef : fxyhypb
57	c
58	c Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
59	c Sinon , choix de fxynew , a derivee sinusoidale ..
60	c
61	c ...... etatinit = . TRUE. si defrun est appele dans ETAT0_LMD ou
62	c LIMIT_LMD pour l'initialisation de start.dat (dic) et
63	c de limit.dat ( dic) ...........
64	c Sinon etatinit = . FALSE .
65	c
66	c Donc etatinit = .F. si on veut comparer les valeurs de grossismx ,
67	c grossismy,clon,clat, fxyhypb lues sur le fichier start avec
68	c celles passees par run.def , au debut du gcm, apres l'appel a
69	c lectba .
70	c Ces parmetres definissant entre autres la grille et doivent etre
71	c pareils et coherents , sinon il y aura divergence du gcm .
72	c
73	c-----------------------------------------------------------------------
74	c initialisations:
75	c ----------------
76
77	tapeout = 6
78
79	c-----------------------------------------------------------------------
80	c Parametres de controle du run:
81	c-----------------------------------------------------------------------
82
83	OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
84
85
86	READ (tapedef,9000) ch1,ch2,ch3
87	WRITE(tapeout,9000) ch1,ch2,ch3
88
89	READ (tapedef,9001) ch1,ch4
90	READ (tapedef,*) dayref
91	WRITE(tapeout,9001) ch1,'dayref'
92	WRITE(tapeout,*) dayref
93
94	READ (tapedef,9001) ch1,ch4
95	READ (tapedef,*) anneeref
96	WRITE(tapeout,9001) ch1,'anneeref'
97	WRITE(tapeout,*) anneeref
98
99	READ (tapedef,9001) ch1,ch4
100	READ (tapedef,*) nday
101	WRITE(tapeout,9001) ch1,'nday'
102	WRITE(tapeout,*) nday
103
104	READ (tapedef,9001) ch1,ch4
105	READ (tapedef,*) day_step
106	WRITE(tapeout,9001) ch1,'day_step'
107	WRITE(tapeout,*) day_step
108
109	READ (tapedef,9001) ch1,ch4
110	READ (tapedef,*) iperiod
111	WRITE(tapeout,9001) ch1,'iperiod'
112	WRITE(tapeout,*) iperiod
113
114	READ (tapedef,9001) ch1,ch4
115	READ (tapedef,*) iapp_tracvl
116	WRITE(tapeout,9001) ch1,'iapp_tracvl'
117	WRITE(tapeout,*) iapp_tracvl
118
119	READ (tapedef,9001) ch1,ch4
120	READ (tapedef,*) iconser
121	WRITE(tapeout,9001) ch1,'iconser'
122	WRITE(tapeout,*) iconser
123
124	READ (tapedef,9001) ch1,ch4
125	READ (tapedef,*) iecri
126	WRITE(tapeout,9001) ch1,'iecri'
127	WRITE(tapeout,*) iecri
128
129	READ (tapedef,9001) ch1,ch4
130	READ (tapedef,*) periodav
131	WRITE(tapeout,9001) ch1,'periodav'
132	WRITE(tapeout,*) periodav
133
134	READ (tapedef,9001) ch1,ch4
135	READ (tapedef,*) dissip_period
136	WRITE(tapeout,9001) ch1,'dissip_period'
137	WRITE(tapeout,*) dissip_period
138
139	ccc .... P. Le Van , modif le 29/04/97 .pour la dissipation ...
140	ccc
141	READ (tapedef,9001) ch1,ch4
142	READ (tapedef,*) lstardis
143	WRITE(tapeout,9001) ch1,'lstardis'
144	WRITE(tapeout,*) lstardis
145
146	READ (tapedef,9001) ch1,ch4
147	READ (tapedef,*) nitergdiv
148	WRITE(tapeout,9001) ch1,'nitergdiv'
149	WRITE(tapeout,*) nitergdiv
150
151	READ (tapedef,9001) ch1,ch4
152	READ (tapedef,*) nitergrot
153	WRITE(tapeout,9001) ch1,'nitergrot'
154	WRITE(tapeout,*) nitergrot
155
156	READ (tapedef,9001) ch1,ch4
157	READ (tapedef,*) niterh
158	WRITE(tapeout,9001) ch1,'niterh'
159	WRITE(tapeout,*) niterh
160
161	READ (tapedef,9001) ch1,ch4
162	READ (tapedef,*) tetagdiv
163	WRITE(tapeout,9001) ch1,'tetagdiv'
164	WRITE(tapeout,*) tetagdiv
165
166	READ (tapedef,9001) ch1,ch4
167	READ (tapedef,*) tetagrot
168	WRITE(tapeout,9001) ch1,'tetagrot'
169	WRITE(tapeout,*) tetagrot
170
171	READ (tapedef,9001) ch1,ch4
172	READ (tapedef,*) tetatemp
173	WRITE(tapeout,9001) ch1,'tetatemp'
174	WRITE(tapeout,*) tetatemp
175
176	READ (tapedef,9001) ch1,ch4
177	READ (tapedef,*) coefdis
178	WRITE(tapeout,9001) ch1,'coefdis'
179	WRITE(tapeout,*) coefdis
180	c
181	READ (tapedef,9001) ch1,ch4
182	READ (tapedef,*) purmats
183	WRITE(tapeout,9001) ch1,'purmats'
184	WRITE(tapeout,*) purmats
185
186	c ...............................................................
187
188	READ (tapedef,9001) ch1,ch4
189	READ (tapedef,*) iflag_phys
190	WRITE(tapeout,9001) ch1,'iflag_phys'
191	WRITE(tapeout,*) iflag_phys
192
193	READ (tapedef,9001) ch1,ch4
194	READ (tapedef,*) iphysiq
195	WRITE(tapeout,9001) ch1,'iphysiq'
196	WRITE(tapeout,*) iphysiq
197
198
199	READ (tapedef,9001) ch1,ch4
200	READ (tapedef,*) cycle_diurne
201	WRITE(tapeout,9001) ch1,'cycle_diurne'
202	WRITE(tapeout,*) cycle_diurne
203
204	READ (tapedef,9001) ch1,ch4
205	READ (tapedef,*) soil_model
206	WRITE(tapeout,9001) ch1,'soil_model'
207	WRITE(tapeout,*) soil_model
208
209	READ (tapedef,9001) ch1,ch4
210	READ (tapedef,*) new_oliq
211	WRITE(tapeout,9001) ch1,'new_oliq'
212	WRITE(tapeout,*) new_oliq
213
214	READ (tapedef,9001) ch1,ch4
215	READ (tapedef,*) ok_orodr
216	WRITE(tapeout,9001) ch1,'ok_orodr'
217	WRITE(tapeout,*) ok_orodr
218
219	READ (tapedef,9001) ch1,ch4
220	READ (tapedef,*) ok_orolf
221	WRITE(tapeout,9001) ch1,'ok_orolf'
222	WRITE(tapeout,*) ok_orolf
223
224	READ (tapedef,9001) ch1,ch4
225	READ (tapedef,*) ok_limitvrai
226	WRITE(tapeout,9001) ch1,'ok_limitvrai'
227	WRITE(tapeout,*) ok_limitvrai
228
229	READ (tapedef,9001) ch1,ch4
230	READ (tapedef,*) nbapp_rad
231	WRITE(tapeout,9001) ch1,'nbapp_rad'
232	WRITE(tapeout,*) nbapp_rad
233
234	READ (tapedef,9001) ch1,ch4
235	READ (tapedef,*) iflag_con
236	WRITE(tapeout,9001) ch1,'iflag_con'
237	WRITE(tapeout,*) iflag_con
238
239	DO i = 1, longcles
240	clesphy0(i) = 0.
241	ENDDO
242	clesphy0(1) = REAL( iflag_con )
243	clesphy0(2) = REAL( nbapp_rad )
244
245	IF( cycle_diurne ) clesphy0(3) = 1.
246	IF( soil_model ) clesphy0(4) = 1.
247	IF( new_oliq ) clesphy0(5) = 1.
248	IF( ok_orodr ) clesphy0(6) = 1.
249	IF( ok_orolf ) clesphy0(7) = 1.
250	IF( ok_limitvrai ) clesphy0(8) = 1.
251
252
253	ccc .... P. Le Van , ajout le 7/03/95 .pour le zoom ...
254	c ......... ( modif le 17/04/96 ) .........
255	c
256	IF( etatinit ) GO TO 100
257
258	READ (tapedef,9001) ch1,ch4
259	READ (tapedef,*) clonn
260	WRITE(tapeout,9001) ch1,'clon'
261	WRITE(tapeout,*) clonn
262	IF( ABS(clon - clonn).GE. 0.001 ) THEN
263	WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
264	*rente de celle lue sur le fichier start '
265	STOP
266	ENDIF
267	c
268	READ (tapedef,9001) ch1,ch4
269	READ (tapedef,*) clatt
270	WRITE(tapeout,9001) ch1,'clat'
271	WRITE(tapeout,*) clatt
272
273	IF( ABS(clat - clatt).GE. 0.001 ) THEN
274	WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
275	*rente de celle lue sur le fichier start '
276	STOP
277	ENDIF
278
279	READ (tapedef,9001) ch1,ch4
280	READ (tapedef,*) grossismxx
281	WRITE(tapeout,9001) ch1,'grossismx'
282	WRITE(tapeout,*) grossismxx
283
284	IF( ABS(grossismx - grossismxx).GE. 0.001 ) THEN
285	WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
286	, differente de celle lue sur le fichier start '
287	STOP
288	ENDIF
289
290	READ (tapedef,9001) ch1,ch4
291	READ (tapedef,*) grossismyy
292	WRITE(tapeout,9001) ch1,'grossismy'
293	WRITE(tapeout,*) grossismyy
294
295	IF( ABS(grossismy - grossismyy).GE. 0.001 ) THEN
296	WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
297	, differente de celle lue sur le fichier start '
298	STOP
299	ENDIF
300
301	IF( grossismx.LT.1. ) THEN
302	WRITE(tapeout,) ' ATTENTION !! grossismx < 1 . * '
303	STOP
304	ELSE
305	alphax = 1. - 1./ grossismx
306	ENDIF
307
308
309	IF( grossismy.LT.1. ) THEN
310	WRITE(tapeout,) ' ATTENTION !! grossismy < 1 . * '
311	STOP
312	ELSE
313	alphay = 1. - 1./ grossismy
314	ENDIF
315
316	c
317	c alphax et alphay sont les anciennes formulat. des grossissements
318	c
319	c
320	READ (tapedef,9001) ch1,ch4
321	READ (tapedef,*) fxyhypbb
322	WRITE(tapeout,9001) ch1,'fxyhypbb'
323	WRITE(tapeout,*) fxyhypbb
324
325	IF( .NOT.fxyhypb ) THEN
326	IF( fxyhypbb ) THEN
327	WRITE(tapeout,) ' ***** PBS DANS DEFRUN ****** '
328	WRITE(tapeout,)' ** fxyhypb lu sur le fichier start est F'
329	, ' alors qu il est T sur run.def **'
330	STOP
331	ENDIF
332	ELSE
333	IF( .NOT.fxyhypbb ) THEN
334	WRITE(tapeout,) ' ***** PBS DANS DEFRUN ****** '
335	WRITE(tapeout,)' ** fxyhypb lu sur le fichier start est t'
336	, ' alors qu il est F sur run.def **'
337	STOP
338	ENDIF
339	ENDIF
340	c
341	READ (tapedef,9001) ch1,ch4
342	READ (tapedef,*) dzoomxx
343	WRITE(tapeout,9001) ch1,'dzoomx'
344	WRITE(tapeout,*) dzoomxx
345
346	READ (tapedef,9001) ch1,ch4
347	READ (tapedef,*) dzoomyy
348	WRITE(tapeout,9001) ch1,'dzoomy'
349	WRITE(tapeout,*) dzoomyy
350
351	READ (tapedef,9001) ch1,ch4
352	READ (tapedef,*) tauxx
353	WRITE(tapeout,9001) ch1,'taux'
354	WRITE(tapeout,*) tauxx
355
356	READ (tapedef,9001) ch1,ch4
357	READ (tapedef,*) tauyy
358	WRITE(tapeout,9001) ch1,'tauy'
359	WRITE(tapeout,*) tauyy
360
361	IF( fxyhypb ) THEN
362
363	IF( ABS(dzoomx - dzoomxx).GE. 0.001 ) THEN
364	WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
365	*ferente de celle lue sur le fichier start '
366	CALL ABORT_gcm("defrun", "", 1)
367	ENDIF
368
369	IF( ABS(dzoomy - dzoomyy).GE. 0.001 ) THEN
370	WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
371	*ferente de celle lue sur le fichier start '
372	CALL ABORT_gcm("defrun", "", 1)
373	ENDIF
374
375	IF( ABS(taux - tauxx).GE. 0.001 ) THEN
376	WRITE(6,*)' La valeur de taux passee par run.def est differente
377	* de celle lue sur le fichier start '
378	CALL ABORT_gcm("defrun", "", 1)
379	ENDIF
380
381	IF( ABS(tauy - tauyy).GE. 0.001 ) THEN
382	WRITE(6,*)' La valeur de tauy passee par run.def est differente
383	* de celle lue sur le fichier start '
384	CALL ABORT_gcm("defrun", "", 1)
385	ENDIF
386
387	ENDIF
388
389	cc
390	IF( .NOT.fxyhypb ) THEN
391	READ (tapedef,9001) ch1,ch4
392	READ (tapedef,*) ysinuss
393	WRITE(tapeout,9001) ch1,'ysinus'
394	WRITE(tapeout,*) ysinuss
395
396
397	IF( .NOT.ysinus ) THEN
398	IF( ysinuss ) THEN
399	WRITE(6,) ' ***** PBS DANS DEFRUN ****** '
400	WRITE(tapeout,)'* ysinus lu sur le fichier start est F',
401	* ' alors qu il est T sur run.def ***'
402	STOP
403	ENDIF
404	ELSE
405	IF( .NOT.ysinuss ) THEN
406	WRITE(6,) ' ***** PBS DANS DEFRUN ****** '
407	WRITE(tapeout,)'* ysinus lu sur le fichier start est T',
408	* ' alors qu il est F sur run.def ***'
409	STOP
410	ENDIF
411	ENDIF
412	ENDIF
413	c
414	WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
415
416	CLOSE(tapedef)
417
418	RETURN
419	c ...............................................
420	c
421	100 CONTINUE
422	c
423	READ (tapedef,9001) ch1,ch4
424	READ (tapedef,*) clon
425	WRITE(tapeout,9001) ch1,'clon'
426	WRITE(tapeout,*) clon
427	c
428	READ (tapedef,9001) ch1,ch4
429	READ (tapedef,*) clat
430	WRITE(tapeout,9001) ch1,'clat'
431	WRITE(tapeout,*) clat
432
433	READ (tapedef,9001) ch1,ch4
434	READ (tapedef,*) grossismx
435	WRITE(tapeout,9001) ch1,'grossismx'
436	WRITE(tapeout,*) grossismx
437
438	READ (tapedef,9001) ch1,ch4
439	READ (tapedef,*) grossismy
440	WRITE(tapeout,9001) ch1,'grossismy'
441	WRITE(tapeout,*) grossismy
442
443	IF( grossismx.LT.1. ) THEN
444	WRITE(tapeout,) ' ATTENTION !! grossismx < 1 . * '
445	STOP
446	ELSE
447	alphax = 1. - 1./ grossismx
448	ENDIF
449
450	IF( grossismy.LT.1. ) THEN
451	WRITE(tapeout,) ' ATTENTION !! grossismy < 1 . * '
452	STOP
453	ELSE
454	alphay = 1. - 1./ grossismy
455	ENDIF
456
457	c
458	READ (tapedef,9001) ch1,ch4
459	READ (tapedef,*) fxyhypb
460	WRITE(tapeout,9001) ch1,'fxyhypb'
461	WRITE(tapeout,*) fxyhypb
462
463	READ (tapedef,9001) ch1,ch4
464	READ (tapedef,*) dzoomx
465	WRITE(tapeout,9001) ch1,'dzoomx'
466	WRITE(tapeout,*) dzoomx
467
468	READ (tapedef,9001) ch1,ch4
469	READ (tapedef,*) dzoomy
470	WRITE(tapeout,9001) ch1,'dzoomy'
471	WRITE(tapeout,*) dzoomy
472
473	READ (tapedef,9001) ch1,ch4
474	READ (tapedef,*) taux
475	WRITE(tapeout,9001) ch1,'taux'
476	WRITE(tapeout,*) taux
477	c
478	READ (tapedef,9001) ch1,ch4
479	READ (tapedef,*) tauy
480	WRITE(tapeout,9001) ch1,'tauy'
481	WRITE(tapeout,*) tauy
482
483	READ (tapedef,9001) ch1,ch4
484	READ (tapedef,*) ysinus
485	WRITE(tapeout,9001) ch1,'ysinus'
486	WRITE(tapeout,*) ysinus
487
488	WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
489	c
490	9000 FORMAT(3(/,a72))
491	9001 FORMAT(/,a72,/,a12)
492	cc
493	CLOSE(tapedef)
494
495	RETURN
496	END

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format