Context Navigation

wxios.F90 @ 5442

Last change on this file since 5442 was 3406, checked in by jghattas, 6 years ago
Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore
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: 24.0 KB

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

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

Download in other formats:

Original Format