Context Navigation

iostart.F90 @ 2909

Last change on this file since 2909 was 2907, checked in by romain.vande, 2 years ago

Mars PCM:
Further implementation of subslope parametrisation.
Carefull ! This is a devolpment revision and it still need improvements and tests.
However, this commit should not change anything for nslope=1. Only nslope=1 is possible for now!

Sloped variables in the startfi are outputed along the nslope dimension.

Possibility to output variables on a specific subslope in diagfi using VAR_slopeXX in the diagfi.def,
with VAR the variable name (ex: tsurf, co2ice...) and XX the slope number (ex: 04, 07...).
Without any specific mention to slope, variable named VAR in the diagfi.def will correspond to the variable in the flat slope, this can change in the future.

Other code changes for nslope.gt.1 (sometimes the grid mesh average is used instead of the value of the subslope):

Changes for albedo :
albedo_mesh_avg is used in callradite

Changes for emis :
emis_mesh_avg is used in callradite

Changes for zdqsdif:
zdqsdif_mesh_avg is used for lifting in turbulent-resolving mode

Changes for qsurf:
qsurf_mesh_avg is used for callradite, rocketduststorm, topmons.
qsurf of the major slope is used for calchim and geticecover (tituscap)

Changes for tsurf is the next commit.

File size: 35.8 KB

