Context Navigation

iostart_PEM.F90 @ 3493

Last change on this file since 3493 was 3457, checked in by jbclement, 6 weeks ago
PCM: Modification of dimension detection for the variables written in "diagpem.nc": in particular for 'nb_str_max' which can evolve and match the value of other dimensions. JBC
File size: 37.8 KB

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

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

Download in other formats:

Original Format