Context Navigation

wxios.F90 @ 4500

Last change on this file since 4500 was 4446, checked in by Laurent Fairhead, 17 months ago
Merged trunk revisions from 4127 to 4443 (HEAD) into branch
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
File size: 25.3 KB

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

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

Download in other formats:

Original Format