Context Navigation

wxios.F90 @ 3603

Last change on this file since 3603 was 3406, checked in by jghattas, 6 years ago
Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 24.0 KB

Rev	Line
[2509]	1	! $Id: wxios.F90 3406 2018-10-23 09:16:41Z musat $
[1825]	2	#ifdef CPP_XIOS
	3	MODULE wxios
	4	USE xios
	5	USE iaxis
	6	USE iaxis_attr
	7	USE icontext_attr
	8	USE idate
	9	USE idomain_attr
	10	USE ifield_attr
	11	USE ifile_attr
	12	USE ixml_tree
	13
	14	!Variables disponibles pendant toute l'execution du programme:
	15
	16	INTEGER, SAVE :: g_comm
[3406]	17	CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
[1825]	18	TYPE(xios_context), SAVE :: g_ctx
	19	!$OMP THREADPRIVATE(g_comm,g_cts_name,g_ctx)
[1852]	20	LOGICAL, SAVE :: g_flag_xml = .FALSE.
	21	CHARACTER(len=100) :: g_field_name = "nofield"
	22	!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
[2271]	23	REAL :: missing_val_omp
	24	REAL :: missing_val
	25	!$OMP THREADPRIVATE(missing_val)
[1825]	26
[2741]	27	#ifdef XIOS1
	28	#error "XIOS v1 no longer supported, use XIOS v2."
	29	#endif
	30
[1825]	31	CONTAINS
	32
	33	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	34	! 36day => 36d etc !!!!!!!!!!!!!!!!!!!!
	35	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	36
	37	SUBROUTINE reformadate(odate, ndate)
	38	CHARACTER(len=*), INTENT(IN) :: odate
[2509]	39	TYPE(xios_duration) :: ndate
[1825]	40
	41	INTEGER :: i = 0
[1852]	42	!!!!!!!!!!!!!!!!!!
	43	! Pour XIOS:
	44	! year : y
	45	! month : mo
	46	! day : d
	47	! hour : h
	48	! minute : mi
	49	! second : s
	50	!!!!!!!!!!!!!!!!!!
	51
[1825]	52	i = INDEX(odate, "day")
	53	IF (i > 0) THEN
[2509]	54	read(odate(1:i-1),*) ndate%day
[1825]	55	END IF
[1852]	56
	57	i = INDEX(odate, "hr")
	58	IF (i > 0) THEN
[2509]	59	read(odate(1:i-1),*) ndate%hour
[1852]	60	END IF
	61
	62	i = INDEX(odate, "mth")
	63	IF (i > 0) THEN
[2509]	64	read(odate(1:i-1),*) ndate%month
[1852]	65	END IF
[1825]	66
[1852]	67	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
[1825]	68	END SUBROUTINE reformadate
	69
	70	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	71	! ave(X) => average etc !!!!!!!!!!!!!!!
	72	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	73
	74	CHARACTER(len=7) FUNCTION reformaop(op)
	75	CHARACTER(len=*), INTENT(IN) :: op
	76
	77	INTEGER :: i = 0
	78	reformaop = "average"
	79
	80	IF (op.EQ."inst(X)") THEN
	81	reformaop = "instant"
	82	END IF
	83
	84	IF (op.EQ."once") THEN
	85	reformaop = "once"
	86	END IF
	87
	88	IF (op.EQ."t_max(X)") THEN
	89	reformaop = "maximum"
	90	END IF
	91
	92	IF (op.EQ."t_min(X)") THEN
	93	reformaop = "minimum"
	94	END IF
	95
[1852]	96	!IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
[1825]	97	END FUNCTION reformaop
	98
	99	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	100	! Routine d'initialisation !!!!!!!!!!!!!
	101	! A lancer juste après mpi_init !!!!!!!!!!!!!
	102	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	103
[2055]	104	SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
[2509]	105	USE print_control_mod, ONLY : prt_level, lunout
[1852]	106	IMPLICIT NONE
	107
[1825]	108	CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
[1852]	109	INTEGER, INTENT(IN), OPTIONAL :: locom
	110	INTEGER, INTENT(OUT), OPTIONAL :: outcom
[2055]	111	CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
[1852]	112
	113
[1825]	114	TYPE(xios_context) :: xios_ctx
[1852]	115	INTEGER :: xios_comm
[1825]	116
[1897]	117	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
[1852]	118
	119
	120
	121	IF (PRESENT(locom)) THEN
[1897]	122	CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
	123	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
[1852]	124	ELSE
[1897]	125	CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
	126	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
