My Project
 All Classes Files Functions Variables Macros
defrun.F
Go to the documentation of this file.
1 !
2 ! $Id: defrun.F 1502 2011-03-21 16:07:54Z 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 ch1*72,ch2*72,ch3*72,ch4*12
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,*)
264 ' La valeur de clon passee par run.def est diffe *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,*)
275 ' La valeur de clat passee par run.def est diffe *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,*)
286 ' La valeur de grossismx passee par run.def est , 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,*)
297 ' La valeur de grossismy passee par run.def est , 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,*)
365 ' La valeur de dzoomx passee par run.def est dif *ferente de celle lue sur le fichier start '
366  CALL abort
367  ENDIF
368 
369  IF( abs(dzoomy - dzoomyy).GE. 0.001 ) THEN
370  WRITE(tapeout,*)
371 ' La valeur de dzoomy passee par run.def est dif *ferente de celle lue sur le fichier start '
372  CALL abort
373  ENDIF
374 
375  IF( abs(taux - tauxx).GE. 0.001 ) THEN
376  WRITE(6,*)
377 ' La valeur de taux passee par run.def est differente * de celle lue sur le fichier start '
378  CALL abort
379  ENDIF
380 
381  IF( abs(tauy - tauyy).GE. 0.001 ) THEN
382  WRITE(6,*)
383 ' La valeur de tauy passee par run.def est differente * de celle lue sur le fichier start '
384  CALL abort
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