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

Last change on this file since 5133 was 5128, checked in by abarral, 5 months ago

Correct bug in vlspltqs_loc.f90 from r2270 where we call SSUM with incorrect arguments.
Merge the three different versions of abort_gcm into one
Fix seq, para 3D compilation broken from r5107 onwards
(lint) usual + Remove uneeded fixed-form continuations

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