Context Navigation

iostart.F90 @ 1862

Last change on this file since 1862 was 1815, checked in by jvatant, 7 years ago
Adapt modifs related to tracers to newstart and start2archive + nqtot in physics -> nqtot_p. Else conflict with nqtot from dyn TBD : use of nqtot_p everywhere in physics instead of nq ... --JVO
File size: 31.6 KB

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

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

Download in other formats:

Original Format