source: LMDZ5/trunk/libf/misc/wxios.F90 @ 3604

Last change on this file since 3604 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
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    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
597END MODULE wxios
598#endif
Note: See TracBrowser for help on using the repository browser.