Context Navigation

iostart.F90 @ 3026

Last change on this file since 3026 was 2952, checked in by romain.vande, 20 months ago
Mars PCM + newstart + start_archive: Correct writing of variables inertiesoil and fluxgeo following r2919 and r2942 RV
File size: 37.1 KB

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

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

Download in other formats:

Original Format