source: LMDZ4/branches/LMDZ4_V2_patch/libf/dyn3d/defrun.F @ 5200

Last change on this file since 5200 was 524, checked in by lmdzadmin, 21 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.3 KB
Line 
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
198ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
199c
200      READ (tapedef,9001) ch1,ch4
201      READ (tapedef,*)    ecritphy
202      WRITE(tapeout,9001) ch1,'ecritphy'
203      WRITE(tapeout,*)    ecritphy
204
205      READ (tapedef,9001) ch1,ch4
206      READ (tapedef,*)    cycle_diurne
207      WRITE(tapeout,9001) ch1,'cycle_diurne'
208      WRITE(tapeout,*)    cycle_diurne
209
210      READ (tapedef,9001) ch1,ch4
211      READ (tapedef,*)    soil_model
212      WRITE(tapeout,9001) ch1,'soil_model'
213      WRITE(tapeout,*)    soil_model
214
215      READ (tapedef,9001) ch1,ch4
216      READ (tapedef,*)    new_oliq
217      WRITE(tapeout,9001) ch1,'new_oliq'
218      WRITE(tapeout,*)    new_oliq
219
220      READ (tapedef,9001) ch1,ch4
221      READ (tapedef,*)    ok_orodr
222      WRITE(tapeout,9001) ch1,'ok_orodr'
223      WRITE(tapeout,*)    ok_orodr
224
225      READ (tapedef,9001) ch1,ch4
226      READ (tapedef,*)    ok_orolf
227      WRITE(tapeout,9001) ch1,'ok_orolf'
228      WRITE(tapeout,*)    ok_orolf
229
230      READ (tapedef,9001) ch1,ch4
231      READ (tapedef,*)    ok_limitvrai
232      WRITE(tapeout,9001) ch1,'ok_limitvrai'
233      WRITE(tapeout,*)    ok_limitvrai
234
235      READ (tapedef,9001) ch1,ch4
236      READ (tapedef,*)    nbapp_rad
237      WRITE(tapeout,9001) ch1,'nbapp_rad'
238      WRITE(tapeout,*)    nbapp_rad
239
240      READ (tapedef,9001) ch1,ch4
241      READ (tapedef,*)    iflag_con
242      WRITE(tapeout,9001) ch1,'iflag_con'
243      WRITE(tapeout,*)    iflag_con
244
245      DO i = 1, longcles
246       clesphy0(i) = 0.
247      ENDDO
248                          clesphy0(1) = FLOAT( iflag_con )
249                          clesphy0(2) = FLOAT( nbapp_rad )
250
251       IF( cycle_diurne  ) clesphy0(3) =  1.
252       IF(   soil_model  ) clesphy0(4) =  1.
253       IF(     new_oliq  ) clesphy0(5) =  1.
254       IF(     ok_orodr  ) clesphy0(6) =  1.
255       IF(     ok_orolf  ) clesphy0(7) =  1.
256       IF(  ok_limitvrai ) clesphy0(8) =  1.
257
258
259ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
260c     .........   (  modif  le 17/04/96 )   .........
261c
262      IF( etatinit ) GO TO 100
263
264      READ (tapedef,9001) ch1,ch4
265      READ (tapedef,*)    clonn
266      WRITE(tapeout,9001) ch1,'clon'
267      WRITE(tapeout,*)    clonn
268      IF( ABS(clon - clonn).GE. 0.001 )  THEN
269       WRITE(tapeout,*) ' La valeur de clon passee par run.def est diffe
270     *rente de  celle lue sur le fichier  start '
271        STOP
272      ENDIF
273c
274      READ (tapedef,9001) ch1,ch4
275      READ (tapedef,*)    clatt
276      WRITE(tapeout,9001) ch1,'clat'
277      WRITE(tapeout,*)    clatt
278
279      IF( ABS(clat - clatt).GE. 0.001 )  THEN
280       WRITE(tapeout,*) ' La valeur de clat passee par run.def est diffe
281     *rente de  celle lue sur le fichier  start '
282        STOP
283      ENDIF
284
285      READ (tapedef,9001) ch1,ch4
286      READ (tapedef,*)    grossismxx
287      WRITE(tapeout,9001) ch1,'grossismx'
288      WRITE(tapeout,*)    grossismxx
289
290      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
291       WRITE(tapeout,*) ' La valeur de grossismx passee par run.def est
292     , differente de celle lue sur le fichier  start '
293        STOP
294      ENDIF
295
296      READ (tapedef,9001) ch1,ch4
297      READ (tapedef,*)    grossismyy
298      WRITE(tapeout,9001) ch1,'grossismy'
299      WRITE(tapeout,*)    grossismyy
300
301      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
302       WRITE(tapeout,*) ' La valeur de grossismy passee par run.def est
303     , differente de celle lue sur le fichier  start '
304        STOP
305      ENDIF
306     
307      IF( grossismx.LT.1. )  THEN
308        WRITE(tapeout,*) ' ***  ATTENTION !! grossismx < 1 .   *** '
309         STOP
310      ELSE
311         alphax = 1. - 1./ grossismx
312      ENDIF
313
314
315      IF( grossismy.LT.1. )  THEN
316        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
317         STOP
318      ELSE
319         alphay = 1. - 1./ grossismy
320      ENDIF
321
322c
323c    alphax et alphay sont les anciennes formulat. des grossissements
324c
325c
326      READ (tapedef,9001) ch1,ch4
327      READ (tapedef,*)    fxyhypbb
328      WRITE(tapeout,9001) ch1,'fxyhypbb'
329      WRITE(tapeout,*)    fxyhypbb
330
331      IF( .NOT.fxyhypb )  THEN
332           IF( fxyhypbb )     THEN
333            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
334            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est F'
335     *,      '                   alors  qu il est  T  sur  run.def  ***'
336              STOP
337           ENDIF
338      ELSE
339           IF( .NOT.fxyhypbb )   THEN
340            WRITE(tapeout,*) ' ********  PBS DANS  DEFRUN  ******** '
341            WRITE(tapeout,*)' *** fxyhypb lu sur le fichier start est t'
342     *,      '                   alors  qu il est  F  sur  run.def  ***'
343              STOP
344           ENDIF
345      ENDIF
346c
347      READ (tapedef,9001) ch1,ch4
348      READ (tapedef,*)    dzoomxx
349      WRITE(tapeout,9001) ch1,'dzoomx'
350      WRITE(tapeout,*)    dzoomxx
351
352      READ (tapedef,9001) ch1,ch4
353      READ (tapedef,*)    dzoomyy
354      WRITE(tapeout,9001) ch1,'dzoomy'
355      WRITE(tapeout,*)    dzoomyy
356
357      READ (tapedef,9001) ch1,ch4
358      READ (tapedef,*)    tauxx
359      WRITE(tapeout,9001) ch1,'taux'
360      WRITE(tapeout,*)    tauxx
361
362      READ (tapedef,9001) ch1,ch4
363      READ (tapedef,*)    tauyy
364      WRITE(tapeout,9001) ch1,'tauy'
365      WRITE(tapeout,*)    tauyy
366
367      IF( fxyhypb )  THEN
368
369       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
370        WRITE(tapeout,*)' La valeur de dzoomx passee par run.def est dif
371     *ferente de celle lue sur le fichier  start '
372        CALL ABORT
373       ENDIF
374
375       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
376        WRITE(tapeout,*)' La valeur de dzoomy passee par run.def est dif
377     *ferente de celle lue sur le fichier  start '
378        CALL ABORT
379       ENDIF
380
381       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
382        WRITE(6,*)' La valeur de taux passee par run.def est differente
383     *  de celle lue sur le fichier  start '
384        CALL ABORT
385       ENDIF
386
387       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
388        WRITE(6,*)' La valeur de tauy passee par run.def est differente
389     *  de celle lue sur le fichier  start '
390        CALL ABORT
391       ENDIF
392
393      ENDIF
394     
395cc
396      IF( .NOT.fxyhypb  )  THEN
397        READ (tapedef,9001) ch1,ch4
398        READ (tapedef,*)    ysinuss
399        WRITE(tapeout,9001) ch1,'ysinus'
400        WRITE(tapeout,*)    ysinuss
401
402
403        IF( .NOT.ysinus )  THEN
404           IF( ysinuss )     THEN
405              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
406              WRITE(tapeout,*)'** ysinus lu sur le fichier start est F',
407     *       ' alors  qu il est  T  sur  run.def  ***'
408              STOP
409           ENDIF
410        ELSE
411           IF( .NOT.ysinuss )   THEN
412              WRITE(6,*) ' ********  PBS DANS  DEFRUN  ******** '
413              WRITE(tapeout,*)'** ysinus lu sur le fichier start est T',
414     *       ' alors  qu il est  F  sur  run.def  ***'
415              STOP
416           ENDIF
417        ENDIF
418      ENDIF
419c
420      WRITE(6,*) ' alphax alphay defrun ',alphax,alphay
421
422      CLOSE(tapedef)
423
424      RETURN
425c   ...............................................
426c
427100   CONTINUE
428c
429      READ (tapedef,9001) ch1,ch4
430      READ (tapedef,*)    clon
431      WRITE(tapeout,9001) ch1,'clon'
432      WRITE(tapeout,*)    clon
433c
434      READ (tapedef,9001) ch1,ch4
435      READ (tapedef,*)    clat
436      WRITE(tapeout,9001) ch1,'clat'
437      WRITE(tapeout,*)    clat
438
439      READ (tapedef,9001) ch1,ch4
440      READ (tapedef,*)    grossismx
441      WRITE(tapeout,9001) ch1,'grossismx'
442      WRITE(tapeout,*)    grossismx
443
444      READ (tapedef,9001) ch1,ch4
445      READ (tapedef,*)    grossismy
446      WRITE(tapeout,9001) ch1,'grossismy'
447      WRITE(tapeout,*)    grossismy
448
449      IF( grossismx.LT.1. )  THEN
450        WRITE(tapeout,*) '***  ATTENTION !! grossismx < 1 .   *** '
451         STOP
452      ELSE
453         alphax = 1. - 1./ grossismx
454      ENDIF
455
456      IF( grossismy.LT.1. )  THEN
457        WRITE(tapeout,*) ' ***  ATTENTION !! grossismy < 1 .   *** '
458         STOP
459      ELSE
460         alphay = 1. - 1./ grossismy
461      ENDIF
462
463c
464      READ (tapedef,9001) ch1,ch4
465      READ (tapedef,*)    fxyhypb
466      WRITE(tapeout,9001) ch1,'fxyhypb'
467      WRITE(tapeout,*)    fxyhypb
468
469      READ (tapedef,9001) ch1,ch4
470      READ (tapedef,*)    dzoomx
471      WRITE(tapeout,9001) ch1,'dzoomx'
472      WRITE(tapeout,*)    dzoomx
473
474      READ (tapedef,9001) ch1,ch4
475      READ (tapedef,*)    dzoomy
476      WRITE(tapeout,9001) ch1,'dzoomy'
477      WRITE(tapeout,*)    dzoomy
478
479      READ (tapedef,9001) ch1,ch4
480      READ (tapedef,*)    taux
481      WRITE(tapeout,9001) ch1,'taux'
482      WRITE(tapeout,*)    taux
483c
484      READ (tapedef,9001) ch1,ch4
485      READ (tapedef,*)    tauy
486      WRITE(tapeout,9001) ch1,'tauy'
487      WRITE(tapeout,*)    tauy
488
489      READ (tapedef,9001) ch1,ch4
490      READ (tapedef,*)    ysinus
491      WRITE(tapeout,9001) ch1,'ysinus'
492      WRITE(tapeout,*)    ysinus
493       
494      WRITE(tapeout,*) ' alphax alphay defrun ',alphax,alphay
495c
4969000  FORMAT(3(/,a72))
4979001  FORMAT(/,a72,/,a12)
498cc
499      CLOSE(tapedef)
500
501      RETURN
502      END
Note: See TracBrowser for help on using the repository browser.