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

Last change on this file since 13 was 2, checked in by lmdz, 25 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 13.1 KB
Line 
1      SUBROUTINE defrun_new( tapedef, etatinit, clesphy0 )
2c
3      IMPLICIT NONE
4c-----------------------------------------------------------------------
5c     Auteurs :   L. Fairhead , P. Le Van  .
6c
7c     Arguments :
8c
9c     tapedef   :
10c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
11c     -metres  du zoom  avec  celles lues sur le fichier start .
12c      clesphy0 :  sortie  .
13c
14       LOGICAL etatinit
15       INTEGER tapedef
16
17       INTEGER        longcles
18       PARAMETER(     longcles = 20 )
19       REAL clesphy0( longcles )
20c
21c   Declarations :
22c   --------------
23#include "dimensions.h"
24#include "paramet.h"
25#include "control.h"
26#include "logic.h"
27#include "serre.h"
28#include "comdissnew.h"
29#include "clesph0.h"
30c
31c
32c   local:
33c   ------
34
35      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
36      INTEGER   tapeout
37      REAL clonn,clatt,grossismxx,grossismyy
38      REAL dzoomxx,dzoomyy
39      LOGICAL  fxyhypbb, ysinuss
40      INTEGER i
41     
42c
43c  -------------------------------------------------------------------
44c
45c       .........     Version  du 29/04/97       ..........
46c
47c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
48c      tetatemp   ajoutes  pour la dissipation   .
49c
50c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
51c
52c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
53c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
54c
55c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
56c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
57c                de limit.dat ( dic)                        ...........
58c           Sinon  etatinit = . FALSE .
59c
60c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
61c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
62c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
63c    lectba . 
64c   Ces parmetres definissant entre autres la grille et doivent etre
65c   pareils et coherents , sinon il y aura  divergence du gcm .
66c
67c-----------------------------------------------------------------------
68c   initialisations:
69c   ----------------
70
71      tapeout = 6
72
73c-----------------------------------------------------------------------
74c  Parametres de controle du run:
75c-----------------------------------------------------------------------
76
77      OPEN( tapedef,file ='run.def',status='old',form='formatted')
78
79
80      READ (tapedef,9000) ch1,ch2,ch3
81      WRITE(tapeout,9000) ch1,ch2,ch3
82
83      READ (tapedef,9001) ch1,ch4
84      WRITE(tapeout,9001) ch1,'dayref'
85      READ (tapedef,*)    dayref
86      WRITE(tapeout,9001) ch1,'dayref'
87      WRITE(tapeout,*)    dayref
88
89      READ (tapedef,9001) ch1,ch4
90      READ (tapedef,*)    anneeref
91      WRITE(tapeout,9001) ch1,'anneeref'
92      WRITE(tapeout,*)    anneeref
93
94      READ (tapedef,9001) ch1,ch4
95      READ (tapedef,*)    nday
96      WRITE(tapeout,9001) ch1,'nday'
97      WRITE(tapeout,*)    nday
98
99      READ (tapedef,9001) ch1,ch4
100      READ (tapedef,*)    day_step
101      WRITE(tapeout,9001) ch1,'day_step'
102      WRITE(tapeout,*)    day_step
103
104      READ (tapedef,9001) ch1,ch4
105      READ (tapedef,*)    iperiod
106      WRITE(tapeout,9001) ch1,'iperiod'
107      WRITE(tapeout,*)    iperiod
108
109      READ (tapedef,9001) ch1,ch4
110      READ (tapedef,*)    iconser
111      WRITE(tapeout,9001) ch1,'iconser'
112      WRITE(tapeout,*)    iconser
113
114      READ (tapedef,9001) ch1,ch4
115      READ (tapedef,*)    iecri
116      WRITE(tapeout,9001) ch1,'iecri'
117      WRITE(tapeout,*)    iecri
118
119      READ (tapedef,9001) ch1,ch4
120      READ (tapedef,*)    periodav
121      WRITE(tapeout,9001) ch1,'periodav'
122      WRITE(tapeout,*)    periodav
123
124      READ (tapedef,9001) ch1,ch4
125      READ (tapedef,*)    idissip
126      WRITE(tapeout,9001) ch1,'idissip'
127      WRITE(tapeout,*)    idissip
128
129ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
130ccc
131      READ (tapedef,9001) ch1,ch4
132      READ (tapedef,*)    lstardis
133      WRITE(tapeout,9001) ch1,'lstardis'
134      WRITE(tapeout,*)    lstardis
135
136      READ (tapedef,9001) ch1,ch4
137      READ (tapedef,*)    nitergdiv
138      WRITE(tapeout,9001) ch1,'nitergdiv'
139      WRITE(tapeout,*)    nitergdiv
140
141      READ (tapedef,9001) ch1,ch4
142      READ (tapedef,*)    nitergrot
143      WRITE(tapeout,9001) ch1,'nitergrot'
144      WRITE(tapeout,*)    nitergrot
145
146      READ (tapedef,9001) ch1,ch4
147      READ (tapedef,*)    niterh
148      WRITE(tapeout,9001) ch1,'niterh'
149      WRITE(tapeout,*)    niterh
150
151      READ (tapedef,9001) ch1,ch4
152      READ (tapedef,*)    tetagdiv
153      WRITE(tapeout,9001) ch1,'tetagdiv'
154      WRITE(tapeout,*)    tetagdiv
155
156      READ (tapedef,9001) ch1,ch4
157      READ (tapedef,*)    tetagrot
158      WRITE(tapeout,9001) ch1,'tetagrot'
159      WRITE(tapeout,*)    tetagrot
160
161      READ (tapedef,9001) ch1,ch4
162      READ (tapedef,*)    tetatemp
163      WRITE(tapeout,9001) ch1,'tetatemp'
164      WRITE(tapeout,*)    tetatemp
165
166      READ (tapedef,9001) ch1,ch4
167      READ (tapedef,*)    coefdis
168      WRITE(tapeout,9001) ch1,'coefdis'
169      WRITE(tapeout,*)    coefdis
170c
171      READ (tapedef,9001) ch1,ch4
172      READ (tapedef,*)    purmats
173      WRITE(tapeout,9001) ch1,'purmats'
174      WRITE(tapeout,*)    purmats
175
176c    ...............................................................
177
178      READ (tapedef,9001) ch1,ch4
179      READ (tapedef,*)    physic
180      WRITE(tapeout,9001) ch1,'physic'
181      WRITE(tapeout,*)    physic
182
183      READ (tapedef,9001) ch1,ch4
184      READ (tapedef,*)    iphysiq
185      WRITE(tapeout,9001) ch1,'iphysiq'
186      WRITE(tapeout,*)    iphysiq
187
188
189ccc   .... P.Le Van, ajout le 03/01/96 pour l'ecriture phys ...
190c
191      READ (tapedef,9001) ch1,ch4
192      READ (tapedef,*)    ecritphy
193      WRITE(tapeout,9001) ch1,'ecritphy'
194      WRITE(tapeout,*)    ecritphy
195
196      READ (tapedef,9001) ch1,ch4
197      READ (tapedef,*)    cycle_diurne
198      WRITE(tapeout,9001) ch1,'cycle_diurne'
199      WRITE(tapeout,*)    cycle_diurne
200
201      READ (tapedef,9001) ch1,ch4
202      READ (tapedef,*)    soil_model
203      WRITE(tapeout,9001) ch1,'soil_model'
204      WRITE(tapeout,*)    soil_model
205
206      READ (tapedef,9001) ch1,ch4
207      READ (tapedef,*)    new_oliq
208      WRITE(tapeout,9001) ch1,'new_oliq'
209      WRITE(tapeout,*)    new_oliq
210
211      READ (tapedef,9001) ch1,ch4
212      READ (tapedef,*)    ok_orodr
213      WRITE(tapeout,9001) ch1,'ok_orodr'
214      WRITE(tapeout,*)    ok_orodr
215
216      READ (tapedef,9001) ch1,ch4
217      READ (tapedef,*)    ok_orolf
218      WRITE(tapeout,9001) ch1,'ok_orolf'
219      WRITE(tapeout,*)    ok_orolf
220
221      READ (tapedef,9001) ch1,ch4
222      READ (tapedef,*)    ok_limitvrai
223      WRITE(tapeout,9001) ch1,'ok_limitvrai'
224      WRITE(tapeout,*)    ok_limitvrai
225
226      READ (tapedef,9001) ch1,ch4
227      READ (tapedef,*)    nbapp_rad
228      WRITE(tapeout,9001) ch1,'nbapp_rad'
229      WRITE(tapeout,*)    nbapp_rad
230
231      READ (tapedef,9001) ch1,ch4
232      READ (tapedef,*)    iflag_con
233      WRITE(tapeout,9001) ch1,'iflag_con'
234      WRITE(tapeout,*)    iflag_con
235
236      DO i = 1, longcles
237       clesphy0(i) = 0.
238      ENDDO
239                          clesphy0(1) = FLOAT( iflag_con )
240                          clesphy0(2) = FLOAT( nbapp_rad )
241
242       IF( cycle_diurne  ) clesphy0(3) =  1.
243       IF(   soil_model  ) clesphy0(4) =  1.
244       IF(     new_oliq  ) clesphy0(5) =  1.
245       IF(     ok_orodr  ) clesphy0(6) =  1.
246       IF(     ok_orolf  ) clesphy0(7) =  1.
247       IF(  ok_limitvrai ) clesphy0(8) =  1.
248
249
250ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
251c     .........   (  modif  le 17/04/96 )   .........
252c
253      IF( etatinit ) GO TO 100
254
255      READ (tapedef,9001) ch1,ch4
256      READ (tapedef,*)    clonn
257      WRITE(tapeout,9001) ch1,'clon'
258      WRITE(tapeout,*)    clonn
259      IF( ABS(clon - clonn).GE. 0.001 )  THEN
260        PRINT *,' La valeur de clon passee par run.def est differente de
261     *  celle lue sur le fichier  start '
262        STOP
263      ENDIF
264c
265c
266      READ (tapedef,9001) ch1,ch4
267      READ (tapedef,*)    clatt
268      WRITE(tapeout,9001) ch1,'clat'
269      WRITE(tapeout,*)    clatt
270
271      IF( ABS(clat - clatt).GE. 0.001 )  THEN
272        PRINT *,' La valeur de clat passee par run.def est differente de
273     *  celle lue sur le fichier  start '
274        STOP
275      ENDIF
276
277      READ (tapedef,9001) ch1,ch4
278      READ (tapedef,*)    grossismxx
279      WRITE(tapeout,9001) ch1,'grossismx'
280      WRITE(tapeout,*)    grossismxx
281
282      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
283        PRINT *,' La valeur de grossismx passee par run.def est differente 
284     *  de celle lue sur le fichier  start '
285        STOP
286      ENDIF
287
288      READ (tapedef,9001) ch1,ch4
289      READ (tapedef,*)    grossismyy
290      WRITE(tapeout,9001) ch1,'grossismy'
291      WRITE(tapeout,*)    grossismyy
292
293      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
294        PRINT *,' La valeur de grossismy passee par run.def est differen
295     * te de celle lue sur le fichier  start '
296        STOP
297      ENDIF
298     
299      IF( grossismx.LT.1. )  THEN
300        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
301         STOP
302      ELSE
303         alphax = 1. - 1./ grossismx
304      ENDIF
305
306
307      IF( grossismy.LT.1. )  THEN
308        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
309         STOP
310      ELSE
311         alphay = 1. - 1./ grossismy
312      ENDIF
313
314      PRINT *,' alphax alphay defrun ',alphax,alphay
315c
316c    alphax et alphay sont les anciennes formulat. des grossissements
317c
318c
319      READ (tapedef,9001) ch1,ch4
320      READ (tapedef,*)    fxyhypbb
321      WRITE(tapeout,9001) ch1,'fxyhypbb'
322      WRITE(tapeout,*)    fxyhypbb
323
324      IF( .NOT.fxyhypb )  THEN
325           IF( fxyhypbb )     THEN
326              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
327              PRINT *,' *** fxyhypb lu sur le fichier start est F ',
328     *       'alors  qu il est  T  sur  run.def  ***'
329              STOP
330           ENDIF
331      ELSE
332           IF( .NOT.fxyhypbb )   THEN
333              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
334              PRINT *,' ***  fxyhypb lu sur le fichier start est T ',
335     *        'alors  qu il est  F  sur  run.def  ****  '
336              STOP
337           ENDIF
338      ENDIF
339c
340      READ (tapedef,9001) ch1,ch4
341      READ (tapedef,*)    dzoomxx
342      WRITE(tapeout,9001) ch1,'dzoomx'
343      WRITE(tapeout,*)    dzoomxx
344
345      IF( fxyhypb )  THEN
346       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
347        PRINT *,' La valeur de dzoomx passee par run.def est differente
348     *  de celle lue sur le fichier  start '
349        STOP
350       ENDIF
351      ENDIF
352
353      READ (tapedef,9001) ch1,ch4
354      READ (tapedef,*)    dzoomyy
355      WRITE(tapeout,9001) ch1,'dzoomy'
356      WRITE(tapeout,*)    dzoomyy
357
358      IF( fxyhypb )  THEN
359       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
360        PRINT *,' La valeur de dzoomy passee par run.def est differente
361     * de celle lue sur le fichier  start '
362        STOP
363       ENDIF
364      ENDIF
365     
366cc
367      IF( .NOT.fxyhypb  )  THEN
368        READ (tapedef,9001) ch1,ch4
369        READ (tapedef,*)    ysinuss
370        WRITE(tapeout,9001) ch1,'ysinus'
371        WRITE(tapeout,*)    ysinuss
372
373
374        IF( .NOT.ysinus )  THEN
375           IF( ysinuss )     THEN
376              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
377              PRINT *,' *** ysinus lu sur le fichier start est F ',
378     *       'alors  qu il est  T  sur  run.def  ***'
379              STOP
380           ENDIF
381        ELSE
382           IF( .NOT.ysinuss )   THEN
383              PRINT *,' ********  PBS DANS  DEFRUN  ******** '
384              PRINT *,' ***  ysinus lu sur le fichier start est T ',
385     *        'alors  qu il est  F  sur  run.def  ****  '
386              STOP
387           ENDIF
388        ENDIF
389      ENDIF
390c
391      close(tapedef)
392      RETURN
393c   ...............................................
394c
395100   CONTINUE
396c
397      READ (tapedef,9001) ch1,ch4
398      READ (tapedef,*)    clon
399      WRITE(tapeout,9001) ch1,'clon'
400      WRITE(tapeout,*)    clon
401c
402      READ (tapedef,9001) ch1,ch4
403      READ (tapedef,*)    clat
404      WRITE(tapeout,9001) ch1,'clat'
405      WRITE(tapeout,*)    clat
406
407      READ (tapedef,9001) ch1,ch4
408      READ (tapedef,*)    grossismx
409      WRITE(tapeout,9001) ch1,'grossismx'
410      WRITE(tapeout,*)    grossismx
411
412      READ (tapedef,9001) ch1,ch4
413      READ (tapedef,*)    grossismy
414      WRITE(tapeout,9001) ch1,'grossismy'
415      WRITE(tapeout,*)    grossismy
416
417      IF( grossismx.LT.1. )  THEN
418        PRINT *,' ***  ATTENTION !! grossismx < 1 .   *** '
419         STOP
420      ELSE
421         alphax = 1. - 1./ grossismx
422      ENDIF
423
424      IF( grossismy.LT.1. )  THEN
425        PRINT *,' ***  ATTENTION !! grossismy < 1 .   *** '
426         STOP
427      ELSE
428         alphay = 1. - 1./ grossismy
429      ENDIF
430
431      PRINT *,' alphax alphay defrun ',alphax,alphay
432
433c
434      READ (tapedef,9001) ch1,ch4
435      READ (tapedef,*)    fxyhypb
436      WRITE(tapeout,9001) ch1,'fxyhypb'
437      WRITE(tapeout,*)    fxyhypb
438
439      READ (tapedef,9001) ch1,ch4
440      READ (tapedef,*)    dzoomx
441      WRITE(tapeout,9001) ch1,'dzoomx'
442      WRITE(tapeout,*)    dzoomx
443
444      READ (tapedef,9001) ch1,ch4
445      READ (tapedef,*)    dzoomy
446      WRITE(tapeout,9001) ch1,'dzoomy'
447      WRITE(tapeout,*)    dzoomy
448c
449      READ (tapedef,9001) ch1,ch4
450      READ (tapedef,*)    ysinus
451      WRITE(tapeout,9001) ch1,'ysinus'
452      WRITE(tapeout,*)    ysinus
453       
454c
4559000  FORMAT(3(/,a72))
4569001  FORMAT(/,a72,/,a12)
457cc
458      close(tapedef)
459      RETURN
460      END
Note: See TracBrowser for help on using the repository browser.