Context Navigation

dynredem_p.F90 @ 3452

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

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

Download in other formats:

Original Format