Context Navigation

defrun.F @ 1934

Last change on this file since 1934 was 1930, checked in by lguez, 11 years ago
abort, dfloat and pause are not in the Fortran standard. Replaced abort by abort_gcm and dfloat by dble. Note: I modified dyn3dpar files that were identical to dyn3d modified files.
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 1930 2014-01-17 16:45:09Z jghattas $
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