[1852]	127	END IF
[1825]	128
[1852]	129	IF (PRESENT(outcom)) THEN
[1897]	130	outcom = xios_comm
	131	IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
[1852]	132	END IF
[1825]	133
	134	!Enregistrement des variables globales:
	135	g_comm = xios_comm
	136	g_ctx_name = xios_ctx_name
	137
[3322]	138	! ! Si couple alors init fait dans cpl_init
	139	! IF (.not. PRESENT(type_ocean)) THEN
	140	! CALL wxios_context_init()
	141	! ENDIF
[2054]	142
[1825]	143	END SUBROUTINE wxios_init
	144
[1852]	145	SUBROUTINE wxios_context_init()
[2509]	146	USE print_control_mod, ONLY : prt_level, lunout
[3406]	147	USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
[1852]	148	IMPLICIT NONE
	149
	150	TYPE(xios_context) :: xios_ctx
	151
[2509]	152	!$OMP MASTER
[1852]	153	!Initialisation du contexte:
[3406]	154	!!CALL xios_context_initialize(g_ctx_name, g_comm)
	155	CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
[1852]	156	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
	157	CALL xios_set_current_context(xios_ctx) !Activation
	158	g_ctx = xios_ctx
	159
[2001]	160	IF (prt_level >= 10) THEN
	161	WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
	162	WRITE(lunout,*) " now call xios_solve_inheritance()"
	163	ENDIF
[1852]	164	!Une première analyse des héritages:
	165	CALL xios_solve_inheritance()
[2509]	166	!$OMP END MASTER
[1852]	167	END SUBROUTINE wxios_context_init
	168
[3322]	169
	170	SUBROUTINE wxios_set_context()
	171	IMPLICIT NONE
	172	TYPE(xios_context) :: xios_ctx
	173
	174	!$OMP MASTER
	175	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
	176	CALL xios_set_current_context(xios_ctx) !Activation
	177	!$OMP END MASTER
	178
	179	END SUBROUTINE wxios_set_context
	180
[1825]	181	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	182	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
	183	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	184
[2095]	185	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
[2509]	186	USE print_control_mod, ONLY : prt_level, lunout
[1852]	187	IMPLICIT NONE
	188
[1825]	189	!Paramètres:
	190	CHARACTER(len=*), INTENT(IN) :: calendrier
[2095]	191	INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
	192	REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
[1825]	193
	194	!Variables:
	195	CHARACTER(len=80) :: abort_message
	196	CHARACTER(len=19) :: date
	197	INTEGER :: njour = 1
	198
	199	!Variables pour xios:
[2509]	200	TYPE(xios_duration) :: mdtime
[1825]	201	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
	202
[2509]	203	mdtime%second=pasdetemps
[1825]	204
	205	!Réglage du calendrier:
	206	SELECT CASE (calendrier)
	207	CASE('earth_360d')
[2509]	208	CALL xios_define_calendar("D360")
	209	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
	210	CASE('earth_365d')
	211	CALL xios_define_calendar("NoLeap")
	212	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
	213	CASE('gregorian')
	214	CALL xios_define_calendar("Gregorian")
	215	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
	216	CASE DEFAULT
	217	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
[3065]	218	CALL abort_physic('Gcm:Xios',abort_message,1)
[2509]	219	END SELECT
[1825]	220
[2095]	221	!Formatage de la date d'origine:
[2509]	222	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
[1825]	223
[2095]	224	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
[2509]	225	CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
[2095]	226
	227	!Formatage de la date de debut:
	228
	229	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
[1825]	230
[2095]	231	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
	232
[2509]	233	CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
[2095]	234
[1825]	235	!Et enfin,le pas de temps:
	236	CALL xios_set_timestep(mdtime)
[1897]	237	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
[1825]	238	END SUBROUTINE wxios_set_cal
	239
[1852]	240	SUBROUTINE wxios_set_timestep(ts)
	241	REAL, INTENT(IN) :: ts
[2509]	242	TYPE(xios_duration) :: mdtime
[1852]	243
[2509]	244	mdtime%timestep = ts
	245
[1852]	246	CALL xios_set_timestep(mdtime)
	247	END SUBROUTINE wxios_set_timestep
	248
[1825]	249	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	250	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
	251	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3077]	252	SUBROUTINE wxios_domain_param(dom_id)
	253	USE dimphy, only: klon
	254	USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
	255	USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
	256	mpi_size, mpi_rank, klon_mpi, &
	257	is_sequential, is_south_pole_dyn
	258	USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
	259	USE print_control_mod, ONLY : prt_level, lunout
	260	USE geometry_mod
