source: trunk/LMDZ.PLUTO/libf/dynphy_lonlat/phypluto/nogcm.F90 @ 3546

Last change on this file since 3546 was 3539, checked in by tbertrand, 2 weeks ago

LMDZ.PLUTO:
Update and Validation of the Volatile Transport Model (VTM, or "nogcm")
Merging missing elements with Pluto.old
TB

File size: 10.8 KB
Line 
1!
2! nogcm for Pluto, based on mars nogcm, 12/2024
3! Author: A. Falco, T. Bertrand
4!
5!
6PROGRAM nogcm
7
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
15
16#ifdef CPP_XIOS
17  ! ug Pour les sorties XIOS
18  USE wxios
19#endif
20
21  USE filtreg_mod
22  USE infotrac
23  USE control_mod, only: planet_type,nday,day_step,iperiod,iphysiq, &
24                             raz_date,anneeref,starttime,dayref,    &
25                             ok_dyn_ins,ok_dyn_ave,iecri,periodav,  &
26                             less1day,fractday,ndynstep,nsplit_phys
27  USE mod_const_mpi, ONLY: COMM_LMDZ
28  use cpdet_mod, only: ini_cpdet
29  USE temps_mod, ONLY: calend,start_time,annee_ref,day_ref, &
30                itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end
31
32
33!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
34! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
35! A nettoyer. On ne veut qu'une ou deux routines d'interface
36! dynamique -> physique pour l'initialisation
37! Ehouarn: the following are needed with (parallel) physics:
38#ifdef CPP_PHYS
39  USE iniphysiq_mod, ONLY: iniphysiq
40#endif
41
42  USE comconst_mod, ONLY: daysec,dtvr,dtphys,rad,g,r,cpp
43  USE logic_mod, ONLY: read_start,iflag_phys,ok_guide,ecripar
44
45!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
46
47  IMPLICIT NONE
48
49  !-----------------------------------------------------------------------
50  !   Declarations:
51  !   -------------
52
53  include "dimensions.h"
54  include "paramet.h"
55  include "comdissnew.h"
56  include "comgeom.h"
57!!!!!!!!!!!#include "control.h"
58!#include "com_io_dyn.h"
59  include "iniprint.h"
60  include "tracstoke.h"
61
62  REAL zdtvr
63
64  !   variables dynamiques
65  REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
66  REAL teta(ip1jmp1,llm)                 ! temperature potentielle
67  REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
68  REAL ps(ip1jmp1)                       ! pression  au sol
69  REAL p (ip1jmp1,llmp1  )               ! pression aux interfac.des couches
70  REAL masse(ip1jmp1,llm)                ! masse d'air
71  REAL phis(ip1jmp1)                     ! geopotentiel au sol
72  REAL phi(ip1jmp1,llm)                  ! geopotentiel
73  REAL w(ip1jmp1,llm)                    ! vitesse verticale
74
75  ! variables dynamiques intermediaire pour le transport
76
77  !   variables pour le fichier histoire
78  REAL dtav      ! intervalle de temps elementaire
79
80  REAL time_0
81
82  LOGICAL lafin
83  INTEGER ij,iq,l,i,j
84
85
86  real time_step, t_wrt, t_ops
87
88  LOGICAL first
89
90  REAL dhecdt(ip1jmp1,llm)
91  CHARACTER (len=15) :: ztit
92
93
94  character (len=80) :: dynhist_file, dynhistave_file
95  character (len=20) :: modname
96  character (len=80) :: abort_message
97  ! locales pour gestion du temps
98  INTEGER :: an, mois, jour
99  REAL :: heure
100  logical use_filtre_fft
101
102!-----------------------------------------------------------------------
103!   Initialisations:
104!   ----------------
105
106  abort_message = 'last timestep reached'
107  modname = 'gcm'
108  lafin    = .FALSE.
109  dynhist_file = 'dyn_hist.nc'
110  dynhistave_file = 'dyn_hist_ave.nc'
111
112
113
114!----------------------------------------------------------------------
115!  lecture des fichiers gcm.def ou run.def
116!  ---------------------------------------
117!
118  CALL conf_gcm( 99, .TRUE. )
119  if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm", &
120       "iphysiq must be a multiple of iperiod", 1)
121
122  use_filtre_fft=.FALSE.
123  CALL getin('use_filtre_fft',use_filtre_fft)
124  IF (use_filtre_fft) call abort_gcm("gcm",'FFT filter is not available in the ' &
125          // 'sequential version of the dynamics.', 1)
126
127!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
128! Initialisation de XIOS
129!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
130
131#ifdef CPP_XIOS
132  CALL wxios_init("LMDZ")
133#endif
134
135
136!
137! Initialisations pour Cp(T) Venus
138  call ini_cpdet
139!
140!-----------------------------------------------------------------------
141!   Choix du calendrier
142!   -------------------
143
144!      calend = 'earth_365d'
145
146#ifdef CPP_IOIPSL
147  if (calend == 'earth_360d') then
148    call ioconf_calendar('360d')
149    write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
150  endif
151#endif
152 
153  !------------------------------------
154  !   Initialisation partie parallele
155  !------------------------------------
156
157  !-----------------------------------------------------------------------
158  !   Initialisation des traceurs
159  !   ---------------------------
160  !  Choix du nombre de traceurs et du schema pour l'advection
161  !  dans fichier traceur.def, par default ou via INCA
162  call infotrac_init
163
164  ! Allocation de la tableau q : champs advectes   
165  allocate(q(ip1jmp1,llm,nqtot))
166
167  !-----------------------------------------------------------------------
168  !   Lecture de l'etat initial :
169  !   ---------------------------
170
171  !  lecture du fichier start.nc
172  if (read_start) then
173     ! we still need to run iniacademic to initialize some
174     ! constants & fields, if we run the 'newtonian' or 'SW' cases:
175     if (iflag_phys.ne.1) then
176        CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
177     endif
178
179     CALL dynetat0("start.nc",vcov,ucov, &
180                    teta,q,masse,ps,phis, time_0)
181       
182     ! Load relaxation fields (simple nudging). AS 09/2013
183     ! ---------------------------------------------------
184     if (planet_type.eq."generic") then
185       if (ok_guide) then
186         CALL relaxetat0("relax.nc")
187       endif
188     endif
189 
190  endif ! of if (read_start)
191
192
193  ! le cas echeant, creation d un etat initial
194  IF (prt_level > 9) WRITE(lunout,*) &
195       'NOGCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
196  if (.not.read_start) then
197     CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
198  endif
199
200
201  !-----------------------------------------------------------------------
202  !   Lecture des parametres de controle pour la simulation :
203  !   -------------------------------------------------------
204  !  on recalcule eventuellement le pas de temps
205
206  IF(MOD(day_step,iperiod).NE.0) THEN
207     abort_message = &
208       'Il faut choisir un nb de pas par jour multiple de iperiod'
209     call abort_gcm(modname,abort_message,1)
210  ENDIF
211
212!  IF(MOD(day_step,iphysiq).NE.0) THEN
213!     abort_message = &
214!       'Il faut choisir un nb de pas par jour multiple de iphysiq'
215!     call abort_gcm(modname,abort_message,1)
216!  ENDIF
217
218  zdtvr    = daysec/REAL(day_step)
219  IF(dtvr.NE.zdtvr) THEN
220     WRITE(lunout,*) &
221          'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
222  ENDIF
223
224  !
225  ! on remet le calendrier à zero si demande
226  !
227  IF (start_time /= starttime) then
228     WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
229     ,' fichier restart ne correspond pas à celle lue dans le run.def'
230     IF (raz_date == 1) then
231        WRITE(lunout,*)'Je prends l''heure lue dans run.def'
232        start_time = starttime
233     ELSE
234        call abort_gcm("gcm", "'Je m''arrete'", 1)
235     ENDIF
236  ENDIF
237  IF (raz_date == 1) THEN
238     annee_ref = anneeref
239     day_ref = dayref
240     day_ini = dayref
241     itau_dyn = 0
242     itau_phy = 0
243     time_0 = 0.
244     write(lunout,*) &
245         'GCM: On reinitialise a la date lue dans gcm.def'
246  ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
247     write(lunout,*) &
248        'GCM: Attention les dates initiales lues dans le fichier'
249     write(lunout,*) &
250        ' restart ne correspondent pas a celles lues dans '
251     write(lunout,*)' gcm.def'
252     write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
253     write(lunout,*)' day_ref=',day_ref," dayref=",dayref
254     write(lunout,*)' Pas de remise a zero'
255  ENDIF
256
257#ifdef CPP_IOIPSL
258  mois = 1
259  heure = 0.
260#else
261  ! Ehouarn: we still need to define JD_ref and JH_ref
262  ! and since we don't know how many days there are in a year
263  ! we set JD_ref to 0 (this should be improved ...)
264  jD_ref=0
265  jH_ref=0
266#endif
267
268  if (iflag_phys.eq.1) then
269     ! these initialisations have already been done (via iniacademic)
270     ! if running in SW or Newtonian mode
271     !-----------------------------------------------------------------------
272     !   Initialisation des constantes dynamiques :
273     !   ------------------------------------------
274     dtvr = zdtvr
275     CALL iniconst
276
277     !-----------------------------------------------------------------------
278     !   Initialisation de la geometrie :
279     !   --------------------------------
280     CALL inigeom
281
282     !-----------------------------------------------------------------------
283     !   Initialisation du filtre :
284     !   --------------------------
285     CALL inifilr
286  endif ! of if (iflag_phys.eq.1)
287  !
288  !-----------------------------------------------------------------------
289  !   Initialisation des I/O :
290  !   ------------------------
291
292  if (nday>=0) then ! standard case
293     day_end=day_ini+nday
294  else ! special case when nday <0, run -nday dynamical steps
295     day_end=day_ini-nday/day_step
296  endif
297  if (less1day) then
298     day_end=day_ini+floor(time_0+fractday)
299  endif
300  if (ndynstep.gt.0) then
301     day_end=day_ini+floor(time_0+float(ndynstep)/float(day_step))
302  endif
303     
304  WRITE(lunout,'(a,i7,a,i7)') &
305               "run from day ",day_ini,"  to day",day_end
306
307  !-----------------------------------------------------------------------
308  !   Initialisation de la physique :
309  !   -------------------------------
310
311  IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
312     ! Physics:
313#ifdef CPP_PHYS
314     CALL iniphysiq(iim,jjm,llm,              &
315          (jjm-1)*iim+2,comm_lmdz,            &
316          daysec,day_ini,dtphys/nsplit_phys,  &
317          rlatu,rlatv,rlonu,rlonv,aire,cu,cv, &
318          rad,g,r,cpp,iflag_phys)
319#endif
320  ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
321
322
323  ! Note that for Mars we transmit day_ini
324  CALL dynredem0("restart.nc", day_end, phis)
325  ecripar = .TRUE.
326
327#ifdef CPP_IOIPSL
328  time_step = zdtvr
329  if (ok_dyn_ins) then
330    ! initialize output file for instantaneous outputs
331    ! t_ops = iecri * daysec ! do operations every t_ops
332    t_ops =((1.0*iecri)/day_step) * daysec 
333    t_wrt = daysec ! iecri * daysec ! write output every t_wrt
334    CALL inithist(day_ref,annee_ref,time_step, &
335                   t_ops,t_wrt)
336  endif
337
338  IF (ok_dyn_ave) THEN
339    ! initialize output file for averaged outputs
340    t_ops = iperiod * time_step ! do operations every t_ops
341    t_wrt = periodav * daysec   ! write output every t_wrt
342    CALL initdynav(day_ref,annee_ref,time_step, &
343            t_ops,t_wrt)
344  END IF
345  dtav = iperiod*dtvr/daysec
346#endif
347! #endif of #ifdef CPP_IOIPSL
348
349  !  Choix des frequences de stokage pour le offline
350  !      istdyn=day_step/4     ! stockage toutes les 6h=1jour/4
351  !      istdyn=day_step/12     ! stockage toutes les 2h=1jour/12
352  istdyn=day_step/4     ! stockage toutes les 6h=1jour/12
353  istphy=istdyn/iphysiq     
354
355  !-----------------------------------------------------------------------
356  !   Integration temporelle du modele :
357  !   ----------------------------------
358
359  CALL leapfrog_nogcm(ucov,vcov,teta,ps,masse,phis,q,time_0)
360
361END PROGRAM nogcm
362
363
Note: See TracBrowser for help on using the repository browser.