Context Navigation

iostart.F90 @ 2613

Last change on this file since 2613 was 1621, checked in by emillour, 8 years ago

Further work on full dynamics/physics separation.

LMDZ.COMMON:

added phy_common/vertical_layers_mod.F90 to store information on vertical grid. This is where routines in the physics should get the information.
The contents of vertical_layers_mod intialized via dynphy_lonlat/inigeomphy_mod.F90.

LMDZ.MARS:

physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
created an "ini_tracer_mod" routine in module "tracer_mod" for a cleaner initialization of the later.
removed some purely dynamics-related outputs (etot0, zoom parameters, etc.) from diagfi.nc and stats.nc outputs as these informations are not available in the physics.

LMDZ.GENERIC:

physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
added nqtot to tracer_h.F90.
removed some purely dynamics-related outputs (etot0, zoom parameters, etc.) from diagfi.nc and stats.nc outputs as these informations are not available in the physics.

LMDZ.VENUS:

physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
added infotrac_phy.F90 to store information on tracers in the physics. Initialized via iniphysiq.
added cpdet_phy_mod.F90 to store t2tpot etc. functions to be used in the physics. Initialized via iniphysiq. IMPORTANT: there are some hard-coded constants! These should match what is in cpdet_mod.F90 in the dynamics.
got rid of references to moyzon_mod module within the physics. The required variables (tmoy, plevmoy) are passed to the physics as arguments to physiq.

LMDZ.TITAN:

added infotrac_phy.F90 to store information on tracers in the physics. Initialized via iniphysiq.
added cpdet_phy_mod.F90 to store t2tpot etc. functions to be used in the physics.
Extra work required to completely decouple physics and dynamics: moyzon_mod should be cleaned up and information passed from dynamics to physics as as arguments. Likewise moyzon_ch and moyzon_mu should not be queried from logic_mod (which is in the dynamics).

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

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

Download in other formats:

Original Format