Context Navigation

wxios.F90 @ 3928

Last change on this file since 3928 was 3003, checked in by Laurent Fairhead, 7 years ago
Modifications to the code and xml files to output Ap and B, the coefficients of the hybrid coordinates as requested by the CMIP6 DataRequest? LF (with guidance from A. Caubel and S. Senesi)
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: 23.2 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
	17	CHARACTER(len=100), SAVE :: g_ctx_name
	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
[2055]	138	! Si couple alors init fait dans cpl_init
	139	IF (.not. PRESENT(type_ocean)) THEN
[2054]	140	CALL wxios_context_init()
[2055]	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
	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:
	154	CALL xios_context_initialize(g_ctx_name, g_comm)
	155	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
	156	CALL xios_set_current_context(xios_ctx) !Activation
	157	g_ctx = xios_ctx
	158
[2001]	159	IF (prt_level >= 10) THEN
	160	WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
	161	WRITE(lunout,*) " now call xios_solve_inheritance()"
	162	ENDIF
[1852]	163	!Une première analyse des héritages:
	164	CALL xios_solve_inheritance()
[2509]	165	!$OMP END MASTER
[1852]	166	END SUBROUTINE wxios_context_init
	167
[1825]	168	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	169	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
	170	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	171
[2095]	172	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
[2509]	173	USE print_control_mod, ONLY : prt_level, lunout
[1852]	174	IMPLICIT NONE
	175
[1825]	176	!Paramètres:
	177	CHARACTER(len=*), INTENT(IN) :: calendrier
[2095]	178	INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
	179	REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
[1825]	180
	181	!Variables:
	182	CHARACTER(len=80) :: abort_message
	183	CHARACTER(len=19) :: date
	184	INTEGER :: njour = 1
	185
	186	!Variables pour xios:
[2509]	187	TYPE(xios_duration) :: mdtime
[1825]	188	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
	189
[2509]	190	mdtime%second=pasdetemps
[1825]	191
	192	!Réglage du calendrier:
	193	SELECT CASE (calendrier)
	194	CASE('earth_360d')
[2509]	195	CALL xios_define_calendar("D360")
	196	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
	197	CASE('earth_365d')
	198	CALL xios_define_calendar("NoLeap")
	199	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
	200	CASE('gregorian')
	201	CALL xios_define_calendar("Gregorian")
	202	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
	203	CASE DEFAULT
	204	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
	205	CALL abort_gcm('Gcm:Xios',abort_message,1)
	206	END SELECT
[1825]	207
[2095]	208	!Formatage de la date d'origine:
[2509]	209	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
[1825]	210
[2095]	211	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
[2509]	212	CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
[2095]	213
	214	!Formatage de la date de debut:
	215
	216	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
[1825]	217
[2095]	218	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
	219
[2509]	220	CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
[2095]	221
[1825]	222	!Et enfin,le pas de temps:
	223	CALL xios_set_timestep(mdtime)
[1897]	224	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
[1825]	225	END SUBROUTINE wxios_set_cal
	226
[1852]	227	SUBROUTINE wxios_set_timestep(ts)
	228	REAL, INTENT(IN) :: ts
[2509]	229	TYPE(xios_duration) :: mdtime
[1852]	230
[2509]	231	mdtime%timestep = ts
	232
[1852]	233	CALL xios_set_timestep(mdtime)
	234	END SUBROUTINE wxios_set_timestep
	235
[1825]	236	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	237	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
	238	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]	239	SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, &
	240	ibegin, iend, ii_begin, ii_end, jbegin, jend, &
	241	data_ni, data_ibegin, data_iend, &
[1897]	242	io_lat, io_lon,is_south_pole,mpi_rank)
[1825]	243
[1897]	244
[2509]	245	USE print_control_mod, ONLY : prt_level, lunout
[1852]	246	IMPLICIT NONE
	247