[1897]	261
[3077]	262	IMPLICIT NONE
	263	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
[1852]	264
[3077]	265	REAL :: rlat_glo(klon_glo)
	266	REAL :: rlon_glo(klon_glo)
	267	REAL :: io_lat(nbp_lat)
	268	REAL :: io_lon(nbp_lon)
	269	LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
[1825]	270	TYPE(xios_domain) :: dom
[3077]	271	INTEGER :: i
[1852]	272	LOGICAL :: boool
[1825]	273
[3077]	274
	275
	276	CALL gather(latitude_deg,rlat_glo)
	277	CALL bcast(rlat_glo)
	278	CALL gather(longitude_deg,rlon_glo)
	279	CALL bcast(rlon_glo)
	280
	281	!$OMP MASTER
	282	io_lat(1)=rlat_glo(1)
	283	io_lat(nbp_lat)=rlat_glo(klon_glo)
	284	IF ((nbp_lon*nbp_lat) > 1) then
	285	DO i=2,nbp_lat-1
	286	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
	287	ENDDO
	288	ENDIF
	289
	290	IF (klon_glo == 1) THEN
	291	io_lon(1)=rlon_glo(1)
	292	ELSE
	293	io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
	294	ENDIF
	295
[1825]	296
	297	!On récupère le handle:
	298	CALL xios_get_domain_handle(dom_id, dom)
	299
	300	!On parametrise le domaine:
[3077]	301	CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
	302	CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
	303	CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
	304
[1852]	305	IF (.NOT.is_sequential) THEN
	306	mask(:,:)=.TRUE.
[1897]	307	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
[3077]	308	if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
[1897]	309	! special case for south pole
[3077]	310	if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
[1897]	311	IF (prt_level >= 10) THEN
	312	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
[3077]	313	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
[1897]	314	ENDIF
[2509]	315	CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
[1852]	316	END IF
	317
[1825]	318	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
	319	!Vérification:
	320	IF (xios_is_valid_domain(dom_id)) THEN
[1897]	321	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
[1825]	322	ELSE
[1897]	323	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
[1825]	324	END IF
[3077]	325	!$OMP END MASTER
	326
[1825]	327	END SUBROUTINE wxios_domain_param
	328
[3077]	329
	330	SUBROUTINE wxios_domain_param_unstructured(dom_id)
	331	USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
	332	USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
	333	USE mod_phys_lmdz_para
	334	USE nrtype, ONLY : PI
	335	IMPLICIT NONE
	336	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
	337	REAL :: lon_mpi(klon_mpi)
	338	REAL :: lat_mpi(klon_mpi)
	339	REAL :: boundslon_mpi(klon_mpi,nvertex)
	340	REAL :: boundslat_mpi(klon_mpi,nvertex)
	341	INTEGER :: ind_cell_glo_mpi(klon_mpi)
	342	TYPE(xios_domaingroup) :: dom
	343
	344
	345	CALL gather_omp(longitude*180/PI,lon_mpi)
	346	CALL gather_omp(latitude*180/PI,lat_mpi)
	347	CALL gather_omp(boundslon*180/PI,boundslon_mpi)
	348	CALL gather_omp(boundslat*180/PI,boundslat_mpi)
	349	CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
	350
	351
	352	!$OMP MASTER
	353	CALL xios_get_domaingroup_handle(dom_id, dom)
	354
	355	!On parametrise le domaine:
	356	CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
	357	CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
	358	bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
	359	CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
	360	!$OMP END MASTER
	361
	362	END SUBROUTINE wxios_domain_param_unstructured
	363
	364
	365
	366
[1825]	367	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	368	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
	369	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3003]	370	SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value, &
	371	positif, bnds)
[2509]	372	USE print_control_mod, ONLY : prt_level, lunout
[1852]	373	IMPLICIT NONE
	374
[2002]	375	CHARACTER (len=*), INTENT(IN) :: axis_id
[1852]	376	INTEGER, INTENT(IN) :: axis_size
[1825]	377	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
[3003]	378	CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
	379	REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
[1825]	380
[2002]	381	! TYPE(xios_axisgroup) :: axgroup
	382	! TYPE(xios_axis) :: ax
	383	! CHARACTER(len=50) :: axis_id
[1825]	384
[2002]	385	! IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
	386	! WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
	387	! WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
	388	! CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
	389	! ENDIF
	390	! axis_id=trim(axisgroup_id)
[1825]	391
	392	!On récupère le groupe d'axes qui va bien:
