LMDZ
wxios.F90
Go to the documentation of this file.
1 ! $Id: wxios.F90 $
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  CONTAINS
28 
29  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
30  ! 36day => 36d etc !!!!!!!!!!!!!!!!!!!!
31  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
32 
33  SUBROUTINE reformadate(odate, ndate)
34  CHARACTER(len=*), INTENT(IN) :: odate
35  CHARACTER(len=100), INTENT(OUT) :: ndate
36 
37  INTEGER :: i = 0
38  !!!!!!!!!!!!!!!!!!
39  ! Pour XIOS:
40  ! year : y
41  ! month : mo
42  ! day : d
43  ! hour : h
44  ! minute : mi
45  ! second : s
46  !!!!!!!!!!!!!!!!!!
47 
48  i = index(odate, "day")
49  IF (i > 0) THEN
50  ndate = odate(1:i-1)//"d"
51  END IF
52 
53  i = index(odate, "hr")
54  IF (i > 0) THEN
55  ndate = odate(1:i-1)//"h"
56  END IF
57 
58  i = index(odate, "mth")
59  IF (i > 0) THEN
60  ndate = odate(1:i-1)//"mo"
61  END IF
62 
63  !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
64  END SUBROUTINE reformadate
65 
66  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
67  ! ave(X) => average etc !!!!!!!!!!!!!!!
68  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
69 
70  CHARACTER(len=7) FUNCTION reformaop(op)
71  CHARACTER(len=*), INTENT(IN) :: op
72 
73  INTEGER :: i = 0
74  reformaop = "average"
75 
76  IF (op.EQ."inst(X)") THEN
77  reformaop = "instant"
78  END IF
79 
80  IF (op.EQ."once") THEN
81  reformaop = "once"
82  END IF
83 
84  IF (op.EQ."t_max(X)") THEN
85  reformaop = "maximum"
86  END IF
87 
88  IF (op.EQ."t_min(X)") THEN
89  reformaop = "minimum"
90  END IF
91 
92  !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
93  END FUNCTION reformaop
94 
95  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
96  ! Routine d'initialisation !!!!!!!!!!!!!
97  ! A lancer juste après mpi_init !!!!!!!!!!!!!
98  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
99 
100  SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
101  IMPLICIT NONE
102  include 'iniprint.h'
103 
104  CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
105  INTEGER, INTENT(IN), OPTIONAL :: locom
106  INTEGER, INTENT(OUT), OPTIONAL :: outcom
107  CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
108 
109 
110  TYPE(xios_context) :: xios_ctx
111  INTEGER :: xios_comm
112 
113  IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
114 
115 
116 
117  IF (PRESENT(locom)) THEN
118  CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm )
119  IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," local_comm=",locom,", return_comm=",xios_comm
120  ELSE
121  CALL xios_initialize(xios_ctx_name, return_comm = xios_comm )
122  IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," return_comm=",xios_comm
123  END IF
124 
125  IF (PRESENT(outcom)) THEN
126  outcom = xios_comm
127  IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
128  END IF
129 
130  !Enregistrement des variables globales:
131  g_comm = xios_comm
132  g_ctx_name = xios_ctx_name
133 
134  ! Si couple alors init fait dans cpl_init
135  IF (.not. PRESENT(type_ocean)) THEN
136  CALL wxios_context_init()
137  ENDIF
138 
139  END SUBROUTINE wxios_init
140 
141  SUBROUTINE wxios_context_init()
142  IMPLICIT NONE
143  include 'iniprint.h'
144 
145  TYPE(xios_context) :: xios_ctx
146 
147  !Initialisation du contexte:
148  CALL xios_context_initialize(g_ctx_name, g_comm)
149  CALL xios_get_handle(g_ctx_name, xios_ctx) !Récupération
150  CALL xios_set_current_context(xios_ctx) !Activation
151  g_ctx = xios_ctx
152 
153  IF (prt_level >= 10) THEN
154  WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
155  WRITE(lunout,*) " now call xios_solve_inheritance()"
156  ENDIF
157  !Une première analyse des héritages:
158  CALL xios_solve_inheritance()
159  END SUBROUTINE wxios_context_init
160 
161  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
162  ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
163  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
164 
165  SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
166  IMPLICIT NONE
167  include 'iniprint.h'
168 
169  !Paramètres:
170  CHARACTER(len=*), INTENT(IN) :: calendrier
171  INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
172  REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
173 
174  !Variables:
175  CHARACTER(len=80) :: abort_message
176  CHARACTER(len=19) :: date
177  INTEGER :: njour = 1
178 
179  !Variables pour xios:
180  TYPE(xios_time) :: mdtime
181  !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
182 
183  mdtime = xios_time(0, 0, 0, 0, 0, pasdetemps)
184 
185  !Réglage du calendrier:
186  SELECT CASE (calendrier)
187  CASE('earth_360d')
188  CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "D360")
189  IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
190  CASE('earth_365d')
191  CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "NoLeap")
192  IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
193  CASE('gregorian')
194  CALL xios_set_context_attr_hdl(g_ctx, calendar_type= "Gregorian")
195  IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
196  CASE DEFAULT
197  abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
198  CALL abort_gcm('Gcm:Xios',abort_message,1)
199  END SELECT
200 
201  !Formatage de la date d'origine:
202  WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
203 
204  IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
205 
206  CALL xios_set_context_attr_hdl(g_ctx, time_origin = date)
207 
208  !Formatage de la date de debut:
209 
210  WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
211 
212  IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
213 
214  CALL xios_set_context_attr_hdl(g_ctx, start_date = date)
215 
216  !Et enfin,le pas de temps:
217  CALL xios_set_timestep(mdtime)
218  IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
219  END SUBROUTINE wxios_set_cal
220 
221  SUBROUTINE wxios_set_timestep(ts)
222  REAL, INTENT(IN) :: ts
223  TYPE(xios_time) :: mdtime
224 
225  mdtime = xios_time(0, 0, 0, 0, 0, ts)
226 
227  CALL xios_set_timestep(mdtime)
228  END SUBROUTINE wxios_set_timestep
229 
230  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
231  ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
232  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
233  SUBROUTINE wxios_domain_param(dom_id, is_sequential, ni, nj, ni_glo, nj_glo, &
234  ibegin, iend, ii_begin, ii_end, jbegin, jend, &
235  data_ni, data_ibegin, data_iend, &
236  io_lat, io_lon,is_south_pole,mpi_rank)
237 
238 
239  IMPLICIT NONE
240  include 'iniprint.h'
241 
242  CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
243  LOGICAL,INTENT(IN) :: is_sequential ! flag
244  INTEGER,INTENT(IN) :: ni ! local MPI domain number of longitudes
245  INTEGER,INTENT(IN) :: nj ! local MPI domain number of latitudes
246  INTEGER,INTENT(IN) :: ni_glo ! global grid number of longitudes
247  INTEGER,INTENT(IN) :: nj_glo ! global grid number of latitudes
248  INTEGER,INTENT(IN) :: ibegin ! start index, on global grid, of local MPI domain
249  INTEGER,INTENT(IN) :: iend ! end index, on global grid, of local MPI domain
250  INTEGER,INTENT(IN) :: ii_begin ! i index at which local data starts (first row)
251  INTEGER,INTENT(IN) :: ii_end ! i index at which local data ends (last row)
252  INTEGER,INTENT(IN) :: jbegin ! start index, on global grid, of local MPI domain
253  INTEGER,INTENT(IN) :: jend ! end index, on global grid, of local MPI domain
254  INTEGER,INTENT(IN) :: data_ni
255  INTEGER,INTENT(IN) :: data_ibegin
256  INTEGER,INTENT(IN) :: data_iend
257  REAL,INTENT(IN) :: io_lat(:) ! latitudes (of global grid)
258  REAL,INTENT(IN) :: io_lon(:) ! longitudes (of global grid)
259  logical,intent(in) :: is_south_pole ! does this process include the south pole?
260  integer,intent(in) :: mpi_rank ! rank of process
261 
262  TYPE(xios_domain) :: dom
263  LOGICAL :: boool
264 
265  !Masque pour les problèmes de recouvrement MPI:
266  LOGICAL :: mask(ni,nj)
267 
268  !On récupère le handle:
269  CALL xios_get_domain_handle(dom_id, dom)
270 
271  IF (prt_level >= 10) THEN
272  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ni:",ni," ni_glo:", ni_glo, " nj:", nj, " nj_glo:", nj_glo
273  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ibegin:",ibegin," iend:", iend, " jbegin:", jbegin, " jend:", jend
274  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," ii_begin:",ii_begin," ii_end:", ii_end
275  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," Size io_lon:", SIZE(io_lon(ibegin:iend)), " io_lat:", SIZE(io_lat(jbegin:jend))
276  ENDIF
277 
278  !On parametrise le domaine:
279  CALL xios_set_domain_attr_hdl(dom, ni_glo=ni_glo, ibegin=ibegin, ni=ni)
280  CALL xios_set_domain_attr_hdl(dom, nj_glo=nj_glo, jbegin=jbegin, nj=nj, data_dim=2)
281  CALL xios_set_domain_attr_hdl(dom, lonvalue=io_lon(ibegin:iend), latvalue=io_lat(jbegin:jend))
282 
283  IF (.NOT.is_sequential) THEN
284  mask(:,:)=.true.
285  if (ii_begin>1) mask(1:ii_begin-1,1) = .false.
286  if (ii_end<ni) mask(ii_end+1:ni,nj) = .false.
287  ! special case for south pole
288  if ((ii_end.eq.1).and.(is_south_pole)) mask(1:ni,nj)=.true.
289  IF (prt_level >= 10) THEN
290  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
291  WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,nj)=",mask(:,nj)
292  ENDIF
293  CALL xios_set_domain_attr_hdl(dom, mask=mask)
294  END IF
295 
296  CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
297  !Vérification:
298  IF (xios_is_valid_domain(dom_id)) THEN
299  IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
300  ELSE
301  IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
302  END IF
303  END SUBROUTINE wxios_domain_param
304 
305  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
306  ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
307  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
308  SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value)
309  IMPLICIT NONE
310  include 'iniprint.h'
311 
312  CHARACTER (len=*), INTENT(IN) :: axis_id
313  INTEGER, INTENT(IN) :: axis_size
314  REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
315 
316 ! TYPE(xios_axisgroup) :: axgroup
317 ! TYPE(xios_axis) :: ax
318 ! CHARACTER(len=50) :: axis_id
319 
320 ! IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
321 ! WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
322 ! WRITE(lunout,*) " increase it to at least ",len_trim(axisgroup_id)
323 ! CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
324 ! ENDIF
325 ! axis_id=trim(axisgroup_id)
326 
327  !On récupère le groupe d'axes qui va bien:
328  !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
329 
330  !On ajoute l'axe correspondant à ce fichier:
331  !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
332 
333  !Et on le parametrise:
334  !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
335 
336  ! Ehouarn: New way to declare axis, without axis_group:
337  CALL xios_set_axis_attr(trim(axis_id),size=axis_size,value=axis_value)
338 
339  !Vérification:
340  IF (xios_is_valid_axis(trim(adjustl(axis_id)))) THEN
341  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", trim(adjustl(axis_id))
342  ELSE
343  WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", trim(adjustl(axis_id))
344  END IF
345 
346  END SUBROUTINE wxios_add_vaxis
347 
348 
349  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
350  ! Pour déclarer un fichier !!!!!!!!!!!!!!!!!!!
351  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
352  SUBROUTINE wxios_add_file(fname, ffreq, flvl)
353  IMPLICIT NONE
354  include 'iniprint.h'
355 
356  CHARACTER(len=*), INTENT(IN) :: fname
357  CHARACTER(len=*), INTENT(IN) :: ffreq
358  INTEGER, INTENT(IN) :: flvl
359 
360  TYPE(xios_file) :: x_file
361  TYPE(xios_filegroup) :: x_fg
362  CHARACTER(len=100) :: nffreq
363 
364  !On regarde si le fichier n'est pas défini par XML:
365  IF (.NOT.xios_is_valid_file(fname)) THEN
366  !On créé le noeud:
367  CALL xios_get_filegroup_handle("defile", x_fg)
368  CALL xios_add_file(x_fg, x_file, fname)
369 
370  !On reformate la fréquence:
371  CALL reformadate(ffreq, nffreq)
372 
373  !On configure:
374  CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
375  output_freq=trim(adjustl(nffreq)), output_level=flvl, enabled=.true.)
376 
377  IF (xios_is_valid_file("X"//fname)) THEN
378  IF (prt_level >= 10) THEN
379  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
380  WRITE(lunout,*) "wxios_add_file: output_freq=",trim(adjustl(nffreq)),"; output_lvl=",flvl
381  ENDIF
382  ELSE
383  WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
384  WRITE(lunout,*) "wxios_add_file: output_freq=",trim(adjustl(nffreq)),"; output_lvl=",flvl
385  END IF
386  ELSE
387  IF (prt_level >= 10) THEN
388  WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
389  ENDIF
390  ! Ehouarn: add an enable=.true. on top of xml definitions... why???
391  CALL xios_set_file_attr(fname, enabled=.true.)
392  END IF
393  END SUBROUTINE wxios_add_file
394 
395  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
396  ! Pour créer un champ !!!!!!!!!!!!!!!!!!!!
397  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
398  SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
399  USE netcdf, only: nf90_fill_real
400 
401  IMPLICIT NONE
402  include 'iniprint.h'
403 
404  CHARACTER(len=*), INTENT(IN) :: fieldname
405  TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
406  CHARACTER(len=*), INTENT(IN) :: fieldlongname
407  CHARACTER(len=*), INTENT(IN) :: fieldunit
408 
409  TYPE(xios_field) :: field
410  CHARACTER(len=10) :: newunit
411  REAL(KIND=8) :: def
412 
413  !La valeur par défaut des champs non définis:
414  def = nf90_fill_real
415 
416  IF (fieldunit .EQ. " ") THEN
417  newunit = "-"
418  ELSE
419  newunit = fieldunit
420  ENDIF
421 
422  !On ajoute le champ:
423  CALL xios_add_field(fieldgroup, field, fieldname)
424  !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
425 
426  !On rentre ses paramètres:
427  CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
428  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
429  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),"; default_value=",nf90_fill_real
430 
431  END SUBROUTINE wxios_add_field
432 
433  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
434  ! Pour déclarer un champ !!!!!!!!!!!!!!!!!
435  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
436  SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
437  IMPLICIT NONE
438  include 'iniprint.h'
439 
440  CHARACTER(len=*), INTENT(IN) :: fieldname
441  INTEGER, INTENT(IN) :: fdim, fid
442  CHARACTER(len=*), INTENT(IN) :: fname
443  CHARACTER(len=*), INTENT(IN) :: fieldlongname
444  CHARACTER(len=*), INTENT(IN) :: fieldunit
445  INTEGER, INTENT(IN) :: field_level
446  CHARACTER(len=*), INTENT(IN) :: op
447 
448  CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
449  CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
450  CHARACTER(len=100) :: operation
451  TYPE(xios_file) :: f
452  TYPE(xios_field) :: field
453  TYPE(xios_fieldgroup) :: fieldgroup
454  LOGICAL :: bool=.false.
455  INTEGER :: lvl =0
456 
457 
458  ! Ajout Abd pour NMC:
459  IF (fid.LE.6) THEN
460  axis_id="presnivs"
461  ELSE
462  axis_id="plev"
463  ENDIF
464 
465  IF (PRESENT(nam_axvert)) THEN
466  axis_id=nam_axvert
467  print*,'nam_axvert=',axis_id
468  ENDIF
469 
470  !on prépare le nom de l'opération:
471  operation = reformaop(op)
472 
473 
474  !On selectionne le bon groupe de champs:
475  IF (fdim.EQ.2) THEN
476  CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
477  ELSE
478  CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
479  ENDIF
480 
481  !On regarde si le champ à déjà été créé ou non:
482  IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
483  !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
484  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
485  g_flag_xml = .true.
486  g_field_name = fieldname
487 
488  ELSE IF (.NOT. g_field_name == fieldname) THEN
489  !Si premier pssage et champ indéfini, alors on le créé
490 
491  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
492 
493  !On le créé:
494  CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
495  IF (xios_is_valid_field(fieldname)) THEN
496  IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
497  ENDIF
498 
499  g_flag_xml = .false.
500  g_field_name = fieldname
501 
502  END IF
503 
504  IF (.NOT. g_flag_xml) THEN
505  !Champ existe déjà, mais pas XML, alors on l'ajoute
506  !On ajoute le champ:
507  CALL xios_get_file_handle(fname, f)
508  CALL xios_add_fieldtofile(f, field)
509 
510 
511  !L'operation, sa frequence:
512  CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=trim(adjustl(operation)), freq_op="1ts", prec=4)
513 
514 
515  !On rentre ses paramètres:
516  CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.true.)
517 
518  IF (fdim.EQ.2) THEN
519  !Si c'est un champ 2D:
520  IF (prt_level >= 10) THEN
521  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
522  WRITE(lunout,*) "wxios_add_field_to_file: op=", trim(adjustl(operation))
523  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
524  ENDIF
525  ELSE
526  !Si 3D :
527  !On ajoute l'axe vertical qui va bien:
528  CALL xios_set_field_attr_hdl(field, axis_ref=trim(adjustl(axis_id)))
529 
530  IF (prt_level >= 10) THEN
531  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
532  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
533  WRITE(lunout,*) "wxios_add_field_to_file: axis=",trim(adjustl(axis_id))
534  ENDIF
535  END IF
536 
537  ELSE
538  !Sinon on se contente de l'activer:
539  CALL xios_set_field_attr(fieldname, enabled=.true.)
540  !NB: This will override an enable=.false. set by a user in the xml file;
541  ! then the only way to not output the field is by changing its
542  ! output level
543  ENDIF
544 
545  END SUBROUTINE wxios_add_field_to_file
546 
547 ! SUBROUTINE wxios_update_calendar(ito)
548 ! INTEGER, INTENT(IN) :: ito
549 ! CALL xios_update_calendar(ito)
550 ! END SUBROUTINE wxios_update_calendar
551 !
552 ! SUBROUTINE wxios_write_2D(fieldname, fdata)
553 ! CHARACTER(len=*), INTENT(IN) :: fieldname
554 ! REAL, DIMENSION(:,:), INTENT(IN) :: fdata
555 !
556 ! CALL xios_send_field(fieldname, fdata)
557 ! END SUBROUTINE wxios_write_2D
558 
559 ! SUBROUTINE wxios_write_3D(fieldname, fdata)
560 ! CHARACTER(len=*), INTENT(IN) :: fieldname
561 ! REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
562 !
563 ! CALL xios_send_field(fieldname, fdata)
564 ! END SUBROUTINE wxios_write_3D
565 
566  SUBROUTINE wxios_closedef()
567  CALL xios_close_context_definition()
568 ! CALL xios_update_calendar(0)
569  END SUBROUTINE wxios_closedef
570 
571  SUBROUTINE wxios_close()
572  CALL xios_context_finalize()
573  CALL xios_finalize()
574  END SUBROUTINE wxios_close
575 END MODULE wxios
576 #endif
level
!$Id NSTRA real GKLIFT real GVSEC REAL GWD_RANDO_RUWMAX!Maximum Eliassen Palm flux at launch level
Definition: YOEGWD.h:12
abort_gcm
subroutine abort_gcm(modname, message, ierr)
Definition: abort_gcm.F:7
i
!$Id klon initialisation mois suivants day_rain itap ENDIF!Calcul fin de nday_rain calcul nday_rain itap DO i
Definition: calcul_divers.h:24
false
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL false
Definition: calcul_STDlev.h:26
prt_level
!FH On elimine toutes les clefs physiques dans la dynamique prt_level
Definition: write_paramLMDZ_dyn.h:9
true
!$Id itapm1 ENDIF!IM on interpole les champs sur les niveaux STD de pression!IM a chaque pas de temps de la physique c!positionnement de l argument logique a false c!pour ne pas recalculer deux fois la meme chose!c!a cet effet un appel a plevel_new a ete deplace c!a la fin de la serie d appels c!la boucle DO nlevSTD a ete internalisee c!dans d ou la creation de cette routine c c!CALL ulevSTD CALL &zphi philevSTD CALL &zx_rh rhlevSTD!DO klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon klev DO klon du jour ou toutes les read_climoz CALL true
Definition: calcul_STDlev.h:139
def
!$Id pressure_exner real ap!hybrid pressure contribution at interlayers real bp!hybrid sigma contribution at interlayer real based on!preff and scaleheight integer disvert_type!type of vertical!automatic!using z2sig def(or 'esasig.def) file logical pressure_exner!compute pressure inside layers using Exner function
unit
!$Header!integer nvarmx s s unit
Definition: gradsdef.h:20
lunout
!$Header!gestion des impressions de sorties et de débogage la sortie standard prt_level COMMON comprint lunout
Definition: iniprint.h:7