source: LMDZ5/trunk/libf/dyn3d/defrun.F @ 1940

Last change on this file since 1940 was 1930, checked in by lguez, 11 years ago

abort, dfloat and pause are not in the Fortran standard. Replaced
abort by abort_gcm and dfloat by dble. Note: I modified dyn3dpar files
that were identical to dyn3d modified files.

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.2 KB
RevLine 
[524]1!
[1403]2! $Id: defrun.F 1930 2014-01-17 16:45:09Z jghattas $
[524]3!
4c
5c
6      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7c
[1403]8      USE control_mod
9 
[524]10      IMPLICIT NONE
11c-----------------------------------------------------------------------
12c     Auteurs :   L. Fairhead , P. Le Van  .
13c
14c     Arguments :
15c
16c     tapedef   :
17c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
18c     -metres  du zoom  avec  celles lues sur le fichier start .
19c      clesphy0 :  sortie  .
20c
21       LOGICAL etatinit
22       INTEGER tapedef
23
24       INTEGER        longcles
25       PARAMETER(     longcles = 20 )
26       REAL clesphy0( longcles )
27c
28c   Declarations :
29c   --------------
30#include "dimensions.h"
31#include "paramet.h"
32#include "logic.h"
33#include "serre.h"
34#include "comdissnew.h"
35#include "clesph0.h"
36c
37c
38c   local:
39c   ------
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     
48c
49c  -------------------------------------------------------------------
50c
51c       .........     Version  du 29/04/97       ..........
52c
53c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
54c      tetatemp   ajoutes  pour la dissipation   .
55c
56c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
57c
58c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
59c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
60c
61c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
62c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
63c                de limit.dat ( dic)                        ...........
64c           Sinon  etatinit = . FALSE .
65c
66c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
67c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
68c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
69c    lectba . 
70c   Ces parmetres definissant entre autres la grille et doivent etre
71c   pareils et coherents , sinon il y aura  divergence du gcm .
72c
73c-----------------------------------------------------------------------
74c   initialisations:
75c   ----------------
76
77      tapeout = 6
78
79c-----------------------------------------------------------------------
80c  Parametres de controle du run:
81c-----------------------------------------------------------------------
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
[1502]135      READ (tapedef,*)    dissip_period
136      WRITE(tapeout,9001) ch1,'dissip_period'
137      WRITE(tapeout,*)    dissip_period
[524]138
139ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
140ccc
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
180c
181      READ (tapedef,9001) ch1,ch4
182      READ (tapedef,*)    purmats
183      WRITE(tapeout,9001) ch1,'purmats'
184      WRITE(tapeout,*)    purmats
185
186c    ...............................................................
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
[1403]242                          clesphy0(1) = REAL( iflag_con )
243                          clesphy0(2) = REAL( nbapp_rad )
[524]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
253ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
254c     .........   (  modif  le 17/04/96 )   .........
255c
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,*) ' La valeur de clon passee par run.def est diffe
264     *rente de  celle lue sur le fichier  start '
265        STOP
266      ENDIF
267c
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,*) ' La valeur de clat passee par run.def est diffe
275     *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,*) ' La valeur de grossismx passee par run.def est
286     , 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,*) ' La valeur de grossismy passee par run.def est
297     , 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
316c
317c    alphax et alphay sont les anciennes formulat. des grossissements
318c
319c
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
340c
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,*)' La valeur de dzoomx passee par run.def est dif
365     *ferente de celle lue sur le fichier  start '
[1930]366        CALL ABORT_gcm("defrun", "", 1)
[524]367       ENDIF
368
369       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
370        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
371     *ferente de celle lue sur le fichier  start '
[1930]372        CALL ABORT_gcm("defrun", "", 1)
[524]373       ENDIF
374
375       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
376        WRITE(6,*)' La valeur de taux passee par run.def est differente
377     *  de celle lue sur le fichier  start '
[1930]378        CALL ABORT_gcm("defrun", "", 1)
[524]379       ENDIF
380
381       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
382        WRITE(6,*)' La valeur de tauy passee par run.def est differente
383     *  de celle lue sur le fichier  start '
[1930]384        CALL ABORT_gcm("defrun", "", 1)
[524]385       ENDIF
386
387      ENDIF
388     
389cc
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
413c
414      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
415
416      CLOSE(tapedef)
417
418      RETURN
419c   ...............................................
420c
421100   CONTINUE
422c
423      READ (tapedef,9001) ch1,ch4
424      READ (tapedef,*)    clon
425      WRITE(tapeout,9001) ch1,'clon'
426      WRITE(tapeout,*)    clon
427c
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
457c
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
477c
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
489c
4909000  FORMAT(3(/,a72))
4919001  FORMAT(/,a72,/,a12)
492cc
493      CLOSE(tapedef)
494
495      RETURN
496      END
Note: See TracBrowser for help on using the repository browser.