[1897]	248	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
	249	LOGICAL,INTENT(IN) :: is_sequential ! flag
	250	INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
	251	INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
	252	INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
	253	INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
	254	INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
	255	INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
	256	INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
	257	INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
	258	INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
	259	INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
	260	INTEGER,INTENT(IN) :: data_ni
	261	INTEGER,INTENT(IN) :: data_ibegin
	262	INTEGER,INTENT(IN) :: data_iend
	263	REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
	264	REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
	265	logical,intent(in) :: is_south_pole ! does this process include the south pole?
	266	integer,intent(in) :: mpi_rank ! rank of process
[1825]	267
	268	TYPE(xios_domain) :: dom
[1852]	269	LOGICAL :: boool
[1825]	270
[1852]	271	!Masque pour les problèmes de recouvrement MPI:
	272	LOGICAL :: mask(ni,nj)
[1825]	273
	274	!On récupère le handle:
	275	CALL xios_get_domain_handle(dom_id, dom)
	276
[1897]	277	IF (prt_level >= 10) THEN
	278	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
	279	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
	280	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
	281	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
	282	ENDIF
[1825]	283
	284	!On parametrise le domaine:
[2509]	285	CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin-1, ni=ni, type="rectilinear")
	286	CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin-1, nj=nj, data_dim=2)
	287	CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(ibegin:iend), latvalue_1d=io_lat(jbegin:jend))
[1852]	288	IF (.NOT.is_sequential) THEN
	289	mask(:,:)=.TRUE.
[1897]	290	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
	291	if (ii_end<ni) mask(ii_end+1:ni,nj) = .FALSE.
	292	! special case for south pole
	293	if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
	294	IF (prt_level >= 10) THEN
	295	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
	296	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
	297	ENDIF
[2509]	298	CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
[1852]	299	END IF
	300
[1825]	301	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
	302	!Vérification:
	303	IF (xios_is_valid_domain(dom_id)) THEN
[1897]	304	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
[1825]	305	ELSE
[1897]	306	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
[1825]	307	END IF
	308	END SUBROUTINE wxios_domain_param
	309
	310	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	311	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
	312	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3003]	313	SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value, &
	314	positif, bnds)
[2509]	315	USE print_control_mod, ONLY : prt_level, lunout
[1852]	316	IMPLICIT NONE
	317
[2002]	318	CHARACTER (len=*), INTENT(IN) :: axis_id
[1852]	319	INTEGER, INTENT(IN) :: axis_size
[1825]	320	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
[3003]	321	CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
	322	REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
[1825]	323
[2002]	324	! TYPE(xios_axisgroup) :: axgroup
	325	! TYPE(xios_axis) :: ax
	326	! CHARACTER(len=50) :: axis_id
[1825]	327
[2002]	328	! IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
	329	! WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
	330	! WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
	331	! CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
	332	! ENDIF
	333	! axis_id=trim(axisgroup_id)
[1825]	334
	335	!On récupère le groupe d'axes qui va bien:
[2002]	336	!CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
[1825]	337
	338	!On ajoute l'axe correspondant à ce fichier:
[2002]	339	!CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
[1825]	340
	341	!Et on le parametrise:
[2002]	342	!CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
[1825]	343
[2002]	344	! Ehouarn: New way to declare axis, without axis_group:
[3003]	345	if (PRESENT(positif) .AND. PRESENT(bnds)) then
	346	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	347	positive=positif, bounds=bnds)
	348	else if (PRESENT(positif)) then
	349	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	350	positive=positif)
	351	else if (PRESENT(bnds)) then
	352	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
	353	bounds=bnds)
	354	else
	355	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
	356	endif
[2741]	357
[1825]	358	!Vérification:
[1852]	359	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
[1897]	360	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
[1825]	361	ELSE
[2001]	362	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
[1825]	363	END IF
	364
	365	END SUBROUTINE wxios_add_vaxis
	366
	367
	368	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	369	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
	370	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	371	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
[2509]	372	USE print_control_mod, ONLY : prt_level, lunout
[1852]	373	IMPLICIT NONE
	374
