source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/libf/dyn3d_common/defrun.F @ 298

Last change on this file since 298 was 222, checked in by ymipsl, 10 years ago

Creating temporary dynamico/lmdz/saturn branche

YM

File size: 14.5 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 
16      IMPLICIT NONE
17c-----------------------------------------------------------------------
18c     Auteurs :   L. Fairhead , P. Le Van  .
19c
20c     Arguments :
21c
22c     tapedef   :
23c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para- 
24c     -metres  du zoom  avec  celles lues sur le fichier start .
25c      clesphy0 :  sortie  .
26c
27       LOGICAL etatinit
28       INTEGER tapedef
29
30       INTEGER        longcles
31       PARAMETER(     longcles = 20 )
32       REAL clesphy0( longcles )
33c
34c   Declarations :
35c   --------------
36#include "dimensions.h"
37#include "paramet.h"
38#include "logic.h"
39#include "serre.h"
40#include "comdissnew.h"
41#include "clesph0.h"
42c
43c
44c   local:
45c   ------
46
47      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
48      INTEGER   tapeout
49      REAL clonn,clatt,grossismxx,grossismyy
50      REAL dzoomxx,dzoomyy,tauxx,tauyy
51      LOGICAL  fxyhypbb, ysinuss
52      INTEGER i
53     
54c
55c  -------------------------------------------------------------------
56c
57c       .........     Version  du 29/04/97       ..........
58c
59c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
60c      tetatemp   ajoutes  pour la dissipation   .
61c
62c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb ** 
63c
64c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
65c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
66c
67c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
68c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
69c                de limit.dat ( dic)                        ...........
70c           Sinon  etatinit = . FALSE .
71c
72c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
73c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
74c   celles passees  par run.def ,  au debut du gcm, apres l'appel a 
75c    lectba . 
76c   Ces parmetres definissant entre autres la grille et doivent etre
77c   pareils et coherents , sinon il y aura  divergence du gcm .
78c
79c-----------------------------------------------------------------------
80c   initialisations:
81c   ----------------
82
83      tapeout = 6
84
85c-----------------------------------------------------------------------
86c  Parametres de controle du run:
87c-----------------------------------------------------------------------
88
89      OPEN( tapedef,file ='gcm.def',status='old',form='formatted')
90
91
92      READ (tapedef,9000) ch1,ch2,ch3
93      WRITE(tapeout,9000) ch1,ch2,ch3
94
95      READ (tapedef,9001) ch1,ch4
96      READ (tapedef,*)    dayref
97      WRITE(tapeout,9001) ch1,'dayref'
98      WRITE(tapeout,*)    dayref
99
100      READ (tapedef,9001) ch1,ch4
101      READ (tapedef,*)    anneeref
102      WRITE(tapeout,9001) ch1,'anneeref'
103      WRITE(tapeout,*)    anneeref
104
105      READ (tapedef,9001) ch1,ch4
106      READ (tapedef,*)    nday
107      WRITE(tapeout,9001) ch1,'nday'
108      WRITE(tapeout,*)    nday
109
110      READ (tapedef,9001) ch1,ch4
111      READ (tapedef,*)    day_step
112      WRITE(tapeout,9001) ch1,'day_step'
113      WRITE(tapeout,*)    day_step
114
115      READ (tapedef,9001) ch1,ch4
116      READ (tapedef,*)    iperiod
117      WRITE(tapeout,9001) ch1,'iperiod'
118      WRITE(tapeout,*)    iperiod
119
120      READ (tapedef,9001) ch1,ch4
121      READ (tapedef,*)    iapp_tracvl
122      WRITE(tapeout,9001) ch1,'iapp_tracvl'
123      WRITE(tapeout,*)    iapp_tracvl
124
125      READ (tapedef,9001) ch1,ch4
126      READ (tapedef,*)    iconser
127      WRITE(tapeout,9001) ch1,'iconser'
128      WRITE(tapeout,*)    iconser
129
130      READ (tapedef,9001) ch1,ch4
131      READ (tapedef,*)    iecri
132      WRITE(tapeout,9001) ch1,'iecri'
133      WRITE(tapeout,*)    iecri
134
135      READ (tapedef,9001) ch1,ch4
136      READ (tapedef,*)    periodav
137      WRITE(tapeout,9001) ch1,'periodav'
138      WRITE(tapeout,*)    periodav
139
140      READ (tapedef,9001) ch1,ch4
141      READ (tapedef,*)    dissip_period
142      WRITE(tapeout,9001) ch1,'dissip_period'
143      WRITE(tapeout,*)    dissip_period
144
145ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
146ccc
147      READ (tapedef,9001) ch1,ch4
148      READ (tapedef,*)    lstardis
149      WRITE(tapeout,9001) ch1,'lstardis'
150      WRITE(tapeout,*)    lstardis
151
152      READ (tapedef,9001) ch1,ch4
153      READ (tapedef,*)    nitergdiv
154      WRITE(tapeout,9001) ch1,'nitergdiv'
155      WRITE(tapeout,*)    nitergdiv
156
157      READ (tapedef,9001) ch1,ch4
158      READ (tapedef,*)    nitergrot
159      WRITE(tapeout,9001) ch1,'nitergrot'
160      WRITE(tapeout,*)    nitergrot
161
162      READ (tapedef,9001) ch1,ch4
163      READ (tapedef,*)    niterh
164      WRITE(tapeout,9001) ch1,'niterh'
165      WRITE(tapeout,*)    niterh
166
167      READ (tapedef,9001) ch1,ch4
168      READ (tapedef,*)    tetagdiv
169      WRITE(tapeout,9001) ch1,'tetagdiv'
170      WRITE(tapeout,*)    tetagdiv
171
172      READ (tapedef,9001) ch1,ch4
173      READ (tapedef,*)    tetagrot
174      WRITE(tapeout,9001) ch1,'tetagrot'
175      WRITE(tapeout,*)    tetagrot
176
177      READ (tapedef,9001) ch1,ch4
178      READ (tapedef,*)    tetatemp
179      WRITE(tapeout,9001) ch1,'tetatemp'
180      WRITE(tapeout,*)    tetatemp
181
182      READ (tapedef,9001) ch1,ch4
183      READ (tapedef,*)    coefdis
184      WRITE(tapeout,9001) ch1,'coefdis'
185      WRITE(tapeout,*)    coefdis
186c
187      READ (tapedef,9001) ch1,ch4
188      READ (tapedef,*)    purmats
189      WRITE(tapeout,9001) ch1,'purmats'
190      WRITE(tapeout,*)    purmats
191
192c    ...............................................................
193
194      READ (tapedef,9001) ch1,ch4
195      READ (tapedef,*)    iflag_phys
196      WRITE(tapeout,9001) ch1,'iflag_phys'
197      WRITE(tapeout,*)    iflag_phys
198
199      READ (tapedef,9001) ch1,ch4
200      READ (tapedef,*)    iphysiq
201      WRITE(tapeout,9001) ch1,'iphysiq'
202      WRITE(tapeout,*)    iphysiq
203
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) = REAL( iflag_con )
249                          clesphy0(2) = REAL( 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_gcm("defrun", "", 1)
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_gcm("defrun", "", 1)
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_gcm("defrun", "", 1)
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_gcm("defrun", "", 1)
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.