source: LMDZ6/branches/Amaury_dev/libf/misc/lmdz_wxios.F90 @ 5153

Last change on this file since 5153 was 5123, checked in by abarral, 4 months ago

Correct various minor mistakes from previous commits

  • 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: 27.4 KB
RevLine 
[2509]1! $Id$
[4619]2
[5117]3MODULE lmdz_wxios
[5118]4  USE lmdz_xios
[1825]5
[5118]6  !Variables disponibles pendant toute l'execution du programme:
[1825]7
[5118]8  INTEGER, SAVE :: g_comm
9  CHARACTER(len = 100), SAVE :: g_ctx_name = "LMDZ"
10  TYPE(xios_context), SAVE :: g_ctx
11  !$OMP THREADPRIVATE(g_comm,g_ctx_name,g_ctx)
12  LOGICAL, SAVE :: g_flag_xml = .FALSE.
13  CHARACTER(len = 100) :: g_field_name = "nofield"
14  !$OMP THREADPRIVATE(g_flag_xml,g_field_name)
15  REAL :: missing_val_omp
16  REAL :: missing_val
17  !$OMP THREADPRIVATE(missing_val)
18
[2741]19#ifdef XIOS1
20#error "XIOS v1 no longer supported, use XIOS v2."
21#endif
22
[5118]23CONTAINS
[1852]24
[5118]25  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26  !   36day => 36d etc     !!!!!!!!!!!!!!!!!!!!
27  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]28
[5118]29  SUBROUTINE reformadate(odate, ndate)
30    CHARACTER(len = *), INTENT(IN) :: odate
31    TYPE(xios_duration) :: ndate
[1852]32
[5118]33    INTEGER :: i = 0
34    !!!!!!!!!!!!!!!!!!
35    ! Pour XIOS:
36    !  year : y
37    !  month : mo
38    !  day : d
39    !  hour : h
40    !  minute : mi
41    !  second : s
42    !!!!!!!!!!!!!!!!!!
[1825]43
[5118]44    i = INDEX(odate, "day")
45    IF (i > 0) THEN
46      read(odate(1:i - 1), *) ndate%day
47    END IF
[1825]48
[5118]49    i = INDEX(odate, "hr")
50    IF (i > 0) THEN
51      read(odate(1:i - 1), *) ndate%hour
52    END IF
[1852]53
[5118]54    i = INDEX(odate, "mth")
55    IF (i > 0) THEN
56      read(odate(1:i - 1), *) ndate%month
57    END IF
[1852]58
[5118]59    !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", odate, " => ", ndate
60  END SUBROUTINE reformadate
[1825]61
[5118]62  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
63  !   ave(X) => average etc     !!!!!!!!!!!!!!!
64  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]65
[5118]66  CHARACTER(len = 7) FUNCTION reformaop(op)
67    CHARACTER(len = *), INTENT(IN) :: op
[1852]68
[5118]69    INTEGER :: i = 0
70    reformaop = "average"
[1852]71
[5118]72    IF (op=="inst(X)") THEN
73      reformaop = "instant"
74    END IF
[2054]75
[5118]76    IF (op=="once") THEN
77      reformaop = "once"
78    END IF
[1825]79
[5118]80    IF (op=="t_max(X)") THEN
81      reformaop = "maximum"
82    END IF
[1852]83
[5118]84    IF (op=="t_min(X)") THEN
85      reformaop = "minimum"
86    END IF
[1852]87
[5118]88    !IF (prt_level >= 10) WRITE(lunout,*) "Xios. ", op, " => ", reformaop
89  END FUNCTION reformaop
[1852]90
[5118]91  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
92  ! Routine d'initialisation      !!!!!!!!!!!!!
93  !     A lancer juste après mpi_init !!!!!!!!!!!!!
94  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[1852]95
[5118]96  SUBROUTINE wxios_init(xios_ctx_name, locom, outcom, type_ocean)
97    USE lmdz_print_control, ONLY: prt_level, lunout
98    IMPLICIT NONE
[3435]99
[5118]100    CHARACTER(len = *), INTENT(IN) :: xios_ctx_name
101    INTEGER, INTENT(IN), OPTIONAL :: locom
102    INTEGER, INTENT(OUT), OPTIONAL :: outcom
103    CHARACTER(len = 6), INTENT(IN), OPTIONAL :: type_ocean
[4606]104
[5118]105    TYPE(xios_context) :: xios_ctx
106    INTEGER :: xios_comm
[4606]107
[5118]108    IF (prt_level >= 10) WRITE(lunout, *) "wxios_init: Initialization"
[4606]109
[5118]110    IF (PRESENT(locom)) THEN
111      CALL xios_initialize(xios_ctx_name, local_comm = locom, return_comm = xios_comm)
112      IF (prt_level >= 10) WRITE(lunout, *) "wxios_init: ctx=", xios_ctx_name, " local_comm=", locom, ", return_comm=", xios_comm
113    ELSE
114      CALL xios_initialize(xios_ctx_name, return_comm = xios_comm)
115      IF (prt_level >= 10) WRITE(lunout, *) "wxios_init: ctx=", xios_ctx_name, " return_comm=", xios_comm
116    END IF
[4606]117
[5118]118    IF (PRESENT(outcom)) THEN
119      outcom = xios_comm
120      IF (prt_level >= 10) WRITE(lunout, *) "wxios_init: ctx=", xios_ctx_name, " outcom=", outcom
121    END IF
[4606]122
[5118]123    !Enregistrement des variables globales:
124    g_comm = xios_comm
125    g_ctx_name = xios_ctx_name
[4606]126
[5118]127    !        ! Si couple alors init fait dans cpl_init
128    !        IF (.NOT. PRESENT(type_ocean)) THEN
129    !            CALL wxios_context_init()
130    !        ENDIF
131    WRITE(*, *)'END of WXIOS_INIT', g_comm, g_ctx_name
[4606]132
[5118]133  END SUBROUTINE wxios_init
134
135  SUBROUTINE wxios_context_init()
136    USE lmdz_print_control, ONLY: prt_level, lunout
137    USE lmdz_phys_mpi_data, ONLY: COMM_LMDZ_PHY
138    IMPLICIT NONE
139
140    TYPE(xios_context) :: xios_ctx
141
142    !$OMP MASTER
143    !Initialisation du contexte:
144    !!CALL xios_context_initialize(g_ctx_name, g_comm)
145    CALL xios_context_initialize(g_ctx_name, COMM_LMDZ_PHY)
146    CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
147    CALL xios_set_current_context(xios_ctx)            !Activation
148    g_ctx = xios_ctx
149
150    CALL wxios_add_group_init
151
152    IF (prt_level >= 10) THEN
153      WRITE(lunout, *) "wxios_context_init: Current context is ", trim(g_ctx_name)
154      WRITE(lunout, *) "     now CALL xios_solve_inheritance()"
155    ENDIF
156    !Une première analyse des héritages:
157    CALL xios_solve_inheritance()
158    !$OMP END MASTER
159  END SUBROUTINE wxios_context_init
160
161
162  SUBROUTINE wxios_add_group_init
163
164    ! routine create by Anne Cozic (2023)
165    ! This routine will create field associated to group defined without description of fields in field.xml file
166    ! This routine need to be CALL before "xios_sole_inheritance" after an !$OMP MASTER directive
167
168    USE infotrac_phy, ONLY: nbtr, nqtot, nqo, type_trac, tracers, niso, ntiso
169    USE lmdz_strings, ONLY: maxlen
170
171    IMPLICIT NONE
172
173    TYPE(xios_fieldgroup) :: group_handle, philev_hdl
174    TYPE(xios_field) :: child
175    INTEGER :: k, iq
176    CHARACTER(len = 12) :: nvar, name_phi
177    CHARACTER(LEN = maxlen) :: varname, dn
178    CHARACTER(LEN = maxlen) :: unt
179
180
181    ! group create for StratAER variables
182    !On ajoute les variables 3D traceurs par l interface fortran
183    CALL xios_get_handle("fields_strataer_trac_3D", group_handle)
184    ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
185    DO iq = 1, nqtot
186      IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
187      dn = 'd' // TRIM(tracers(iq)%name) // '_'
188
189      unt = "kg kg-1"
190      varname = trim(tracers(iq)%name)
191      CALL xios_add_child(group_handle, child, varname)
192      CALL xios_set_attr(child, name = varname, unit = unt)
193
194      unt = "kg kg-1 s-1"
195      varname = TRIM(dn) // 'vdf'
196      CALL xios_add_child(group_handle, child, varname)
197      CALL xios_set_attr(child, name = varname, unit = unt)
198      varname = TRIM(dn) // 'the'
199      CALL xios_add_child(group_handle, child, varname)
200      CALL xios_set_attr(child, name = varname, unit = unt)
201      varname = TRIM(dn) // 'con'
202      CALL xios_add_child(group_handle, child, varname)
203      CALL xios_set_attr(child, name = varname, unit = unt)
204      varname = TRIM(dn) // 'lessi_impa'
205      CALL xios_add_child(group_handle, child, varname)
206      CALL xios_set_attr(child, name = varname, unit = unt)
207      varname = TRIM(dn) // 'lessi_nucl'
208      CALL xios_add_child(group_handle, child, varname)
209      CALL xios_set_attr(child, name = varname, unit = unt)
210      varname = TRIM(dn) // 'insc'
211      CALL xios_add_child(group_handle, child, varname)
212      CALL xios_set_attr(child, name = varname, unit = unt)
213      varname = TRIM(dn) // 'bcscav'
214      CALL xios_add_child(group_handle, child, varname)
215      CALL xios_set_attr(child, name = varname, unit = unt)
216      varname = TRIM(dn) // 'evapls'
217      CALL xios_add_child(group_handle, child, varname)
218      CALL xios_set_attr(child, name = varname, unit = unt)
219      varname = TRIM(dn) // 'ls'
220      CALL xios_add_child(group_handle, child, varname)
221      CALL xios_set_attr(child, name = varname, unit = unt)
222      varname = TRIM(dn) // 'trsp'
223      CALL xios_add_child(group_handle, child, varname)
224      CALL xios_set_attr(child, name = varname, unit = unt)
225      varname = TRIM(dn) // 'sscav'
226      CALL xios_add_child(group_handle, child, varname)
227      CALL xios_set_attr(child, name = varname, unit = unt)
228      varname = TRIM(dn) // 'sat'
229      CALL xios_add_child(group_handle, child, varname)
230      CALL xios_set_attr(child, name = varname, unit = unt)
231      varname = TRIM(dn) // 'uscav'
232      CALL xios_add_child(group_handle, child, varname)
233      CALL xios_set_attr(child, name = varname, unit = unt)
234    END DO
235    !On ajoute les variables 2D traceurs par l interface fortran
236    CALL xios_get_handle("fields_strataer_trac_2D", group_handle)
237    ! On boucle sur les traceurs pour les ajouter au groupe puis fixer les attributs
238    DO iq = 1, nqtot
239      IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
240
241      unt = "kg m-2"
242      varname = 'cum' // trim(tracers(iq)%name)
243
244      CALL xios_add_child(group_handle, child, varname)
245      CALL xios_set_attr(child, name = varname, unit = unt)
246
247      unt = "kg m-2 s-1"
248      varname = 'cumd' // trim(tracers(iq)%name) // '_dry'
249      CALL xios_add_child(group_handle, child, varname)
250      CALL xios_set_attr(child, name = varname, unit = unt)
251    ENDDO
252
253
254    ! group create for offline mass flow variables
255    CALL xios_get_handle("philev_grp", philev_hdl)
256
257    DO k = 1, 79
258      IF (k<10) THEN
259        WRITE(nvar, '(i1)') k
260      ELSE IF (k<100) THEN
261        WRITE(nvar, '(i2)') k
262      ELSE
263        WRITE(nvar, '(i3)') k
264      END IF
265      name_phi = "phi_lev" // TRIM(nvar)
266      CALL xios_add_child(philev_hdl, child, "phi_lev" // TRIM(nvar))
267      CALL xios_set_attr(child, name = trim(name_phi))
268    ENDDO
269
270  END SUBROUTINE wxios_add_group_init
271
272  SUBROUTINE wxios_set_context()
273    IMPLICIT NONE
274    TYPE(xios_context) :: xios_ctx
275
276    !$OMP MASTER
277    CALL xios_get_handle(g_ctx_name, xios_ctx)    !Récupération
278    CALL xios_set_current_context(xios_ctx)            !Activation
279    !$OMP END MASTER
280
281  END SUBROUTINE wxios_set_context
282
283  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
284  ! Routine de paramétrisation !!!!!!!!!!!!!!!!!!
285  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
286
287  SUBROUTINE wxios_set_cal(pasdetemps, calendrier, annee, mois, jour, heure, ini_an, ini_mois, ini_jour, ini_heure)
288    USE lmdz_print_control, ONLY: prt_level, lunout
289    USE lmdz_abort_physic, ONLY: abort_physic
290    IMPLICIT NONE
291
292    !Paramètres:
293    CHARACTER(len = *), INTENT(IN) :: calendrier
294    INTEGER, INTENT(IN) :: annee, mois, jour, ini_an, ini_mois, ini_jour
295    REAL, INTENT(IN) :: pasdetemps, heure, ini_heure
296
297    !Variables:
298    CHARACTER(len = 80) :: abort_message
299    CHARACTER(len = 19) :: date
300    INTEGER :: njour = 1
301
302    !Variables pour xios:
303    TYPE(xios_duration) :: mdtime
304    !REAL(kind = 8) :: year=0, month=0, day=0, hour=0, minute=0, second=0
305
306    mdtime%second = pasdetemps
307
308    !Réglage du calendrier:
309    SELECT CASE (calendrier)
310    CASE('earth_360d')
311      CALL xios_define_calendar("D360")
312      IF (prt_level >= 10) WRITE(lunout, *) 'wxios_set_cal: Calendrier terrestre a 360 jours/an'
313    CASE('earth_365d')
314      CALL xios_define_calendar("NoLeap")
315      IF (prt_level >= 10) WRITE(lunout, *) 'wxios_set_cal: Calendrier terrestre a 365 jours/an'
316    CASE('gregorian')
317      CALL xios_define_calendar("Gregorian")
318      IF (prt_level >= 10) WRITE(lunout, *) 'wxios_set_cal: Calendrier gregorien'
319    CASE DEFAULT
320      abort_message = 'wxios_set_cal: Mauvais choix de calendrier'
321      CALL abort_physic('Gcm:Xios', abort_message, 1)
322    END SELECT
323
324    !Formatage de la date d'origine:
325    WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") annee, mois, jour, int(heure)
326
327    IF (prt_level >= 10) WRITE(lunout, *) "wxios_set_cal: Time origin: ", date
328    CALL xios_set_time_origin(xios_date(annee, mois, jour, int(heure), 0, 0))
329
330    !Formatage de la date de debut:
331
332    WRITE(date, "(i4.4,'-',i2.2,'-',i2.2,' ',i2.2,':00:00')") ini_an, ini_mois, ini_jour, int(ini_heure)
333
334    IF (prt_level >= 10) WRITE(lunout, *) "wxios_set_cal: Start date: ", date
335
336    CALL xios_set_start_date(xios_date(ini_an, ini_mois, ini_jour, int(ini_heure), 0, 0))
337
338    !Et enfin,le pas de temps:
339    CALL xios_set_timestep(mdtime)
340    IF (prt_level >= 10) WRITE(lunout, *) "wxios_set_cal: ts=", mdtime
341  END SUBROUTINE wxios_set_cal
342
343  SUBROUTINE wxios_set_timestep(ts)
344    REAL, INTENT(IN) :: ts
345    TYPE(xios_duration) :: mdtime
346
347    mdtime%timestep = ts
348
349    CALL xios_set_timestep(mdtime)
350  END SUBROUTINE wxios_set_timestep
351
352  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
353  ! Pour initialiser un domaine !!!!!!!!!!!!!!!!!!!!
354  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
355  SUBROUTINE wxios_domain_param(dom_id)
356    USE dimphy, ONLY: klon
357    USE lmdz_phys_transfert_para, ONLY: gather, bcast
358    USE lmdz_phys_para, ONLY: jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
359            mpi_size, mpi_rank, klon_mpi, &
360            is_sequential, is_south_pole_dyn
361    USE lmdz_grid_phy, ONLY: nbp_lon, nbp_lat, klon_glo
362    USE lmdz_print_control, ONLY: prt_level, lunout
363    USE lmdz_geometry
364
365    IMPLICIT NONE
366    CHARACTER(len = *), INTENT(IN) :: dom_id ! domain identifier
367
368    REAL :: rlat_glo(klon_glo)
369    REAL :: rlon_glo(klon_glo)
370    REAL :: io_lat(nbp_lat)
371    REAL :: io_lon(nbp_lon)
372    LOGICAL :: mask(nbp_lon, jj_nb) !Masque pour les problèmes de recouvrement MPI
373    TYPE(xios_domain) :: dom
374    INTEGER :: i
375    LOGICAL :: boool
376
377    CALL gather(latitude_deg, rlat_glo)
378    CALL bcast(rlat_glo)
379    CALL gather(longitude_deg, rlon_glo)
380    CALL bcast(rlon_glo)
381
382    !$OMP MASTER
383    io_lat(1) = rlat_glo(1)
384    io_lat(nbp_lat) = rlat_glo(klon_glo)
385    IF ((nbp_lon * nbp_lat) > 1) THEN
386      DO i = 2, nbp_lat - 1
387        io_lat(i) = rlat_glo(2 + (i - 2) * nbp_lon)
[4608]388      ENDDO
[5118]389    ENDIF
[4608]390
[5118]391    IF (klon_glo == 1) THEN
392      io_lon(1) = rlon_glo(1)
393    ELSE
394      io_lon(1:nbp_lon) = rlon_glo(2:nbp_lon + 1)
395    ENDIF
[4608]396
[4606]397
[5118]398    !On récupère le handle:
399    CALL xios_get_handle(dom_id, dom)
[3435]400
[5118]401    !On parametrise le domaine:
402    CALL xios_set_attr(dom, ni_glo = nbp_lon, ibegin = 0, ni = nbp_lon, type = "rectilinear")
403    CALL xios_set_attr(dom, nj_glo = nbp_lat, jbegin = jj_begin - 1, nj = jj_nb, data_dim = 2)
404    CALL xios_set_attr(dom, lonvalue_1d = io_lon(1:nbp_lon), latvalue_1d = io_lat(jj_begin:jj_end))
405    CALL xios_set_domain_attr("dom_out", domain_ref = dom_id)
[3435]406
[5118]407    !On definit un axe de latitudes pour les moyennes zonales
408    IF (xios_is_valid_axis("axis_lat")) THEN
409      CALL xios_set_axis_attr("axis_lat", n_glo = nbp_lat, n = jj_nb, begin = jj_begin - 1, value = io_lat(jj_begin:jj_end))
410    ENDIF
411    IF (xios_is_valid_axis("axis_lat_greordered")) THEN
412      CALL xios_set_axis_attr("axis_lat_greordered", n_glo = nbp_lat, n = jj_nb, begin = jj_begin - 1, &
413              value = io_lat(jj_begin:jj_end) * (-1.))
414    ENDIF
[3435]415
[5118]416    IF (.NOT.is_sequential) THEN
417      mask(:, :) = .TRUE.
418      IF (ii_begin>1) mask(1:ii_begin - 1, 1) = .FALSE.
419      IF (ii_end<nbp_lon) mask(ii_end + 1:nbp_lon, jj_nb) = .FALSE.
420      ! special case for south pole
421      IF ((ii_end==1).AND.(is_south_pole_dyn)) mask(1:nbp_lon, jj_nb) = .TRUE.
422      IF (prt_level >= 10) THEN
423        WRITE(lunout, *) "wxios_domain_param: mpirank=", mpi_rank, " mask(:,1)=", mask(:, 1)
424        WRITE(lunout, *) "wxios_domain_param: mpirank=", mpi_rank, " mask(:,jj_nb)=", mask(:, jj_nb)
425      ENDIF
426      CALL xios_set_attr(dom, mask_2d = mask)
427    END IF
[1825]428
[5118]429    CALL xios_is_defined_attr(dom, ni_glo = boool)
430    !Vérification:
431    IF (xios_is_valid_domain(dom_id)) THEN
432      IF (prt_level >= 10) WRITE(lunout, *) "wxios_domain_param: Domain initialized: ", trim(dom_id), boool
433    ELSE
434      IF (prt_level >= 10) WRITE(lunout, *) "wxios_domain_param: Invalid domain: ", trim(dom_id)
435    END IF
436    !$OMP END MASTER
[1852]437
[5118]438  END SUBROUTINE wxios_domain_param
[1825]439
[2095]440
[5118]441  SUBROUTINE wxios_domain_param_unstructured(dom_id)
442    USE lmdz_geometry, ONLY: longitude, latitude, boundslon, boundslat, ind_cell_glo
443    USE lmdz_grid_phy, ONLY: nvertex, klon_glo
444    USE lmdz_physical_constants, ONLY: PI
[5123]445    USE lmdz_phys_para
[5118]446    USE lmdz_ioipsl_getin_p, ONLY: getin_p
447    IMPLICIT NONE
448    CHARACTER(len = *), INTENT(IN) :: dom_id ! domain identifier
449    REAL :: lon_mpi(klon_mpi)
450    REAL :: lat_mpi(klon_mpi)
451    REAL :: boundslon_mpi(klon_mpi, nvertex)
452    REAL :: boundslat_mpi(klon_mpi, nvertex)
453    INTEGER :: ind_cell_glo_mpi(klon_mpi)
454    TYPE(xios_domain) :: dom
[2095]455
[5118]456    LOGICAL :: remap_output
[1825]457
[5118]458    CALL gather_omp(longitude * 180 / PI, lon_mpi)
459    CALL gather_omp(latitude * 180 / PI, lat_mpi)
460    CALL gather_omp(boundslon * 180 / PI, boundslon_mpi)
461    CALL gather_omp(boundslat * 180 / PI, boundslat_mpi)
462    CALL gather_omp(ind_cell_glo, ind_cell_glo_mpi)
[1852]463
[5118]464    remap_output = .TRUE.
465    CALL getin_p("remap_output", remap_output)
[2509]466
[5118]467    !$OMP MASTER
468    CALL xios_get_handle(dom_id, dom)
[1852]469
[5118]470    !On parametrise le domaine:
471    CALL xios_set_attr(dom, ni_glo = klon_glo, ibegin = ij_begin - 1, ni = ij_nb, type = "unstructured")
472    CALL xios_set_attr(dom, nvertex = nvertex, lonvalue_1d = lon_mpi, latvalue_1d = lat_mpi, &
473            bounds_lon_1d = TRANSPOSE(boundslon_mpi), bounds_lat_1d = TRANSPOSE(boundslat_mpi))
474    CALL xios_set_attr(dom, i_index = ind_cell_glo_mpi(:) - 1)
475    IF (remap_output) THEN
476      CALL xios_set_domain_attr("dom_out", domain_ref = "dom_regular")
477      CALL xios_set_fieldgroup_attr("remap_expr", expr = "@this_ref")
478      CALL xios_set_fieldgroup_attr("remap_1800s", freq_op = xios_duration_convert_from_string("1800s"))
479      CALL xios_set_fieldgroup_attr("remap_1h", freq_op = xios_duration_convert_from_string("1h"))
480      CALL xios_set_fieldgroup_attr("remap_3h", freq_op = xios_duration_convert_from_string("3h"))
481      CALL xios_set_fieldgroup_attr("remap_6h", freq_op = xios_duration_convert_from_string("6h"))
482      CALL xios_set_fieldgroup_attr("remap_1d", freq_op = xios_duration_convert_from_string("1d"))
483      CALL xios_set_fieldgroup_attr("remap_1mo", freq_op = xios_duration_convert_from_string("1mo"))
484    ENDIF
485    !$OMP END MASTER
[1897]486
[5118]487  END SUBROUTINE wxios_domain_param_unstructured
[1852]488
[3435]489
[5118]490  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
491  ! Pour déclarer un axe vertical !!!!!!!!!!!!!!!
492  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
493  SUBROUTINE wxios_add_vaxis(axis_id, axis_size, axis_value, &
494          positif, bnds)
495    USE lmdz_print_control, ONLY: prt_level, lunout
496    IMPLICIT NONE
[3435]497
[5118]498    CHARACTER (len = *), INTENT(IN) :: axis_id
499    INTEGER, INTENT(IN) :: axis_size
500    REAL, DIMENSION(axis_size), INTENT(IN) :: axis_value
501    CHARACTER (len = *), INTENT(IN), OPTIONAL :: positif
502    REAL, DIMENSION(axis_size, 2), INTENT(IN), OPTIONAL :: bnds
[3435]503
[5118]504    !        TYPE(xios_axisgroup) :: axgroup
505    !        TYPE(xios_axis) :: ax
506    !        CHARACTER(len=50) :: axis_id
[3435]507
[5118]508    !        IF (len_trim(axisgroup_id).gt.len(axis_id)) THEN
509    !          WRITE(lunout,*) "wxios_add_vaxis: error, size of axis_id too small!!"
510    !          WRITE(lunout,*) "     increase it to at least ",len_trim(axisgroup_id)
511    !          CALL abort_gcm("wxios_add_vaxis","len(axis_id) too small",1)
512    !        ENDIF
513    !        axis_id=trim(axisgroup_id)
[3435]514
[5118]515    !On récupère le groupe d'axes qui va bien:
516    !CALL xios_get_axisgroup_handle(axisgroup_id, axgroup)
[3165]517
[5118]518    !On ajoute l'axe correspondant à ce fichier:
519    !CALL xios_add_axis(axgroup, ax, TRIM(ADJUSTL(axis_id)))
[1852]520
[5118]521    !Et on le parametrise:
522    !CALL xios_set_axis_attr_hdl(ax, size=axis_size, value=axis_value)
[3435]523
[5118]524    ! Ehouarn: New way to declare axis, without axis_group:
525    IF (PRESENT(positif) .AND. PRESENT(bnds)) THEN
526      CALL xios_set_axis_attr(trim(axis_id), n_glo = axis_size, value = axis_value, &
527              positive = positif, bounds = bnds)
528    ELSE IF (PRESENT(positif)) THEN
529      CALL xios_set_axis_attr(trim(axis_id), n_glo = axis_size, value = axis_value, &
530              positive = positif)
531    ELSE IF (PRESENT(bnds)) THEN
532      CALL xios_set_axis_attr(trim(axis_id), n_glo = axis_size, value = axis_value, &
533              bounds = bnds)
534    else
535      CALL xios_set_axis_attr(trim(axis_id), n_glo = axis_size, value = axis_value)
536    endif
[3435]537
[5118]538    !Vérification:
539    IF (xios_is_valid_axis(TRIM(ADJUSTL(axis_id)))) THEN
540      IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_vaxis: Axis created: ", TRIM(ADJUSTL(axis_id))
541    ELSE
542      WRITE(lunout, *) "wxios_add_vaxis: Invalid axis: ", TRIM(ADJUSTL(axis_id))
543    END IF
[3435]544
[5118]545  END SUBROUTINE wxios_add_vaxis
546
547
548  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
549  ! Pour déclarer un fichier  !!!!!!!!!!!!!!!!!!!
550  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
551  SUBROUTINE wxios_add_file(fname, ffreq, flvl)
552    USE lmdz_print_control, ONLY: prt_level, lunout
553    IMPLICIT NONE
554
555    CHARACTER(len = *), INTENT(IN) :: fname
556    CHARACTER(len = *), INTENT(IN) :: ffreq
557    INTEGER, INTENT(IN) :: flvl
558
559    TYPE(xios_file) :: x_file
560    TYPE(xios_filegroup) :: x_fg
561    TYPE(xios_duration) :: nffreq
562
563    !On regarde si le fichier n'est pas défini par XML:
564    IF (.NOT.xios_is_valid_file(fname)) THEN
565      !On créé le noeud:
566      CALL xios_get_handle("defile", x_fg)
567      CALL xios_add_child(x_fg, x_file, fname)
568
569      !On reformate la fréquence:
570      CALL reformadate(ffreq, nffreq)
571
572      !On configure:
573      CALL xios_set_attr(x_file, name = "X" // fname, &
574              output_freq = nffreq, output_level = flvl, enabled = .TRUE.)
575
576      IF (xios_is_valid_file("X" // fname)) THEN
577        IF (prt_level >= 10) THEN
578          WRITE(lunout, *) "wxios_add_file: New file: ", "X" // fname
579          WRITE(lunout, *) "wxios_add_file: output_freq=", nffreq, "; output_lvl=", flvl
[3435]580        ENDIF
[5118]581      ELSE
582        WRITE(lunout, *) "wxios_add_file: Error, invalid file: ", "X" // trim(fname)
583        WRITE(lunout, *) "wxios_add_file: output_freq=", nffreq, "; output_lvl=", flvl
584      END IF
585    ELSE
586      IF (prt_level >= 10) THEN
587        WRITE(lunout, *) "wxios_add_file: File ", trim(fname), " défined using XML."
588      ENDIF
589      ! Ehouarn: add an enable=.TRUE. on top of xml definitions... why???
590      CALL xios_set_file_attr(fname, enabled = .TRUE.)
591    END IF
592  END SUBROUTINE wxios_add_file
[3435]593
[5118]594  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
595  ! Pour créer un champ      !!!!!!!!!!!!!!!!!!!!
596  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
597  SUBROUTINE wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
598    USE netcdf, ONLY: nf90_fill_real
599    USE lmdz_iniprint, ONLY: lunout, prt_level
[3435]600
[5118]601    IMPLICIT NONE
[3435]602
[5118]603    CHARACTER(len = *), INTENT(IN) :: fieldname
604    TYPE(xios_fieldgroup), INTENT(IN) :: fieldgroup
605    CHARACTER(len = *), INTENT(IN) :: fieldlongname
606    CHARACTER(len = *), INTENT(IN) :: fieldunit
[3435]607
[5118]608    TYPE(xios_field) :: field
609    CHARACTER(len = 10) :: newunit
610    REAL(KIND = 8) :: def
[3435]611
[5118]612    !La valeur par défaut des champs non définis:
613    def = nf90_fill_real
[1852]614
[5118]615    IF (fieldunit == " ") THEN
616      newunit = "-"
617    ELSE
618      newunit = fieldunit
619    ENDIF
[2741]620
[5118]621    !On ajoute le champ:
622    CALL xios_add_child(fieldgroup, field, fieldname)
623    !IF (prt_level >= 10) WRITE(lunout,*) "wxios_add_field: ",fieldname,fieldgroup, fieldlongname, fieldunit
[1825]624
[5118]625    !On rentre ses paramètres:
626    CALL xios_set_attr(field, standard_name = fieldlongname, unit = newunit, default_value = def)
627    IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_field: Field ", trim(fieldname), "cree:"
628    IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_field: long_name=", trim(fieldlongname), "; unit=", trim(newunit), ";  default_value=", nf90_fill_real
[1852]629
[5118]630  END SUBROUTINE wxios_add_field
[1852]631
[5118]632  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
633  ! Pour déclarer un champ      !!!!!!!!!!!!!!!!!
634  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
635  SUBROUTINE wxios_add_field_to_file(fieldname, fdim, fid, fname, fieldlongname, fieldunit, field_level, op, nam_axvert)
636    USE lmdz_print_control, ONLY: prt_level, lunout
637    IMPLICIT NONE
[1825]638
[5118]639    CHARACTER(len = *), INTENT(IN) :: fieldname
640    INTEGER, INTENT(IN) :: fdim, fid
641    CHARACTER(len = *), INTENT(IN) :: fname
642    CHARACTER(len = *), INTENT(IN) :: fieldlongname
643    CHARACTER(len = *), INTENT(IN) :: fieldunit
644    INTEGER, INTENT(IN) :: field_level
645    CHARACTER(len = *), INTENT(IN) :: op
[1852]646
[5118]647    CHARACTER(len = 20) :: axis_id ! Ehouarn: dangerous...
648    CHARACTER(len = 20), INTENT(IN), OPTIONAL :: nam_axvert
649    CHARACTER(len = 100) :: operation
650    TYPE(xios_file) :: f
651    TYPE(xios_field) :: field
652    TYPE(xios_fieldgroup) :: fieldgroup
653    TYPE(xios_duration) :: freq_op
[2741]654
[5118]655    LOGICAL :: bool = .FALSE.
656    INTEGER :: lvl = 0
657
658
659    ! Ajout Abd pour NMC:
660    IF (fid<=6) THEN
661      axis_id = "presnivs"
662    ELSE
663      axis_id = "plev"
664    ENDIF
665
666    IF (PRESENT(nam_axvert)) THEN
667      axis_id = nam_axvert
668      PRINT*, 'nam_axvert=', axis_id
669    ENDIF
670
671    !on prépare le nom de l'opération:
672    operation = reformaop(op)
673
674
675    !On selectionne le bon groupe de champs:
676    IF (fdim==2) THEN
677      CALL xios_get_handle("fields_2D", fieldgroup)
678    ELSE
679      CALL xios_get_handle("fields_3D", fieldgroup)
680    ENDIF
681
682    !On regarde si le champ à déjà été créé ou non:
683    IF (xios_is_valid_field(fieldname) .AND. .NOT. g_field_name == fieldname) THEN
684      !Si ce champ existe via XML (ie, dès le premier passage, ie g_field_name != fieldname) alors rien d'autre à faire
685      IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_field_to_file: Field ", trim(fieldname), "exists via XML"
686      g_flag_xml = .TRUE.
687      g_field_name = fieldname
688
689    ELSE IF (.NOT. g_field_name == fieldname) THEN
690      !Si premier pssage et champ indéfini, alors on le créé
691
692      IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_field_to_file: Field ", trim(fieldname), "does not exist"
693
694      !On le créé:
695      CALL wxios_add_field(fieldname, fieldgroup, fieldlongname, fieldunit)
696      IF (xios_is_valid_field(fieldname)) THEN
697        IF (prt_level >= 10) WRITE(lunout, *) "wxios_add_field_to_file: Field ", trim(fieldname), "created"
698      ENDIF
699
700      g_flag_xml = .FALSE.
701      g_field_name = fieldname
702
703    END IF
704
705    IF (.NOT. g_flag_xml) THEN
706      !Champ existe déjà, mais pas XML, alors on l'ajoute
707      !On ajoute le champ:
708      CALL xios_get_handle(fname, f)
709      CALL xios_add_child(f, field)
710
711
712      !L'operation, sa frequence:
713      freq_op%timestep = 1
714      CALL xios_set_attr(field, field_ref = fieldname, operation = TRIM(ADJUSTL(operation)), freq_op = freq_op, prec = 4)
715
716
717      !On rentre ses paramètres:
718      CALL xios_set_attr(field, level = field_level, enabled = .TRUE.)
719
720      IF (fdim==2) THEN
721        !Si c'est un champ 2D:
722        IF (prt_level >= 10) THEN
723          WRITE(lunout, *) "wxios_add_field_to_file: 2D Field ", trim(fieldname), " in ", "X" // trim(fname), " configured with:"
724          WRITE(lunout, *) "wxios_add_field_to_file: op=", TRIM(ADJUSTL(operation))
725          WRITE(lunout, *) "wxios_add_field_to_file: freq_op=1ts", "; lvl=", field_level
[2001]726        ENDIF
[5118]727      ELSE
728        !Si 3D :
729        !On ajoute l'axe vertical qui va bien:
730        CALL xios_set_attr(field, axis_ref = TRIM(ADJUSTL(axis_id)))
731
732        IF (prt_level >= 10) THEN
733          WRITE(lunout, *) "wxios_add_field_to_file: 3D Field", trim(fieldname), " in ", "X" // trim(fname), "configured with:"
734          WRITE(lunout, *) "wxios_add_field_to_file: freq_op=1ts", "; lvl=", field_level
735          WRITE(lunout, *) "wxios_add_field_to_file: axis=", TRIM(ADJUSTL(axis_id))
[2137]736        ENDIF
[5118]737      END IF
[1852]738
[5118]739    ELSE
740      !Sinon on se contente de l'activer:
741      CALL xios_set_field_attr(fieldname, enabled = .TRUE.)
742      !NB: This will override an enable=.FALSE. set by a user in the xml file;
743      !   then the only way to not output the field is by changing its
744      !   output level
745    ENDIF
[1852]746
[5118]747  END SUBROUTINE wxios_add_field_to_file
[1825]748
[5118]749  !    SUBROUTINE wxios_update_calendar(ito)
750  !        INTEGER, INTENT(IN) :: ito
751  !        CALL xios_update_calendar(ito)
752  !    END SUBROUTINE wxios_update_calendar
[1852]753
[5118]754  !    SUBROUTINE wxios_write_2D(fieldname, fdata)
755  !        CHARACTER(len=*), INTENT(IN) :: fieldname
756  !        REAL, DIMENSION(:,:), INTENT(IN) :: fdata
[1852]757
[5118]758  !        CALL xios_send_field(fieldname, fdata)
759  !    END SUBROUTINE wxios_write_2D
[1852]760
[5118]761  !    SUBROUTINE wxios_write_3D(fieldname, fdata)
762  !        CHARACTER(len=*), INTENT(IN) :: fieldname
763  !        REAL, DIMENSION(:,:,:), INTENT(IN) :: fdata
[5099]764
[5118]765  !        CALL xios_send_field(fieldname, fdata)
766  !    END SUBROUTINE wxios_write_3D
[5099]767
[5118]768  SUBROUTINE wxios_closedef()
769    CALL xios_close_context_definition()
770    !        CALL xios_update_calendar(0)
771  END SUBROUTINE wxios_closedef
[5099]772
[5118]773  SUBROUTINE wxios_close()
774    CALL xios_context_finalize()
775    CALL xios_finalize()
776  END SUBROUTINE wxios_close
[5117]777END MODULE lmdz_wxios
[4619]778
Note: See TracBrowser for help on using the repository browser.