Context Navigation

wxios.F90 @ 5213

Last change on this file since 5213 was 5206, checked in by Laurent Fairhead, 44 hours ago
Corrections to properly close XIOS contexts in LMDZ (either with DYNAMICO or lonlat) 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: 29.8 KB

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

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

Download in other formats:

Original Format