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

Last change on this file since 4867 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
RevLine 
[2509]1! $Id$
[1825]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)
[1852]20    LOGICAL, SAVE :: g_flag_xml = .FALSE.
21    CHARACTER(len=100) :: g_field_name = "nofield"
22!$OMP THREADPRIVATE(g_flag_xml,g_field_name)
[2271]23    REAL :: missing_val_omp
24    REAL :: missing_val
25!$OMP THREADPRIVATE(missing_val)
[1825]26
[2741]27#ifdef XIOS1
28#error "XIOS v1 no longer supported, use XIOS v2."
29#endif
30
[1825]31    CONTAINS
32   
33    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
34    !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
35    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
36   
37    SUBROUTINE reformadate(odate, ndate)
38        CHARACTER(len=*), INTENT(IN) :: odate
[2509]39        TYPE(xios_duration) :: ndate
[1825]40       
41        INTEGER :: i = 0
[1852]42         !!!!!!!!!!!!!!!!!!
43         ! Pour XIOS:
44         !  year : y
45         !  month : mo
46         !  day : d
47         !  hour : h
48         !  minute : mi
49         !  second : s
50         !!!!!!!!!!!!!!!!!!
51
[1825]52        i = INDEX(odate, "day")
53        IF (i > 0) THEN
[2509]54            read(odate(1:i-1),*) ndate%day
[1825]55        END IF
[1852]56
57        i = INDEX(odate, "hr")
58        IF (i > 0) THEN
[2509]59            read(odate(1:i-1),*) ndate%hour
[1852]60        END IF
61
62        i = INDEX(odate, "mth")
63        IF (i > 0) THEN
[2509]64            read(odate(1:i-1),*) ndate%month
[1852]65        END IF
[1825]66       
[1852]67        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
[1825]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       
[1852]96        !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
[1825]97    END FUNCTION reformaop
98
99    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
100    ! Routine d'initialisation      !!!!!!!!!!!!!
101    !     A lancer juste après mpi_init !!!!!!!!!!!!!
102    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
103
[2055]104    SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
[2509]105        USE print_control_mod, ONLY : prt_level, lunout
[1852]106        IMPLICIT NONE
107
[1825]108      CHARACTER(len=*), INTENT(IN) :: xios_ctx_name
[1852]109      INTEGER, INTENT(IN), OPTIONAL :: locom
110      INTEGER, INTENT(OUT), OPTIONAL :: outcom
[2055]111      CHARACTER(len=6), INTENT(IN), OPTIONAL :: type_ocean
[1852]112
113   
[1825]114        TYPE(xios_context) :: xios_ctx
[1852]115        INTEGER :: xios_comm
[1825]116
[1897]117        IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: Initialization"
[1852]118
119
120
121        IF (PRESENT(locom)) THEN
[1897]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
[1852]124        ELSE
[1897]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
[1852]127        END IF
[1825]128       
[1852]129        IF (PRESENT(outcom)) THEN
[1897]130          outcom = xios_comm
131          IF (prt_level >= 10) WRITE(lunout,*) "wxios_init: ctx=",xios_ctx_name," outcom=",outcom
[1852]132        END IF
[1825]133       
134        !Enregistrement des variables globales:
135        g_comm = xios_comm
136        g_ctx_name = xios_ctx_name
137       
[2055]138        ! Si couple alors init fait dans cpl_init
139        IF (.not. PRESENT(type_ocean)) THEN
[2054]140            CALL wxios_context_init()
[2055]141        ENDIF
[2054]142
[1825]143    END SUBROUTINE wxios_init
144
[1852]145    SUBROUTINE wxios_context_init()
[2509]146        USE print_control_mod, ONLY : prt_level, lunout
147!        USE mod_phys_lmdz_mpi_data, ONLY : COMM_LMDZ_PHY
[1852]148        IMPLICIT NONE
149
150        TYPE(xios_context) :: xios_ctx
151
[2509]152!$OMP MASTER
[1852]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
[2001]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
[1852]163        !Une première analyse des héritages:
164        CALL xios_solve_inheritance()
[2509]165!$OMP END MASTER
[1852]166    END SUBROUTINE wxios_context_init
167
[1825]168    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
169    ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
170    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
171
[2095]172    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
[2509]173        USE print_control_mod, ONLY : prt_level, lunout
[1852]174        IMPLICIT NONE
175
[1825]176     !Paramètres:
177     CHARACTER(len=*), INTENT(IN) :: calendrier
[2095]178     INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
179     REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
[1825]180     
181     !Variables:
182     CHARACTER(len=80) :: abort_message
183     CHARACTER(len=19) :: date
184     INTEGER :: njour = 1
185     
186     !Variables pour xios:
[2509]187     TYPE(xios_duration) :: mdtime
[1825]188     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
189     
[2509]190        mdtime%second=pasdetemps
[1825]191
192        !Réglage du calendrier:
193        SELECT CASE (calendrier)
194            CASE('earth_360d')
[2509]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
[1825]207       
[2095]208        !Formatage de la date d'origine:
[2509]209        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
[1825]210       
[2095]211        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
[2509]212        CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
[2095]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)
[1825]217       
[2095]218        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
219       
[2509]220        CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
[2095]221       
[1825]222        !Et enfin,le pas de temps:
223        CALL xios_set_timestep(mdtime)
[1897]224        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
[1825]225    END SUBROUTINE wxios_set_cal
226
[1852]227    SUBROUTINE wxios_set_timestep(ts)
228        REAL, INTENT(IN) :: ts
[2509]229        TYPE(xios_duration) :: mdtime     
[1852]230
[2509]231        mdtime%timestep = ts
232
[1852]233        CALL xios_set_timestep(mdtime)
234    END SUBROUTINE wxios_set_timestep
235
[1825]236    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
237    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
238    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]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,                    &
[1897]242                                    io_lat, io_lon,is_south_pole,mpi_rank)
[1825]243         
[1897]244
[2509]245        USE print_control_mod, ONLY : prt_level, lunout
[1852]246        IMPLICIT NONE
247
[1897]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
[1825]267       
268        TYPE(xios_domain) :: dom
[1852]269        LOGICAL :: boool
[1825]270       
[1852]271        !Masque pour les problèmes de recouvrement MPI:
272        LOGICAL :: mask(ni,nj)
[1825]273       
274        !On récupère le handle:
275        CALL xios_get_domain_handle(dom_id, dom)
276       
[1897]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
[1825]283       
284        !On parametrise le domaine:
[2509]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))
[1852]288        IF (.NOT.is_sequential) THEN
289            mask(:,:)=.TRUE.
[1897]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
[2509]298            CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
[1852]299        END IF
300
[1825]301         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
302        !Vérification:
303        IF (xios_is_valid_domain(dom_id)) THEN
[1897]304            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
[1825]305        ELSE
[1897]306            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
[1825]307        END IF
308    END SUBROUTINE wxios_domain_param
309   
310    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
311    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
312    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3003]313    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value,     &
314                               positif, bnds)
[2509]315        USE print_control_mod, ONLY : prt_level, lunout
[1852]316        IMPLICIT NONE
317
[2002]318        CHARACTER (len=*), INTENT(IN) :: axis_id
[1852]319        INTEGER, INTENT(IN) :: axis_size
[1825]320        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
[3003]321        CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
322        REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
[1825]323       
[2002]324!        TYPE(xios_axisgroup) :: axgroup
325!        TYPE(xios_axis) :: ax
326!        CHARACTER(len=50) :: axis_id
[1825]327       
[2002]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)
[1825]334       
335        !On récupère le groupe d'axes qui va bien:
[2002]336        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
[1825]337       
338        !On ajoute l'axe correspondant à ce fichier:
[2002]339        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
[1825]340       
341        !Et on le parametrise:
[2002]342        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
[1825]343       
[2002]344        ! Ehouarn: New way to declare axis, without axis_group:
[3003]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
[2741]357
[1825]358        !Vérification:
[1852]359        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
[1897]360            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
[1825]361        ELSE
[2001]362            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
[1825]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)
[2509]372        USE print_control_mod, ONLY : prt_level, lunout
[1852]373        IMPLICIT NONE
374
[1825]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
[2509]381        TYPE(xios_duration) :: nffreq
[1825]382       
[1852]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)
[1825]388       
[1852]389            !On reformate la fréquence:
390            CALL reformadate(ffreq, nffreq)
[1825]391       
[1852]392            !On configure:
393            CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
[2509]394                output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
395       
[1852]396            IF (xios_is_valid_file("X"//fname)) THEN
[2001]397                IF (prt_level >= 10) THEN
398                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
[2509]399                  WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[2001]400                ENDIF
[1852]401            ELSE
[2001]402                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
[2509]403                WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[1852]404            END IF
[1825]405        ELSE
[2001]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.)
[1825]411        END IF
412    END SUBROUTINE wxios_add_file
413   
414    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]415    ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
[1825]416    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
417    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
[1897]418        USE netcdf, only: nf90_fill_real
[1852]419
420        IMPLICIT NONE
421        INCLUDE 'iniprint.h'
[1825]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)
[1897]443        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
[1825]444       
445        !On rentre ses paramètres:
446        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
[1897]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
[1825]449
450    END SUBROUTINE wxios_add_field
451   
452    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]453    ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
[1825]454    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2137]455    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
[2509]456        USE print_control_mod, ONLY : prt_level, lunout
[1852]457        IMPLICIT NONE
458
[1825]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       
[2001]467        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
[2137]468        CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
[1825]469        CHARACTER(len=100) :: operation
470        TYPE(xios_file) :: f
471        TYPE(xios_field) :: field
472        TYPE(xios_fieldgroup) :: fieldgroup
[2509]473        TYPE(xios_duration) :: freq_op
[2741]474
[1852]475        LOGICAL :: bool=.FALSE.
476        INTEGER :: lvl =0
[1825]477       
478       
[2001]479        ! Ajout Abd pour NMC:
480        IF (fid.LE.6) THEN
481          axis_id="presnivs"
482        ELSE
483          axis_id="plev"
484        ENDIF
[2137]485 
486        IF (PRESENT(nam_axvert)) THEN
487           axis_id=nam_axvert
488           print*,'nam_axvert=',axis_id
489        ENDIF
[1825]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
[2001]497          CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
[1825]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:
[1852]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
[1897]505            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
[1852]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
[1897]512            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
[1825]513           
514            !On le créé:
515            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
516            IF (xios_is_valid_field(fieldname)) THEN
[1897]517                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
[1825]518            ENDIF
519
[1852]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:
[2509]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)
[1852]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:
[1897]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
[1852]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               
[1897]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
[1852]557            END IF
[1825]558       
559        ELSE
[1852]560            !Sinon on se contente de l'activer:
561            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
[2002]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
[1852]565        ENDIF       
[1825]566       
567    END SUBROUTINE wxios_add_field_to_file
568   
[2002]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
[1825]580   
[2002]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
[1825]587   
588    SUBROUTINE wxios_closedef()
589        CALL xios_close_context_definition()
[2095]590!        CALL xios_update_calendar(0)
[1825]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.