[1825]	375	CHARACTER(len=*), INTENT(IN) :: fname
	376	CHARACTER(len=*), INTENT(IN) :: ffreq
	377	INTEGER, INTENT(IN) :: flvl
	378
	379	TYPE(xios_file) :: x_file
	380	TYPE(xios_filegroup) :: x_fg
[2509]	381	TYPE(xios_duration) :: nffreq
[1825]	382
[1852]	383	!On regarde si le fichier n'est pas défini par XML:
	384	IF (.NOT.xios_is_valid_file(fname)) THEN
	385	!On créé le noeud:
	386	CALL xios_get_filegroup_handle("defile", x_fg)
	387	CALL xios_add_file(x_fg, x_file, fname)
[1825]	388
[1852]	389	!On reformate la fréquence:
	390	CALL reformadate(ffreq, nffreq)
[1825]	391
[1852]	392	!On configure:
	393	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
[2509]	394	output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
	395
[1852]	396	IF (xios_is_valid_file("X"//fname)) THEN
[2001]	397	IF (prt_level >= 10) THEN
	398	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
[2509]	399	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[2001]	400	ENDIF
[1852]	401	ELSE
[2001]	402	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
[2509]	403	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[1852]	404	END IF
[1825]	405	ELSE
[2001]	406	IF (prt_level >= 10) THEN
	407	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
	408	ENDIF
	409	! Ehouarn: add an enable=.true. on top of xml definitions... why???
	410	CALL xios_set_file_attr(fname, enabled=.TRUE.)
[1825]	411	END IF
	412	END SUBROUTINE wxios_add_file
	413
	414	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]	415	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
[1825]	416	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	417	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
[1897]	418	USE netcdf, only: nf90_fill_real
[1852]	419
	420	IMPLICIT NONE
	421	INCLUDE 'iniprint.h'
[1825]	422
	423	CHARACTER(len=*), INTENT(IN) :: fieldname
	424	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
	425	CHARACTER(len=*), INTENT(IN) :: fieldlongname
	426	CHARACTER(len=*), INTENT(IN) :: fieldunit
	427
	428	TYPE(xios_field) :: field
	429	CHARACTER(len=10) :: newunit
	430	REAL(KIND=8) :: def
	431
	432	!La valeur par défaut des champs non définis:
	433	def = nf90_fill_real
	434
	435	IF (fieldunit .EQ. " ") THEN
	436	newunit = "-"
	437	ELSE
	438	newunit = fieldunit
	439	ENDIF
	440
	441	!On ajoute le champ:
	442	CALL xios_add_field(fieldgroup, field, fieldname)
[1897]	443	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
[1825]	444
	445	!On rentre ses paramètres:
	446	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
[1897]	447	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
	448	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
[1825]	449
	450	END SUBROUTINE wxios_add_field
	451
	452	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]	453	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
[1825]	454	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2137]	455	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
[2509]	456	USE print_control_mod, ONLY : prt_level, lunout
[1852]	457	IMPLICIT NONE
	458
[1825]	459	CHARACTER(len=*), INTENT(IN) :: fieldname
	460	INTEGER, INTENT(IN) :: fdim, fid
	461	CHARACTER(len=*), INTENT(IN) :: fname
	462	CHARACTER(len=*), INTENT(IN) :: fieldlongname
	463	CHARACTER(len=*), INTENT(IN) :: fieldunit
	464	INTEGER, INTENT(IN) :: field_level
	465	CHARACTER(len=*), INTENT(IN) :: op
	466
[2001]	467	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
[2137]	468	CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
[1825]	469	CHARACTER(len=100) :: operation
	470	TYPE(xios_file) :: f
	471	TYPE(xios_field) :: field
	472	TYPE(xios_fieldgroup) :: fieldgroup
[2509]	473	TYPE(xios_duration) :: freq_op
[2741]	474
[1852]	475	LOGICAL :: bool=.FALSE.
	476	INTEGER :: lvl =0
[1825]	477
	478
