source: LMDZ.3.3/trunk/libf/dyn3d/defrun_new.F

Last change on this file was 207, checked in by lmdz, 24 years ago

petit detail
LF

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