Context Navigation

dynredem_p.F90 @ 3509

Last change on this file since 3509 was 3509, checked in by jbclement, 13 days ago
Dynamic + Mars PCM: Addition of the description for the 'controle' array in the "start.nc" and "startfi.nc" files. It is given by the variable 'controle_descriptor' whose the element 'controle_descriptor(i)' explains 'controle(i)'. JBC
File size: 17.1 KB

Line
1	!
2	! $Id: dynredem_p.F 1635 2012-07-12 11:37:16Z lguez $
3	!
4	SUBROUTINE dynredem0_p(fichnom,iday_end,phis)
5	#ifdef CPP_IOIPSL
6	USE IOIPSL
7	#endif
8	USE parallel_lmdz, ONLY: mpi_rank
9	USE infotrac, ONLY: nqtot, tname, ttext
10	USE netcdf, ONLY: NF90_CREATE, NF90_DEF_DIM, NF90_INQ_VARID, NF90_GLOBAL, &
11	NF90_CLOSE, NF90_PUT_ATT, NF90_UNLIMITED, NF90_CLOBBER
12	USE dynredem_mod, ONLY: cre_var, put_var1, put_var2, put_char1, err, modname, fil
13	use netcdf95, only: NF95_PUT_VAR
14	use control_mod, only : planet_type
15	USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,pa,preff, &
16	nivsig,nivsigs
17	USE comconst_mod, ONLY: daysec,dtvr,rad,omeg,g,cpp,kappa,pi
18	USE logic_mod, ONLY: fxyhypb,ysinus
19	USE serre_mod, ONLY: clon,clat,grossismx,grossismy,dzoomx,dzoomy, &
20	taux,tauy
21	USE temps_mod, ONLY: annee_ref,day_ref,itau_dyn,itaufin, &
22	start_time,hour_ini
23	USE ener_mod, ONLY: etot0,ptot0,ztot0,stot0,ang0
24
25	IMPLICIT NONE
26	!=======================================================================
27	! Writting the NetCDF restart file (initialisation)
28	!=======================================================================
29	! Declarations:
30	! -------------
31	include "dimensions.h"
32	include "paramet.h"
33	include "comgeom2.h"
34	include "netcdf.inc"
35	include "iniprint.h"
36
37	!===============================================================================
38	! Arguments:
39	CHARACTER(LEN=*), INTENT(IN) :: fichnom !--- FILE NAME
40	INTEGER, INTENT(IN) :: iday_end !---
41	REAL, INTENT(IN) :: phis(iip1, jjp1) !--- GROUND GEOPOTENTIAL
42	!===============================================================================
43	! Local variables:
44	INTEGER :: iq,l
45	INTEGER, PARAMETER :: length=100
46	INTEGER, PARAMETER :: ldscrpt = 28, ndscrpt = 42
47	REAL :: tab_cntrl(length) ! run parameters
48	character(ndscrpt), dimension(ldscrpt), parameter :: dscrpt_tab_cntrl = (/ &
49	"(1) Number of nodes along longitude ", &
50	"(2) Number of nodes along latitude ", &
51	"(3) Number of atmospheric layers ", &
52	"(4) Initial day ", &
53	"(5) Radius of the planet ", &
54	"(6) Rotation of the planet (rad/s) ", &
55	"(7) Gravity (m/s2) ", &
56	"(8) Specific heat Cp (J.kg-1.K-1) ", &
57	"(9) = r/Cp (=kappa) ", &
58	"(10) Lenght of a sol (s) ", &
59	"(11) Dynamical time step (s) ", &
60	"(12) Total energy ", &
61	"(13) Total pressure ", &
62	"(14) Total enstrophy ", &
63	"(15) Total enthalpy ", &
64	"(16) Total angular momentum ", &
65	"(17) Reference pressure (Pa) ", &
66	"(18) Reference surface pressure (Pa) ", &
67	"(19) Longitude of center of zoom ", &
68	"(20) Latitude of center of zoom ", &
69	"(21) Zooming factor, along longitude ", &
70	"(22) Zooming factor, along latitude ", &
71	"(23) - ", &
72	"(24) Extention (in longitude) of zoom ", &
73	"(25) Extention (in latitude) of zoom ", &
74	"(26) - ", &
75	"(27) Stiffness factor of zoom in longitude", &
76	"(28) Stiffness factor of zoom in latitude "/)
77	INTEGER :: ierr
78	CHARACTER(LEN=80) :: abort_message
79
80	! For NetCDF:
81	CHARACTER(LEN=30) :: unites
82	INTEGER :: indexID, descrptID, dscrpt_sID
83	INTEGER :: rlonuID, rlonvID, rlatuID, rlatvID
84	INTEGER :: sID, sigID, nID, vID, timID
85	INTEGER :: yyears0, jjour0, mmois0
86	REAL :: zan0, zjulian, hours
87
88	CHARACTER(len=12) :: start_file_type="earth" ! default start file type
89	INTEGER :: idecal
90
91	!===============================================================================
92	if (mpi_rank==0) then ! only the master reads input file
93	! fill dynredem_mod module variables
94	modname='dynredem0_p'; fil=fichnom
95
96	#ifdef CPP_IOIPSL
97	call ymds2ju(annee_ref, 1, iday_end, 0.0, zjulian)
98	call ju2ymds(zjulian, yyears0, mmois0, jjour0, hours)
99	#else
100	! set yyears0, mmois0, jjour0 to 0,1,1 (hours is not used)
101	yyears0=0
102	mmois0=1
103	jjour0=1
104	#endif
105
106	!!! AS: idecal is a hack to be able to read planeto starts...
107	!!! .... while keeping everything OK for LMDZ EARTH
108	if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
109	write(lunout,*) trim(modname),' : Planeto-like start file'
110	start_file_type="planeto"
111	idecal = 4
112	else
113	if ( planet_type.eq."titan" ) then
114	! Titan inherited Earth-like start files with idecal=5
115	write(lunout,*) trim(modname),' : Titan start file'
116	else
117	write(lunout,*) trim(modname),' : Earth-like start file'
118	endif
119	idecal = 5
120	endif
121
122	tab_cntrl(:) = 0.
123	tab_cntrl(1) = REAL(iim)
124	tab_cntrl(2) = REAL(jjm)
125	tab_cntrl(3) = REAL(llm)
126	if (start_file_type.eq."earth") then
127	tab_cntrl(4)=REAL(day_ref)
128	else
129	!tab_cntrl(4)=REAL(day_end)
130	tab_cntrl(4)=REAL(iday_end)
131	endif
132	tab_cntrl(5) = REAL(annee_ref)
133	tab_cntrl(idecal+1) = rad
134	tab_cntrl(idecal+2) = omeg
135	tab_cntrl(idecal+3) = g
136	tab_cntrl(idecal+4) = cpp
137	tab_cntrl(idecal+5) = kappa
138	tab_cntrl(idecal+6) = daysec
139	tab_cntrl(idecal+7) = dtvr
140	tab_cntrl(idecal+8) = etot0
141	tab_cntrl(idecal+9) = ptot0
142	tab_cntrl(idecal+10) = ztot0
143	tab_cntrl(idecal+11) = stot0
144	tab_cntrl(idecal+12) = ang0
145	tab_cntrl(idecal+13) = pa
146	tab_cntrl(idecal+14) = preff
147
148	! ..... parameters for the zoom ......
149	tab_cntrl(idecal+15) = clon
150	tab_cntrl(idecal+16) = clat
151	tab_cntrl(idecal+17) = grossismx
152	tab_cntrl(idecal+18) = grossismy
153	!
154	IF ( fxyhypb ) THEN
155	tab_cntrl(idecal+19) = 1.
156	tab_cntrl(idecal+20) = dzoomx
157	tab_cntrl(idecal+21) = dzoomy
158	tab_cntrl(idecal+22) = 0.
159	tab_cntrl(idecal+23) = taux
160	tab_cntrl(idecal+24) = tauy
161	ELSE
162	tab_cntrl(idecal+19) = 0.
163	tab_cntrl(idecal+20) = dzoomx
164	tab_cntrl(idecal+21) = dzoomy
165	tab_cntrl(idecal+22) = 0.
166	tab_cntrl(idecal+23) = 0.
167	tab_cntrl(idecal+24) = 0.
168	IF( ysinus ) tab_cntrl(idecal+22) = 1.
169	ENDIF
170
171	if (start_file_type.eq."earth") then
172	tab_cntrl(idecal+25) = REAL(iday_end)
173	tab_cntrl(idecal+26) = REAL(itau_dyn + itaufin)
174	! start_time: start_time of simulation (not necessarily 0.)
175	tab_cntrl(idecal+27) = start_time
176	endif
177
178	if (planet_type=="mars") then ! For Mars only
179	! tab_cntrl(29)=hour_ini
180	tab_cntrl(29)=0
181	endif
182
183	!--- File creation
184	CALL err(NF90_CREATE(fichnom,NF90_CLOBBER,nid))
185
186	!--- Some global attributes
187	CALL err(NF90_PUT_ATT(nid,NF90_GLOBAL,"title","Fichier demarrage dynamique"))
188
189	!--- Dimensions
190	if (start_file_type.eq."earth") then
191	CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
192	CALL err(NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID))
193	CALL err(NF90_DEF_DIM(nid,"rlatu", jjp1, rlatuID))
194	CALL err(NF90_DEF_DIM(nid,"rlonv", iip1, rlonvID))
195	CALL err(NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID))
196	CALL err(NF90_DEF_DIM(nid,"sigs", llm, sID))
197	CALL err(NF90_DEF_DIM(nid,"sig", llmp1, sigID))
198	CALL err(NF90_DEF_DIM(nid,"temps", NF90_UNLIMITED, timID))
199	CALL err(NF90_DEF_DIM(nid,"descriptor", ldscrpt, descrptID))
200	CALL err(NF90_DEF_DIM(nid,"description_size", ndscrpt, dscrpt_sID))
201	else
202	CALL err(NF90_DEF_DIM(nid,"index", length, indexID))
203	CALL err(NF90_DEF_DIM(nid,"rlonu", iip1, rlonuID))
204	CALL err(NF90_DEF_DIM(nid,"latitude", jjp1, rlatuID))
205	CALL err(NF90_DEF_DIM(nid,"longitude", iip1, rlonvID))
206	CALL err(NF90_DEF_DIM(nid,"rlatv", jjm, rlatvID))
207	CALL err(NF90_DEF_DIM(nid,"altitude", llm, sID))
208	CALL err(NF90_DEF_DIM(nid,"interlayer", llmp1, sigID))
209	CALL err(NF90_DEF_DIM(nid,"Time", NF90_UNLIMITED, timID))
210	CALL err(NF90_DEF_DIM(nid,"descriptor", ldscrpt, descrptID))
211	CALL err(NF90_DEF_DIM(nid,"description_size", ndscrpt, dscrpt_sID))
212	endif
213
214	!--- Define and save invariant fields
215	CALL put_var1(nid,"controle","Parametres de controle" ,[indexID],tab_cntrl)
216	CALL put_char1(nid,"controle_descriptor","Description of control parameters",[dscrpt_sID,descrptID],dscrpt_tab_cntrl)
217	CALL put_var1(nid,"rlonu" ,"Longitudes des points U",[rlonuID],rlonu)
218	CALL put_var1(nid,"rlatu" ,"Latitudes des points U" ,[rlatuID],rlatu)
219	CALL put_var1(nid,"rlonv" ,"Longitudes des points V",[rlonvID],rlonv)
220	CALL put_var1(nid,"rlatv" ,"Latitudes des points V" ,[rlatvID],rlatv)
221	if (start_file_type.eq."earth") then
222	CALL put_var1(nid,"nivsigs" ,"Numero naturel des couches s" ,[sID] ,nivsigs)
223	CALL put_var1(nid,"nivsig" ,"Numero naturel des couches sigma",[sigID],nivsig)
224	endif ! of if (start_file_type.eq."earth")
225	CALL put_var1(nid,"ap" ,"Coefficient A pour hybride" ,[sigID],ap)
226	CALL put_var1(nid,"bp" ,"Coefficient B pour hybride" ,[sigID],bp)
227	if (start_file_type.ne."earth") then
228	CALL put_var1(nid,"aps","Coef AS: hybrid pressure at midlayers",[sID],aps)
229	CALL put_var1(nid,"bps","Coef BS: hybrid sigma at midlayers",[sID],bps)
230	endif ! of if (start_file_type.eq."earth")
231	CALL put_var1(nid,"presnivs","" ,[sID] ,presnivs)
232	if (start_file_type.ne."earth") then
233	ierr = NF_REDEF (nid)
234	#ifdef NC_DOUBLE
235	ierr = NF_DEF_VAR(nid,"latitude",NF_DOUBLE,1,rlatuID,vID)
236	#else
237	ierr = NF_DEF_VAR(nid,"latitude",NF_FLOAT,1,rlatuID,vID)
238	#endif
239	ierr =NF_PUT_ATT_TEXT(nid,vID,'units',13,"degrees_north")
240	ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
241	"North latitude")
242	ierr = NF_ENDDEF(nid)
243	call NF95_PUT_VAR(nid,vID,rlatu*180/pi)
244	!
245	ierr = NF_REDEF (nid)
246	#ifdef NC_DOUBLE
247	ierr=NF_DEF_VAR(nid,"longitude",NF_DOUBLE,1,rlonvID,vID)
248	#else
249	ierr=NF_DEF_VAR(nid,"longitude",NF_FLOAT,1,rlonvID,vID)
250	#endif
251	ierr = NF_PUT_ATT_TEXT (nid,vID,"long_name", 14, &
252	"East longitude")
253	ierr = NF_PUT_ATT_TEXT(nid,vID,'units',12,"degrees_east")
254	ierr = NF_ENDDEF(nid)
255	call NF95_PUT_VAR(nid,vID,rlonv*180/pi)
256	!
257	ierr = NF_REDEF (nid)
258	#ifdef NC_DOUBLE
259	ierr = NF_DEF_VAR (nid, "altitude", NF_DOUBLE, 1, &
260	sID,vID)
261	#else
262	ierr = NF_DEF_VAR (nid, "altitude", NF_FLOAT, 1, &
263	sID,vID)
264	#endif
265	ierr = NF_PUT_ATT_TEXT(nid,vID,"long_name",10,"pseudo-alt")
266	ierr = NF_PUT_ATT_TEXT (nid,vID,'units',2,"km")
267	ierr = NF_PUT_ATT_TEXT (nid,vID,'positive',2,"up")
268	ierr = NF_ENDDEF(nid)
269	call NF95_PUT_VAR(nid,vID,pseudoalt)
270	CALL err(NF_REDEF(nid))
271	endif ! of if (start_file_type.ne."earth")
272
273	! covariant <-> contravariant <-> natural conversion coefficients
274	CALL put_var2(nid,"cu","Coefficient de passage pour U",[rlonuID,rlatuID],cu)
275	CALL put_var2(nid,"cv","Coefficient de passage pour V",[rlonvID,rlatvID],cv)
276	CALL put_var2(nid,"aire","Aires de chaque maille" ,[rlonvID,rlatuID],aire)
277	CALL put_var2(nid,"phisinit","Geopotentiel au sol" ,[rlonvID,rlatuID],phis)
278
279
280	! Define variables that will be stored later:
281	WRITE(unites,"('days since ',i4,'-',i2.2,'-',i2.2,' 00:00:00')") &
282	yyears0,mmois0,jjour0
283	IF (start_file_type.eq."earth") THEN
284	CALL cre_var(nid,"temps","Temps de simulation",[timID],unites)
285	ELSE
286	CALL cre_var(nid,"Time","Temps de simulation",[timID],unites)
287	ENDIF
288
289	CALL cre_var(nid,"ucov" ,"Vitesse U" ,[rlonuID,rlatuID,sID,timID])
290	CALL cre_var(nid,"vcov" ,"Vitesse V" ,[rlonvID,rlatvID,sID,timID])
291	CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
292
293	IF(nqtot.GE.1) THEN
294	DO iq=1,nqtot
295	CALL cre_var(nid,tname(iq),ttext(iq),[rlonvID,rlatuID,sID,timID])
296	END DO
297	ENDIF
298
299	CALL cre_var(nid,"masse","Masse d air" ,[rlonvID,rlatuID,sID,timID])
300	CALL cre_var(nid,"ps" ,"Pression au sol",[rlonvID,rlatuID ,timID])
301
302	CALL err(NF90_CLOSE (nid)) ! close file
303
304	WRITE(lunout,*)TRIM(modname)//': iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
305	WRITE(lunout,*)TRIM(modname)//': rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
306
307	endif ! of if (mpi_rank==0)
308
309	END SUBROUTINE dynredem0_p
310
311	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
312
313	SUBROUTINE dynredem1_p(fichnom,time,vcov,ucov,teta,q,masse,ps)
314	!
315	!-------------------------------------------------------------------------------
316	! Purpose: Write the NetCDF restart file (append).
317	!-------------------------------------------------------------------------------
318	USE parallel_lmdz, ONLY: mpi_rank, gather_field
319	USE infotrac, ONLY: nqtot, tname, type_trac
320	USE control_mod, only : planet_type
321	USE netcdf, ONLY: NF90_OPEN, NF90_NOWRITE, NF90_GET_VAR, NF90_INQ_VARID, &
322	NF90_CLOSE, NF90_WRITE, NF90_PUT_VAR, NF90_NoErr
323	use netcdf95, only: NF95_PUT_VAR
324	USE temps_mod, ONLY: itaufin,itau_dyn
325	USE dynredem_mod, ONLY: dynredem_write_u, dynredem_write_v, dynredem_read_u, &
326	err, modname, fil, msg
327
328	IMPLICIT NONE
329	include "dimensions.h"
330	include "paramet.h"
331	include "netcdf.inc"
332	include "comgeom.h"
333	include "iniprint.h"
334	!===============================================================================
335	! Arguments:
336	CHARACTER(LEN=*), INTENT(IN) :: fichnom !-- FILE NAME
337	REAL, INTENT(IN) :: time !-- TIME
338	REAL, INTENT(IN) :: vcov(iip1,jjm, llm) !-- V COVARIANT WIND
339	REAL, INTENT(IN) :: ucov(iip1,jjp1,llm) !-- U COVARIANT WIND
340	REAL, INTENT(IN) :: teta(iip1,jjp1,llm) !-- POTENTIAL TEMPERATURE
341	REAL, INTENT(INOUT) :: q(iip1,jjp1,llm,nqtot) !-- TRACERS
342	REAL, INTENT(IN) :: masse(iip1,jjp1,llm) !-- MASS PER CELL
343	REAL, INTENT(IN) :: ps(iip1,jjp1) !-- GROUND PRESSURE
344	!===============================================================================
345	! Local variables:
346	INTEGER :: l, iq, nid, vID, ierr, nid_trac, vID_trac
347	INTEGER,SAVE :: nb=0
348	INTEGER, PARAMETER :: length=100
349	REAL :: tab_cntrl(length) ! tableau des parametres du run
350	CHARACTER(LEN=256) :: var, dum
351	LOGICAL :: lread_inca
352	CHARACTER(LEN=80) :: abort_message
353	CHARACTER(len=12) :: start_file_type="earth" ! default start file type
354
355	! fill dynredem_mod module variables
356	modname='dynredem1_p'; fil=fichnom
357
358	! Gather datasets
359	call Gather_Field(ucov,ip1jmp1,llm,0)
360	call Gather_Field(vcov,ip1jm,llm,0)
361	call Gather_Field(teta,ip1jmp1,llm,0)
362	call Gather_Field(masse,ip1jmp1,llm,0)
363	call Gather_Field(ps,ip1jmp1,1,0)
364
365	do iq=1,nqtot
366	call Gather_Field(q(:,:,:,iq),ip1jmp1,llm,0)
367	enddo
368
369	IF (mpi_rank==0) THEN ! only the master writes restart file
370
371	if ((planet_type.eq."generic").or.(planet_type.eq."mars")) then
372	write(lunout,*) trim(modname),' : Planeto-like start file'
373	start_file_type="planeto"
374	else
375	write(lunout,*) trim(modname),' : Earth-like start file'
376	endif
377
378	CALL err(NF90_OPEN(fil,NF90_WRITE,nid),"open",fil)
379
380	!--- Write/extend time coordinate
381	nb = nb + 1
382	if (start_file_type.eq."earth") then
383	ierr = NF_INQ_VARID(nid, "temps", vID)
384	IF (ierr .NE. NF_NOERR) THEN
385	write(lunout,*) NF_STRERROR(ierr)
386	abort_message='Variable temps n est pas definie'
387	CALL abort_gcm(modname,abort_message,ierr)
388	ENDIF
389	else
390	ierr = NF_INQ_VARID(nid,"Time", vID)
391	IF (ierr .NE. NF_NOERR) THEN
392	write(lunout,*) NF_STRERROR(ierr)
393	abort_message='Variable Time not found'
394	CALL abort_gcm(modname,abort_message,ierr)
395	ENDIF
396	endif ! of if (start_file_type.eq."earth")
397	call NF95_PUT_VAR(nid,vID,time,start=(/nb/))
398	WRITE(lunout,*)TRIM(modname)//": Saving for ", nb, time
399
400	!--- Rewrite control table (itaufin undefined in dynredem0)
401	var="controle"
402	CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
403	CALL err(NF90_GET_VAR(nid,vID,tab_cntrl),"get",var)
404	if (start_file_type=="earth") then
405	tab_cntrl(31) = REAL(itau_dyn + itaufin)
406	else
407	tab_cntrl(31) = 0
408	endif
409	CALL err(NF90_INQ_VARID(nid,var,vID),"inq",var)
410	CALL err(NF90_PUT_VAR(nid,vID,tab_cntrl),"put",var)
411
412	!--- Save fields
413	CALL dynredem_write_u(nid,"ucov" ,ucov ,llm, nb)
414	CALL dynredem_write_v(nid,"vcov" ,vcov ,llm, nb)
415	CALL dynredem_write_u(nid,"teta" ,teta ,llm, nb)
416	CALL dynredem_write_u(nid,"masse",masse,llm, nb)
417	CALL dynredem_write_u(nid,"ps" ,ps ,1, nb)
418
419	!--- Tracers in file "start_trac.nc" (added by Anne)
420	lread_inca=.FALSE.; fil="start_trac.nc"
421	IF(type_trac=='inca') INQUIRE(FILE=fil,EXIST=lread_inca)
422	IF(lread_inca) CALL err(NF90_OPEN(fil,NF90_NOWRITE,nid_trac),"open")
423
424	!--- Save tracers
425	IF(nqtot.GE.1) THEN
426	DO iq=1,nqtot
427	var=tname(iq); ierr=-1
428	IF(lread_inca) THEN !--- Possibly read from "start_trac.nc"
429	fil="start_trac.nc"
430	ierr=NF90_INQ_VARID(nid_trac,var,vID_trac)
431	dum='inq'; IF(ierr==NF90_NoErr) dum='fnd'
432	WRITE(lunout,*)msg(dum,var)
433
434
435	IF(ierr==NF90_NoErr) CALL dynredem_read_u(nid_trac,var,q(:,:,:,iq),llm)
436	END IF ! of IF(lread_inca)
437	fil=fichnom
438	CALL dynredem_write_u(nid,var,q(:,:,:,iq),llm,nb)
439	END DO ! of DO iq=1,nqtot
440	ENDIF ! of IF(nqtot.GE.1)
441
442	CALL err(NF90_CLOSE(nid),"close")
443	fil="start_trac.nc"
444	IF(lread_inca) CALL err(NF90_CLOSE(nid_trac),"close")
445
446	ENDIF ! of IF (mpi_rank==0)
447
448	END SUBROUTINE dynredem1_p
449

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

Download in other formats:

Original Format