source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3dpar/defrun.F @ 4667

Last change on this file since 4667 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 14.1 KB
Line 
1!
2! $Id: defrun.F 1299 2010-01-20 14:27:21Z fhourdin $
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,*)    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,*)    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.