Context Navigation

lmdz_wxios.F90 @ 5133

Last change on this file since 5133 was 5123, checked in by abarral, 5 months ago
Correct various minor mistakes from previous commits
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: 27.4 KB

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

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

Download in other formats:

Original Format