Line
1	MODULE iostart
2
3	IMPLICIT NONE
4	PRIVATE
5	INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
6	INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
7
8	! restartfi.nc file dimension identifiers: (see open_restartphy())
9	INTEGER,SAVE :: idim1 ! "index" dimension
10	INTEGER,SAVE :: idim2 ! "physical_points" dimension
11	INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
12	INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
13	INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
14	INTEGER,SAVE :: idim6 ! "nlayer" dimension
15	INTEGER,SAVE :: idim7 ! "Time" dimension
16	INTEGER,SAVE :: idim8 ! "nslope" dimension
17	INTEGER,SAVE :: idim9 ! "inter slope" dimension
18	INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
19	INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
20
21	INTERFACE get_field
22	MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
23	END INTERFACE get_field
24
25	INTERFACE get_var
26	MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
27	END INTERFACE get_var
28
29	INTERFACE put_field
30	MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
31	END INTERFACE put_field
32
33	INTERFACE put_var
34	MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
35	END INTERFACE put_var
36
37	PUBLIC nid_start, length
38	PUBLIC get_field,get_var,put_field,put_var
39	PUBLIC inquire_dimension, inquire_dimension_length
40	PUBLIC inquire_field, inquire_field_ndims
41	PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
42
43	CONTAINS
44
45	SUBROUTINE open_startphy(filename)
46	USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
47	USE mod_phys_lmdz_para, only: is_master, bcast
48	IMPLICIT NONE
49	CHARACTER(LEN=*) :: filename
50	INTEGER :: ierr
51
52	IF (is_master) THEN
53	ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
54	IF (ierr.NE.NF90_NOERR) THEN
55	write(,)'open_startphy: problem opening file '//trim(filename)
56	write(,)trim(nf90_strerror(ierr))
57	CALL abort_physic("open_startphy","Cannot open file",1)
58	ENDIF
59	ENDIF
60
61	CALL bcast(nid_start) ! tell all procs about nid_start
62
63	END SUBROUTINE open_startphy
64
65	SUBROUTINE close_startphy
66	USE netcdf, only: NF90_CLOSE
67	USE mod_phys_lmdz_para, only: is_master
68	IMPLICIT NONE
69	INTEGER :: ierr
70
71	IF (is_master) THEN
72	ierr = NF90_CLOSE (nid_start)
73	ENDIF
74
75	END SUBROUTINE close_startphy
76
77
78	FUNCTION inquire_field(Field_name)
79	! check if a given field is present in the input file
80	USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
81	USE mod_phys_lmdz_para, only: is_master, bcast
82	IMPLICIT NONE
83	CHARACTER(LEN=*),INTENT(IN) :: Field_name
84	LOGICAL :: inquire_field
85	INTEGER :: varid
86	INTEGER :: ierr
87
88	IF (is_master) THEN
89	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
90	IF (ierr==NF90_NOERR) THEN
91	Inquire_field=.TRUE.
92	ELSE
93	Inquire_field=.FALSE.
94	ENDIF
95	ENDIF
96
97	CALL bcast(inquire_field)
98
99	END FUNCTION inquire_field
100
101
102	FUNCTION inquire_field_ndims(Field_name)
103	! give the number of dimensions of "Field_name" stored in the input file
104	USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
105	NF90_NOERR, nf90_strerror
106	USE mod_phys_lmdz_para, only: is_master, bcast
107	IMPLICIT NONE
108	CHARACTER(LEN=*),INTENT(IN) :: Field_name
109	INTEGER :: inquire_field_ndims
110	INTEGER :: varid
111	INTEGER :: ierr
112
113	IF (is_master) THEN
114	ierr=nf90_inq_varid(nid_start,Field_name,varid)
115	ierr=nf90_inquire_variable(nid_start,varid,&
116	ndims=inquire_field_ndims)
117	IF (ierr.NE.NF90_NOERR) THEN
118	write(,)'inquire_field_ndims: problem obtaining ndims of '&
119	//trim(field_name)
120	write(,)trim(nf90_strerror(ierr))
121	CALL abort_physic("inquire_field_ndims","Failed to get ndims",1)
122	ENDIF
123	ENDIF
124
125	CALL bcast(inquire_field_ndims)
126
127	END FUNCTION inquire_field_ndims
128
129
130	FUNCTION inquire_dimension(Field_name)
131	! check if a given dimension is present in the input file
132	USE netcdf, only: nf90_inq_dimid, NF90_NOERR
133	USE mod_phys_lmdz_para, only: is_master, bcast
134	IMPLICIT NONE
135	CHARACTER(LEN=*),INTENT(IN) :: Field_name
136	LOGICAL :: inquire_dimension
137	INTEGER :: varid
138	INTEGER :: ierr
139
140	IF (is_master) THEN
141	ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
142	IF (ierr==NF90_NOERR) THEN
143	Inquire_dimension=.TRUE.
144	ELSE
145	Inquire_dimension=.FALSE.
146	ENDIF
147	ENDIF
148
149	CALL bcast(inquire_dimension)
150
151	END FUNCTION inquire_dimension
152
153	FUNCTION inquire_dimension_length(Field_name)
154	! give the length of the "Field_name" dimension stored in the input file
155	USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
156	NF90_NOERR, nf90_strerror
157	USE mod_phys_lmdz_para, only: is_master, bcast
158	IMPLICIT NONE
159	CHARACTER(LEN=*),INTENT(IN) :: Field_name
160	INTEGER :: inquire_dimension_length
161	INTEGER :: varid
162	INTEGER :: ierr
163
164	IF (is_master) THEN
165	ierr=nf90_inq_dimid(nid_start,Field_name,varid)
166	ierr=nf90_inquire_dimension(nid_start,varid,&
167	len=inquire_dimension_length)
168	IF (ierr.NE.NF90_NOERR) THEN
169	write(,)'inquire_field_length: problem obtaining length of '&
170	//trim(field_name)
171	write(,)trim(nf90_strerror(ierr))
172	CALL abort_physic("inquire_field_ndims","Failed to get length",1)
173	ENDIF
174	ENDIF
175
176	CALL bcast(inquire_dimension_length)
177
178	END FUNCTION inquire_dimension_length
179
180
181
182	SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
183	! For a surface field
184	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
185	IMPLICIT NONE
186	CHARACTER(LEN=*),INTENT(IN) :: Field_name
187	REAL,INTENT(INOUT) :: Field(:)
188	LOGICAL,INTENT(OUT),OPTIONAL :: found
189	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
190
191	integer :: edges(4), corners(4)
192
193	edges(1)=klon_glo
194	edges(2:4)=1
195	corners(1:4)=1
196	if (PRESENT(timeindex)) then
197	corners(2)=timeindex
198	endif
199
200	IF (PRESENT(found)) THEN
201	CALL Get_field_rgen(field_name,field,1,corners,edges,found)
202	ELSE
203	CALL Get_field_rgen(field_name,field,1,corners,edges)
204	ENDIF
205
206	END SUBROUTINE Get_Field_r1
207
208	SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
209	! For a "3D" horizontal-vertical field
210	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
211	IMPLICIT NONE
212	CHARACTER(LEN=*),INTENT(IN) :: Field_name
213	REAL,INTENT(INOUT) :: Field(:,:)
214	LOGICAL,INTENT(OUT),OPTIONAL :: found
215	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
216
217	integer :: edges(4), corners(4)
218
219	edges(1)=klon_glo
220	edges(2)=size(field,2)
221	edges(3:4)=1
222	corners(1:4)=1
223	if (PRESENT(timeindex)) then
224	corners(3)=timeindex
225	endif
226
227	IF (PRESENT(found)) THEN
228	CALL Get_field_rgen(field_name,field,size(field,2),&
229	corners,edges,found)
230	ELSE
231	CALL Get_field_rgen(field_name,field,size(field,2),&
232	corners,edges)
233	ENDIF
234
235
236	END SUBROUTINE Get_Field_r2
237
238	SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
239	! for a "4D" field surf/alt/??
240	use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
241	IMPLICIT NONE
242	CHARACTER(LEN=*),INTENT(IN) :: Field_name
243	REAL,INTENT(INOUT) :: Field(:,:,:)
244	LOGICAL,INTENT(OUT),OPTIONAL :: found
245	INTEGER,INTENT(IN),OPTIONAL :: timeindex ! time index of sought data
246
247	integer :: edges(4), corners(4)
248
249	edges(1)=klon_glo
250	edges(2)=size(field,2)
251	edges(3)=size(field,3)
252	edges(4)=1
253	corners(1:4)=1
254	if (PRESENT(timeindex)) then
255	corners(4)=timeindex
256	endif
257
258	IF (PRESENT(found)) THEN
259	CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
260	corners,edges,found)
261	ELSE
262	CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
263	corners,edges)
264	ENDIF
265
266	END SUBROUTINE Get_Field_r3
267
268	SUBROUTINE Get_field_rgen(field_name,field,field_size, &
269	corners,edges,found)
270	USE netcdf
271	USE dimphy
272	USE mod_grid_phy_lmdz
273	USE mod_phys_lmdz_para
274	IMPLICIT NONE
275	CHARACTER(LEN=*) :: Field_name
276	INTEGER :: field_size
277	REAL :: field(klon,field_size)
278	INTEGER,INTENT(IN) :: corners(4)
279	INTEGER,INTENT(IN) :: edges(4)
280	LOGICAL,OPTIONAL :: found
281
282	REAL :: field_glo(klon_glo,field_size)
283	LOGICAL :: tmp_found
284	INTEGER :: varid
285	INTEGER :: ierr
286
287	IF (is_master) THEN
288
289	ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
290
291	IF (ierr==NF90_NOERR) THEN
292	CALL body(field_glo)
293	tmp_found=.TRUE.
294	ELSE
295	tmp_found=.FALSE.
296	ENDIF
297
298	ENDIF
299
300	CALL bcast(tmp_found)
301
302	IF (tmp_found) THEN
303	CALL scatter(field_glo,field)
304	ENDIF
305
306	IF (PRESENT(found)) THEN
307	found=tmp_found
308	ELSE
309	IF (.NOT. tmp_found) THEN
310	PRINT*, 'get_field_rgen: Field <'//field_name//'> not found'
311	CALL abort_physic("get_field_rgen","Failed to get field",1)
312	ENDIF
313	ENDIF
314
315
316	CONTAINS
317
318	SUBROUTINE body(field_glo)
319	REAL :: field_glo(klon_glo*field_size)
320	ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
321	IF (ierr/=NF90_NOERR) THEN
322	! La variable exist dans le fichier mais la lecture a echouee.
323	PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
324
325	! IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
326	! ! Essaye de lire le variable sur surface uniqument, comme fait avant
327	! field_glo(:)=0.
328	! ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
329	! IF (ierr/=NF90_NOERR) THEN
330	! PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
331	! CALL abort
332	! ELSE
333	! PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
334	! END IF
335	! ELSE
336	CALL abort_physic("get_field_rgen","Failed to read field",1)
337	! ENDIF
338	ENDIF
339
340	END SUBROUTINE body
341
342	END SUBROUTINE Get_field_rgen
343
344
345	SUBROUTINE get_var_r0(var_name,var,found)
346	! Get a scalar from input file
347	IMPLICIT NONE
348	CHARACTER(LEN=*),INTENT(IN) :: var_name
349	REAL,INTENT(INOUT) :: var
350	LOGICAL,OPTIONAL,INTENT(OUT) :: found
351
352	REAL :: varout(1)
353
354	IF (PRESENT(found)) THEN
355	CALL Get_var_rgen(var_name,varout,size(varout),found)
356	ELSE
357	CALL Get_var_rgen(var_name,varout,size(varout))
358	ENDIF
359	var=varout(1)
360
361	END SUBROUTINE get_var_r0
362
363	SUBROUTINE get_var_r1(var_name,var,found)
364	! Get a vector from input file
365	IMPLICIT NONE
366	CHARACTER(LEN=*),INTENT(IN) :: var_name
367	REAL,INTENT(INOUT) :: var(:)
368	LOGICAL,OPTIONAL,INTENT(OUT) :: found
369
370	IF (PRESENT(found)) THEN
371	CALL Get_var_rgen(var_name,var,size(var),found)
372	ELSE
373	CALL Get_var_rgen(var_name,var,size(var))
374	ENDIF
375
376	END SUBROUTINE get_var_r1
377
378	SUBROUTINE get_var_r2(var_name,var,found)
379	! Get a 2D field from input file
380	IMPLICIT NONE
381	CHARACTER(LEN=*),INTENT(IN) :: var_name
382	REAL,INTENT(OUT) :: var(:,:)
383	LOGICAL,OPTIONAL,INTENT(OUT) :: found
384
385	IF (PRESENT(found)) THEN
386	CALL Get_var_rgen(var_name,var,size(var),found)
387	ELSE
388	CALL Get_var_rgen(var_name,var,size(var))
389	ENDIF
390
391	END SUBROUTINE get_var_r2
392
393	SUBROUTINE get_var_r3(var_name,var,found)
394	! Get a 3D field frominput file
395	IMPLICIT NONE
396	CHARACTER(LEN=*),INTENT(IN) :: var_name
397	REAL,INTENT(INOUT) :: var(:,:,:)
398	LOGICAL,OPTIONAL,INTENT(OUT) :: found
399
400	IF (PRESENT(found)) THEN
401	CALL Get_var_rgen(var_name,var,size(var),found)
402	ELSE
403	CALL Get_var_rgen(var_name,var,size(var))
404	ENDIF
405
406	END SUBROUTINE get_var_r3
407
408	SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
409	USE netcdf
410	USE dimphy
411	USE mod_grid_phy_lmdz
412	USE mod_phys_lmdz_para
413	IMPLICIT NONE
414	CHARACTER(LEN=*) :: var_name
415	INTEGER :: var_size
416	REAL :: var(var_size)
417	LOGICAL,OPTIONAL :: found
418
419	LOGICAL :: tmp_found
420	INTEGER :: varid
421	INTEGER :: ierr
422
423	IF (is_mpi_root .AND. is_omp_root) THEN
424
425	ierr=NF90_INQ_VARID(nid_start,var_name,varid)
426
427	IF (ierr==NF90_NOERR) THEN
428	ierr=NF90_GET_VAR(nid_start,varid,var)
429	IF (ierr/=NF90_NOERR) THEN
430	PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>'
431	CALL abort_physic("get_var_rgen","Failed to read variable",1)
432	ENDIF
433	tmp_found=.TRUE.
434	ELSE
435	tmp_found=.FALSE.
436	ENDIF
437
438	ENDIF
439
440	CALL bcast(tmp_found)
441
442	IF (tmp_found) THEN
443	CALL bcast(var)
444	ENDIF
445
446	IF (PRESENT(found)) THEN
447	found=tmp_found
448	ELSE
449	IF (.NOT. tmp_found) THEN
450	PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found'
451	CALL abort_physic("get_var_rgen","Failed to read variable",1)
452	ENDIF
453	ENDIF
454
455	END SUBROUTINE Get_var_rgen
456
457	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
458
459	SUBROUTINE open_restartphy(filename)
460	USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
461	NF90_NOERR, nf90_strerror, &
462	NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
463	NF90_UNLIMITED, NF90_ENDDEF, &
464	NF90_WRITE, NF90_OPEN
465	USE mod_phys_lmdz_para, only: is_master
466	USE mod_grid_phy_lmdz, only: klon_glo
467	USE dimphy, only: klev, klevp1
468	USE tracer_mod, only: nqmx
469	USE comsoil_h, only: nsoilmx
470	USE comslope_mod, only: nslope
471	IMPLICIT NONE
472	CHARACTER(LEN=*),INTENT(IN) :: filename
473	INTEGER :: ierr
474	LOGICAL,SAVE :: already_created=.false.
475
476	IF (is_master) THEN
477	if (.not.already_created) then
478	! At the very first call, create the file
479	ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
480	nid_restart)
481	IF (ierr/=NF90_NOERR) THEN
482	write(,)'open_restartphy: problem creating file '//trim(filename)
483	write(,)trim(nf90_strerror(ierr))
484	CALL abort_physic("open_restartphy","Failed creating file",1)
485	ENDIF
486	already_created=.true.
487	else
488	! Just open the file
489	ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
490	IF (ierr/=NF90_NOERR) THEN
491	write(,)'open_restartphy: problem opening file '//trim(filename)
492	write(,)trim(nf90_strerror(ierr))
493	CALL abort_physic("open_restartphy","Failed opening file",1)
494	ENDIF
495	return
496	endif ! of if (.not.already_created)
497
498	ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
499	"Physics start file")
500	IF (ierr/=NF90_NOERR) THEN
501	write(,)'open_restartphy: problem writing title '
502	write(,)trim(nf90_strerror(ierr))
503	ENDIF
504
505	ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
506	IF (ierr/=NF90_NOERR) THEN
507	write(,)'open_restartphy: problem defining index dimension '
508	write(,)trim(nf90_strerror(ierr))
509	CALL abort_physic("open_restartphy","Failed defining index",1)
510	ENDIF
511
512	ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
513	IF (ierr/=NF90_NOERR) THEN
514	write(,)'open_restartphy: problem defining physical_points dimension '
515	write(,)trim(nf90_strerror(ierr))
516	CALL abort_physic("open_restartphy","Failed defining physical_points",1)
517	ENDIF
518
519	ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
520	IF (ierr/=NF90_NOERR) THEN
521	write(,)'open_restartphy: problem defining subsurface_layers dimension '
522	write(,)trim(nf90_strerror(ierr))
523	CALL abort_physic("open_restartphy","Failed defining subsurface_layers",1)
524	ENDIF
525
526	ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
527	IF (ierr/=NF90_NOERR) THEN
528	write(,)'open_restartphy: problem defining nlayer_plus_1 dimension '
529	write(,)trim(nf90_strerror(ierr))
530	CALL abort_physic("open_restartphy","Failed defining nlayer_plus_1",1)
531	ENDIF
532
533	if (nqmx.ne.0) then
534	ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqmx,idim5)
535	else
536	! pretend nqmx=1 because 0 size implies unlimited dimension for NetCDF
537	ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",1,idim5)
538	endif
539	IF (ierr/=NF90_NOERR) THEN
540	write(,)'open_restartphy: problem defining number_of_advected_fields dimension '
541	write(,)trim(nf90_strerror(ierr))
542	CALL abort_physic("open_restartphy","Failed defining number_of_advected_fields",1)
543	ENDIF
544
545	ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
546	IF (ierr/=NF90_NOERR) THEN
547	write(,)'open_restartphy: problem defining nlayer dimension '
548	write(,)trim(nf90_strerror(ierr))
549	CALL abort_physic("open_restartphy","Failed defining nlayer",1)
550	ENDIF
551
552	ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
553	IF (ierr/=NF90_NOERR) THEN
554	write(,)'open_restartphy: problem defining Time dimension '
555	write(,)trim(nf90_strerror(ierr))
556	CALL abort_physic("open_restartphy","Failed defining Time",1)
557	ENDIF
558
559	ierr=NF90_DEF_DIM(nid_restart,"nslope",nslope,idim8)
560	IF (ierr/=NF90_NOERR) THEN
561	write(,)'phyredem: problem defining nslope dimension'
562	write(,)trim(nf90_strerror(ierr))
563	CALL ABORT
564	ENDIF
565
566	ierr=NF90_DEF_DIM(nid_restart,"inter slope",nslope+1,idim9)
567	IF (ierr/=NF90_NOERR) THEN
568	write(,)'phyredem: problem defining inter slope dimension'
569	write(,)trim(nf90_strerror(ierr))
570	CALL ABORT
571	ENDIF
572
573	ierr=NF90_ENDDEF(nid_restart)
574	IF (ierr/=NF90_NOERR) THEN
575	write(,)'open_restartphy: problem ending definition mode '
576	write(,)trim(nf90_strerror(ierr))
577	CALL abort_physic("open_restartphy","Failed ending definition mode",1)
578	ENDIF
579	ENDIF
580
581	END SUBROUTINE open_restartphy
582
583	SUBROUTINE close_restartphy
584	USE netcdf, only: NF90_CLOSE
585	USE mod_phys_lmdz_para, only: is_master
586	IMPLICIT NONE
587	INTEGER :: ierr
588
589	IF (is_master) THEN
590	ierr = NF90_CLOSE (nid_restart)
591	ENDIF
592
593	END SUBROUTINE close_restartphy
594
595	SUBROUTINE put_field_r1(field_name,title,field,time)
596	! For a surface field
597	IMPLICIT NONE
598	CHARACTER(LEN=*),INTENT(IN) :: field_name
599	CHARACTER(LEN=*),INTENT(IN) :: title
600	REAL,INTENT(IN) :: field(:)
601	REAL,OPTIONAL,INTENT(IN) :: time
602
603	IF (present(time)) THEN
604	! if timeindex is present, it is a time-dependent variable
605	CALL put_field_rgen(field_name,title,field,1,time)
606	ELSE
607	CALL put_field_rgen(field_name,title,field,1)
608	ENDIF
609
610	END SUBROUTINE put_field_r1
611
612	SUBROUTINE put_field_r2(field_name,title,field,time)
613	! For a "3D" horizontal-vertical field
614	IMPLICIT NONE
615	CHARACTER(LEN=*),INTENT(IN) :: field_name
616	CHARACTER(LEN=*),INTENT(IN) :: title
617	REAL,INTENT(IN) :: field(:,:)
618	REAL,OPTIONAL,INTENT(IN) :: time
619
620	IF (present(time)) THEN
621	! if timeindex is present, it is a time-dependent variable
622	CALL put_field_rgen(field_name,title,field,size(field,2),time)
623	ELSE
624	CALL put_field_rgen(field_name,title,field,size(field,2))
625	ENDIF
626
627	END SUBROUTINE put_field_r2
628
629	SUBROUTINE put_field_r3(field_name,title,field,time)
630	! For a "4D" field surf/alt/??
631	IMPLICIT NONE
632	CHARACTER(LEN=*),INTENT(IN) :: field_name
633	CHARACTER(LEN=*),INTENT(IN) :: title
634	REAL,INTENT(IN) :: field(:,:,:)
635	REAL,OPTIONAL,INTENT(IN) :: time
636
637	IF (present(time)) THEN
638	! if timeindex is present, it is a time-dependent variable
639	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
640	time)
641	ELSE
642	CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
643	ENDIF
644
645	END SUBROUTINE put_field_r3
646
647	SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
648	USE netcdf
649	USE dimphy
650	USE comsoil_h, only: nsoilmx
651	USE comslope_mod, ONLY: nslope
652	USE mod_grid_phy_lmdz
653	USE mod_phys_lmdz_para
654	IMPLICIT NONE
655	CHARACTER(LEN=*),INTENT(IN) :: field_name
656	CHARACTER(LEN=*),INTENT(IN) :: title
657	INTEGER,INTENT(IN) :: field_size
658	REAL,INTENT(IN) :: field(klon,field_size)
659	REAL,OPTIONAL,INTENT(IN) :: time
660
661	REAL :: field_glo(klon_glo,field_size)
662	INTEGER :: ierr
663	INTEGER :: nvarid
664	INTEGER :: idim
665
666	CALL gather(field,field_glo)
667
668	IF (is_master) THEN
669
670	IF (field_size==1) THEN
671	! input is a 1D "surface field" array
672	if (.not.present(time)) then ! for a time-independent field
673	ierr=NF90_REDEF(nid_restart)
674	#ifdef NC_DOUBLE
675	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
676	(/idim2/),nvarid)
677	#else
678	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
679	(/idim2/),nvarid)
680	#endif
681	if (ierr.ne.NF90_NOERR) then
682	write(,)"put_field_rgen error: failed to define "//trim(field_name)
683	write(,)trim(nf90_strerror(ierr))
684	endif
685	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
686	ierr=NF90_ENDDEF(nid_restart)
687	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
688	else
689	! check if the variable has already been defined:
690	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
691	if (ierr/=NF90_NOERR) then ! variable not found, define it
692	ierr=NF90_REDEF(nid_restart)
693	#ifdef NC_DOUBLE
694	if(field_name.eq. "tauscaling" .or. field_name.eq. "totcloudfrac" .or. field_name.eq. "wstar" ) then
695	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
696	(/idim2,idim7/),nvarid)
697	else
698	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
699	(/idim2,idim8,idim7/),nvarid)
700	endif
701	#else
702	if(field_name.eq. "tauscaling" .or. field_name.eq. "totcloudfrac" .or. field_name.eq. "wstar" ) then
703	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
704	(/idim2,idim7/),nvarid)
705	else
706	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
707	(/idim2,idim8,idim7/),nvarid)
708	endif
709	#endif
710	if (ierr.ne.NF90_NOERR) then
711	write(,)"put_field_rgen error: failed to define "//trim(field_name)
712	write(,)trim(nf90_strerror(ierr))
713	endif
714	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
715	ierr=NF90_ENDDEF(nid_restart)
716	endif
717	! Write the variable
718	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
719	start=(/1,timeindex/))
720	endif ! of if (.not.present(timeindex))
721
722	ELSE IF (field_size==klev) THEN
723	! input is a 2D "atmospheric field" array
724	if (.not.present(time)) then ! for a time-independent field
725	ierr=NF90_REDEF(nid_restart)
726	#ifdef NC_DOUBLE
727	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
728	(/idim2,idim6/),nvarid)
729	#else
730	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
731	(/idim2,idim6/),nvarid)
732	#endif
733	if (ierr.ne.NF90_NOERR) then
734	write(,)"put_field_rgen error: failed to define "//trim(field_name)
735	write(,)trim(nf90_strerror(ierr))
736	endif
737	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
738	ierr=NF90_ENDDEF(nid_restart)
739	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
740	else
741	! check if the variable has already been defined:
742	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
743	if (ierr/=NF90_NOERR) then ! variable not found, define it
744	ierr=NF90_REDEF(nid_restart)
745	#ifdef NC_DOUBLE
746	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
747	(/idim2,idim6,idim7/),nvarid)
748	#else
749	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
750	(/idim2,idim6,idim7/),nvarid)
751	#endif
752	if (ierr.ne.NF90_NOERR) then
753	write(,)"put_field_rgen error: failed to define "//trim(field_name)
754	write(,)trim(nf90_strerror(ierr))
755	endif
756	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
757	ierr=NF90_ENDDEF(nid_restart)
758	endif
759	! Write the variable
760	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
761	start=(/1,1,timeindex/))
762	endif ! of if (.not.present(time))
763
764	ELSE IF (field_size==klevp1) THEN
765	! input is a 2D "interlayer atmospheric field" array
766	if (.not.present(time)) then ! for a time-independent field
767	ierr=NF90_REDEF(nid_restart)
768	#ifdef NC_DOUBLE
769	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
770	(/idim2,idim4/),nvarid)
771	#else
772	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
773	(/idim2,idim4/),nvarid)
774	#endif
775	if (ierr.ne.NF90_NOERR) then
776	write(,)"put_field_rgen error: failed to define "//trim(field_name)
777	write(,)trim(nf90_strerror(ierr))
778	endif
779	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
780	ierr = NF90_ENDDEF(nid_restart)
781	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
782	else
783	! check if the variable has already been defined:
784	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
785	if (ierr/=NF90_NOERR) then ! variable not found, define it
786	ierr=NF90_REDEF(nid_restart)
787	#ifdef NC_DOUBLE
788	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
789	(/idim2,idim4,idim7/),nvarid)
790	#else
791	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
792	(/idim2,idim4,idim7/),nvarid)
793	#endif
794	if (ierr.ne.NF90_NOERR) then
795	write(,)"put_field_rgen error: failed to define "//trim(field_name)
796	write(,)trim(nf90_strerror(ierr))
797	endif
798	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
799	ierr=NF90_ENDDEF(nid_restart)
800	endif
801	! Write the variable
802	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
803	start=(/1,1,timeindex/))
804	endif ! of if (.not.present(timeindex))
805
806	ELSE IF (field_size==nsoilmx) THEN
807	! input is a 2D "subsurface field" array
808	if (.not.present(time)) then ! for a time-independent field
809	ierr = NF90_REDEF(nid_restart)
810	#ifdef NC_DOUBLE
811	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
812	(/idim2,idim3/),nvarid)
813	#else
814	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
815	(/idim2,idim3/),nvarid)
816	#endif
817	if (ierr.ne.NF90_NOERR) then
818	write(,)"put_field_rgen error: failed to define "//trim(field_name)
819	write(,)trim(nf90_strerror(ierr))
820	endif
821	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
822	ierr = NF90_ENDDEF(nid_restart)
823	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
824	else
825	! check if the variable has already been defined:
826	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
827	if (ierr/=NF90_NOERR) then ! variable not found, define it
828	ierr=NF90_REDEF(nid_restart)
829	#ifdef NC_DOUBLE
830	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
831	(/idim2,idim3,idim7/),nvarid)
832	#else
833	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
834	(/idim2,idim3,idim7/),nvarid)
835	#endif
836	if (ierr.ne.NF90_NOERR) then
837	write(,)"put_field_rgen error: failed to define "//trim(field_name)
838	write(,)trim(nf90_strerror(ierr))
839	endif
840	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
841	ierr=NF90_ENDDEF(nid_restart)
842	endif
843	! Write the variable
844	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
845	start=(/1,1,timeindex/))
846
847	endif ! of if (.not.present(time))
848
849	ELSE IF (field_size==nslope) THEN
850	! input is a 2D "subsurface field" array
851	if (.not.present(time)) then ! for a time-independent field
852	ierr = NF90_REDEF(nid_restart)
853	#ifdef NC_DOUBLE
854	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
855	(/idim2,idim8/),nvarid)
856	#else
857	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
858	(/idim2,idim8/),nvarid)
859	#endif
860	if (ierr.ne.NF90_NOERR) then
861	write(,)"put_field_rgen error: failed to define"//trim(field_name)
862	write(,)trim(nf90_strerror(ierr))
863	endif
864	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
865	ierr = NF90_ENDDEF(nid_restart)
866	ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
867	else
868	! check if the variable has already been defined:
869	ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
870	if (ierr/=NF90_NOERR) then ! variable not found, define it
871	ierr=NF90_REDEF(nid_restart)
872	#ifdef NC_DOUBLE
873	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
874	(/idim2,idim8,idim7/),nvarid)
875	#else
876	ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
877	(/idim2,idim8,idim7/),nvarid)
878	#endif
879	if (ierr.ne.NF90_NOERR) then
880	write(,)"put_field_rgen error: failed to define"//trim(field_name)
881	write(,)trim(nf90_strerror(ierr))
882	endif
883	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
884	ierr=NF90_ENDDEF(nid_restart)
885	endif
886	! Write the variable
887	ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
888	start=(/1,1,timeindex/))
889
890	endif ! of if (.not.present(time))
891
892	ELSE
893	PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
894	write(,) " field_size =",field_size
895	CALL abort_physic("put_field_rgen","wrong field dimension",1)
896	ENDIF
897
898	! Check the writting of field to file went OK
899	if (ierr.ne.NF90_NOERR) then
900	write(,) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
901	write(,)trim(nf90_strerror(ierr))
902	CALL abort_physic("put_field_rgen","Failed writing field",1)
903	endif
904
905	ENDIF ! of IF (is_master)
906
907	END SUBROUTINE put_field_rgen
908
909	SUBROUTINE put_var_r0(var_name,title,var)
910	! Put a scalar in file
911	IMPLICIT NONE
912	CHARACTER(LEN=*),INTENT(IN) :: var_name
913	CHARACTER(LEN=*),INTENT(IN) :: title
914	REAL,INTENT(IN) :: var
915	REAL :: varin(1)
916
917	varin(1)=var
918
919	CALL put_var_rgen(var_name,title,varin,size(varin))
920
921	END SUBROUTINE put_var_r0
922
923
924	SUBROUTINE put_var_r1(var_name,title,var)
925	! Put a vector in file
926	IMPLICIT NONE
927	CHARACTER(LEN=*),INTENT(IN) :: var_name
928	CHARACTER(LEN=*),INTENT(IN) :: title
929	REAL,INTENT(IN) :: var(:)
930
931	CALL put_var_rgen(var_name,title,var,size(var))
932
933	END SUBROUTINE put_var_r1
934
935	SUBROUTINE put_var_r2(var_name,title,var)
936	! Put a 2D field in file
937	IMPLICIT NONE
938	CHARACTER(LEN=*),INTENT(IN) :: var_name
939	CHARACTER(LEN=*),INTENT(IN) :: title
940	REAL,INTENT(IN) :: var(:,:)
941
942	CALL put_var_rgen(var_name,title,var,size(var))
943
944	END SUBROUTINE put_var_r2
945
946	SUBROUTINE put_var_r3(var_name,title,var)
947	! Put a 3D field in file
948	IMPLICIT NONE
949	CHARACTER(LEN=*),INTENT(IN) :: var_name
950	CHARACTER(LEN=*),INTENT(IN) :: title
951	REAL,INTENT(IN) :: var(:,:,:)
952
953	CALL put_var_rgen(var_name,title,var,size(var))
954
955	END SUBROUTINE put_var_r3
956
957	SUBROUTINE put_var_rgen(var_name,title,var,var_size)
958	USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
959	NF90_FLOAT, NF90_DOUBLE, &
960	NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
961	nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
962	USE comsoil_h, only: nsoilmx
963	USE comslope_mod, only: nslope
964	USE mod_phys_lmdz_para, only: is_master
965	IMPLICIT NONE
966	CHARACTER(LEN=*),INTENT(IN) :: var_name
967	CHARACTER(LEN=*),INTENT(IN) :: title
968	INTEGER,INTENT(IN) :: var_size
969	REAL,INTENT(IN) :: var(var_size)
970
971	INTEGER :: ierr
972	INTEGER :: nvarid
973	INTEGER :: idim1d
974	logical,save :: firsttime=.true.
975
976	IF (is_master) THEN
977
978	IF (var_name=="Time") THEN
979	! Very specific case of "Time" variable
980	if (firsttime) then
981	! Create the "Time variable"
982	ierr=NF90_REDEF(nid_restart)
983	#ifdef NC_DOUBLE
984	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
985	(/idim7/),nvarid)
986	#else
987	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
988	(/idim7/),nvarid)
989	#endif
990	IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
991	ierr=NF90_ENDDEF(nid_restart)
992
993	firsttime=.false.
994	endif
995	! Append "time" value
996	! get current length of "Time" dimension
997	ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
998	ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
999	timeindex=timeindex+1
1000	ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
1001	ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
1002	start=(/timeindex/))
1003	IF (ierr/=NF90_NOERR) THEN
1004	write(,)'put_var_rgen: problem writing Time'
1005	write(,)trim(nf90_strerror(ierr))
1006	CALL abort_physic("get_var_rgen","Failed to write Time",1)
1007	ENDIF
1008	return ! nothing left to do
1009	ELSEIF (var_size==length) THEN
1010	! We know it is a "controle" kind of 1D array
1011	idim1d=idim1
1012	ELSEIF (var_size==nsoilmx) THEN
1013	! We know it is an "mlayer" kind of 1D array
1014	idim1d=idim3
1015	ELSEIF (var_size==nslope+1) THEN
1016	! We know it is an "inter slope" kind of 1D array
1017	idim1d=idim9
1018	ELSE
1019	PRINT *, "put_var_rgen error : wrong dimension"
1020	write(,) " var_size =",var_size
1021	CALL abort_physic("get_var_rgen","Wrong variable dimension",1)
1022
1023	ENDIF ! of IF (var_size==length) THEN
1024
1025	! Swich to NetCDF define mode
1026	ierr=NF90_REDEF (nid_restart)
1027	! Define the variable
1028	#ifdef NC_DOUBLE
1029	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
1030	#else
1031	ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
1032	#endif
1033	! Add a "title" attribute
1034	IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
1035	! Swich out of define mode
1036	ierr=NF90_ENDDEF(nid_restart)
1037	! Write variable to file
1038	ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
1039	IF (ierr/=NF90_NOERR) THEN
1040	write(,)'put_var_rgen: problem writing '//trim(var_name)
1041	write(,)trim(nf90_strerror(ierr))
1042	CALL abort_physic("get_var_rgen","Failed writing variable",1)
1043	ENDIF
1044	ENDIF ! of IF (is_master)
1045
1046	END SUBROUTINE put_var_rgen
1047
1048	END MODULE iostart

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

Download in other formats:

Original Format