Context Navigation

wxios.F90 @ 4608

Last change on this file since 4608 was 4608, checked in by acozic, 12 months ago

Add of an output file containing mass flow when offline parameter is to "yes"
this file will be on horizontal grid with vertical level klev
When LMDZ is coupled to Inca, we don't call anymore the routine phystoken if offline=y

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

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

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

Download in other formats:

Original Format