Context Navigation

iostart.F90 @ 1242

Last change on this file since 1242 was 1130, checked in by emillour, 11 years ago

Mars GCM:
Series of changes to enable running in parallel (using LMDZ.COMMON dynamics);
Current LMDZ.MARS can still notheless be compiled and run in serial mode
"as previously".
Summary of main changes:

Main programs (newstart, start2archive, xvik) that used to be in dyn3d have been moved to phymars.
dyn3d/control.h is now module control_mod.F90
rearanged input/outputs routines everywhere to handle serial/MPI cases. physdem.F => phyredem.F90 , phyetat0.F => phyetat0.F90 ; all read/write routines for startfi files are gathered in module iostart.F90
added parallelism related routines init_phys_lmdz.F90, comgeomphy.F90, dimphy.F90, iniphysiq.F90, mod_grid_phy_lmdz.F90, mod_phys_lmdz_mpi_data.F90, mod_phys_lmdz_mpi_transfert.F90, mod_phys_lmdz_omp_data.F90, mod_phys_lmdz_omp_transfert.F90, mod_phys_lmdz_para.F90, mod_phys_lmdz_transfert_para.F90 in phymars and mod_const_mpi.F90 in dyn3d (for compliance with parallel case)
created generic routines 'planetwide_maxval' and 'planetwide_minval', in module "planetwide_mod", that enable obtaining the min and max of a field over the whole planet.

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

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

Download in other formats:

Original Format