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

Last change on this file since 5120 was 5118, checked in by abarral, 2 months ago

Replace iniprint.h by lmdz_iniprint.f90
(lint) along the way

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