GCC Code Coverage Report


Directory: ./
File: dyn/gcm.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 71 110 64.5%
Branches: 19 48 39.6%

Line Branch Exec Source
1 !
2 ! $Id: gcm.F90 3579 2019-10-09 13:11:07Z fairhead $
3 !
4 !
5 !
6 12 PROGRAM gcm
7
8 1 USE IOIPSL
9
10
11
12 USE filtreg_mod
13 USE infotrac
14 USE control_mod
15 USE mod_const_mpi, ONLY: COMM_LMDZ
16 USE temps_mod, ONLY: calend,start_time,annee_ref,day_ref, &
17 itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end
18 USE comconst_mod, ONLY: cpp, daysec, dtphys, dtvr, g, r, rad
19 USE logic_mod, ONLY: ecripar, iflag_phys, read_start
20
21 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
22 ! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
23 ! A nettoyer. On ne veut qu'une ou deux routines d'interface
24 ! dynamique -> physique pour l'initialisation
25 USE iniphysiq_mod, ONLY: iniphysiq
26 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
27
28 IMPLICIT NONE
29
30 ! ...... Version du 10/01/98 ..........
31
32 ! avec coordonnees verticales hybrides
33 ! avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
34
35 !=======================================================================
36 !
37 ! Auteur: P. Le Van /L. Fairhead/F.Hourdin
38 ! -------
39 !
40 ! Objet:
41 ! ------
42 !
43 ! GCM LMD nouvelle grille
44 !
45 !=======================================================================
46 !
47 ! ... Dans inigeom , nouveaux calculs pour les elongations cu , cv
48 ! et possibilite d'appeler une fonction f(y) a derivee tangente
49 ! hyperbolique a la place de la fonction a derivee sinusoidale.
50 ! ... Possibilite de choisir le schema pour l'advection de
51 ! q , en modifiant iadv dans traceur.def (MAF,10/02) .
52 !
53 ! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
54 ! Pour Van-Leer iadv=10
55 !
56 !-----------------------------------------------------------------------
57 ! Declarations:
58 ! -------------
59
60 include "dimensions.h"
61 include "paramet.h"
62 include "comdissnew.h"
63 include "comgeom.h"
64 include "description.h"
65 include "iniprint.h"
66 include "tracstoke.h"
67
68 REAL zdtvr
69
70 ! variables dynamiques
71 REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
72 REAL teta(ip1jmp1,llm) ! temperature potentielle
73 REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
74 REAL ps(ip1jmp1) ! pression au sol
75 ! REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches
76 REAL masse(ip1jmp1,llm) ! masse d'air
77 REAL phis(ip1jmp1) ! 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
91 real time_step, t_wrt, t_ops
92
93 ! LOGICAL call_iniphys
94 ! data call_iniphys/.true./
95
96 !+jld variables test conservation energie
97 ! REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
98 ! Tendance de la temp. potentiel d (theta)/ d t due a la
99 ! tansformation d'energie cinetique en energie thermique
100 ! cree par la dissipation
101 ! REAL dhecdt(ip1jmp1,llm)
102 ! REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
103 ! REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec
104 ! CHARACTER (len=15) :: ztit
105 !-jld
106
107
108 character (len=80) :: dynhist_file, dynhistave_file
109 character (len=20) :: modname
110 character (len=80) :: abort_message
111 ! locales pour gestion du temps
112 INTEGER :: an, mois, jour
113 REAL :: heure
114 logical use_filtre_fft
115
116 !-----------------------------------------------------------------------
117 ! Initialisations:
118 ! ----------------
119
120 1 abort_message = 'last timestep reached'
121 1 modname = 'gcm'
122 1 descript = 'Run GCM LMDZ'
123 lafin = .FALSE.
124 1 dynhist_file = 'dyn_hist.nc'
125 1 dynhistave_file = 'dyn_hist_ave.nc'
126
127
128
129 !----------------------------------------------------------------------
130 ! lecture des fichiers gcm.def ou run.def
131 ! ---------------------------------------
132 !
133 1 CALL conf_gcm( 99, .TRUE.)
134
135
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm", &
136 "iphysiq must be a multiple of iperiod", 1)
137
138 1 use_filtre_fft=.FALSE.
139 1 CALL getin('use_filtre_fft',use_filtre_fft)
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (use_filtre_fft) call abort_gcm("gcm", 'FFT filter is not available in ' &
141 // 'the sequential version of the dynamics.', 1)
142
143 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
144 ! Initialisation de XIOS
145 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
146
147
148
149 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
150 ! FH 2008/05/02
151 ! A nettoyer. On ne veut qu'une ou deux routines d'interface
152 ! dynamique -> physique pour l'initialisation
153 !#ifdef 1
154 ! CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
155 ! ! call InitComgeomphy ! now done in iniphysiq
156 !#endif
157 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
158 !-----------------------------------------------------------------------
159 ! Choix du calendrier
160 ! -------------------
161
162 ! calend = 'earth_365d'
163
164
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if (calend == 'earth_360d') then
165 1 call ioconf_calendar('360d')
166 1 write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
167 else if (calend == 'earth_365d') then
168 call ioconf_calendar('noleap')
169 write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
170 else if (calend == 'gregorian') then
171 call ioconf_calendar('gregorian')
172 write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
173 else
174 abort_message = 'Mauvais choix de calendrier'
175 call abort_gcm(modname,abort_message,1)
176 endif
177 !-----------------------------------------------------------------------
178 !
179 !
180 !------------------------------------
181 ! Initialisation partie parallele
182 !------------------------------------
183
184 !
185 !
186 !-----------------------------------------------------------------------
187 ! Initialisation des traceurs
188 ! ---------------------------
189 ! Choix du nombre de traceurs et du schema pour l'advection
190 ! dans fichier traceur.def, par default ou via INCA
191 1 call infotrac_init
192
193 ! Allocation de la tableau q : champs advectes
194
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
1 allocate(q(ip1jmp1,llm,nqtot))
195
196 !-----------------------------------------------------------------------
197 ! Lecture de l'etat initial :
198 ! ---------------------------
199
200 ! lecture du fichier start.nc
201
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if (read_start) then
202 ! we still need to run iniacademic to initialize some
203 ! constants & fields, if we run the 'newtonian' or 'SW' cases:
204
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (iflag_phys.ne.1) then
205 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
206 endif
207
208 ! if (planet_type.eq."earth") then
209 ! Load an Earth-format start file
210 CALL dynetat0("start.nc",vcov,ucov, &
211 1 teta,q,masse,ps,phis, time_0)
212 ! endif ! of if (planet_type.eq."earth")
213
214 ! write(73,*) 'ucov',ucov
215 ! write(74,*) 'vcov',vcov
216 ! write(75,*) 'teta',teta
217 ! write(76,*) 'ps',ps
218 ! write(77,*) 'q',q
219
220 endif ! of if (read_start)
221
222
223 ! le cas echeant, creation d un etat initial
224
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (prt_level > 9) WRITE(lunout,*) &
225 'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
226
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (.not.read_start) then
227 start_time=0.
228 annee_ref=anneeref
229 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
230 endif
231
232
233 !-----------------------------------------------------------------------
234 ! Lecture des parametres de controle pour la simulation :
235 ! -------------------------------------------------------
236 ! on recalcule eventuellement le pas de temps
237
238
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF(MOD(day_step,iperiod).NE.0) THEN
239 abort_message = &
240 'Il faut choisir un nb de pas par jour multiple de iperiod'
241 call abort_gcm(modname,abort_message,1)
242 ENDIF
243
244
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF(MOD(day_step,iphysiq).NE.0) THEN
245 abort_message = &
246 'Il faut choisir un nb de pas par jour multiple de iphysiq'
247 call abort_gcm(modname,abort_message,1)
248 ENDIF
249
250 1 zdtvr = daysec/REAL(day_step)
251
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF(dtvr.NE.zdtvr) THEN
252 WRITE(lunout,*) &
253 'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
254 ENDIF
255
256 !
257 ! on remet le calendrier \`a zero si demande
258 !
259
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (start_time /= starttime) then
260 WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
261 ,' fichier restart ne correspond pas a celle lue dans le run.def'
262 IF (raz_date == 1) then
263 WRITE(lunout,*)'Je prends l''heure lue dans run.def'
264 start_time = starttime
265 ELSE
266 call abort_gcm("gcm", "'Je m''arrete'", 1)
267 ENDIF
268 ENDIF
269
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (raz_date == 1) THEN
270 1 annee_ref = anneeref
271 1 day_ref = dayref
272 1 day_ini = dayref
273 1 itau_dyn = 0
274 1 itau_phy = 0
275 1 time_0 = 0.
276 write(lunout,*) &
277 1 'GCM: On reinitialise a la date lue dans gcm.def'
278 ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
279 write(lunout,*) &
280 'GCM: Attention les dates initiales lues dans le fichier'
281 write(lunout,*) &
282 ' restart ne correspondent pas a celles lues dans '
283 write(lunout,*)' gcm.def'
284 write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
285 write(lunout,*)' day_ref=',day_ref," dayref=",dayref
286 write(lunout,*)' Pas de remise a zero'
287 ENDIF
288
289 ! if (annee_ref .ne. anneeref .or. day_ref .ne. 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 ! if (raz_date .ne. 1) then
298 ! write(lunout,*)
299 ! . 'GCM: On garde les dates du fichier restart'
300 ! else
301 ! annee_ref = anneeref
302 ! day_ref = dayref
303 ! day_ini = dayref
304 ! itau_dyn = 0
305 ! itau_phy = 0
306 ! time_0 = 0.
307 ! write(lunout,*)
308 ! . 'GCM: On reinitialise a la date lue dans gcm.def'
309 ! endif
310 ! ELSE
311 ! raz_date = 0
312 ! endif
313
314 1 mois = 1
315 1 heure = 0.
316 1 call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
317 1 jH_ref = jD_ref - int(jD_ref)
318 1 jD_ref = int(jD_ref)
319
320 1 call ioconf_startdate(INT(jD_ref), jH_ref)
321
322 1 write(lunout,*)'DEBUG'
323 1 write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
324 1 write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
325 1 call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
326 1 write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
327 1 write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
328
329
330
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if (iflag_phys.eq.1) then
331 ! these initialisations have already been done (via iniacademic)
332 ! if running in SW or Newtonian mode
333 !-----------------------------------------------------------------------
334 ! Initialisation des constantes dynamiques :
335 ! ------------------------------------------
336 1 dtvr = zdtvr
337 1 CALL iniconst
338
339 !-----------------------------------------------------------------------
340 ! Initialisation de la geometrie :
341 ! --------------------------------
342 1 CALL inigeom
343
344 !-----------------------------------------------------------------------
345 ! Initialisation du filtre :
346 ! --------------------------
347 1 CALL inifilr
348 endif ! of if (iflag_phys.eq.1)
349 !
350 !-----------------------------------------------------------------------
351 ! Initialisation de la dissipation :
352 ! ----------------------------------
353
354 CALL inidissip( lstardis, nitergdiv, nitergrot, niterh , &
355 1 tetagdiv, tetagrot , tetatemp, vert_prof_dissip)
356
357 ! numero de stockage pour les fichiers de redemarrage:
358
359 !-----------------------------------------------------------------------
360 ! Initialisation des I/O :
361 ! ------------------------
362
363
364
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 if (nday>=0) then
365 1 day_end = day_ini + nday
366 else
367 day_end = day_ini - nday/day_step
368 endif
369 1 WRITE(lunout,300)day_ini,day_end
370 300 FORMAT('1'/,15x,'run du jour',i7,2x,'au jour',i7//)
371
372 1 call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
373 1 write (lunout,301)jour, mois, an
374 1 call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
375 1 write (lunout,302)jour, mois, an
376 301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
377 302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4)
378
379 !-----------------------------------------------------------------------
380 ! Initialisation de la physique :
381 ! -------------------------------
382
383
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
384 ! Physics:
385 CALL iniphysiq(iim,jjm,llm, &
386 (jjm-1)*iim+2,comm_lmdz, &
387 daysec,day_ini,dtphys/nsplit_phys, &
388 rlatu,rlatv,rlonu,rlonv,aire,cu,cv,rad,g,r,cpp, &
389 1 iflag_phys)
390 ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
391
392 ! if (planet_type.eq."earth") then
393 ! Write an Earth-format restart file
394
395 1 CALL dynredem0("restart.nc", day_end, phis)
396 ! endif
397
398 1 ecripar = .TRUE.
399
400 1 time_step = zdtvr
401
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 if (ok_dyn_ins) then
402 ! initialize output file for instantaneous outputs
403 ! t_ops = iecri * daysec ! do operations every t_ops
404 t_ops =((1.0*iecri)/day_step) * daysec
405 t_wrt = daysec ! iecri * daysec ! write output every t_wrt
406 CALL inithist(day_ref,annee_ref,time_step, &
407 t_ops,t_wrt)
408 endif
409
410
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (ok_dyn_ave) THEN
411 ! initialize output file for averaged outputs
412 t_ops = iperiod * time_step ! do operations every t_ops
413 t_wrt = periodav * daysec ! write output every t_wrt
414 CALL initdynav(day_ref,annee_ref,time_step, &
415 t_ops,t_wrt)
416 END IF
417 dtav = iperiod*dtvr/daysec
418 ! #endif of #ifdef 1
419
420 ! Choix des frequences de stokage pour le offline
421 ! istdyn=day_step/4 ! stockage toutes les 6h=1jour/4
422 ! istdyn=day_step/12 ! stockage toutes les 2h=1jour/12
423 1 istdyn=day_step/4 ! stockage toutes les 6h=1jour/12
424 1 istphy=istdyn/iphysiq
425
426
427 !
428 !-----------------------------------------------------------------------
429 ! Integration temporelle du modele :
430 ! ----------------------------------
431
432 ! write(78,*) 'ucov',ucov
433 ! write(78,*) 'vcov',vcov
434 ! write(78,*) 'teta',teta
435 ! write(78,*) 'ps',ps
436 ! write(78,*) 'q',q
437
438
439 1 CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,time_0)
440
441 1 END PROGRAM gcm
442