Context Navigation

defrun.F @ 1354

Last change on this file since 1354 was 985, checked in by Laurent Fairhead, 16 years ago
Mise a jour de dyn3dpar par rapport a dyn3d, inclusion OpenMP et filtre FFT YM LF
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 14.1 KB

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

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

Download in other formats:

Original Format