Context Navigation

wxios.F90 @ 2232

Last change on this file since 2232 was 2137, checked in by idelkadi, 10 years ago
Implementation de XIOS pour les sorties du simulateur COSP
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: 22.0 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	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2137]	434	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
[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...
[2137]	447	CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
[1825]	448	CHARACTER(len=100) :: operation
	449	TYPE(xios_file) :: f
	450	TYPE(xios_field) :: field
	451	TYPE(xios_fieldgroup) :: fieldgroup
[1852]	452	LOGICAL :: bool=.FALSE.
	453	INTEGER :: lvl =0
[1825]	454
	455
[2001]	456	! Ajout Abd pour NMC:
	457	IF (fid.LE.6) THEN
	458	axis_id="presnivs"
	459	ELSE
	460	axis_id="plev"
	461	ENDIF
[2137]	462
	463	IF (PRESENT(nam_axvert)) THEN
	464	axis_id=nam_axvert
	465	print*,'nam_axvert=',axis_id
	466	ENDIF
[1825]	467
	468	!on prépare le nom de l'opération:
	469	operation = reformaop(op)
	470
	471
	472	!On selectionne le bon groupe de champs:
	473	IF (fdim.EQ.2) THEN
[2001]	474	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
[1825]	475	ELSE
	476	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
	477	ENDIF
	478
	479	!On regarde si le champ à déjà été créé ou non:
[1852]	480	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
	481	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
[1897]	482	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
[1852]	483	g_flag_xml = .TRUE.
	484	g_field_name = fieldname
	485
	486	ELSE IF (.NOT. g_field_name == fieldname) THEN
	487	!Si premier pssage et champ indéfini, alors on le créé
	488
[1897]	489	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
[1825]	490
	491	!On le créé:
	492	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
	493	IF (xios_is_valid_field(fieldname)) THEN
[1897]	494	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
[1825]	495	ENDIF
	496
[1852]	497	g_flag_xml = .FALSE.
	498	g_field_name = fieldname
	499
	500	END IF
	501
	502	IF (.NOT. g_flag_xml) THEN
	503	!Champ existe déjà, mais pas XML, alors on l'ajoute
	504	!On ajoute le champ:
	505	CALL xios_get_file_handle(fname, f)
	506	CALL xios_add_fieldtofile(f, field)
	507
	508
	509	!L'operation, sa frequence:
	510	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op="1ts", prec=4)
	511
	512
	513	!On rentre ses paramètres:
	514	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
	515
	516	IF (fdim.EQ.2) THEN
	517	!Si c'est un champ 2D:
[1897]	518	IF (prt_level >= 10) THEN
	519	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
	520	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
	521	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	522	ENDIF
[1852]	523	ELSE
	524	!Si 3D :
	525	!On ajoute l'axe vertical qui va bien:
	526	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
	527
[1897]	528	IF (prt_level >= 10) THEN
	529	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
	530	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
	531	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
	532	ENDIF
[1852]	533	END IF
[1825]	534
	535	ELSE
[1852]	536	!Sinon on se contente de l'activer:
	537	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
[2002]	538	!NB: This will override an enable=.false. set by a user in the xml file;
	539	! then the only way to not output the field is by changing its
	540	! output level
[1852]	541	ENDIF
[1825]	542
	543	END SUBROUTINE wxios_add_field_to_file
	544
[2002]	545	! SUBROUTINE wxios_update_calendar(ito)
	546	! INTEGER, INTENT(IN) :: ito
	547	! CALL xios_update_calendar(ito)
	548	! END SUBROUTINE wxios_update_calendar
	549	!
	550	! SUBROUTINE wxios_write_2D(fieldname, fdata)
	551	! CHARACTER(len=*), INTENT(IN) :: fieldname
	552	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
	553	!
	554	! CALL xios_send_field(fieldname, fdata)
	555	! END SUBROUTINE wxios_write_2D
[1825]	556
[2002]	557	! SUBROUTINE wxios_write_3D(fieldname, fdata)
	558	! CHARACTER(len=*), INTENT(IN) :: fieldname
	559	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
	560	!
	561	! CALL xios_send_field(fieldname, fdata)
	562	! END SUBROUTINE wxios_write_3D
[1825]	563
	564	SUBROUTINE wxios_closedef()
	565	CALL xios_close_context_definition()
[2095]	566	! CALL xios_update_calendar(0)
[1825]	567	END SUBROUTINE wxios_closedef
	568
	569	SUBROUTINE wxios_close()
	570	CALL xios_context_finalize()
	571	CALL xios_finalize()
	572	END SUBROUTINE wxios_close
	573	END MODULE wxios
	574	#endif

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

Download in other formats:

Original Format