source: LMDZ4/trunk/libf/dyn3dpar/conf_gcm.F @ 1323

Last change on this file since 1323 was 1323, checked in by Laurent Fairhead, 14 years ago

Changes made in r1293 are integrated into the trunk
Start files are identical between r1293 and this version


Les modifications de la r1293 sont intégrées à la trunk
Les fichiers start et startphy sont identiques entre la version 1293 et celle-ci

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 27.3 KB
Line 
1!
2! $Id: conf_gcm.F 1323 2010-03-12 16:19:12Z fairhead $
3!
4c
5c
6      SUBROUTINE conf_gcm( tapedef, etatinit, clesphy0 )
7c
8#ifdef CPP_IOIPSL
9      use IOIPSL
10#else
11! if not using IOIPSL, we still need to use (a local version of) getin
12      use ioipsl_getincom
13#endif
14      use misc_mod
15      use mod_filtre_fft, ONLY : use_filtre_fft
16      use mod_hallo, ONLY : use_mpi_alloc
17      use parallel, ONLY : omp_chunk
18      IMPLICIT NONE
19c-----------------------------------------------------------------------
20c     Auteurs :   L. Fairhead , P. Le Van  .
21c
22c     Arguments :
23c
24c     tapedef   :
25c     etatinit  :     = TRUE   , on ne  compare pas les valeurs des para-
26c     -metres  du zoom  avec  celles lues sur le fichier start .
27c      clesphy0 :  sortie  .
28c
29       LOGICAL etatinit
30       INTEGER tapedef
31
32       INTEGER        longcles
33       PARAMETER(     longcles = 20 )
34       REAL clesphy0( longcles )
35c
36c   Declarations :
37c   --------------
38#include "dimensions.h"
39#include "paramet.h"
40#include "control.h"
41#include "logic.h"
42#include "serre.h"
43#include "comdissnew.h"
44!#include "clesphys.h"
45#include "iniprint.h"
46#include "temps.h"
47#include "comconst.h"
48
49! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
50c
51c
52c   local:
53c   ------
54
55      CHARACTER ch1*72,ch2*72,ch3*72,ch4*12
56      REAL clonn,clatt,grossismxx,grossismyy
57      REAL dzoomxx,dzoomyy, tauxx,tauyy
58      LOGICAL  fxyhypbb, ysinuss
59      INTEGER i
60     
61c
62c  -------------------------------------------------------------------
63c
64c       .........     Version  du 29/04/97       ..........
65c
66c   Nouveaux parametres nitergdiv,nitergrot,niterh,tetagdiv,tetagrot,
67c      tetatemp   ajoutes  pour la dissipation   .
68c
69c   Autre parametre ajoute en fin de liste de tapedef : ** fxyhypb **
70c
71c  Si fxyhypb = .TRUE. , choix de la fonction a derivee tangente hyperb.
72c    Sinon , choix de fxynew  , a derivee sinusoidale  ..
73c
74c   ......  etatinit = . TRUE. si defrun  est appele dans ETAT0_LMD  ou
75c         LIMIT_LMD  pour l'initialisation de start.dat (dic) et
76c                de limit.dat ( dic)                        ...........
77c           Sinon  etatinit = . FALSE .
78c
79c   Donc etatinit = .F.  si on veut comparer les valeurs de  grossismx ,
80c    grossismy,clon,clat, fxyhypb  lues sur  le fichier  start  avec
81c   celles passees  par run.def ,  au debut du gcm, apres l'appel a
82c    lectba . 
83c   Ces parmetres definissant entre autres la grille et doivent etre
84c   pareils et coherents , sinon il y aura  divergence du gcm .
85c
86c-----------------------------------------------------------------------
87c   initialisations:
88c   ----------------
89      adjust=.false.
90      call getin('adjust',adjust)
91     
92      itaumax=0
93      call getin('itaumax',itaumax);
94      if (itaumax<=0) itaumax=HUGE(itaumax)
95     
96!Config  Key  = lunout
97!Config  Desc = unite de fichier pour les impressions
98!Config  Def  = 6
99!Config  Help = unite de fichier pour les impressions
100!Config         (defaut sortie standard = 6)
101      lunout=6
102      CALL getin('lunout', lunout)
103      IF (lunout /= 5 .and. lunout /= 6) THEN
104        OPEN(lunout,FILE='lmdz.out')
105      ENDIF
106
107!Config  Key  = prt_level
108!Config  Desc = niveau d'impressions de débogage
109!Config  Def  = 0
110!Config  Help = Niveau d'impression pour le débogage
111!Config         (0 = minimum d'impression)
112      prt_level = 0
113      CALL getin('prt_level',prt_level)
114
115c-----------------------------------------------------------------------
116c  Parametres de controle du run:
117c-----------------------------------------------------------------------
118!Config  Key  = planet_type
119!Config  Desc = planet type ("earth", "mars", "venus", ...)
120!Config  Def  = earth
121!Config  Help = this flag sets the type of atymosphere that is considered
122      planet_type="earth"
123      CALL getin('planet_type',planet_type)
124
125!Config  Key  = calend
126!Config  Desc = type de calendrier utilise
127!Config  Def  = earth_360d
128!Config  Help = valeur possible: earth_360d, earth_365d, earth_366d
129!Config         
130      calend = 'earth_360d'
131      CALL getin('calend', calend)
132
133!Config  Key  = dayref
134!Config  Desc = Jour de l'etat initial
135!Config  Def  = 1
136!Config  Help = Jour de l'etat initial ( = 350  si 20 Decembre ,
137!Config         par expl. ,comme ici ) ... A completer
138      dayref=1
139      CALL getin('dayref', dayref)
140
141!Config  Key  = anneeref
142!Config  Desc = Annee de l'etat initial
143!Config  Def  = 1998
144!Config  Help = Annee de l'etat  initial
145!Config         (   avec  4  chiffres   ) ... A completer
146      anneeref = 1998
147      CALL getin('anneeref',anneeref)
148
149!Config  Key  = raz_date
150!Config  Desc = Remise a zero de la date initiale
151!Config  Def  = 0 (pas de remise a zero)
152!Config  Help = Remise a zero de la date initiale
153!Config         0 pas de remise a zero, on garde la date du fichier restart
154!Config         1 prise en compte de la date de gcm.def avec remise a zero
155!Config         des compteurs de pas de temps
156      raz_date = 0
157      CALL getin('raz_date', raz_date)
158
159!Config  Key  = nday
160!Config  Desc = Nombre de jours d'integration
161!Config  Def  = 10
162!Config  Help = Nombre de jours d'integration
163!Config         ... On pourait aussi permettre des mois ou des annees !
164      nday = 10
165      CALL getin('nday',nday)
166
167!Config  Key  = day_step
168!Config  Desc = nombre de pas par jour
169!Config  Def  = 240
170!Config  Help = nombre de pas par jour (multiple de iperiod) (
171!Config          ici pour  dt = 1 min )
172       day_step = 240
173       CALL getin('day_step',day_step)
174
175!Config  Key  = iperiod
176!Config  Desc = periode pour le pas Matsuno
177!Config  Def  = 5
178!Config  Help = periode pour le pas Matsuno (en pas de temps)
179       iperiod = 5
180       CALL getin('iperiod',iperiod)
181
182!Config  Key  = iapp_tracvl
183!Config  Desc = frequence du groupement des flux
184!Config  Def  = iperiod
185!Config  Help = frequence du groupement des flux (en pas de temps)
186       iapp_tracvl = iperiod
187       CALL getin('iapp_tracvl',iapp_tracvl)
188
189!Config  Key  = iconser
190!Config  Desc = periode de sortie des variables de controle
191!Config  Def  = 240 
192!Config  Help = periode de sortie des variables de controle
193!Config         (En pas de temps)
194       iconser = 240 
195       CALL getin('iconser', iconser)
196
197!Config  Key  = iecri
198!Config  Desc = periode d'ecriture du fichier histoire
199!Config  Def  = 1
200!Config  Help = periode d'ecriture du fichier histoire (en jour)
201       iecri = 1
202       CALL getin('iecri',iecri)
203
204
205!Config  Key  = periodav
206!Config  Desc = periode de stockage fichier histmoy
207!Config  Def  = 1
208!Config  Help = periode de stockage fichier histmoy (en jour)
209       periodav = 1.
210       CALL getin('periodav',periodav)
211
212!Config  Key  = output_grads_dyn
213!Config  Desc = output dynamics diagnostics in 'dyn.dat' file
214!Config  Def  = n
215!Config  Help = output dynamics diagnostics in Grads-readable 'dyn.dat' file
216       output_grads_dyn=.false.
217       CALL getin('output_grads_dyn',output_grads_dyn)
218
219!Config  Key  = idissip
220!Config  Desc = periode de la dissipation
221!Config  Def  = 10
222!Config  Help = periode de la dissipation
223!Config         (en pas) ... a completer !
224       idissip = 10
225       CALL getin('idissip',idissip)
226
227ccc  ....   P. Le Van , modif le 29/04/97 .pour la dissipation  ...
228ccc
229
230!Config  Key  = lstardis
231!Config  Desc = choix de l'operateur de dissipation
232!Config  Def  = y
233!Config  Help = choix de l'operateur de dissipation
234!Config         'y' si on veut star et 'n' si on veut non-start !
235!Config         Moi y en a pas comprendre !
236       lstardis = .TRUE.
237       CALL getin('lstardis',lstardis)
238
239
240!Config  Key  = nitergdiv
241!Config  Desc = Nombre d'iteration de gradiv
242!Config  Def  = 1
243!Config  Help = nombre d'iterations de l'operateur de dissipation
244!Config         gradiv
245       nitergdiv = 1
246       CALL getin('nitergdiv',nitergdiv)
247
248!Config  Key  = nitergrot
249!Config  Desc = nombre d'iterations de nxgradrot
250!Config  Def  = 2
251!Config  Help = nombre d'iterations de l'operateur de dissipation 
252!Config         nxgradrot
253       nitergrot = 2
254       CALL getin('nitergrot',nitergrot)
255
256
257!Config  Key  = niterh
258!Config  Desc = nombre d'iterations de divgrad
259!Config  Def  = 2
260!Config  Help = nombre d'iterations de l'operateur de dissipation
261!Config         divgrad
262       niterh = 2
263       CALL getin('niterh',niterh)
264
265
266!Config  Key  = tetagdiv
267!Config  Desc = temps de dissipation pour div
268!Config  Def  = 7200
269!Config  Help = temps de dissipation des plus petites longeur
270!Config         d'ondes pour u,v (gradiv)
271       tetagdiv = 7200.
272       CALL getin('tetagdiv',tetagdiv)
273
274!Config  Key  = tetagrot
275!Config  Desc = temps de dissipation pour grad
276!Config  Def  = 7200
277!Config  Help = temps de dissipation des plus petites longeur
278!Config         d'ondes pour u,v (nxgradrot)
279       tetagrot = 7200.
280       CALL getin('tetagrot',tetagrot)
281
282!Config  Key  = tetatemp
283!Config  Desc = temps de dissipation pour h
284!Config  Def  = 7200
285!Config  Help =  temps de dissipation des plus petites longeur
286!Config         d'ondes pour h (divgrad)   
287       tetatemp  = 7200.
288       CALL getin('tetatemp',tetatemp )
289
290! Parametres controlant la variation sur la verticale des constantes de
291! dissipation.
292! Pour le moment actifs uniquement dans la version a 39 niveaux
293! avec ok_strato=y
294
295       dissip_factz=4.
296       dissip_deltaz=10.
297       dissip_zref=30.
298       CALL getin('dissip_factz',dissip_factz )
299       CALL getin('dissip_deltaz',dissip_deltaz )
300       CALL getin('dissip_zref',dissip_zref )
301
302       iflag_top_bound=1
303       tau_top_bound=1.e-5
304       CALL getin('iflag_top_bound',iflag_top_bound)
305       CALL getin('tau_top_bound',tau_top_bound)
306
307!
308!Config  Key  = coefdis
309!Config  Desc = coefficient pour gamdissip
310!Config  Def  = 0
311!Config  Help = coefficient pour gamdissip 
312       coefdis = 0.
313       CALL getin('coefdis',coefdis)
314
315!Config  Key  = purmats
316!Config  Desc = Schema d'integration
317!Config  Def  = n
318!Config  Help = Choix du schema d'integration temporel.
319!Config         y = pure Matsuno sinon c'est du Matsuno-leapfrog
320       purmats = .FALSE.
321       CALL getin('purmats',purmats)
322
323!Config  Key  = ok_guide
324!Config  Desc = Guidage
325!Config  Def  = n
326!Config  Help = Guidage
327       ok_guide = .FALSE.
328       CALL getin('ok_guide',ok_guide)
329
330c    ...............................................................
331
332!Config  Key  =  read_start
333!Config  Desc = Initialize model using a 'start.nc' file
334!Config  Def  = y
335!Config  Help = y: intialize dynamical fields using a 'start.nc' file
336!               n: fields are initialized by 'iniacademic' routine
337       read_start= .true.
338       CALL getin('read_start',read_start)
339
340!Config  Key  = iflag_phys
341!Config  Desc = Avec ls physique
342!Config  Def  = 1
343!Config  Help = Permet de faire tourner le modele sans
344!Config         physique.
345       iflag_phys = 1
346       CALL getin('iflag_phys',iflag_phys)
347
348
349!Config  Key  =  iphysiq
350!Config  Desc = Periode de la physique
351!Config  Def  = 5
352!Config  Help = Periode de la physique en pas de temps de la dynamique.
353       iphysiq = 5
354       CALL getin('iphysiq', iphysiq)
355
356!Config  Key  = ip_ebil_dyn
357!Config  Desc = PRINT level for energy conserv. diag.
358!Config  Def  = 0
359!Config  Help = PRINT level for energy conservation diag. ;
360!               les options suivantes existent :
361!Config         0 pas de print
362!Config         1 pas de print
363!Config         2 print,
364       ip_ebil_dyn = 0
365       CALL getin('ip_ebil_dyn',ip_ebil_dyn)
366!
367
368
369ccc  ....   P. Le Van , ajout  le 7/03/95 .pour le zoom ...
370c     .........   (  modif  le 17/04/96 )   .........
371c
372      IF( etatinit ) GO TO 100
373
374!Config  Key  = clon
375!Config  Desc = centre du zoom, longitude
376!Config  Def  = 0
377!Config  Help = longitude en degres du centre
378!Config         du zoom
379       clonn = 0.
380       CALL getin('clon',clonn)
381
382!Config  Key  = clat
383!Config  Desc = centre du zoom, latitude
384!Config  Def  = 0
385!Config  Help = latitude en degres du centre du zoom
386!Config         
387       clatt = 0.
388       CALL getin('clat',clatt)
389
390c
391c
392      IF( ABS(clat - clatt).GE. 0.001 )  THEN
393        write(lunout,*)'conf_gcm: La valeur de clat passee par run.def',
394     &    ' est differente de celle lue sur le fichier  start '
395        STOP
396      ENDIF
397
398!Config  Key  = grossismx
399!Config  Desc = zoom en longitude
400!Config  Def  = 1.0
401!Config  Help = facteur de grossissement du zoom,
402!Config         selon la longitude
403       grossismxx = 1.0
404       CALL getin('grossismx',grossismxx)
405
406
407      IF( ABS(grossismx - grossismxx).GE. 0.001 )  THEN
408        write(lunout,*)'conf_gcm: La valeur de grossismx passee par ',
409     &  'run.def est differente de celle lue sur le fichier  start '
410        STOP
411      ENDIF
412
413!Config  Key  = grossismy
414!Config  Desc = zoom en latitude
415!Config  Def  = 1.0
416!Config  Help = facteur de grossissement du zoom,
417!Config         selon la latitude
418       grossismyy = 1.0
419       CALL getin('grossismy',grossismyy)
420
421      IF( ABS(grossismy - grossismyy).GE. 0.001 )  THEN
422        write(lunout,*)'conf_gcm: La valeur de grossismy passee par ',
423     & 'run.def est differente de celle lue sur le fichier  start '
424        STOP
425      ENDIF
426     
427      IF( grossismx.LT.1. )  THEN
428        write(lunout,*)
429     &       'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
430         STOP
431      ELSE
432         alphax = 1. - 1./ grossismx
433      ENDIF
434
435
436      IF( grossismy.LT.1. )  THEN
437        write(lunout,*)
438     &       'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
439         STOP
440      ELSE
441         alphay = 1. - 1./ grossismy
442      ENDIF
443
444      write(lunout,*)'conf_gcm: alphax alphay',alphax,alphay
445c
446c    alphax et alphay sont les anciennes formulat. des grossissements
447c
448c
449
450!Config  Key  = fxyhypb
451!Config  Desc = Fonction  hyperbolique
452!Config  Def  = y
453!Config  Help = Fonction  f(y)  hyperbolique  si = .true. 
454!Config         sinon  sinusoidale
455       fxyhypbb = .TRUE.
456       CALL getin('fxyhypb',fxyhypbb)
457
458      IF( .NOT.fxyhypb )  THEN
459         IF( fxyhypbb )     THEN
460            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
461            write(lunout,*)' *** fxyhypb lu sur le fichier start est ',
462     *       'F alors  qu il est  T  sur  run.def  ***'
463              STOP
464         ENDIF
465      ELSE
466         IF( .NOT.fxyhypbb )   THEN
467            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
468            write(lunout,*)' ***  fxyhypb lu sur le fichier start est ',
469     *        'T alors  qu il est  F  sur  run.def  ****  '
470              STOP
471         ENDIF
472      ENDIF
473c
474!Config  Key  = dzoomx
475!Config  Desc = extension en longitude
476!Config  Def  = 0
477!Config  Help = extension en longitude  de la zone du zoom 
478!Config         ( fraction de la zone totale)
479       dzoomxx = 0.0
480       CALL getin('dzoomx',dzoomxx)
481
482      IF( fxyhypb )  THEN
483       IF( ABS(dzoomx - dzoomxx).GE. 0.001 )  THEN
484        write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ',
485     *  'run.def est differente de celle lue sur le fichier  start '
486        STOP
487       ENDIF
488      ENDIF
489
490!Config  Key  = dzoomy
491!Config  Desc = extension en latitude
492!Config  Def  = 0
493!Config  Help = extension en latitude de la zone  du zoom 
494!Config         ( fraction de la zone totale)
495       dzoomyy = 0.0
496       CALL getin('dzoomy',dzoomyy)
497
498      IF( fxyhypb )  THEN
499       IF( ABS(dzoomy - dzoomyy).GE. 0.001 )  THEN
500        write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ',
501     * 'run.def est differente de celle lue sur le fichier  start '
502        STOP
503       ENDIF
504      ENDIF
505     
506!Config  Key  = taux
507!Config  Desc = raideur du zoom en  X
508!Config  Def  = 3
509!Config  Help = raideur du zoom en  X
510       tauxx = 3.0
511       CALL getin('taux',tauxx)
512
513      IF( fxyhypb )  THEN
514       IF( ABS(taux - tauxx).GE. 0.001 )  THEN
515        write(lunout,*)'conf_gcm: La valeur de taux passee par ',
516     * 'run.def est differente de celle lue sur le fichier  start '
517        STOP
518       ENDIF
519      ENDIF
520
521!Config  Key  = tauyy
522!Config  Desc = raideur du zoom en  Y
523!Config  Def  = 3
524!Config  Help = raideur du zoom en  Y
525       tauyy = 3.0
526       CALL getin('tauy',tauyy)
527
528      IF( fxyhypb )  THEN
529       IF( ABS(tauy - tauyy).GE. 0.001 )  THEN
530        write(lunout,*)'conf_gcm: La valeur de tauy passee par ',
531     * 'run.def est differente de celle lue sur le fichier  start '
532        STOP
533       ENDIF
534      ENDIF
535
536cc
537      IF( .NOT.fxyhypb  )  THEN
538
539!Config  Key  = ysinus
540!Config  IF   = !fxyhypb
541!Config  Desc = Fonction en Sinus
542!Config  Def  = y
543!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true.
544!Config         sinon y = latit.
545       ysinuss = .TRUE.
546       CALL getin('ysinus',ysinuss)
547
548        IF( .NOT.ysinus )  THEN
549          IF( ysinuss )     THEN
550            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
551            write(lunout,*)' *** ysinus lu sur le fichier start est F',
552     *       ' alors  qu il est  T  sur  run.def  ***'
553            STOP
554          ENDIF
555        ELSE
556          IF( .NOT.ysinuss )   THEN
557            write(lunout,*)' ********  PBS DANS  CONF_GCM  ******** '
558            write(lunout,*)' *** ysinus lu sur le fichier start est T',
559     *        ' alors  qu il est  F  sur  run.def  ****  '
560              STOP
561          ENDIF
562        ENDIF
563      ENDIF ! of IF( .NOT.fxyhypb  )
564c
565!Config  Key  = offline
566!Config  Desc = Nouvelle eau liquide
567!Config  Def  = n
568!Config  Help = Permet de mettre en route la
569!Config         nouvelle parametrisation de l'eau liquide !
570       offline = .FALSE.
571       CALL getin('offline',offline)
572
573!Config  Key  = config_inca
574!Config  Desc = Choix de configuration de INCA
575!Config  Def  = none
576!Config  Help = Choix de configuration de INCA :
577!Config         'none' = sans INCA
578!Config         'chem' = INCA avec calcul de chemie
579!Config         'aero' = INCA avec calcul des aerosols
580      config_inca = 'none'
581      CALL getin('config_inca',config_inca)
582
583!Config  Key  = ok_dynzon
584!Config  Desc = calcul et sortie des transports
585!Config  Def  = n
586!Config  Help = Permet de mettre en route le calcul des transports
587!Config         
588      ok_dynzon = .FALSE.
589      CALL getin('ok_dynzon',ok_dynzon)
590
591
592      write(lunout,*)' #########################################'
593      write(lunout,*)' Configuration des parametres du gcm: '
594      write(lunout,*)' planet_type = ', planet_type
595      write(lunout,*)' calend = ', calend
596      write(lunout,*)' dayref = ', dayref
597      write(lunout,*)' anneeref = ', anneeref
598      write(lunout,*)' nday = ', nday
599      write(lunout,*)' day_step = ', day_step
600      write(lunout,*)' iperiod = ', iperiod
601      write(lunout,*)' iconser = ', iconser
602      write(lunout,*)' iecri = ', iecri
603      write(lunout,*)' periodav = ', periodav
604      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
605      write(lunout,*)' idissip = ', idissip
606      write(lunout,*)' lstardis = ', lstardis
607      write(lunout,*)' nitergdiv = ', nitergdiv
608      write(lunout,*)' nitergrot = ', nitergrot
609      write(lunout,*)' niterh = ', niterh
610      write(lunout,*)' tetagdiv = ', tetagdiv
611      write(lunout,*)' tetagrot = ', tetagrot
612      write(lunout,*)' tetatemp = ', tetatemp
613      write(lunout,*)' coefdis = ', coefdis
614      write(lunout,*)' purmats = ', purmats
615      write(lunout,*)' read_start = ', read_start
616      write(lunout,*)' iflag_phys = ', iflag_phys
617      write(lunout,*)' iphysiq = ', iphysiq
618      write(lunout,*)' clonn = ', clonn
619      write(lunout,*)' clatt = ', clatt
620      write(lunout,*)' grossismx = ', grossismx
621      write(lunout,*)' grossismy = ', grossismy
622      write(lunout,*)' fxyhypbb = ', fxyhypbb
623      write(lunout,*)' dzoomxx = ', dzoomxx
624      write(lunout,*)' dzoomy = ', dzoomyy
625      write(lunout,*)' tauxx = ', tauxx
626      write(lunout,*)' tauyy = ', tauyy
627      write(lunout,*)' offline = ', offline
628      write(lunout,*)' config_inca = ', config_inca
629      write(lunout,*)' ok_dynzon = ', ok_dynzon
630
631      RETURN
632c   ...............................................
633c
634100   CONTINUE
635!Config  Key  = clon
636!Config  Desc = centre du zoom, longitude
637!Config  Def  = 0
638!Config  Help = longitude en degres du centre
639!Config         du zoom
640       clon = 0.
641       CALL getin('clon',clon)
642
643!Config  Key  = clat
644!Config  Desc = centre du zoom, latitude
645!Config  Def  = 0
646!Config  Help = latitude en degres du centre du zoom
647!Config         
648       clat = 0.
649       CALL getin('clat',clat)
650
651!Config  Key  = grossismx
652!Config  Desc = zoom en longitude
653!Config  Def  = 1.0
654!Config  Help = facteur de grossissement du zoom,
655!Config         selon la longitude
656       grossismx = 1.0
657       CALL getin('grossismx',grossismx)
658
659!Config  Key  = grossismy
660!Config  Desc = zoom en latitude
661!Config  Def  = 1.0
662!Config  Help = facteur de grossissement du zoom,
663!Config         selon la latitude
664       grossismy = 1.0
665       CALL getin('grossismy',grossismy)
666
667      IF( grossismx.LT.1. )  THEN
668        write(lunout,*)
669     &   'conf_gcm: ***  ATTENTION !! grossismx < 1 .   *** '
670         STOP
671      ELSE
672         alphax = 1. - 1./ grossismx
673      ENDIF
674
675
676      IF( grossismy.LT.1. )  THEN
677        write(lunout,*)
678     &  'conf_gcm: ***  ATTENTION !! grossismy < 1 .   *** '
679         STOP
680      ELSE
681         alphay = 1. - 1./ grossismy
682      ENDIF
683
684      write(lunout,*)'conf_gcm: alphax alphay ',alphax,alphay
685c
686c    alphax et alphay sont les anciennes formulat. des grossissements
687c
688c
689
690!Config  Key  = fxyhypb
691!Config  Desc = Fonction  hyperbolique
692!Config  Def  = y
693!Config  Help = Fonction  f(y)  hyperbolique  si = .true. 
694!Config         sinon  sinusoidale
695       fxyhypb = .TRUE.
696       CALL getin('fxyhypb',fxyhypb)
697
698!Config  Key  = dzoomx
699!Config  Desc = extension en longitude
700!Config  Def  = 0
701!Config  Help = extension en longitude  de la zone du zoom 
702!Config         ( fraction de la zone totale)
703       dzoomx = 0.0
704       CALL getin('dzoomx',dzoomx)
705
706!Config  Key  = dzoomy
707!Config  Desc = extension en latitude
708!Config  Def  = 0
709!Config  Help = extension en latitude de la zone  du zoom 
710!Config         ( fraction de la zone totale)
711       dzoomy = 0.0
712       CALL getin('dzoomy',dzoomy)
713
714!Config  Key  = taux
715!Config  Desc = raideur du zoom en  X
716!Config  Def  = 3
717!Config  Help = raideur du zoom en  X
718       taux = 3.0
719       CALL getin('taux',taux)
720
721!Config  Key  = tauy
722!Config  Desc = raideur du zoom en  Y
723!Config  Def  = 3
724!Config  Help = raideur du zoom en  Y
725       tauy = 3.0
726       CALL getin('tauy',tauy)
727
728!Config  Key  = ysinus
729!Config  IF   = !fxyhypb
730!Config  Desc = Fonction en Sinus
731!Config  Def  = y
732!Config  Help = Fonction  f(y) avec y = Sin(latit.) si = .true.
733!Config         sinon y = latit.
734       ysinus = .TRUE.
735       CALL getin('ysinus',ysinus)
736c
737!Config  Key  = offline
738!Config  Desc = Nouvelle eau liquide
739!Config  Def  = n
740!Config  Help = Permet de mettre en route la
741!Config         nouvelle parametrisation de l'eau liquide !
742       offline = .FALSE.
743       CALL getin('offline',offline)
744
745!Config  Key  = config_inca
746!Config  Desc = Choix de configuration de INCA
747!Config  Def  = none
748!Config  Help = Choix de configuration de INCA :
749!Config         'none' = sans INCA
750!Config         'chem' = INCA avec calcul de chemie
751!Config         'aero' = INCA avec calcul des aerosols
752      config_inca = 'none'
753      CALL getin('config_inca',config_inca)
754
755!Config  Key  = ok_dynzon
756!Config  Desc = calcul et sortie des transports
757!Config  Def  = n
758!Config  Help = Permet de mettre en route le calcul des transports
759!Config         
760      ok_dynzon = .FALSE.
761      CALL getin('ok_dynzon',ok_dynzon)
762
763!Config  Key  = use_filtre_fft
764!Config  Desc = flag d'activation des FFT pour le filtre
765!Config  Def  = false
766!Config  Help = permet d'activer l'utilisation des FFT pour effectuer
767!Config         le filtrage aux poles.
768      use_filtre_fft=.FALSE.
769      CALL getin('use_filtre_fft',use_filtre_fft)
770
771      IF (use_filtre_fft .AND. grossismx /= 1.0) THEN
772        write(lunout,*)'WARNING !!! '
773        write(lunout,*)"Le zoom en longitude est incompatible",
774     &                 " avec l'utilisation du filtre FFT ",
775     &                 "---> filtre FFT désactivé "
776       use_filtre_fft=.FALSE.
777      ENDIF
778     
779 
780     
781!Config  Key  = use_mpi_alloc
782!Config  Desc = Utilise un buffer MPI en m�moire globale
783!Config  Def  = false
784!Config  Help = permet d'activer l'utilisation d'un buffer MPI
785!Config         en m�moire globale a l'aide de la fonction MPI_ALLOC.
786!Config         Cela peut am�liorer la bande passante des transferts MPI
787!Config         d'un facteur 2 
788      use_mpi_alloc=.FALSE.
789      CALL getin('use_mpi_alloc',use_mpi_alloc)
790
791!Config  Key  = omp_chunk
792!Config  Desc = taille des blocs openmp
793!Config  Def  = 1
794!Config  Help = defini la taille des packets d'it�ration openmp
795!Config         distribu�e � chaque t�che lors de l'entr�e dans une
796!Config         boucle parall�lis�e
797 
798      omp_chunk=1
799      CALL getin('omp_chunk',omp_chunk)
800
801!Config key = ok_strato
802!Config  Desc = activation de la version strato
803!Config  Def  = .FALSE.
804!Config  Help = active la version stratosphérique de LMDZ de F. Lott
805
806      ok_strato=.FALSE.
807      CALL getin('ok_strato',ok_strato)
808
809!Config  Key  = ok_gradsfile
810!Config  Desc = activation des sorties grads du guidage
811!Config  Def  = n
812!Config  Help = active les sorties grads du guidage
813
814       ok_gradsfile = .FALSE.
815       CALL getin('ok_gradsfile',ok_gradsfile)
816
817!Config  Key  = ok_limit
818!Config  Desc = creation des fichiers limit dans create_etat0_limit
819!Config  Def  = y
820!Config  Help = production du fichier limit.nc requise
821
822       ok_limit = .TRUE.
823       CALL getin('ok_limit',ok_limit)
824
825!Config  Key  = ok_etat0
826!Config  Desc = creation des fichiers etat0 dans create_etat0_limit
827!Config  Def  = y
828!Config  Help = production des fichiers start.nc, startphy.nc requise
829
830      ok_etat0 = .TRUE.
831      CALL getin('ok_etat0',ok_etat0)
832
833      write(lunout,*)' #########################################'
834      write(lunout,*)' Configuration des parametres de cel0'
835     &             //'_limit: '
836      write(lunout,*)' planet_type = ', planet_type
837      write(lunout,*)' calend = ', calend
838      write(lunout,*)' dayref = ', dayref
839      write(lunout,*)' anneeref = ', anneeref
840      write(lunout,*)' nday = ', nday
841      write(lunout,*)' day_step = ', day_step
842      write(lunout,*)' iperiod = ', iperiod
843      write(lunout,*)' iconser = ', iconser
844      write(lunout,*)' iecri = ', iecri
845      write(lunout,*)' periodav = ', periodav
846      write(lunout,*)' output_grads_dyn = ', output_grads_dyn
847      write(lunout,*)' idissip = ', idissip
848      write(lunout,*)' lstardis = ', lstardis
849      write(lunout,*)' nitergdiv = ', nitergdiv
850      write(lunout,*)' nitergrot = ', nitergrot
851      write(lunout,*)' niterh = ', niterh
852      write(lunout,*)' tetagdiv = ', tetagdiv
853      write(lunout,*)' tetagrot = ', tetagrot
854      write(lunout,*)' tetatemp = ', tetatemp
855      write(lunout,*)' coefdis = ', coefdis
856      write(lunout,*)' purmats = ', purmats
857      write(lunout,*)' read_start = ', read_start
858      write(lunout,*)' iflag_phys = ', iflag_phys
859      write(lunout,*)' iphysiq = ', iphysiq
860      write(lunout,*)' clon = ', clon
861      write(lunout,*)' clat = ', clat
862      write(lunout,*)' grossismx = ', grossismx
863      write(lunout,*)' grossismy = ', grossismy
864      write(lunout,*)' fxyhypb = ', fxyhypb
865      write(lunout,*)' dzoomx = ', dzoomx
866      write(lunout,*)' dzoomy = ', dzoomy
867      write(lunout,*)' taux = ', taux
868      write(lunout,*)' tauy = ', tauy
869      write(lunout,*)' offline = ', offline
870      write(lunout,*)' config_inca = ', config_inca
871      write(lunout,*)' ok_dynzon = ', ok_dynzon
872      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
873      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc
874      write(lunout,*)' omp_chunk = ', omp_chunk
875      write(lunout,*)' ok_strato = ', ok_strato
876      write(lunout,*)' ok_gradsfile = ', ok_gradsfile
877      write(lunout,*)' ok_limit = ', ok_limit
878      write(lunout,*)' ok_etat0 = ', ok_etat0
879c
880      RETURN
881      END
Note: See TracBrowser for help on using the repository browser.