source: LMDZ4/branches/LMDZ4V5.0-dev/libf/dyn3d/defrun.F @ 2654

Last change on this file since 2654 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
RevLine 
[524]1!
[1299]2! $Id: defrun.F 1299 2010-01-20 14:27:21Z jyg $
[524]3!
4c
5c
6      SUBROUTINE defrun( tapedef, etatinit, clesphy0 )
7c
[1299]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
135      READ (tapedef,*)    idissip
136      WRITE(tapeout,9001) ch1,'idissip'
137      WRITE(tapeout,*)    idissip
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
[1299]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 '
366        CALL ABORT
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 '
372        CALL ABORT
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 '
378        CALL ABORT
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 '
384        CALL ABORT
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.