[2002]	393	!CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
[1825]	394
	395	!On ajoute l'axe correspondant à ce fichier:
[2002]	396	!CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
[1825]	397
	398	!Et on le parametrise:
[2002]	399	!CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
[1825]	400
[2002]	401	! Ehouarn: New way to declare axis, without axis_group:
[3003]	402	if (PRESENT(positif) .AND. PRESENT(bnds)) then
	403	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	404	positive=positif, bounds=bnds)
	405	else if (PRESENT(positif)) then
	406	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	407	positive=positif)
	408	else if (PRESENT(bnds)) then
	409	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	410	bounds=bnds)
	411	else
	412	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
	413	endif
[2741]	414
[1825]	415	!Vérification:
[1852]	416	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
[1897]	417	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
[1825]	418	ELSE
[2001]	419	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
[1825]	420	END IF
	421
	422	END SUBROUTINE wxios_add_vaxis
	423
	424
	425	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	426	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
	427	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	428	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
[2509]	429	USE print_control_mod, ONLY : prt_level, lunout
[1852]	430	IMPLICIT NONE
	431
[1825]	432	CHARACTER(len=*), INTENT(IN) :: fname
	433	CHARACTER(len=*), INTENT(IN) :: ffreq
	434	INTEGER, INTENT(IN) :: flvl
	435
	436	TYPE(xios_file) :: x_file
	437	TYPE(xios_filegroup) :: x_fg
[2509]	438	TYPE(xios_duration) :: nffreq
[1825]	439
[1852]	440	!On regarde si le fichier n'est pas défini par XML:
	441	IF (.NOT.xios_is_valid_file(fname)) THEN
	442	!On créé le noeud:
	443	CALL xios_get_filegroup_handle("defile", x_fg)
	444	CALL xios_add_file(x_fg, x_file, fname)
[1825]	445
[1852]	446	!On reformate la fréquence:
	447	CALL reformadate(ffreq, nffreq)
[1825]	448
[1852]	449	!On configure:
	450	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
[2509]	451	output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
	452
[1852]	453	IF (xios_is_valid_file("X"//fname)) THEN
[2001]	454	IF (prt_level >= 10) THEN
	455	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
[2509]	456	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[2001]	457	ENDIF
[1852]	458	ELSE
[2001]	459	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
[2509]	460	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[1852]	461	END IF
[1825]	462	ELSE
[2001]	463	IF (prt_level >= 10) THEN
	464	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
	465	ENDIF
	466	! Ehouarn: add an enable=.true. on top of xml definitions... why???
	467	CALL xios_set_file_attr(fname, enabled=.TRUE.)
[1825]	468	END IF
	469	END SUBROUTINE wxios_add_file
	470
	471	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]	472	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
[1825]	473	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	474	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
[1897]	475	USE netcdf, only: nf90_fill_real
[1852]	476
	477	IMPLICIT NONE
	478	INCLUDE 'iniprint.h'
[1825]	479
	480	CHARACTER(len=*), INTENT(IN) :: fieldname
	481	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
	482	CHARACTER(len=*), INTENT(IN) :: fieldlongname
	483	CHARACTER(len=*), INTENT(IN) :: fieldunit
	484
	485	TYPE(xios_field) :: field
	486	CHARACTER(len=10) :: newunit
	487	REAL(KIND=8) :: def
	488
	489	!La valeur par défaut des champs non définis:
	490	def = nf90_fill_real
	491
	492	IF (fieldunit .EQ. " ") THEN
	493	newunit = "-"
	494	ELSE
	495	newunit = fieldunit
	496	ENDIF
	497
	498	!On ajoute le champ:
	499	CALL xios_add_field(fieldgroup, field, fieldname)
[1897]	500	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
[1825]	501
	502	!On rentre ses paramètres:
	503	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
[1897]	504	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
	505	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
[1825]	506
	507	END SUBROUTINE wxios_add_field
	508
	509	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]	510	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
[1825]	511	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2137]	512	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
[2509]	513	USE print_control_mod, ONLY : prt_level, lunout
[1852]	514	IMPLICIT NONE
	515
[1825]	516	CHARACTER(len=*), INTENT(IN) :: fieldname
	517	INTEGER, INTENT(IN) :: fdim, fid
	518	CHARACTER(len=*), INTENT(IN) :: fname
	519	CHARACTER(len=*), INTENT(IN) :: fieldlongname
	520	CHARACTER(len=*), INTENT(IN) :: fieldunit
	521	INTEGER, INTENT(IN) :: field_level
	522	CHARACTER(len=*), INTENT(IN) :: op
	523
