My Project
 All Classes Files Functions Variables Macros
defrun.F
Go to the documentation of this file.
1 !
2 ! $Id$
3 !
4 c
5 c
6  SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7 c
8  USE control_mod
9  IMPLICIT NONE
10 c-----------------------------------------------------------------------
11 c Auteurs : L. Fairhead , P. Le Van .
12 c
13 c Arguments :
14 c
15 c tapedef :
16 c etatinit : = TRUE , on ne compare pas les valeurs des para-
17 c -metres du zoom avec celles lues sur le fichier start .
18 c clesphy0 : sortie .
19 c
20  LOGICAL etatinit
21  INTEGER tapedef
22 
23  INTEGER longcles
24  parameter( longcles = 20 )
25  REAL clesphy0( longcles )
26 c
27 c Declarations :
28 c --------------
29 #include "dimensions.h"
30 #include "paramet.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 ch1*72,ch2*72,ch3*72,ch4*12
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,*) dissip_period
135  WRITE(tapeout,9001) ch1,'dissip_period'
136  WRITE(tapeout,*) dissip_period
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) = REAL( iflag_con )
244  clesphy0(2) = REAL( 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,*)
265 ' La valeur de clon passee par run.def est diffe *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,*)
276 ' La valeur de clat passee par run.def est diffe *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,*)
287 ' La valeur de grossismx passee par run.def est , 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,*)
298 ' La valeur de grossismy passee par run.def est , 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,*)
366 ' La valeur de dzoomx passee par run.def est dif *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,*)
372 ' La valeur de dzoomy passee par run.def est dif *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,*)
378 ' La valeur de taux passee par run.def est differente * 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,*)
384 ' La valeur de tauy passee par run.def est differente * 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