source: trunk/LMDZ.COMMON/libf/dyn3d_common/defrun.F @ 3000

Last change on this file since 3000 was 1422, checked in by milmd, 10 years ago

In GENERIC, MARS and COMMON models replace some include files by modules (usefull for decoupling physics with dynamics).

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