Context Navigation

wxios.F90 @ 4672

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

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

Download in other formats:

Original Format