Context Navigation

gcm.F90 @ 3574

Last change on this file since 3574 was 3574, checked in by jbclement, 32 hours ago

COMMON:
The compilation generates a Fortran subroutine to track compilation and version (SVN or Git) details through the executable file. Put the argument 'version' as an option when executing the code to display these information and create a file "version_diff.txt" containing the diff result.
It can work with every program but it has been implemented only for: 'gcm', 'parallel gcm', 'pem', '1D Mars PCM', 'Mars newstart', 'Mars start2archive' and '1D Generic PCM'.
JBC

File size: 17.5 KB

Line
1	!
2	! $Id: gcm.F 1446 2010-10-22 09:27:25Z emillour $
3	!
4	!
5	!
6	PROGRAM gcm
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	ecritstart
28	USE mod_const_mpi, ONLY: COMM_LMDZ
29	use cpdet_mod, only: ini_cpdet
30	USE temps_mod, ONLY: calend,start_time,annee_ref,day_ref, &
31	itau_dyn,itau_phy,day_ini,jD_ref,jH_ref,day_end
32	use version_info_mod, only: print_version_info
33
34
35	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36	! FH 2008/05/09 On elimine toutes les clefs physiques dans la dynamique
37	! A nettoyer. On ne veut qu'une ou deux routines d'interface
38	! dynamique -> physique pour l'initialisation
39	! Ehouarn: the following are needed with (parallel) physics:
40	#ifdef CPP_PHYS
41	USE iniphysiq_mod, ONLY: iniphysiq
42	#endif
43
44	USE comconst_mod, ONLY: daysec,dtvr,dtphys,rad,g,r,cpp
45	USE logic_mod, ONLY: read_start,iflag_phys,ok_guide,ecripar
46
47	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
48
49	IMPLICIT NONE
50
51	! ...... Version du 10/01/98 ..........
52
53	! avec coordonnees verticales hybrides
54	! avec nouveaux operat. dissipation * ( gradiv2,divgrad2,nxgraro2 )
55
56	!=======================================================================
57	!
58	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
59	! -------
60	!
61	! Objet:
62	! ------
63	!
64	! GCM LMD nouvelle grille
65	!
66	!=======================================================================
67	!
68	! ... Dans inigeom , nouveaux calculs pour les elongations cu , cv
69	! et possibilite d'appeler une fonction f(y) a derivee tangente
70	! hyperbolique a la place de la fonction a derivee sinusoidale.
71	! ... Possibilite de choisir le schema pour l'advection de
72	! q , en modifiant iadv dans traceur.def (MAF,10/02) .
73	!
74	! Pour Van-Leer + Vapeur d'eau saturee, iadv(1)=4. (F.Codron,10/99)
75	! Pour Van-Leer iadv=10
76	!
77	!-----------------------------------------------------------------------
78	! Declarations:
79	! -------------
80
81	include "dimensions.h"
82	include "paramet.h"
83	include "comdissnew.h"
84	include "comgeom.h"
85	!!!!!!!!!!!#include "control.h"
86	!#include "com_io_dyn.h"
87	include "iniprint.h"
88	include "tracstoke.h"
89
90	REAL zdtvr
91
92	! variables dynamiques
93	REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
94	REAL teta(ip1jmp1,llm) ! temperature potentielle
95	REAL, ALLOCATABLE, DIMENSION(:,:,:):: q! champs advectes
96	REAL ps(ip1jmp1) ! pression au sol
97	REAL p (ip1jmp1,llmp1 ) ! pression aux interfac.des couches
98	REAL masse(ip1jmp1,llm) ! masse d'air
99	REAL phis(ip1jmp1) ! geopotentiel au sol
100	REAL phi(ip1jmp1,llm) ! geopotentiel
101	REAL w(ip1jmp1,llm) ! vitesse verticale
102
103	! variables dynamiques intermediaire pour le transport
104
105	! variables pour le fichier histoire
106	REAL dtav ! intervalle de temps elementaire
107
108	REAL time_0
109
110	LOGICAL lafin
111	INTEGER ij,iq,l,i,j
112
113
114	real time_step, t_wrt, t_ops
115
116	LOGICAL first
117
118	! LOGICAL call_iniphys
119	! data call_iniphys/.true./
120
121	!+jld variables test conservation energie
122	! REAL ecin(ip1jmp1,llm),ecin0(ip1jmp1,llm)
123	! Tendance de la temp. potentiel d (theta)/ d t due a la
124	! tansformation d'energie cinetique en energie thermique
125	! cree par la dissipation
126	REAL dhecdt(ip1jmp1,llm)
127	! REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
128	! REAL d_h_vcol, d_qt, d_qw, d_ql, d_ec
129	CHARACTER (len=15) :: ztit
130	!-jld
131
132
133	character (len=80) :: dynhist_file, dynhistave_file
134	character (len=20) :: modname
135	character (len=80) :: abort_message
136	character(100) :: arg ! To read command-line arguments
137	! locales pour gestion du temps
138	INTEGER :: an, mois, jour
139	REAL :: heure
140	logical use_filtre_fft
141	logical :: present
142
143	!-----------------------------------------------------------------------
144	! Initialisations:
145	! ----------------
146
147	if (command_argument_count() > 0) then ! Get the number of command-line arguments
148	call get_command_argument(1,arg) ! Read the argument given to the program
149	select case (trim(adjustl(arg)))
150	case('version')
151	call print_version_info()
152	stop
153	case default
154	error stop "The argument given to the program is unknown!"
155	end select
156	endif
157
158	abort_message = 'last timestep reached'
159	modname = 'gcm'
160	lafin = .FALSE.
161	dynhist_file = 'dyn_hist.nc'
162	dynhistave_file = 'dyn_hist_ave.nc'
163
164
165
166	!----------------------------------------------------------------------
167	! Load flags and options from run.def
168	! ---------------------------------------
169	!
170	! Start by checking that there indeed is a run.def file
171	INQUIRE(file="run.def", EXIST=present)
172	IF(.not. present) then
173	CALL abort_gcm("gcm", "file run.def not found, Aborting!",1)
174	ENDIF
175
176	CALL conf_gcm( 99, .TRUE. )
177	if (mod(iphysiq, iperiod) /= 0) call abort_gcm("conf_gcm", &
178	"iphysiq must be a multiple of iperiod", 1)
179
180	use_filtre_fft=.FALSE.
181	CALL getin('use_filtre_fft',use_filtre_fft)
182	IF (use_filtre_fft) call abort_gcm("gcm",'FFT filter is not available in the ' &
183	// 'sequential version of the dynamics.', 1)
184
185	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
186	! Initialisation de XIOS
187	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
188
189	#ifdef CPP_XIOS
190	CALL wxios_init("LMDZ")
191	#endif
192
193
194	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
195	! FH 2008/05/02
196	! A nettoyer. On ne veut qu'une ou deux routines d'interface
197	! dynamique -> physique pour l'initialisation
198	!#ifdef CPP_PHYS
199	! CALL init_phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
200	!! call initcomgeomphy ! now done in iniphysiq
201	!#endif
202	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
203	!
204	! Initialisations pour Cp(T) Venus
205	call ini_cpdet
206	!
207	!-----------------------------------------------------------------------
208	! Choix du calendrier
209	! -------------------
210
211	! calend = 'earth_365d'
212
213	#ifdef CPP_IOIPSL
214	if (calend == 'earth_360d') then
215	call ioconf_calendar('360d')
216	write(lunout,*)'CALENDRIER CHOISI: Terrestre a 360 jours/an'
217	else if (calend == 'earth_365d') then
218	call ioconf_calendar('noleap')
219	write(lunout,*)'CALENDRIER CHOISI: Terrestre a 365 jours/an'
220	else if (calend == 'earth_366d') then
221	call ioconf_calendar('gregorian')
222	write(lunout,*)'CALENDRIER CHOISI: Terrestre bissextile'
223	else if (calend == 'titan') then
224	! call ioconf_calendar('titan')
225	write(lunout,*)'CALENDRIER CHOISI: Titan'
226	abort_message = 'A FAIRE...'
227	call abort_gcm(modname,abort_message,1)
228	else if (calend == 'venus') then
229	! call ioconf_calendar('venus')
230	write(lunout,*)'CALENDRIER CHOISI: Venus'
231	abort_message = 'A FAIRE...'
232	call abort_gcm(modname,abort_message,1)
233	else
234	abort_message = 'Mauvais choix de calendrier'
235	call abort_gcm(modname,abort_message,1)
236	endif
237	#endif
238	!-----------------------------------------------------------------------
239	!
240	!
241	!------------------------------------
242	! Initialisation partie parallele
243	!------------------------------------
244
245	!
246	!
247	!-----------------------------------------------------------------------
248	! Initialisation des traceurs
249	! ---------------------------
250	! Choix du nombre de traceurs et du schema pour l'advection
251	! dans fichier traceur.def, par default ou via INCA
252	call infotrac_init
253
254	! Allocation de la tableau q : champs advectes
255	allocate(q(ip1jmp1,llm,nqtot))
256
257	!-----------------------------------------------------------------------
258	! Lecture de l'etat initial :
259	! ---------------------------
260
261	! lecture du fichier start.nc
262	if (read_start) then
263	! we still need to run iniacademic to initialize some
264	! constants & fields, if we run the 'newtonian' or 'SW' cases:
265	if (iflag_phys.ne.1) then
266	CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
267	endif
268
269	CALL dynetat0("start.nc",vcov,ucov, &
270	teta,q,masse,ps,phis, time_0)
271
272	! Load relaxation fields (simple nudging). AS 09/2013
273	! ---------------------------------------------------
274	if (planet_type.eq."generic") then
275	if (ok_guide) then
276	CALL relaxetat0("relax.nc")
277	endif
278	endif
279
280	! write(73,*) 'ucov',ucov
281	! write(74,*) 'vcov',vcov
282	! write(75,*) 'teta',teta
283	! write(76,*) 'ps',ps
284	! write(77,*) 'q',q
285
286	endif ! of if (read_start)
287
288
289	! le cas echeant, creation d un etat initial
290	IF (prt_level > 9) WRITE(lunout,*) &
291	'GCM: AVANT iniacademic AVANT AVANT AVANT AVANT'
292	if (.not.read_start) then
293	CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
294	endif
295
296
297	!-----------------------------------------------------------------------
298	! Lecture des parametres de controle pour la simulation :
299	! -------------------------------------------------------
300	! on recalcule eventuellement le pas de temps
301
302	IF(MOD(day_step,iperiod).NE.0) THEN
303	abort_message = &
304	'Il faut choisir un nb de pas par jour multiple de iperiod'
305	call abort_gcm(modname,abort_message,1)
306	ENDIF
307
308	IF(MOD(day_step,iphysiq).NE.0) THEN
309	abort_message = &
310	'Il faut choisir un nb de pas par jour multiple de iphysiq'
311	call abort_gcm(modname,abort_message,1)
312	ENDIF
313
314	zdtvr = daysec/REAL(day_step)
315	IF(dtvr.NE.zdtvr) THEN
316	WRITE(lunout,*) &
317	'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr
318	ENDIF
319	dtvr=zdtvr
320
321	!
322	! on remet le calendrier a zero si demande
323	!
324	IF (start_time /= starttime) then
325	WRITE(lunout,*)' GCM: Attention l''heure de depart lue dans le' &
326	,' fichier restart ne correspond pas a celle lue dans le run.def'
327	IF (raz_date == 1) then
328	WRITE(lunout,*)'Je prends l''heure lue dans run.def'
329	start_time = starttime
330	ELSE
331	call abort_gcm("gcm", "'Je m''arrete'", 1)
332	ENDIF
333	ENDIF
334	IF (raz_date == 1) THEN
335	annee_ref = anneeref
336	day_ref = dayref
337	day_ini = dayref
338	itau_dyn = 0
339	itau_phy = 0
340	time_0 = 0.
341	write(lunout,*) &
342	'GCM: On reinitialise a la date lue dans gcm.def'
343	ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
344	write(lunout,*) &
345	'GCM: Attention les dates initiales lues dans le fichier'
346	write(lunout,*) &
347	' restart ne correspondent pas a celles lues dans '
348	write(lunout,*)' gcm.def'
349	write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
350	write(lunout,*)' day_ref=',day_ref," dayref=",dayref
351	write(lunout,*)' Pas de remise a zero'
352	ENDIF
353
354	! if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
355	! write(lunout,*)
356	! . 'GCM: Attention les dates initiales lues dans le fichier'
357	! write(lunout,*)
358	! . ' restart ne correspondent pas a celles lues dans '
359	! write(lunout,*)' gcm.def'
360	! write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
361	! write(lunout,*)' day_ref=',day_ref," dayref=",dayref
362	! if (raz_date .ne. 1) then
363	! write(lunout,*)
364	! . 'GCM: On garde les dates du fichier restart'
365	! else
366	! annee_ref = anneeref
367	! day_ref = dayref
368	! day_ini = dayref
369	! itau_dyn = 0
370	! itau_phy = 0
371	! time_0 = 0.
372	! write(lunout,*)
373	! . 'GCM: On reinitialise a la date lue dans gcm.def'
374	! endif
375	! ELSE
376	! raz_date = 0
377	! endif
378
379	#ifdef CPP_IOIPSL
380	mois = 1
381	heure = 0.
382	! Ce n'est defini pour l'instant que pour la Terre...
383	if (planet_type.eq.'earth') then
384	call ymds2ju(annee_ref, mois, day_ref, heure, jD_ref)
385	jH_ref = jD_ref - int(jD_ref)
386	jD_ref = int(jD_ref)
387
388	call ioconf_startdate(INT(jD_ref), jH_ref)
389
390	write(lunout,*)'DEBUG'
391	write(lunout,*)'annee_ref, mois, day_ref, heure, jD_ref'
392	write(lunout,*)annee_ref, mois, day_ref, heure, jD_ref
393	call ju2ymds(jD_ref+jH_ref,an, mois, jour, heure)
394	write(lunout,*)'jD_ref+jH_ref,an, mois, jour, heure'
395	write(lunout,*)jD_ref+jH_ref,an, mois, jour, heure
396	! else if (planet_type.eq.'titan') then
397	! jD_ref=1 ! Only if we use old Titan starts (J.V.O 2016)
398	else
399	! A voir pour Titan et Venus
400	jD_ref=0
401	jH_ref=0
402	write(lunout,*)'A VOIR POUR VENUS ET TITAN: jD_ref, jH_ref'
403	write(lunout,*)jD_ref,jH_ref
404	endif ! planet_type
405	#else
406	! Ehouarn: we still need to define JD_ref and JH_ref
407	! and since we don't know how many days there are in a year
408	! we set JD_ref to 0 (this should be improved ...)
409	jD_ref=0
410	jH_ref=0
411	#endif
412
413	if (iflag_phys.eq.1) then
414	! these initialisations have already been done (via iniacademic)
415	! if running in SW or Newtonian mode
416	!-----------------------------------------------------------------------
417	! Initialisation des constantes dynamiques :
418	! ------------------------------------------
419	dtvr = zdtvr
420	CALL iniconst
421
422	!-----------------------------------------------------------------------
423	! Initialisation de la geometrie :
424	! --------------------------------
425	CALL inigeom
426
427	!-----------------------------------------------------------------------
428	! Initialisation du filtre :
429	! --------------------------
430	CALL inifilr
431	endif ! of if (iflag_phys.eq.1)
432	!
433	!-----------------------------------------------------------------------
434	! Initialisation de la dissipation :
435	! ----------------------------------
436
437	CALL inidissip( lstardis, nitergdiv, nitergrot, niterh , &
438	tetagdiv, tetagrot , tetatemp, vert_prof_dissip)
439
440	!-----------------------------------------------------------------------
441	! Initialisation des I/O :
442	! ------------------------
443
444	if (nday>=0) then ! standard case
445	day_end=day_ini+nday
446	else ! special case when nday <0, run -nday dynamical steps
447	day_end=day_ini-nday/day_step
448	endif
449	if (less1day) then
450	day_end=day_ini+floor(time_0+fractday)
451	endif
452	if (ndynstep.gt.0) then
453	day_end=day_ini+floor(time_0+float(ndynstep)/float(day_step))
454	endif
455
456	WRITE(lunout,'(a,i7,a,i7)') &
457	"run from day ",day_ini," to day",day_end
458
459	#ifdef CPP_IOIPSL
460	! Ce n'est defini pour l'instant que pour la Terre...
461	if (planet_type.eq.'earth') then
462	call ju2ymds(jD_ref + day_ini - day_ref, an, mois, jour, heure)
463	write (lunout,301)jour, mois, an
464	call ju2ymds(jD_ref + day_end - day_ref, an, mois, jour, heure)
465	write (lunout,302)jour, mois, an
466	else
467	! A voir pour Titan et Venus
468	write(lunout,*)'A VOIR POUR VENUS/TITAN: separation en annees...'
469	endif ! planet_type
470	301 FORMAT('1'/,15x,'run du ', i2,'/',i2,'/',i4)
471	302 FORMAT('1'/,15x,' au ', i2,'/',i2,'/',i4)
472	#endif
473
474
475	!-----------------------------------------------------------------------
476	! Initialisation de la physique :
477	! -------------------------------
478
479	IF ((iflag_phys==1).or.(iflag_phys>=100)) THEN
480	! Physics:
481	#ifdef CPP_PHYS
482	CALL iniphysiq(iim,jjm,llm, &
483	(jjm-1)*iim+2,comm_lmdz, &
484	daysec,day_ini,dtphys/nsplit_phys, &
485	rlatu,rlatv,rlonu,rlonv,aire,cu,cv, &
486	rad,g,r,cpp,iflag_phys)
487	#endif
488	ENDIF ! of IF ((iflag_phys==1).or.(iflag_phys>=100))
489
490
491	! If we want to save multiple restart at different time (ecritstart.GT.0)
492	! We will write in restart the initial day of the simulation and put all
493	! the different time in the Time variable
494	! However, if we write only one restart, we save the last day of the
495	! simulation and put the remaining time (which is 0 if we do fulls days)
496	! in the Time variable
497
498	if (planet_type=="mars") then
499	if (ecritstart.GT.0) then
500	! For Mars we transmit day_ini
501	CALL dynredem0("restart.nc", day_ini, phis)
502	else
503	CALL dynredem0("restart.nc", day_end, phis)
504	endif
505	else
506	CALL dynredem0("restart.nc", day_end, phis)
507	endif
508	ecripar = .TRUE.
509
510	#ifdef CPP_IOIPSL
511	time_step = zdtvr
512	if (ok_dyn_ins) then
513	! initialize output file for instantaneous outputs
514	! t_ops = iecri * daysec ! do operations every t_ops
515	t_ops =((1.0iecri)/day_step) daysec
516	t_wrt = daysec ! iecri * daysec ! write output every t_wrt
517	CALL inithist(day_ref,annee_ref,time_step,t_ops,t_wrt)
518	endif
519
520	IF (ok_dyn_ave) THEN
521	! initialize output file for averaged outputs
522	t_ops = iperiod * time_step ! do operations every t_ops
523	t_wrt = periodav * daysec ! write output every t_wrt
524	CALL initdynav(day_ref,annee_ref,time_step,t_ops,t_wrt)
525	END IF
526	dtav = iperiod*dtvr/daysec
527	#endif
528	! #endif of #ifdef CPP_IOIPSL
529
530	! Choix des frequences de stokage pour le offline
531	! istdyn=day_step/4 ! stockage toutes les 6h=1jour/4
532	! istdyn=day_step/12 ! stockage toutes les 2h=1jour/12
533	istdyn=day_step/4 ! stockage toutes les 6h=1jour/12
534	istphy=istdyn/iphysiq
535
536
537	!
538	!-----------------------------------------------------------------------
539	! Integration temporelle du modele :
540	! ----------------------------------
541
542	! write(78,*) 'ucov',ucov
543	! write(78,*) 'vcov',vcov
544	! write(78,*) 'teta',teta
545	! write(78,*) 'ps',ps
546	! write(78,*) 'q',q
547
548
549	CALL leapfrog(ucov,vcov,teta,ps,masse,phis,q,time_0)
550
551	END PROGRAM gcm
552

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

Download in other formats:

Original Format