Context Navigation

defrun_new.F @ 201

Last change on this file since 201 was 177, checked in by lmdzadmin, 24 years ago

Lots of stuff, plus particulierement:

appel a ORCHIDEE en etat de marche (pb de grille subsiste)
modifs de Pascale sur soil dans le cas ou ok_veget=false -

Property svn:eol-style set to native
Property svn:executable set to *
Property svn:keywords set to Author Date Id Revision

File size: 13.1 KB

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

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

Download in other formats:

Original Format