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