Context Navigation

wxios.F90 @ 2104

Last change on this file since 2104 was 2095, checked in by Laurent Fairhead, 10 years ago

Modifications nécessaires pour la bonne définition du temps dans les
fichier Xios

Necessary modifications for the definition of time in Xios files

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: 21.9 KB

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

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

Download in other formats:

Original Format