[2001]	479	! Ajout Abd pour NMC:
	480	IF (fid.LE.6) THEN
	481	axis_id="presnivs"
	482	ELSE
	483	axis_id="plev"
	484	ENDIF
[2137]	485
	486	IF (PRESENT(nam_axvert)) THEN
	487	axis_id=nam_axvert
	488	print*,'nam_axvert=',axis_id
	489	ENDIF
[1825]	490
	491	!on prépare le nom de l'opération:
	492	operation = reformaop(op)
	493
	494
	495	!On selectionne le bon groupe de champs:
	496	IF (fdim.EQ.2) THEN
[2001]	497	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
[1825]	498	ELSE
	499	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
	500	ENDIF
	501
	502	!On regarde si le champ à déjà été créé ou non:
[1852]	503	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
	504	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
[1897]	505	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
[1852]	506	g_flag_xml = .TRUE.
	507	g_field_name = fieldname
	508
	509	ELSE IF (.NOT. g_field_name == fieldname) THEN
	510	!Si premier pssage et champ indéfini, alors on le créé
	511
[1897]	512	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
[1825]	513
	514	!On le créé:
	515	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
	516	IF (xios_is_valid_field(fieldname)) THEN
[1897]	517	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
[1825]	518	ENDIF
	519
[1852]	520	g_flag_xml = .FALSE.
	521	g_field_name = fieldname
	522
	523	END IF
	524
	525	IF (.NOT. g_flag_xml) THEN
	526	!Champ existe déjà, mais pas XML, alors on l'ajoute
	527	!On ajoute le champ:
	528	CALL xios_get_file_handle(fname, f)
	529	CALL xios_add_fieldtofile(f, field)
	530
	531
	532	!L'operation, sa frequence:
[2509]	533	freq_op%timestep=1
	534	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
[1852]	535
	536
	537	!On rentre ses paramètres:
	538	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
	539
	540	IF (fdim.EQ.2) THEN
	541	!Si c'est un champ 2D:
[1897]	542	IF (prt_level >= 10) THEN
	543	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
	544	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
	545	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	546	ENDIF
[1852]	547	ELSE
	548	!Si 3D :
	549	!On ajoute l'axe vertical qui va bien:
	550	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
	551
[1897]	552	IF (prt_level >= 10) THEN
	553	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
	554	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	555	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
	556	ENDIF
[1852]	557	END IF
[1825]	558
	559	ELSE
[1852]	560	!Sinon on se contente de l'activer:
	561	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
[2002]	562	!NB: This will override an enable=.false. set by a user in the xml file;
	563	! then the only way to not output the field is by changing its
	564	! output level
[1852]	565	ENDIF
[1825]	566
	567	END SUBROUTINE wxios_add_field_to_file
	568
[2002]	569	! SUBROUTINE wxios_update_calendar(ito)
	570	! INTEGER, INTENT(IN) :: ito
	571	! CALL xios_update_calendar(ito)
	572	! END SUBROUTINE wxios_update_calendar
	573	!
	574	! SUBROUTINE wxios_write_2D(fieldname, fdata)
	575	! CHARACTER(len=*), INTENT(IN) :: fieldname
	576	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
	577	!
	578	! CALL xios_send_field(fieldname, fdata)
	579	! END SUBROUTINE wxios_write_2D
[1825]	580
[2002]	581	! SUBROUTINE wxios_write_3D(fieldname, fdata)
	582	! CHARACTER(len=*), INTENT(IN) :: fieldname
	583	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
	584	!
	585	! CALL xios_send_field(fieldname, fdata)
	586	! END SUBROUTINE wxios_write_3D
[1825]	587
	588	SUBROUTINE wxios_closedef()
	589	CALL xios_close_context_definition()
[2095]	590	! CALL xios_update_calendar(0)
[1825]	591	END SUBROUTINE wxios_closedef
	592
	593	SUBROUTINE wxios_close()
	594	CALL xios_context_finalize()
	595	CALL xios_finalize()
	596	END SUBROUTINE wxios_close
	597	END MODULE wxios
	598	#endif

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

Download in other formats:

Original Format