source: LMDZ6/branches/DYNAMICO-conv-GC/libf/misc/wxios.F90 @ 3603

Last change on this file since 3603 was 3406, checked in by jghattas, 6 years ago

Added all modifications in the model code that were used for the simulations with DYANMICO during the Grand Challeng 2018. Modifications done by Y. Meurdesoif, L. Fairhead and A.K. Traore

  • 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
  • Property svn:keywords set to Id
File size: 24.0 KB
RevLine 
[2509]1! $Id: wxios.F90 3406 2018-10-23 09:16:41Z musat $
[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
[3406]17    CHARACTER(len=100), SAVE :: g_ctx_name ="LMDZ"
[1825]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       
[3322]138!        ! Si couple alors init fait dans cpl_init
139!        IF (.not. PRESENT(type_ocean)) THEN
140!            CALL wxios_context_init()
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
[3406]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:
[3406]154        !!CALL xios_context_initialize(g_ctx_name, g_comm)
155        CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
[1852]156        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
157        CALL xios_set_current_context(xios_ctx)            !Activation
158        g_ctx = xios_ctx
159
[2001]160        IF (prt_level >= 10) THEN
161          WRITE(lunout,*) "wxios_context_init: Current context is ",trim(g_ctx_name)
162          WRITE(lunout,*) "     now call xios_solve_inheritance()"
163        ENDIF
[1852]164        !Une première analyse des héritages:
165        CALL xios_solve_inheritance()
[2509]166!$OMP END MASTER
[1852]167    END SUBROUTINE wxios_context_init
168
[3322]169
170    SUBROUTINE wxios_set_context()
171        IMPLICIT NONE
172        TYPE(xios_context) :: xios_ctx
173
174       !$OMP MASTER
175        CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
176        CALL xios_set_current_context(xios_ctx)            !Activation
177       !$OMP END MASTER
178
179    END SUBROUTINE wxios_set_context
180
[1825]181    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
182    ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
183    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
184
[2095]185    SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
[2509]186        USE print_control_mod, ONLY : prt_level, lunout
[1852]187        IMPLICIT NONE
188
[1825]189     !Paramètres:
190     CHARACTER(len=*), INTENT(IN) :: calendrier
[2095]191     INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
192     REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
[1825]193     
194     !Variables:
195     CHARACTER(len=80) :: abort_message
196     CHARACTER(len=19) :: date
197     INTEGER :: njour = 1
198     
199     !Variables pour xios:
[2509]200     TYPE(xios_duration) :: mdtime
[1825]201     !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
202     
[2509]203        mdtime%second=pasdetemps
[1825]204
205        !Réglage du calendrier:
206        SELECT CASE (calendrier)
207            CASE('earth_360d')
[2509]208                CALL xios_define_calendar("D360")
209                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
210            CASE('earth_365d')
211                CALL xios_define_calendar("NoLeap")
212                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
213            CASE('gregorian')
214                CALL xios_define_calendar("Gregorian")
215                IF (prt_level >= 10) WRITE(lunout,*) 'wxios_set_cal: Calendrier gregorien'
216            CASE DEFAULT
217                abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
[3065]218                CALL abort_physic('Gcm:Xios',abort_message,1)
[2509]219        END SELECT
[1825]220       
[2095]221        !Formatage de la date d'origine:
[2509]222        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
[1825]223       
[2095]224        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Time origin: ", date
[2509]225        CALL xios_set_time_origin(xios_date(annee,mois,jour,int(heure),0,0))
[2095]226
227        !Formatage de la date de debut:
228
229        WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
[1825]230       
[2095]231        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: Start date: ", date
232       
[2509]233        CALL xios_set_start_date(xios_date(ini_an,ini_mois,ini_jour,int(ini_heure),0,0))
[2095]234       
[1825]235        !Et enfin,le pas de temps:
236        CALL xios_set_timestep(mdtime)
[1897]237        IF (prt_level >= 10) WRITE(lunout,*) "wxios_set_cal: ts=",mdtime
[1825]238    END SUBROUTINE wxios_set_cal
239
[1852]240    SUBROUTINE wxios_set_timestep(ts)
241        REAL, INTENT(IN) :: ts
[2509]242        TYPE(xios_duration) :: mdtime     
[1852]243
[2509]244        mdtime%timestep = ts
245
[1852]246        CALL xios_set_timestep(mdtime)
247    END SUBROUTINE wxios_set_timestep
248
[1825]249    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
250    ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
251    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3077]252    SUBROUTINE wxios_domain_param(dom_id)
253       USE dimphy, only: klon
254       USE mod_phys_lmdz_transfert_para, ONLY: gather, bcast
255       USE mod_phys_lmdz_para, only: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
256                                     mpi_size, mpi_rank, klon_mpi, &
257                                     is_sequential, is_south_pole_dyn
258       USE mod_grid_phy_lmdz, only: nbp_lon, nbp_lat, klon_glo         
259       USE print_control_mod, ONLY : prt_level, lunout
260       USE geometry_mod
[1897]261
[3077]262       IMPLICIT NONE
263        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
[1852]264
[3077]265        REAL   :: rlat_glo(klon_glo)
266        REAL   :: rlon_glo(klon_glo)
267        REAL   :: io_lat(nbp_lat)
268        REAL   :: io_lon(nbp_lon)
269        LOGICAL :: mask(nbp_lon,jj_nb) !Masque pour les problèmes de recouvrement MPI
[1825]270        TYPE(xios_domain) :: dom
[3077]271        INTEGER :: i
[1852]272        LOGICAL :: boool
[1825]273       
[3077]274
275
276        CALL gather(latitude_deg,rlat_glo)
277        CALL bcast(rlat_glo)
278        CALL gather(longitude_deg,rlon_glo)
279        CALL bcast(rlon_glo)
280   
281  !$OMP MASTER 
282        io_lat(1)=rlat_glo(1)
283        io_lat(nbp_lat)=rlat_glo(klon_glo)
284        IF ((nbp_lon*nbp_lat) > 1) then
285          DO i=2,nbp_lat-1
286            io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
287          ENDDO
288        ENDIF
289
290        IF (klon_glo == 1) THEN
291          io_lon(1)=rlon_glo(1)
292        ELSE
293          io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
294        ENDIF
295
[1825]296       
297        !On récupère le handle:
298        CALL xios_get_domain_handle(dom_id, dom)
299       
300        !On parametrise le domaine:
[3077]301        CALL xios_set_domain_attr_hdl(dom, ni_glo=nbp_lon, ibegin=0, ni=nbp_lon, type="rectilinear")
302        CALL xios_set_domain_attr_hdl(dom, nj_glo=nbp_lat, jbegin=jj_begin-1, nj=jj_nb, data_dim=2)
303        CALL xios_set_domain_attr_hdl(dom, lonvalue_1d=io_lon(1:nbp_lon), latvalue_1d=io_lat(jj_begin:jj_end))
304
[1852]305        IF (.NOT.is_sequential) THEN
306            mask(:,:)=.TRUE.
[1897]307            if (ii_begin>1) mask(1:ii_begin-1,1) = .FALSE.
[3077]308            if (ii_end<nbp_lon) mask(ii_end+1:nbp_lon,jj_nb) = .FALSE.
[1897]309            ! special case for south pole
[3077]310            if ((ii_end==1).and.(is_south_pole_dyn)) mask(1:nbp_lon,jj_nb)=.true.
[1897]311            IF (prt_level >= 10) THEN
312              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,1)=",mask(:,1)
[3077]313              WRITE(lunout,*) "wxios_domain_param: mpirank=",mpi_rank," mask(:,jj_nb)=",mask(:,jj_nb)
[1897]314            ENDIF
[2509]315            CALL xios_set_domain_attr_hdl(dom, mask_2d=mask)
[1852]316        END IF
317
[1825]318         CALL xios_is_defined_domain_attr_hdl(dom,ni_glo=boool)
319        !Vérification:
320        IF (xios_is_valid_domain(dom_id)) THEN
[1897]321            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
[1825]322        ELSE
[1897]323            IF (prt_level >= 10) WRITE(lunout,*) "wxios_domain_param: Invalid domain: ", trim(dom_id)
[1825]324        END IF
[3077]325!$OMP END MASTER
326       
[1825]327    END SUBROUTINE wxios_domain_param
328   
[3077]329
330    SUBROUTINE wxios_domain_param_unstructured(dom_id)
331        USE geometry_mod, ONLY : longitude, latitude, boundslon, boundslat,ind_cell_glo
332        USE mod_grid_phy_lmdz, ONLY : nvertex, klon_glo
333        USE mod_phys_lmdz_para
334        USE nrtype, ONLY : PI
335        IMPLICIT NONE
336        CHARACTER(len=*),INTENT(IN) :: dom_id ! domain identifier
337        REAL :: lon_mpi(klon_mpi)
338        REAL :: lat_mpi(klon_mpi)
339        REAL :: boundslon_mpi(klon_mpi,nvertex)
340        REAL :: boundslat_mpi(klon_mpi,nvertex)
341        INTEGER :: ind_cell_glo_mpi(klon_mpi)
342        TYPE(xios_domaingroup) :: dom
343
344
345        CALL gather_omp(longitude*180/PI,lon_mpi)
346        CALL gather_omp(latitude*180/PI,lat_mpi)
347        CALL gather_omp(boundslon*180/PI,boundslon_mpi)
348        CALL gather_omp(boundslat*180/PI,boundslat_mpi)
349        CALL gather_omp(ind_cell_glo,ind_cell_glo_mpi)
350       
351
352!$OMP MASTER
353        CALL xios_get_domaingroup_handle(dom_id, dom)
354       
355        !On parametrise le domaine:
356        CALL xios_set_attr(dom, ni_glo=klon_glo, ibegin=ij_begin-1, ni=ij_nb, type="unstructured")
357        CALL xios_set_attr(dom, nvertex=nvertex, lonvalue_1d=lon_mpi, latvalue_1d=lat_mpi, &
358                           bounds_lon_1d=TRANSPOSE(boundslon_mpi), bounds_lat_1d=TRANSPOSE(boundslat_mpi) )
359        CALL xios_set_attr(dom, i_index=ind_cell_glo_mpi(:)-1)
360!$OMP END MASTER
361
362    END SUBROUTINE wxios_domain_param_unstructured
363
364
365
366
[1825]367    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
368    ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
369    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3003]370    SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value,     &
371                               positif, bnds)
[2509]372        USE print_control_mod, ONLY : prt_level, lunout
[1852]373        IMPLICIT NONE
374
[2002]375        CHARACTER (len=*), INTENT(IN) :: axis_id
[1852]376        INTEGER, INTENT(IN) :: axis_size
[1825]377        REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
[3003]378        CHARACTER (len=*), INTENT(IN), OPTIONAL :: positif
379        REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
[1825]380       
[2002]381!        TYPE(xios_axisgroup) :: axgroup
382!        TYPE(xios_axis) :: ax
383!        CHARACTER(len=50) :: axis_id
[1825]384       
[2002]385!        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
386!          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
387!          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
388!          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
389!        ENDIF
390!        axis_id=trim(axisgroup_id)
[1825]391       
392        !On récupère le groupe d'axes qui va bien:
[2002]393        !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
[1825]394       
395        !On ajoute l'axe correspondant à ce fichier:
[2002]396        !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
[1825]397       
398        !Et on le parametrise:
[2002]399        !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
[1825]400       
[2002]401        ! Ehouarn: New way to declare axis, without axis_group:
[3003]402        if (PRESENT(positif) .AND. PRESENT(bnds)) then
403          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
404                                  positive=positif, bounds=bnds)
405        else if (PRESENT(positif)) then
406          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
407                                  positive=positif)
408        else if (PRESENT(bnds)) then
409          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value, &
410                                  bounds=bnds)
411        else
412          CALL xios_set_axis_attr(trim(axis_id),n_glo=axis_size,value=axis_value)
413        endif
[2741]414
[1825]415        !Vérification:
[1852]416        IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
[1897]417            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
[1825]418        ELSE
[2001]419            WRITE(lunout,*) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
[1825]420        END IF
421
422    END SUBROUTINE wxios_add_vaxis
423   
424   
425    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
426    ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
427    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
428    SUBROUTINE wxios_add_file(fname, ffreq, flvl)
[2509]429        USE print_control_mod, ONLY : prt_level, lunout
[1852]430        IMPLICIT NONE
431
[1825]432        CHARACTER(len=*), INTENT(IN) :: fname
433        CHARACTER(len=*), INTENT(IN) :: ffreq
434        INTEGER, INTENT(IN) :: flvl
435       
436        TYPE(xios_file) :: x_file
437        TYPE(xios_filegroup) :: x_fg
[2509]438        TYPE(xios_duration) :: nffreq
[1825]439       
[1852]440        !On regarde si le fichier n'est pas défini par XML:
441        IF (.NOT.xios_is_valid_file(fname)) THEN
442            !On créé le noeud:
443            CALL xios_get_filegroup_handle("defile", x_fg)
444            CALL xios_add_file(x_fg, x_file, fname)
[1825]445       
[1852]446            !On reformate la fréquence:
447            CALL reformadate(ffreq, nffreq)
[1825]448       
[1852]449            !On configure:
450            CALL xios_set_file_attr_hdl(x_file, name="X"//fname,&
[2509]451                output_freq=nffreq, output_level=flvl, enabled=.TRUE.)
452       
[1852]453            IF (xios_is_valid_file("X"//fname)) THEN
[2001]454                IF (prt_level >= 10) THEN
455                  WRITE(lunout,*) "wxios_add_file: New file: ", "X"//fname
[2509]456                  WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[2001]457                ENDIF
[1852]458            ELSE
[2001]459                WRITE(lunout,*) "wxios_add_file: Error, invalid file: ", "X"//trim(fname)
[2509]460                WRITE(lunout,*) "wxios_add_file: output_freq=",nffreq,"; output_lvl=",flvl
[1852]461            END IF
[1825]462        ELSE
[2001]463            IF (prt_level >= 10) THEN
464              WRITE(lunout,*) "wxios_add_file: File ",trim(fname), " défined using XML."
465            ENDIF
466            ! Ehouarn: add an enable=.true. on top of xml definitions... why???
467            CALL xios_set_file_attr(fname, enabled=.TRUE.)
[1825]468        END IF
469    END SUBROUTINE wxios_add_file
470   
471    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]472    ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
[1825]473    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
474    SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
[1897]475        USE netcdf, only: nf90_fill_real
[1852]476
477        IMPLICIT NONE
478        INCLUDE 'iniprint.h'
[1825]479       
480        CHARACTER(len=*), INTENT(IN) :: fieldname
481        TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
482        CHARACTER(len=*), INTENT(IN) :: fieldlongname
483        CHARACTER(len=*), INTENT(IN) :: fieldunit
484       
485        TYPE(xios_field) :: field
486        CHARACTER(len=10) :: newunit
487        REAL(KIND=8) :: def
488       
489        !La valeur par défaut des champs non définis:
490        def = nf90_fill_real
491       
492        IF (fieldunit .EQ. " ") THEN
493            newunit = "-"
494        ELSE
495            newunit = fieldunit
496        ENDIF
497       
498        !On ajoute le champ:
499        CALL xios_add_field(fieldgroup, field, fieldname)
[1897]500        !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
[1825]501       
502        !On rentre ses paramètres:
503        CALL xios_set_field_attr_hdl(field, standard_name=fieldlongname, unit=newunit, default_value=def)
[1897]504        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: Field ",trim(fieldname), "cree:"
505        IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: long_name=",trim(fieldlongname),"; unit=",trim(newunit),";  default_value=",nf90_fill_real
[1825]506
507    END SUBROUTINE wxios_add_field
508   
509    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]510    ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
[1825]511    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[2137]512    SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
[2509]513        USE print_control_mod, ONLY : prt_level, lunout
[1852]514        IMPLICIT NONE
515
[1825]516        CHARACTER(len=*), INTENT(IN) :: fieldname
517        INTEGER, INTENT(IN)          :: fdim, fid
518        CHARACTER(len=*), INTENT(IN) :: fname
519        CHARACTER(len=*), INTENT(IN) :: fieldlongname
520        CHARACTER(len=*), INTENT(IN) :: fieldunit
521        INTEGER, INTENT(IN)          :: field_level
522        CHARACTER(len=*), INTENT(IN) :: op
523       
[2001]524        CHARACTER(len=20) :: axis_id ! Ehouarn: dangerous...
[2137]525        CHARACTER(len=20), INTENT(IN), OPTIONAL :: nam_axvert
[1825]526        CHARACTER(len=100) :: operation
527        TYPE(xios_file) :: f
528        TYPE(xios_field) :: field
529        TYPE(xios_fieldgroup) :: fieldgroup
[2509]530        TYPE(xios_duration) :: freq_op
[2741]531
[1852]532        LOGICAL :: bool=.FALSE.
533        INTEGER :: lvl =0
[1825]534       
535       
[2001]536        ! Ajout Abd pour NMC:
537        IF (fid.LE.6) THEN
538          axis_id="presnivs"
539        ELSE
540          axis_id="plev"
541        ENDIF
[2137]542 
543        IF (PRESENT(nam_axvert)) THEN
544           axis_id=nam_axvert
545           print*,'nam_axvert=',axis_id
546        ENDIF
[1825]547       
548        !on prépare le nom de l'opération:
549        operation = reformaop(op)
550       
551       
552        !On selectionne le bon groupe de champs:
553        IF (fdim.EQ.2) THEN
[2001]554          CALL xios_get_fieldgroup_handle("fields_2D", fieldgroup)
[1825]555        ELSE
556          CALL xios_get_fieldgroup_handle("fields_3D", fieldgroup)
557        ENDIF
558       
559        !On regarde si le champ à déjà été créé ou non:
[1852]560        IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
561            !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
[1897]562            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
[1852]563            g_flag_xml = .TRUE.
564            g_field_name = fieldname
565
566        ELSE IF (.NOT. g_field_name == fieldname) THEN
567            !Si premier pssage et champ indéfini, alors on le créé
568
[1897]569            IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
[1825]570           
571            !On le créé:
572            CALL wxios_add_field(fieldname,  fieldgroup, fieldlongname, fieldunit)
573            IF (xios_is_valid_field(fieldname)) THEN
[1897]574                IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
[1825]575            ENDIF
576
[1852]577            g_flag_xml = .FALSE.
578            g_field_name = fieldname
579
580        END IF
581
582        IF (.NOT. g_flag_xml) THEN
583            !Champ existe déjà, mais pas XML, alors on l'ajoute
584            !On ajoute le champ:
585            CALL xios_get_file_handle(fname, f)
586            CALL xios_add_fieldtofile(f, field)
587           
588           
589            !L'operation, sa frequence:
[2509]590            freq_op%timestep=1
591            CALL xios_set_field_attr_hdl(field, field_ref=fieldname, operation=TRIM(ADJUSTL(operation)), freq_op=freq_op, prec=4)
[1852]592
593           
594            !On rentre ses paramètres:
595            CALL xios_set_field_attr_hdl(field, level=field_level, enabled=.TRUE.)
596           
597            IF (fdim.EQ.2) THEN
598                !Si c'est un champ 2D:
[1897]599                IF (prt_level >= 10) THEN
600                  WRITE(lunout,*) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X"//trim(fname) ," configured with:"
601                  WRITE(lunout,*) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
602                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
603                ENDIF
[1852]604            ELSE
605                !Si 3D :
606                !On ajoute l'axe vertical qui va bien:
607                CALL xios_set_field_attr_hdl(field, axis_ref=TRIM(ADJUSTL(axis_id)))
608               
[1897]609                IF (prt_level >= 10) THEN
610                  WRITE(lunout,*) "wxios_add_field_to_file: 3D Field",trim(fieldname), " in ", "X"//trim(fname), "configured with:"
611                  WRITE(lunout,*) "wxios_add_field_to_file: freq_op=1ts","; lvl=",field_level
612                  WRITE(lunout,*) "wxios_add_field_to_file: axis=",TRIM(ADJUSTL(axis_id))
613                ENDIF
[1852]614            END IF
[1825]615       
616        ELSE
[1852]617            !Sinon on se contente de l'activer:
618            CALL xios_set_field_attr(fieldname, enabled=.TRUE.)
[2002]619            !NB: This will override an enable=.false. set by a user in the xml file;
620            !   then the only way to not output the field is by changing its
621            !   output level
[1852]622        ENDIF       
[1825]623       
624    END SUBROUTINE wxios_add_field_to_file
625   
[2002]626!    SUBROUTINE wxios_update_calendar(ito)
627!        INTEGER, INTENT(IN) :: ito
628!        CALL xios_update_calendar(ito)
629!    END SUBROUTINE wxios_update_calendar
630!   
631!    SUBROUTINE wxios_write_2D(fieldname, fdata)
632!        CHARACTER(len=*), INTENT(IN) :: fieldname
633!        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
634!
635!        CALL xios_send_field(fieldname, fdata)
636!    END SUBROUTINE wxios_write_2D
[1825]637   
[2002]638!    SUBROUTINE wxios_write_3D(fieldname, fdata)
639!        CHARACTER(len=*), INTENT(IN) :: fieldname
640!        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
641!       
642!        CALL xios_send_field(fieldname, fdata)
643!    END SUBROUTINE wxios_write_3D
[1825]644   
645    SUBROUTINE wxios_closedef()
646        CALL xios_close_context_definition()
[2095]647!        CALL xios_update_calendar(0)
[1825]648    END SUBROUTINE wxios_closedef
649   
650    SUBROUTINE wxios_close()
651        CALL xios_context_finalize()
652         CALL xios_finalize()
653     END SUBROUTINE wxios_close
654END MODULE wxios
655#endif
Note: See TracBrowser for help on using the repository browser.