source: LMDZ5/branches/LMDZ5_SPLA/libf/bibio/wxios.F90 @ 3064

Last change on this file since 3064 was 2002, checked in by Ehouarn Millour, 11 years ago

Further cleanup concerning XIOS (mainly about axes being defined as axes and not as groups of axes).
EM

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