[2001]	524	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
[2137]	525	CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
[1825]	526	CHARACTER(len=100) :: operation
	527	TYPE(xios_file) :: f
	528	TYPE(xios_field) :: field
	529	TYPE(xios_fieldgroup) :: fieldgroup
[2509]	530	TYPE(xios_duration) :: freq_op
[2741]	531
[1852]	532	LOGICAL :: bool=.FALSE.
	533	INTEGER :: lvl =0
[1825]	534
	535
[2001]	536	! Ajout Abd pour NMC:
	537	IF (fid.LE.6) THEN
	538	axis_id="presnivs"
	539	ELSE
	540	axis_id="plev"
	541	ENDIF
[2137]	542
	543	IF (PRESENT(nam_axvert)) THEN
	544	axis_id=nam_axvert
	545	print*,'nam_axvert=',axis_id
	546	ENDIF
[1825]	547
	548	!on prépare le nom de l'opération:
	549	operation = reformaop(op)
	550
	551
	552	!On selectionne le bon groupe de champs:
	553	IF (fdim.EQ.2) THEN
[2001]	554	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
[1825]	555	ELSE
	556	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
	557	ENDIF
	558
	559	!On regarde si le champ à déjà été créé ou non:
[1852]	560	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
	561	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
[1897]	562	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
[1852]	563	g_flag_xml = .TRUE.
	564	g_field_name = fieldname
	565
	566	ELSE IF (.NOT. g_field_name == fieldname) THEN
	567	!Si premier pssage et champ indéfini, alors on le créé
	568
[1897]	569	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
[1825]	570
	571	!On le créé:
	572	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
	573	IF (xios_is_valid_field(fieldname)) THEN
[1897]	574	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
[1825]	575	ENDIF
	576
[1852]	577	g_flag_xml = .FALSE.
	578	g_field_name = fieldname
	579
	580	END IF
	581
	582	IF (.NOT. g_flag_xml) THEN
	583	!Champ existe déjà, mais pas XML, alors on l'ajoute
	584	!On ajoute le champ:
	585	CALL xios_get_file_handle(fname, f)
	586	CALL xios_add_fieldtofile(f, field)
	587
	588
	589	!L'operation, sa frequence:
[2509]	590	freq_op%timestep=1
	591	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
[1852]	592
	593
	594	!On rentre ses paramètres:
	595	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
	596
	597	IF (fdim.EQ.2) THEN
	598	!Si c'est un champ 2D:
[1897]	599	IF (prt_level >= 10) THEN
	600	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
	601	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
	602	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	603	ENDIF
[1852]	604	ELSE
	605	!Si 3D :
	606	!On ajoute l'axe vertical qui va bien:
	607	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
	608
[1897]	609	IF (prt_level >= 10) THEN
	610	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
	611	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	612	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
	613	ENDIF
[1852]	614	END IF
[1825]	615
	616	ELSE
[1852]	617	!Sinon on se contente de l'activer:
	618	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
[2002]	619	!NB: This will override an enable=.false. set by a user in the xml file;
	620	! then the only way to not output the field is by changing its
	621	! output level
[1852]	622	ENDIF
[1825]	623
	624	END SUBROUTINE wxios_add_field_to_file
	625
[2002]	626	! SUBROUTINE wxios_update_calendar(ito)
	627	! INTEGER, INTENT(IN) :: ito
	628	! CALL xios_update_calendar(ito)
	629	! END SUBROUTINE wxios_update_calendar
	630	!
	631	! SUBROUTINE wxios_write_2D(fieldname, fdata)
	632	! CHARACTER(len=*), INTENT(IN) :: fieldname
	633	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
	634	!
	635	! CALL xios_send_field(fieldname, fdata)
	636	! END SUBROUTINE wxios_write_2D
[1825]	637
[2002]	638	! SUBROUTINE wxios_write_3D(fieldname, fdata)
	639	! CHARACTER(len=*), INTENT(IN) :: fieldname
	640	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
	641	!
	642	! CALL xios_send_field(fieldname, fdata)
	643	! END SUBROUTINE wxios_write_3D
[1825]	644
	645	SUBROUTINE wxios_closedef()
	646	CALL xios_close_context_definition()
[2095]	647	! CALL xios_update_calendar(0)
[1825]	648	END SUBROUTINE wxios_closedef
	649
	650	SUBROUTINE wxios_close()
	651	CALL xios_context_finalize()
	652	CALL xios_finalize()
	653	END SUBROUTINE wxios_close
	654	END MODULE wxios
	655	#endif

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

Download in other formats:

Original Format