source: LMDZ4/trunk/libf/dyn3d/defrun.F @ 1124

Last change on this file since 1124 was 956, checked in by lmdzadmin, 17 years ago

Nettoyage du controle des parametres physiques. FH

Les parametres cycle_diurne, soil_model, new_oliq, ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad et iflag_con
sont maintenant geres par la physique uniquement.
ecritphy est elimine.
dimphy.F90 et clesphys.h ne sont plus utilises par le code dynamique.
Le test academique obtenu en compilant avec
makegcm -p nophys gcm
fonctionne. FH
IM
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.1 KB
RevLine 
[524]1!
2! $Header$
3!
4c
5c
6      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7c
8      IMPLICIT NONE
9c-----------------------------------------------------------------------
10c     Auteurs :   L. Fairhead , P. Le Van  .
11c
12c     Arguments :
13c
14c     tapedef   :
15c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
16c     -metres  du zoom  avec  celles lues sur le fichier start .
17c      clesphy0 :  sortie  .
18c
19       LOGICAL etatinit
20       INTEGER tapedef
21
22       INTEGER        longcles
23       PARAMETER(     longcles = 20 )
24       REAL clesphy0( longcles )
25c
26c   Declarations :
27c   --------------
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"
35c
36c
37c   local:
38c   ------
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     
47c
48c  -------------------------------------------------------------------
49c
50c       .........     Version  du 29/04/97       ..........
51c
52c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
53c      tetatemp   ajoutes  pour la dissipation   .
54c
55c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
56c
57c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
58c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
59c
60c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
61c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
62c                de limit.dat ( dic)                        ...........
63c           Sinon  etatinit = . FALSE .
64c
65c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
66c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
67c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
68c    lectba . 
69c   Ces parmetres definissant entre autres la grille et doivent etre
70c   pareils et coherents , sinon il y aura  divergence du gcm .
71c
72c-----------------------------------------------------------------------
73c   initialisations:
74c   ----------------
75
76      tapeout = 6
77
78c-----------------------------------------------------------------------
79c  Parametres de controle du run:
80c-----------------------------------------------------------------------
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
138ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
139ccc
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
179c
180      READ (tapedef,9001) ch1,ch4
181      READ (tapedef,*)    purmats
182      WRITE(tapeout,9001) ch1,'purmats'
183      WRITE(tapeout,*)    purmats
184
185c    ...............................................................
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      READ (tapedef,9001) ch1,ch4
199      READ (tapedef,*)    cycle_diurne
200      WRITE(tapeout,9001) ch1,'cycle_diurne'
201      WRITE(tapeout,*)    cycle_diurne
202
203      READ (tapedef,9001) ch1,ch4
204      READ (tapedef,*)    soil_model
205      WRITE(tapeout,9001) ch1,'soil_model'
206      WRITE(tapeout,*)    soil_model
207
208      READ (tapedef,9001) ch1,ch4
209      READ (tapedef,*)    new_oliq
210      WRITE(tapeout,9001) ch1,'new_oliq'
211      WRITE(tapeout,*)    new_oliq
212
213      READ (tapedef,9001) ch1,ch4
214      READ (tapedef,*)    ok_orodr
215      WRITE(tapeout,9001) ch1,'ok_orodr'
216      WRITE(tapeout,*)    ok_orodr
217
218      READ (tapedef,9001) ch1,ch4
219      READ (tapedef,*)    ok_orolf
220      WRITE(tapeout,9001) ch1,'ok_orolf'
221      WRITE(tapeout,*)    ok_orolf
222
223      READ (tapedef,9001) ch1,ch4
224      READ (tapedef,*)    ok_limitvrai
225      WRITE(tapeout,9001) ch1,'ok_limitvrai'
226      WRITE(tapeout,*)    ok_limitvrai
227
228      READ (tapedef,9001) ch1,ch4
229      READ (tapedef,*)    nbapp_rad
230      WRITE(tapeout,9001) ch1,'nbapp_rad'
231      WRITE(tapeout,*)    nbapp_rad
232
233      READ (tapedef,9001) ch1,ch4
234      READ (tapedef,*)    iflag_con
235      WRITE(tapeout,9001) ch1,'iflag_con'
236      WRITE(tapeout,*)    iflag_con
237
238      DO i = 1, longcles
239       clesphy0(i) = 0.
240      ENDDO
241                          clesphy0(1) = FLOAT( iflag_con )
242                          clesphy0(2) = FLOAT( nbapp_rad )
243
244       IF( cycle_diurne  ) clesphy0(3) =  1.
245       IF(   soil_model  ) clesphy0(4) =  1.
246       IF(     new_oliq  ) clesphy0(5) =  1.
247       IF(     ok_orodr  ) clesphy0(6) =  1.
248       IF(     ok_orolf  ) clesphy0(7) =  1.
249       IF(  ok_limitvrai ) clesphy0(8) =  1.
250
251
252ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
253c     .........   (  modif  le 17/04/96 )   .........
254c
255      IF( etatinit ) GO TO 100
256
257      READ (tapedef,9001) ch1,ch4
258      READ (tapedef,*)    clonn
259      WRITE(tapeout,9001) ch1,'clon'
260      WRITE(tapeout,*)    clonn
261      IF( ABS(clon - clonn).GE. 0.001 )  THEN
262       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
263     *rente de  celle lue sur le fichier  start '
264        STOP
265      ENDIF
266c
267      READ (tapedef,9001) ch1,ch4
268      READ (tapedef,*)    clatt
269      WRITE(tapeout,9001) ch1,'clat'
270      WRITE(tapeout,*)    clatt
271
272      IF( ABS(clat - clatt).GE. 0.001 )  THEN
273       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
274     *rente de  celle lue sur le fichier  start '
275        STOP
276      ENDIF
277
278      READ (tapedef,9001) ch1,ch4
279      READ (tapedef,*)    grossismxx
280      WRITE(tapeout,9001) ch1,'grossismx'
281      WRITE(tapeout,*)    grossismxx
282
283      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
284       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
285     , differente de celle lue sur le fichier  start '
286        STOP
287      ENDIF
288
289      READ (tapedef,9001) ch1,ch4
290      READ (tapedef,*)    grossismyy
291      WRITE(tapeout,9001) ch1,'grossismy'
292      WRITE(tapeout,*)    grossismyy
293
294      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
295       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
296     , differente de celle lue sur le fichier  start '
297        STOP
298      ENDIF
299     
300      IF( grossismx.LT.1. )  THEN
301        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
302         STOP
303      ELSE
304         alphax = 1. - 1./ grossismx
305      ENDIF
306
307
308      IF( grossismy.LT.1. )  THEN
309        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
310         STOP
311      ELSE
312         alphay = 1. - 1./ grossismy
313      ENDIF
314
315c
316c    alphax et alphay sont les anciennes formulat. des grossissements
317c
318c
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            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
327            WRITE(tapeout,*)' *** 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            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
334            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
335     *,      '                   alors  qu il est  F  sur  run.def  ***'
336              STOP
337           ENDIF
338      ENDIF
339c
340      READ (tapedef,9001) ch1,ch4
341      READ (tapedef,*)    dzoomxx
342      WRITE(tapeout,9001) ch1,'dzoomx'
343      WRITE(tapeout,*)    dzoomxx
344
345      READ (tapedef,9001) ch1,ch4
346      READ (tapedef,*)    dzoomyy
347      WRITE(tapeout,9001) ch1,'dzoomy'
348      WRITE(tapeout,*)    dzoomyy
349
350      READ (tapedef,9001) ch1,ch4
351      READ (tapedef,*)    tauxx
352      WRITE(tapeout,9001) ch1,'taux'
353      WRITE(tapeout,*)    tauxx
354
355      READ (tapedef,9001) ch1,ch4
356      READ (tapedef,*)    tauyy
357      WRITE(tapeout,9001) ch1,'tauy'
358      WRITE(tapeout,*)    tauyy
359
360      IF( fxyhypb )  THEN
361
362       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
363        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
364     *ferente de celle lue sur le fichier  start '
365        CALL ABORT
366       ENDIF
367
368       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
369        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
370     *ferente de celle lue sur le fichier  start '
371        CALL ABORT
372       ENDIF
373
374       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
375        WRITE(6,*)' La valeur de taux passee par run.def est differente
376     *  de celle lue sur le fichier  start '
377        CALL ABORT
378       ENDIF
379
380       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
381        WRITE(6,*)' La valeur de tauy passee par run.def est differente
382     *  de celle lue sur le fichier  start '
383        CALL ABORT
384       ENDIF
385
386      ENDIF
387     
388cc
389      IF( .NOT.fxyhypb  )  THEN
390        READ (tapedef,9001) ch1,ch4
391        READ (tapedef,*)    ysinuss
392        WRITE(tapeout,9001) ch1,'ysinus'
393        WRITE(tapeout,*)    ysinuss
394
395
396        IF( .NOT.ysinus )  THEN
397           IF( ysinuss )     THEN
398              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
399              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
400     *       ' alors  qu il est  T  sur  run.def  ***'
401              STOP
402           ENDIF
403        ELSE
404           IF( .NOT.ysinuss )   THEN
405              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
406              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
407     *       ' alors  qu il est  F  sur  run.def  ***'
408              STOP
409           ENDIF
410        ENDIF
411      ENDIF
412c
413      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
414
415      CLOSE(tapedef)
416
417      RETURN
418c   ...............................................
419c
420100   CONTINUE
421c
422      READ (tapedef,9001) ch1,ch4
423      READ (tapedef,*)    clon
424      WRITE(tapeout,9001) ch1,'clon'
425      WRITE(tapeout,*)    clon
426c
427      READ (tapedef,9001) ch1,ch4
428      READ (tapedef,*)    clat
429      WRITE(tapeout,9001) ch1,'clat'
430      WRITE(tapeout,*)    clat
431
432      READ (tapedef,9001) ch1,ch4
433      READ (tapedef,*)    grossismx
434      WRITE(tapeout,9001) ch1,'grossismx'
435      WRITE(tapeout,*)    grossismx
436
437      READ (tapedef,9001) ch1,ch4
438      READ (tapedef,*)    grossismy
439      WRITE(tapeout,9001) ch1,'grossismy'
440      WRITE(tapeout,*)    grossismy
441
442      IF( grossismx.LT.1. )  THEN
443        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
444         STOP
445      ELSE
446         alphax = 1. - 1./ grossismx
447      ENDIF
448
449      IF( grossismy.LT.1. )  THEN
450        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
451         STOP
452      ELSE
453         alphay = 1. - 1./ grossismy
454      ENDIF
455
456c
457      READ (tapedef,9001) ch1,ch4
458      READ (tapedef,*)    fxyhypb
459      WRITE(tapeout,9001) ch1,'fxyhypb'
460      WRITE(tapeout,*)    fxyhypb
461
462      READ (tapedef,9001) ch1,ch4
463      READ (tapedef,*)    dzoomx
464      WRITE(tapeout,9001) ch1,'dzoomx'
465      WRITE(tapeout,*)    dzoomx
466
467      READ (tapedef,9001) ch1,ch4
468      READ (tapedef,*)    dzoomy
469      WRITE(tapeout,9001) ch1,'dzoomy'
470      WRITE(tapeout,*)    dzoomy
471
472      READ (tapedef,9001) ch1,ch4
473      READ (tapedef,*)    taux
474      WRITE(tapeout,9001) ch1,'taux'
475      WRITE(tapeout,*)    taux
476c
477      READ (tapedef,9001) ch1,ch4
478      READ (tapedef,*)    tauy
479      WRITE(tapeout,9001) ch1,'tauy'
480      WRITE(tapeout,*)    tauy
481
482      READ (tapedef,9001) ch1,ch4
483      READ (tapedef,*)    ysinus
484      WRITE(tapeout,9001) ch1,'ysinus'
485      WRITE(tapeout,*)    ysinus
486       
487      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
488c
4899000  FORMAT(3(/,a72))
4909001  FORMAT(/,a72,/,a12)
491cc
492      CLOSE(tapedef)
493
494      RETURN
495      END
Note: See TracBrowser for help on using the repository browser.