Context Navigation

gcm.F90 @ 4098

Last change on this file since 4098 was 4050, checked in by dcugnet, 3 years ago

Second commit for new tracers.

include most of the keys in the tracers descriptor vector "tracers(:)".
fix in phylmdiso/cv3_routines: fq_* variables were used where their fxt_* counterparts were expected.
multiple IF(nqdesc(iq)>0) and IF(nqfils(iq)>0) tests suppressed, because they are not needed: "do ... enddo" loops with 0 upper bound are not executed.
remove French accents from comments (encoding problem) in phylmdiso/cv3_routines and phylmdiso/cv30_routines.
modifications in "isotopes_verif_mod", where the call to function "iso_verif_tag17_q_deltad_chn" in "iso_verif_tag17_q_deltad_chn" was not detected at linking stage, although defined in the same module (?).

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

File size: 14.8 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format