source: LMDZ5/branches/testing/libf/dyn3dmem/defrun.F @ 1707

Last change on this file since 1707 was 1707, checked in by Laurent Fairhead, 11 years ago

Version testing basée sur la r1706


Testing release based on r1706

File size: 14.2 KB
Line 
1!
2! $Id$
3!
4c
5c
6      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7c
8      USE control_mod
9      IMPLICIT NONE
10c-----------------------------------------------------------------------
11c     Auteurs :   L. Fairhead , P. Le Van  .
12c
13c     Arguments :
14c
15c     tapedef   :
16c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
17c     -metres  du zoom  avec  celles lues sur le fichier start .
18c      clesphy0 :  sortie  .
19c
20       LOGICAL etatinit
21       INTEGER tapedef
22
23       INTEGER        longcles
24       PARAMETER(     longcles = 20 )
25       REAL clesphy0( longcles )
26c
27c   Declarations :
28c   --------------
29#include "dimensions.h"
30#include "paramet.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,*)    dissip_period
135      WRITE(tapeout,9001) ch1,'dissip_period'
136      WRITE(tapeout,*)    dissip_period
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
198ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
199c
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
254ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
255c     .........   (  modif  le 17/04/96 )   .........
256c
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
268c
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
317c
318c    alphax et alphay sont les anciennes formulat. des grossissements
319c
320c
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
341c
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     
390cc
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
414c
415      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
416
417      CLOSE(tapedef)
418
419      RETURN
420c   ...............................................
421c
422100   CONTINUE
423c
424      READ (tapedef,9001) ch1,ch4
425      READ (tapedef,*)    clon
426      WRITE(tapeout,9001) ch1,'clon'
427      WRITE(tapeout,*)    clon
428c
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
458c
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
478c
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
490c
4919000  FORMAT(3(/,a72))
4929001  FORMAT(/,a72,/,a12)
493cc
494      CLOSE(tapedef)
495
496      RETURN
497      END
Note: See TracBrowser for help on using the repository browser.