Context Navigation

wxios.F90 @ 5179

Last change on this file since 5179 was 2381, checked in by acozic, 9 years ago

Make some commit to fit with INCA coupling

merge with rev 2180 on trunk
merge with rev 2185 on trunk
merge with rev 2200 on trunk
change gregorian calendar in wxios

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

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

Download in other formats:

Original Format