Context Navigation

wxios.F90 @ 4617

Last change on this file since 4617 was 4608, checked in by acozic, 2 years ago

Add of an output file containing mass flow when offline parameter is to "yes"
this file will be on horizontal grid with vertical level klev
When LMDZ is coupled to Inca, we don't call anymore the routine phystoken if offline=y

Anne Cozic

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

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

Download in other formats:

Original Format