Context Navigation

← Previous Revision
Next Revision →
Normal
Revision Log

iostart.F90

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

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

Download in other formats:

Original Format