Context Navigation

wxios.F90 @ 3336

Last change on this file since 3336 was 3336, checked in by Laurent Fairhead, 6 years ago
Continuing merge of DYNAMICO and LMDZ physics. With this revision all differences with the LMDZ physics branch of DYNAMICO have been integrated in LMDZ6 branch. Now for the merge with trunk
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 Property svn:keywords set to `Id`
File size: 23.9 KB

Line
1	! $Id: wxios.F90 3336 2018-05-29 13:16:06Z fairhead $
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
143	END SUBROUTINE wxios_init
144
145	SUBROUTINE wxios_context_init()
146	USE print_control_mod, ONLY : prt_level, lunout
147	USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
148	IMPLICIT NONE
149
150	TYPE(xios_context) :: xios_ctx
151
152	!$OMP MASTER
153	!Initialisation du contexte:
154	CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
155	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
156	CALL xios_set_current_context(xios_ctx) !Activation
157	g_ctx = xios_ctx
158
159	IF (prt_level >= 10) THEN
160	WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
161	WRITE(lunout,*) " now call xios_solve_inheritance()"
162	ENDIF
163	!Une première analyse des héritages:
164	CALL xios_solve_inheritance()
165	!$OMP END MASTER
166	END SUBROUTINE wxios_context_init
167
168
169	SUBROUTINE wxios_set_context()
170	IMPLICIT NONE
171	TYPE(xios_context) :: xios_ctx
172
173	!$OMP MASTER
174	CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
175	CALL xios_set_current_context(xios_ctx) !Activation
176	!$OMP END MASTER
177
178	END SUBROUTINE wxios_set_context
179
180	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
181	! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
182	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
183
184	SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
185	USE print_control_mod, ONLY : prt_level, lunout
186	IMPLICIT NONE
187
188	!Paramètres:
189	CHARACTER(len=*), INTENT(IN) :: calendrier
190	INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
191	REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
192
193	!Variables:
194	CHARACTER(len=80) :: abort_message
195	CHARACTER(len=19) :: date
196	INTEGER :: njour = 1
197
198	!Variables pour xios:
199	TYPE(xios_duration) :: mdtime
200	!REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
201
202	mdtime%second=pasdetemps
203
204	!Réglage du calendrier:
205	SELECT CASE (calendrier)
206	CASE('earth_360d')
207	CALL xios_define_calendar("D360")
208	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
209	CASE('earth_365d')
210	CALL xios_define_calendar("NoLeap")
211	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
212	CASE('gregorian')
213	CALL xios_define_calendar("Gregorian")
214	IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
215	CASE DEFAULT
216	abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
217	CALL abort_physic('Gcm:Xios',abort_message,1)
218	END SELECT
219
220	!Formatage de la date d'origine:
221	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
222
223	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
224	CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
225
226	!Formatage de la date de debut:
227
228	WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
229
230	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
231
232	CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
233
234	!Et enfin,le pas de temps:
235	CALL xios_set_timestep(mdtime)
236	IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
237	END SUBROUTINE wxios_set_cal
238
239	SUBROUTINE wxios_set_timestep(ts)
240	REAL, INTENT(IN) :: ts
241	TYPE(xios_duration) :: mdtime
242
243	mdtime%timestep = ts
244
245	CALL xios_set_timestep(mdtime)
246	END SUBROUTINE wxios_set_timestep
247
248	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
249	! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
250	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
251	SUBROUTINE wxios_domain_param(dom_id)
252	USE dimphy, only: klon
253	USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
254	USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
255	mpi_size, mpi_rank, klon_mpi, &
256	is_sequential, is_south_pole_dyn
257	USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo
258	USE print_control_mod, ONLY : prt_level, lunout
259	USE geometry_mod
260
261	IMPLICIT NONE
262	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
263
264	REAL :: rlat_glo(klon_glo)
265	REAL :: rlon_glo(klon_glo)
266	REAL :: io_lat(nbp_lat)
267	REAL :: io_lon(nbp_lon)
268	LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
269	TYPE(xios_domain) :: dom
270	INTEGER :: i
271	LOGICAL :: boool
272
273
274
275	CALL gather(latitude_deg,rlat_glo)
276	CALL bcast(rlat_glo)
277	CALL gather(longitude_deg,rlon_glo)
278	CALL bcast(rlon_glo)
279
280	!$OMP MASTER
281	io_lat(1)=rlat_glo(1)
282	io_lat(nbp_lat)=rlat_glo(klon_glo)
283	IF ((nbp_lon*nbp_lat) > 1) then
284	DO i=2,nbp_lat-1
285	io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
286	ENDDO
287	ENDIF
288
289	IF (klon_glo == 1) THEN
290	io_lon(1)=rlon_glo(1)
291	ELSE
292	io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
293	ENDIF
294
295
296	!On récupère le handle:
297	CALL xios_get_domain_handle(dom_id, dom)
298
299	!On parametrise le domaine:
300	CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
301	CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
302	CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
303
304	IF (.NOT.is_sequential) THEN
305	mask(:,:)=.TRUE.
306	if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
307	if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
308	! special case for south pole
309	if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
310	IF (prt_level >= 10) THEN
311	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
312	WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
313	ENDIF
314	CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
315	END IF
316
317	CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
318	!Vérification:
319	IF (xios_is_valid_domain(dom_id)) THEN
320	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
321	ELSE
322	IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
323	END IF
324	!$OMP END MASTER
325
326	END SUBROUTINE wxios_domain_param
327
328
329	SUBROUTINE wxios_domain_param_unstructured(dom_id)
330	USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
331	USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
332	USE mod_phys_lmdz_para
333	USE nrtype, ONLY : PI
334	IMPLICIT NONE
335	CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
336	REAL :: lon_mpi(klon_mpi)
337	REAL :: lat_mpi(klon_mpi)
338	REAL :: boundslon_mpi(klon_mpi,nvertex)
339	REAL :: boundslat_mpi(klon_mpi,nvertex)
340	INTEGER :: ind_cell_glo_mpi(klon_mpi)
341	TYPE(xios_domaingroup) :: dom
342
343
344	CALL gather_omp(longitude*180/PI,lon_mpi)
345	CALL gather_omp(latitude*180/PI,lat_mpi)
346	CALL gather_omp(boundslon*180/PI,boundslon_mpi)
347	CALL gather_omp(boundslat*180/PI,boundslat_mpi)
348	CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
349
350
351	!$OMP MASTER
352	CALL xios_get_domaingroup_handle(dom_id, dom)
353
354	!On parametrise le domaine:
355	CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
356	CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
357	bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
358	CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
359	!$OMP END MASTER
360
361	END SUBROUTINE wxios_domain_param_unstructured
362
363
364
365
366	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
367	! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
368	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
369	SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value, &
370	positif, bnds)
371	USE print_control_mod, ONLY : prt_level, lunout
372	IMPLICIT NONE
373
374	CHARACTER (len=*), INTENT(IN) :: axis_id
375	INTEGER, INTENT(IN) :: axis_size
376	REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
377	CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
378	REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
379
380	! TYPE(xios_axisgroup) :: axgroup
381	! TYPE(xios_axis) :: ax
382	! CHARACTER(len=50) :: axis_id
383
384	! IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
385	! WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
386	! WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
387	! CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
388	! ENDIF
389	! axis_id=trim(axisgroup_id)
390
391	!On récupère le groupe d'axes qui va bien:
392	!CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
393
394	!On ajoute l'axe correspondant à ce fichier:
395	!CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
396
397	!Et on le parametrise:
398	!CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
399
400	! Ehouarn: New way to declare axis, without axis_group:
401	if (PRESENT(positif) .AND. PRESENT(bnds)) then
402	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
403	positive=positif, bounds=bnds)
404	else if (PRESENT(positif)) then
405	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
406	positive=positif)
407	else if (PRESENT(bnds)) then
408	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
409	bounds=bnds)
410	else
411	CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
412	endif
413
414	!Vérification:
415	IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
416	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
417	ELSE
418	WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
419	END IF
420
421	END SUBROUTINE wxios_add_vaxis
422
423
424	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
425	! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
426	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
427	SUBROUTINE wxios_add_file(fname, ffreq, flvl)
428	USE print_control_mod, ONLY : prt_level, lunout
429	IMPLICIT NONE
430
431	CHARACTER(len=*), INTENT(IN) :: fname
432	CHARACTER(len=*), INTENT(IN) :: ffreq
433	INTEGER, INTENT(IN) :: flvl
434
435	TYPE(xios_file) :: x_file
436	TYPE(xios_filegroup) :: x_fg
437	TYPE(xios_duration) :: nffreq
438
439	!On regarde si le fichier n'est pas défini par XML:
440	IF (.NOT.xios_is_valid_file(fname)) THEN
441	!On créé le noeud:
442	CALL xios_get_filegroup_handle("defile", x_fg)
443	CALL xios_add_file(x_fg, x_file, fname)
444
445	!On reformate la fréquence:
446	CALL reformadate(ffreq, nffreq)
447
448	!On configure:
449	CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
450	output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
451
452	IF (xios_is_valid_file("X"//fname)) THEN
453	IF (prt_level >= 10) THEN
454	WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
455	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
456	ENDIF
457	ELSE
458	WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
459	WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
460	END IF
461	ELSE
462	IF (prt_level >= 10) THEN
463	WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
464	ENDIF
465	! Ehouarn: add an enable=.true. on top of xml definitions... why???
466	CALL xios_set_file_attr(fname, enabled=.TRUE.)
467	END IF
468	END SUBROUTINE wxios_add_file
469
470	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
471	! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
472	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
473	SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
474	USE netcdf, only: nf90_fill_real
475
476	IMPLICIT NONE
477	INCLUDE 'iniprint.h'
478
479	CHARACTER(len=*), INTENT(IN) :: fieldname
480	TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
481	CHARACTER(len=*), INTENT(IN) :: fieldlongname
482	CHARACTER(len=*), INTENT(IN) :: fieldunit
483
484	TYPE(xios_field) :: field
485	CHARACTER(len=10) :: newunit
486	REAL(KIND=8) :: def
487
488	!La valeur par défaut des champs non définis:
489	def = nf90_fill_real
490
491	IF (fieldunit .EQ. " ") THEN
492	newunit = "-"
493	ELSE
494	newunit = fieldunit
495	ENDIF
496
497	!On ajoute le champ:
498	CALL xios_add_field(fieldgroup, field, fieldname)
499	!IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
500
501	!On rentre ses paramètres:
502	CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
503	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
504	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
505
506	END SUBROUTINE wxios_add_field
507
508	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
509	! Pour déclarer un champ !!!!!!!!!!!!!!!!!
510	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
511	SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
512	USE print_control_mod, ONLY : prt_level, lunout
513	IMPLICIT NONE
514
515	CHARACTER(len=*), INTENT(IN) :: fieldname
516	INTEGER, INTENT(IN) :: fdim, fid
517	CHARACTER(len=*), INTENT(IN) :: fname
518	CHARACTER(len=*), INTENT(IN) :: fieldlongname
519	CHARACTER(len=*), INTENT(IN) :: fieldunit
520	INTEGER, INTENT(IN) :: field_level
521	CHARACTER(len=*), INTENT(IN) :: op
522
523	CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
524	CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
525	CHARACTER(len=100) :: operation
526	TYPE(xios_file) :: f
527	TYPE(xios_field) :: field
528	TYPE(xios_fieldgroup) :: fieldgroup
529	TYPE(xios_duration) :: freq_op
530
531	LOGICAL :: bool=.FALSE.
532	INTEGER :: lvl =0
533
534
535	! Ajout Abd pour NMC:
536	IF (fid.LE.6) THEN
537	axis_id="presnivs"
538	ELSE
539	axis_id="plev"
540	ENDIF
541
542	IF (PRESENT(nam_axvert)) THEN
543	axis_id=nam_axvert
544	print*,'nam_axvert=',axis_id
545	ENDIF
546
547	!on prépare le nom de l'opération:
548	operation = reformaop(op)
549
550
551	!On selectionne le bon groupe de champs:
552	IF (fdim.EQ.2) THEN
553	CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
554	ELSE
555	CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
556	ENDIF
557
558	!On regarde si le champ à déjà été créé ou non:
559	IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
560	!Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
561	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
562	g_flag_xml = .TRUE.
563	g_field_name = fieldname
564
565	ELSE IF (.NOT. g_field_name == fieldname) THEN
566	!Si premier pssage et champ indéfini, alors on le créé
567
568	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
569
570	!On le créé:
571	CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
572	IF (xios_is_valid_field(fieldname)) THEN
573	IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
574	ENDIF
575
576	g_flag_xml = .FALSE.
577	g_field_name = fieldname
578
579	END IF
580
581	IF (.NOT. g_flag_xml) THEN
582	!Champ existe déjà, mais pas XML, alors on l'ajoute
583	!On ajoute le champ:
584	CALL xios_get_file_handle(fname, f)
585	CALL xios_add_fieldtofile(f, field)
586
587
588	!L'operation, sa frequence:
589	freq_op%timestep=1
590	CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
591
592
593	!On rentre ses paramètres:
594	CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
595
596	IF (fdim.EQ.2) THEN
597	!Si c'est un champ 2D:
598	IF (prt_level >= 10) THEN
599	WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
600	WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
601	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
602	ENDIF
603	ELSE
604	!Si 3D :
605	!On ajoute l'axe vertical qui va bien:
606	CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
607
608	IF (prt_level >= 10) THEN
609	WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
610	WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
611	WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
612	ENDIF
613	END IF
614
615	ELSE
616	!Sinon on se contente de l'activer:
617	CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
618	!NB: This will override an enable=.false. set by a user in the xml file;
619	! then the only way to not output the field is by changing its
620	! output level
621	ENDIF
622
623	END SUBROUTINE wxios_add_field_to_file
624
625	! SUBROUTINE wxios_update_calendar(ito)
626	! INTEGER, INTENT(IN) :: ito
627	! CALL xios_update_calendar(ito)
628	! END SUBROUTINE wxios_update_calendar
629	!
630	! SUBROUTINE wxios_write_2D(fieldname, fdata)
631	! CHARACTER(len=*), INTENT(IN) :: fieldname
632	! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
633	!
634	! CALL xios_send_field(fieldname, fdata)
635	! END SUBROUTINE wxios_write_2D
636
637	! SUBROUTINE wxios_write_3D(fieldname, fdata)
638	! CHARACTER(len=*), INTENT(IN) :: fieldname
639	! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
640	!
641	! CALL xios_send_field(fieldname, fdata)
642	! END SUBROUTINE wxios_write_3D
643
644	SUBROUTINE wxios_closedef()
645	CALL xios_close_context_definition()
646	! CALL xios_update_calendar(0)
647	END SUBROUTINE wxios_closedef
648
649	SUBROUTINE wxios_close()
650	CALL xios_context_finalize()
651	CALL xios_finalize()
652	END SUBROUTINE wxios_close
653	END MODULE wxios
654	#endif

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

Download in other formats:

Original Format