source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/gcm.F90 @ 5172

Last change on this file since 5172 was 5159, checked in by abarral, 5 months ago

Put dimensions.h and paramet.h into modules

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Id
File size: 15.0 KB
Line 
1
2! $Id: gcm.F90 5159 2024-08-02 19:58:25Z abarral $
3
4PROGRAM gcm
5
6  USE IOIPSL
7
8  USE mod_const_mpi, ONLY: init_const_mpi
9  USE parallel_lmdz
10  USE infotrac, ONLY: nqtot, init_infotrac
11  USE mod_hallo
12  USE Bands
13  USE lmdz_filtreg
14  USE control_mod
15
16
17  USE iniphysiq_mod, ONLY: iniphysiq
18  USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_PHYS
19
20  USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, g, r, rad
21  USE logic_mod ! all of it, because of copyin clause when calling leapfrog
22  USE temps_mod, ONLY: calend,start_time,annee_ref,day_ref, &
23                       itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end, &
24                       dt,hour_ini,itaufin
25  USE mod_xios_dyn3dmem, ONLY: xios_dyn3dmem_init
26  USE lmdz_filtreg, ONLY: inifilr
27  USE lmdz_description, ONLY: descript
28  USE lmdz_iniprint, ONLY: lunout, prt_level
29  USE lmdz_comdissnew, ONLY: lstardis, nitergdiv, nitergrot, niterh, tetagdiv, &
30          tetagrot, tetatemp, coefdis, vert_prof_dissip
31  USE lmdz_comgeom
32  USE lmdz_tracstoke
33
34  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
35  USE lmdz_paramet
36  IMPLICIT NONE
37
38  !      ......   Version  du 10/01/98    ..........
39
40  !             avec  coordonnees  verticales hybrides
41  !   avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
42
43  !=======================================================================
44
45  !   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
46  !   -------
47
48  !   Objet:
49  !   ------
50
51  !   GCM LMD nouvelle grille
52
53  !=======================================================================
54
55  !  ... Dans inigeom , nouveaux calculs pour les elongations  cu , cv
56  !      et possibilite d'appeler une fonction f(y)  a derivee tangente
57  !      hyperbolique a la  place de la fonction a derivee sinusoidale.
58  !  ... Possibilite de choisir le schema pour l'advection de
59  !        q  , en modifiant iadv dans traceur.def  (MAF,10/02) .
60
61  !      Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
62  !      Pour Van-Leer iadv=10
63
64  !-----------------------------------------------------------------------
65  !   Declarations:
66  !   -------------
67
68
69
70  REAL zdtvr
71
72  !   variables dynamiques
73  REAL,ALLOCATABLE,SAVE  :: vcov(:,:),ucov(:,:) ! vents covariants
74  REAL,ALLOCATABLE,SAVE  :: teta(:,:)     ! temperature potentielle
75  REAL, ALLOCATABLE,SAVE :: q(:,:,:)      ! champs advectes
76  REAL,ALLOCATABLE,SAVE  :: ps(:)         ! pression  au sol
77  !      REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
78  REAL,ALLOCATABLE,SAVE  :: masse(:,:)    ! masse d'air
79  REAL,ALLOCATABLE,SAVE  :: phis(:)       ! geopotentiel au sol
80  !      REAL phi(ip1jmp1,llm)                  ! geopotentiel
81  !      REAL w(ip1jmp1,llm)                    ! vitesse verticale
82
83  ! variables dynamiques intermediaire pour le transport
84
85  !   variables pour le fichier histoire
86  REAL dtav      ! intervalle de temps elementaire
87
88  REAL time_0
89
90  LOGICAL lafin
91
92  REAL time_step, t_wrt, t_ops
93
94  !+jld variables test conservation energie
95  !      REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
96  !     Tendance de la temp. potentiel d (theta)/ d t due a la
97  !     tansformation d'energie cinetique en energie thermique
98  !     cree par la dissipation
99  !      REAL dhecdt(ip1jmp1,llm)
100  !      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
101  !      REAL      d_h_vcol, d_qt, d_qw, d_ql, d_ec
102  !      CHARACTER (len=15) :: ztit
103  !-jld
104
105
106  CHARACTER (LEN=80) :: dynhist_file, dynhistave_file
107  CHARACTER (LEN=20) :: modname
108  CHARACTER (LEN=80) :: abort_message
109  ! locales pour gestion du temps
110  INTEGER :: an, mois, jour
111  REAL :: heure
112  ! needed for xios interface
113  CHARACTER (LEN=10) :: xios_cal_type
114  INTEGER :: anref, moisref, jourref
115  REAL :: heureref
116 
117
118
119  !-----------------------------------------------------------------------
120  !   Initialisations:
121  !   ----------------
122
123  abort_message = 'last timestep reached'
124  modname = 'gcm'
125  descript = 'Run GCM LMDZ'
126  lafin    = .FALSE.
127  dynhist_file = 'dyn_hist'
128  dynhistave_file = 'dyn_hist_ave'
129
130
131
132  !----------------------------------------------------------------------
133  !  lecture des fichiers gcm.def ou run.def
134  !  ---------------------------------------
135
136  CALL conf_gcm( 99, .TRUE. )
137  IF (mod(iphysiq, iperiod) /= 0) CALL abort_gcm("conf_gcm", &
138       "iphysiq must be a multiple of iperiod", 1)
139
140
141  !------------------------------------
142  !   Initialisation partie parallele
143  !------------------------------------
144  CALL init_const_mpi
145
146  CALL init_parallel
147  CALL Read_Distrib
148
149!#ifdef CPP_PHYS
150!  CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
151  !#endif
152  !      CALL set_bands
153  !#ifdef CPP_PHYS
154!  CALL Init_interface_dyn_phys
155!#endif
156  CALL barrier
157
158  CALL set_bands
159  IF (mpi_rank==0) CALL WriteBands
160  CALL Set_Distrib(distrib_caldyn)
161
162  !$OMP PARALLEL
163  CALL Init_Mod_hallo
164  !$OMP END PARALLEL
165
166  !#ifdef CPP_PHYS
167  !c$OMP PARALLEL
168  !      CALL InitComgeomphy ! now done in iniphysiq
169  !c$OMP END PARALLEL
170  !#endif
171
172  !-----------------------------------------------------------------------
173  !   Choix du calendrier
174  !   -------------------
175
176  !      calend = 'earth_365d'
177
178  IF (calend == 'earth_360d') THEN
179     CALL ioconf_calendar('360_day')
180     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
181     xios_cal_type='d360'
182  ELSE IF (calend == 'earth_365d') THEN
183     CALL ioconf_calendar('noleap')
184     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
185     xios_cal_type='noleap'
186  ELSE IF (calend == 'gregorian') THEN
187     CALL ioconf_calendar('gregorian')
188     WRITE(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
189     xios_cal_type='gregorian'
190  else
191     abort_message = 'Mauvais choix de calendrier'
192     CALL abort_gcm(modname,abort_message,1)
193  ENDIF
194
195
196  !-----------------------------------------------------------------------
197  !   Initialisation des traceurs
198  !   ---------------------------
199  !  Choix du nombre de traceurs et du schema pour l'advection
200  !  dans fichier traceur.def, par default ou via INCA
201  CALL init_infotrac
202
203  ! Allocation de la tableau q : champs advectes   
204  ALLOCATE(ucov(ijb_u:ije_u,llm))
205  ALLOCATE(vcov(ijb_v:ije_v,llm))
206  ALLOCATE(teta(ijb_u:ije_u,llm))
207  ALLOCATE(masse(ijb_u:ije_u,llm))
208  ALLOCATE(ps(ijb_u:ije_u))
209  ALLOCATE(phis(ijb_u:ije_u))
210  ALLOCATE(q(ijb_u:ije_u,llm,nqtot))
211
212  !-----------------------------------------------------------------------
213  !   Lecture de l'etat initial :
214  !   ---------------------------
215
216  !  lecture du fichier start.nc
217  IF (read_start) THEN
218     ! we still need to run iniacademic to initialize some
219     ! constants & fields, if we run the 'newtonian' or 'SW' cases:
220     IF (iflag_phys/=1) THEN
221        CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
222     endif
223
224     !        if (planet_type.EQ."earth") THEN
225     ! Load an Earth-format start file
226     CALL dynetat0_loc("start.nc",vcov,ucov, &
227          teta,q,masse,ps,phis, time_0)
228     !        endif ! of if (planet_type.EQ."earth")
229
230     !       WRITE(73,*) 'ucov',ucov
231     !       WRITE(74,*) 'vcov',vcov
232     !       WRITE(75,*) 'teta',teta
233     !       WRITE(76,*) 'ps',ps
234     !       WRITE(77,*) 'q',q
235
236  ENDIF ! of if (read_start)
237
238  ! le cas echeant, creation d un etat initial
239  IF (prt_level > 9) WRITE(lunout,*) &
240       'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
241  IF (.NOT.read_start) THEN
242     start_time=0.
243     annee_ref=anneeref
244     CALL iniacademic_loc(vcov,ucov,teta,q,masse,ps,phis,time_0)
245  ENDIF
246
247  !-----------------------------------------------------------------------
248  !   Lecture des parametres de controle pour la simulation :
249  !   -------------------------------------------------------
250  !  on recalcule eventuellement le pas de temps
251
252  IF(MOD(day_step,iperiod)/=0) THEN
253     abort_message =  &
254          'Il faut choisir un nb de pas par jour multiple de iperiod'
255     CALL abort_gcm(modname,abort_message,1)
256  ENDIF
257
258  IF(MOD(day_step,iphysiq)/=0) THEN
259     abort_message =  &
260          'Il faut choisir un nb de pas par jour multiple de iphysiq'
261     CALL abort_gcm(modname,abort_message,1)
262  ENDIF
263
264  zdtvr    = daysec/REAL(day_step)
265  IF(dtvr/=zdtvr) THEN
266     WRITE(lunout,*) &
267          'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
268  ENDIF
269
270  ! on remet le calendrier \`a zero si demande
271
272  IF (start_time /= starttime) THEN
273     WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
274          ,' fichier restart ne correspond pas a celle lue dans le run.def'
275     IF (raz_date == 1) THEN
276        WRITE(lunout,*)'Je prends l''heure lue dans run.def'
277        start_time = starttime
278     ELSE
279        WRITE(lunout,*)'Je m''arrete'
280        CALL abort
281     ENDIF
282  ENDIF
283  IF (raz_date == 1) THEN
284     annee_ref = anneeref
285     day_ref = dayref
286     day_ini = dayref
287     itau_dyn = 0
288     itau_phy = 0
289     time_0 = 0.
290     WRITE(lunout,*) &
291          'GCM: On reinitialise a la date lue dans gcm.def'
292  ELSE IF (annee_ref /= anneeref .OR. day_ref /= dayref) THEN
293     WRITE(lunout,*) &
294          'GCM: Attention les dates initiales lues dans le fichier'
295     WRITE(lunout,*) &
296          ' restart ne correspondent pas a celles lues dans '
297     WRITE(lunout,*)' gcm.def'
298     WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
299     WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
300     WRITE(lunout,*)' Pas de remise a zero'
301  ENDIF
302  !      if (annee_ref .NE. anneeref .OR. day_ref .NE. dayref) THEN
303  !        WRITE(lunout,*)
304  !     .  'GCM: Attention les dates initiales lues dans le fichier'
305  !        WRITE(lunout,*)
306  !     .  ' restart ne correspondent pas a celles lues dans '
307  !        WRITE(lunout,*)' gcm.def'
308  !        WRITE(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
309  !        WRITE(lunout,*)' day_ref=',day_ref," dayref=",dayref
310  !        if (raz_date .NE. 1) THEN
311  !          WRITE(lunout,*)
312  !     .    'GCM: On garde les dates du fichier restart'
313  !        else
314  !          annee_ref = anneeref
315  !          day_ref = dayref
316  !          day_ini = dayref
317  !          itau_dyn = 0
318  !          itau_phy = 0
319  !          time_0 = 0.
320  !          WRITE(lunout,*)
321  !     .   'GCM: On reinitialise a la date lue dans gcm.def'
322  !        endif
323  !      ELSE
324  !        raz_date = 0
325  !      endif
326
327  mois = 1
328  heure = 0.
329  CALL ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
330  jH_ref = jD_ref - int(jD_ref)
331  jD_ref = int(jD_ref)
332
333  CALL ioconf_startdate(INT(jD_ref), jH_ref)
334
335  WRITE(lunout,*)'DEBUG'
336  WRITE(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
337  WRITE(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
338  CALL ju2ymds(jD_ref+jH_ref,anref, moisref, jourref, heureref)
339  WRITE(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
340  WRITE(lunout,*)jD_ref+jH_ref,anref, moisref, jourref, heureref
341
342  IF (iflag_phys==1) THEN
343     ! these initialisations have already been done (via iniacademic)
344     ! if running in SW or Newtonian mode
345     !-----------------------------------------------------------------------
346     !   Initialisation des constantes dynamiques :
347     !   ------------------------------------------
348     dtvr = zdtvr
349     CALL iniconst
350
351     !-----------------------------------------------------------------------
352     !   Initialisation de la geometrie :
353     !   --------------------------------
354     CALL inigeom
355
356     !-----------------------------------------------------------------------
357     !   Initialisation du filtre :
358     !   --------------------------
359     CALL inifilr
360  ENDIF ! of if (iflag_phys.EQ.1)
361
362  !-----------------------------------------------------------------------
363  !   Initialisation de la dissipation :
364  !   ----------------------------------
365
366  CALL inidissip( lstardis, nitergdiv, nitergrot, niterh   , &
367       tetagdiv, tetagrot , tetatemp, vert_prof_dissip)
368
369  !-----------------------------------------------------------------------
370  !   Initialisation des I/O :
371  !   ------------------------
372
373
374  IF (nday>=0) THEN
375     day_end = day_ini + nday
376  else
377     day_end = day_ini - nday/day_step
378  ENDIF
379
380  WRITE(lunout,300)day_ini,day_end
381300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
382
383  CALL ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
384  write (lunout,301)jour, mois, an
385  CALL ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
386  write (lunout,302)jour, mois, an
387301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
388302 FORMAT('1'/,15x,'    au ', i2,'/',i2,'/',i4)
389
390  !-----------------------------------------------------------------------
391  !   Initialisation de la physique :
392  !   -------------------------------
393
394  !  Choix des frequences de stokage pour le offline
395  !      istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
396  !      istdyn=day_step/12     ! stockage toutes les 2h=1jour/12
397  istdyn=day_step/8     ! stockage toutes les 6h=1jour/12
398  istphy=istdyn/iphysiq
399
400  IF ((iflag_phys==1).OR.(iflag_phys>=100)) THEN
401     ! Physics:
402    IF (CPPKEY_PHYS) THEN
403      CALL iniphysiq(iim,jjm,llm, &
404            distrib_phys(mpi_rank),comm_lmdz, &
405            daysec,day_ini,dtphys/nsplit_phys, &
406            rlatu,rlatv,rlonu,rlonv,aire,cu,cv,rad,g,r,cpp, &
407            iflag_phys)
408    END IF
409  ENDIF ! of IF ((iflag_phys==1).OR.(iflag_phys>=100))
410
411
412  !      if (planet_type.EQ."earth") THEN
413  ! Write an Earth-format restart file
414  CALL dynredem0_loc("restart.nc", day_end, phis)
415  !      endif
416
417  ecripar = .TRUE.
418
419  time_step = zdtvr
420     IF (ok_dyn_ins) THEN
421        ! initialize output file for instantaneous outputs
422        ! t_ops = iecri * daysec ! do operations every t_ops
423        t_ops =((1.0*iecri)/day_step) * daysec
424        t_wrt = daysec ! iecri * daysec ! write output every t_wrt
425        CALL inithist_loc(day_ref,annee_ref,time_step, &
426             t_ops,t_wrt)
427     endif
428
429     IF (ok_dyn_ave) THEN
430        ! initialize output file for averaged outputs
431        t_ops = iperiod * time_step ! do operations every t_ops
432        t_wrt = periodav * daysec   ! write output every t_wrt
433        CALL initdynav_loc(day_ref,annee_ref,time_step,t_ops,t_wrt)
434     END IF
435  dtav = iperiod*dtvr/daysec
436
437! setting up DYN3D/XIOS inerface
438  IF (ok_dyn_xios) THEN
439      CALL xios_dyn3dmem_init(xios_cal_type, anref, moisref, jourref,heureref, an,   &
440          mois, jour, heure, zdtvr)
441  ENDIF
442
443  !-----------------------------------------------------------------------
444  !   Integration temporelle du modele :
445  !   ----------------------------------
446
447  !       WRITE(78,*) 'ucov',ucov
448  !       WRITE(78,*) 'vcov',vcov
449  !       WRITE(78,*) 'teta',teta
450  !       WRITE(78,*) 'ps',ps
451  !       WRITE(78,*) 'q',q
452
453  !!$OMP PARALLEL DEFAULT(SHARED) COPYIN(/temps/,/logici/,/logicl/)
454  !     Copy all threadprivate variables in temps_mod logic_mod
455  !$OMP PARALLEL DEFAULT(SHARED) &
456  !$OMP COPYIN(dt,jD_ref,jH_ref,start_time,hour_ini,day_ini,day_end) &
457  !$OMP COPYIN(annee_ref,day_ref,itau_dyn,itau_phy,itaufin,calend) &
458  !$OMP COPYIN(purmats,forward,leapf,apphys,statcl,conser,apdiss,apdelq) &
459  !$OMP COPYIN(saison,ecripar,fxyhypb,ysinus,read_start,ok_guide) &
460  !$OMP COPYIN(ok_strato,ok_gradsfile,ok_limit,ok_etat0) &
461  !$OMP COPYIN(iflag_phys,iflag_trac,adv_qsat_liq)
462  CALL leapfrog_loc(ucov,vcov,teta,ps,masse,phis,q,time_0)
463  !$OMP END PARALLEL
464
465  !      OPEN(unit=5487,file='ok_lmdz',status='replace')
466  !      WRITE(5487,*) 'ok_lmdz'
467  !      CLOSE(5487)
468END PROGRAM gcm
Note: See TracBrowser for help on using the repository browser.