- Timestamp:
- 2018-02-28T17:23:20+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r9019 r9367 43 43 USE ioipsl, ONLY : ju2ymds ! for calendar 44 44 USE crs ! Grid coarsening 45 USE lib_fortran 46 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 45 47 46 48 IMPLICIT NONE … … 62 64 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 63 65 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 66 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 67 PUBLIC iom_set_rstw_var_active, iom_set_rst_vars 64 68 # endif 65 69 … … 87 91 CONTAINS 88 92 89 SUBROUTINE iom_init( cdname )93 SUBROUTINE iom_init( cdname, fname ) 90 94 !!---------------------------------------------------------------------- 91 95 !! *** ROUTINE *** … … 95 99 !!---------------------------------------------------------------------- 96 100 CHARACTER(len=*), INTENT(in) :: cdname 97 !101 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 98 102 #if defined key_iomput 99 103 ! 100 104 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 101 105 TYPE(xios_date) :: start_date 102 CHARACTER(len= 10) :: clname106 CHARACTER(len=lc) :: clname 103 107 INTEGER :: ji, jkmin 108 LOGICAL :: llrst_context ! is context related to restart 104 109 ! 105 110 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 112 117 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 113 118 CALL iom_swap( cdname ) 114 119 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 115 120 116 121 ! Calendar type is now defined in xml file … … 125 130 126 131 ! horizontal grid definition 127 CALL set_scalar132 IF(.NOT.llrst_context) CALL set_scalar 128 133 ! 129 134 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 130 CALL set_grid( "T", glamt, gphit )131 CALL set_grid( "U", glamu, gphiu )132 CALL set_grid( "V", glamv, gphiv )133 CALL set_grid( "W", glamt, gphit )135 CALL set_grid( "T", glamt, gphit, .FALSE. ) 136 CALL set_grid( "U", glamu, gphiu, .FALSE. ) 137 CALL set_grid( "V", glamv, gphiv, .FALSE. ) 138 CALL set_grid( "W", glamt, gphit, .FALSE. ) 134 139 CALL set_grid_znl( gphit ) 135 140 ! … … 149 154 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 150 155 ! 151 CALL set_grid( "T", glamt_crs, gphit_crs )152 CALL set_grid( "U", glamu_crs, gphiu_crs )153 CALL set_grid( "V", glamv_crs, gphiv_crs )154 CALL set_grid( "W", glamt_crs, gphit_crs )156 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE. ) 157 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE. ) 158 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE. ) 159 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE. ) 155 160 CALL set_grid_znl( gphit_crs ) 156 161 ! 157 162 CALL dom_grid_glo ! Return to parent grid domain 158 163 ! 159 IF( ln_cfmeta ) THEN ! Add additional grid metadata164 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 160 165 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 161 166 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 170 175 ! 171 176 ! vertical grid definition 172 CALL iom_set_axis_attr( "deptht", gdept_1d ) 173 CALL iom_set_axis_attr( "depthu", gdept_1d ) 174 CALL iom_set_axis_attr( "depthv", gdept_1d ) 175 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 176 ! 177 ! Add vertical grid bounds 178 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 179 zt_bnds(2,: ) = gdept_1d(:) 180 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 181 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 182 zw_bnds(1,: ) = gdepw_1d(:) 183 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 184 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 185 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 186 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 187 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 188 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 189 ! 177 IF(.NOT.llrst_context) THEN 178 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 179 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 180 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 181 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 182 183 ! Add vertical grid bounds 184 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 185 zt_bnds(2,: ) = gdept_1d(:) 186 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 187 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 188 zw_bnds(1,: ) = gdepw_1d(:) 189 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 190 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 191 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 192 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 193 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 194 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 195 ! 190 196 # if defined key_floats 191 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )197 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 192 198 # endif 193 199 # if defined key_lim3 194 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )195 ! SIMIP diagnostics (4 main arctic straits)196 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) )200 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 201 ! SIMIP diagnostics (4 main arctic straits) 202 CALL iom_set_axis_attr( "nstrait", (/ (REAL(ji,wp), ji=1,4) /) ) 197 203 # endif 198 CALL iom_set_axis_attr( "icbcla", class_num ) 199 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 200 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 201 204 CALL iom_set_axis_attr( "icbcla", class_num ) 205 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 206 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 207 ENDIF 208 ! 202 209 ! automatic definitions of some of the xml attributs 203 CALL set_xmlatt 210 IF( TRIM(cdname) == TRIM(crxios_context) ) THEN 211 !set names of the fields in restart file IF using XIOS to read data 212 CALL iom_set_rst_context() 213 CALL iom_set_rst_vars(rst_rfields) 214 !set which fields are to be read from restart file 215 CALL iom_set_rstr_active() 216 ELSE IF( TRIM(cdname) == TRIM(cwxios_context) ) THEN 217 !set names of the fields in restart file IF using XIOS to write data 218 CALL iom_set_rst_context() 219 CALL iom_set_rst_vars(rst_wfields) 220 !set which fields are to be written to a restart file 221 CALL iom_set_rstw_active(fname) 222 ELSE 223 CALL set_xmlatt 224 ENDIF 204 225 ! 205 226 ! end file definition … … 215 236 END SUBROUTINE iom_init 216 237 238 SUBROUTINE iom_set_rstw_var_active(field) 239 !!--------------------------------------------------------------------- 240 !! *** SUBROUTINE iom_set_rstw_var_active *** 241 !! 242 !! ** Purpose : enable variable in restart file when writing with XIOS 243 !!--------------------------------------------------------------------- 244 CHARACTER(len = *), INTENT(IN) :: field 245 INTEGER :: i 246 LOGICAL :: llis_set 247 248 llis_set = .FALSE. 249 250 DO i = 1, max_rst_fields 251 IF(TRIM(rst_wfields(i)%vname) == field) THEN 252 rst_wfields(i)%active = .TRUE. 253 llis_set = .TRUE. 254 EXIT 255 ENDIF 256 ENDDO 257 !Warn if variable is not in defined in rst_wfields 258 IF(.NOT.llis_set) THEN 259 IF(lwp) THEN 260 write(numout,cform_err) 261 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 262 ENDIF 263 nstop = nstop + 1 264 ENDIF 265 266 END SUBROUTINE iom_set_rstw_var_active 267 268 SUBROUTINE iom_set_rstr_active() 269 !!--------------------------------------------------------------------- 270 !! *** SUBROUTINE iom_set_rstr_active *** 271 !! 272 !! ** Purpose : define file name in XIOS context for reading restart file, 273 !! enable variables present in restart file for reading with XIOS 274 !!--------------------------------------------------------------------- 275 276 !sets enabled = .TRUE. for each field in restart file 277 CHARACTER(len=256) :: rst_file 278 TYPE(xios_field) :: field_hdl 279 TYPE(xios_file) :: file_hdl 280 TYPE(xios_filegroup) :: filegroup_hdl 281 INTEGER :: i 282 CHARACTER(lc) :: clpath 283 284 clpath = TRIM(cn_ocerst_indir) 285 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 286 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 287 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 288 ELSE 289 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 290 ENDIF 291 !set name of the restart file and enable available fields 292 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 293 CALL xios_get_handle("file_definition", filegroup_hdl ) 294 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 295 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 296 par_access="collective", enabled=.TRUE., mode="read", & 297 output_freq=xios_timestep) 298 !define variables for restart context 299 DO i = 1, max_rst_fields 300 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 301 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 302 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 303 SELECT CASE (TRIM(rst_rfields(i)%grid)) 304 CASE ("grid_N_3D") 305 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 306 domain_ref="grid_N", axis_ref="nav_lev", operation = "instant") 307 CASE ("grid_N") 308 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 309 domain_ref="grid_N", operation = "instant") 310 CASE ("grid_vector") 311 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 312 axis_ref="nav_lev", operation = "instant") 313 CASE ("grid_scalar") 314 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 315 scalar_ref = "grid_scalar", operation = "instant") 316 END SELECT 317 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 318 ENDIF 319 ENDIF 320 END DO 321 END SUBROUTINE iom_set_rstr_active 322 323 SUBROUTINE iom_set_rstw_core(cdmdl) 324 !!--------------------------------------------------------------------- 325 !! *** SUBROUTINE iom_set_rstw_core *** 326 !! 327 !! ** Purpose : set variables which are always in restart file 328 !!--------------------------------------------------------------------- 329 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 330 331 IF(cdmdl == "OPA") THEN 332 !from restart.F90 333 CALL iom_set_rstw_var_active("rdt") 334 IF ( .NOT. ln_diurnal_only ) THEN 335 CALL iom_set_rstw_var_active('ub' ) 336 CALL iom_set_rstw_var_active('vb' ) 337 CALL iom_set_rstw_var_active('tb' ) 338 CALL iom_set_rstw_var_active('sb' ) 339 CALL iom_set_rstw_var_active('sshb') 340 ! 341 CALL iom_set_rstw_var_active('un' ) 342 CALL iom_set_rstw_var_active('vn' ) 343 CALL iom_set_rstw_var_active('tn' ) 344 CALL iom_set_rstw_var_active('sn' ) 345 CALL iom_set_rstw_var_active('sshn') 346 CALL iom_set_rstw_var_active('rhop') 347 ! extra variable needed for the ice sheet coupling 348 IF ( ln_iscpl ) THEN 349 CALL iom_set_rstw_var_active('tmask') 350 CALL iom_set_rstw_var_active('umask') 351 CALL iom_set_rstw_var_active('vmask') 352 CALL iom_set_rstw_var_active('smask') 353 CALL iom_set_rstw_var_active('e3t_n') 354 CALL iom_set_rstw_var_active('e3u_n') 355 CALL iom_set_rstw_var_active('e3v_n') 356 CALL iom_set_rstw_var_active('gdepw_n') 357 END IF 358 ENDIF 359 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 360 !from trasbc.F90 361 CALL iom_set_rstw_var_active('sbc_hc_b') 362 CALL iom_set_rstw_var_active('sbc_sc_b') 363 ENDIF 364 END SUBROUTINE iom_set_rstw_core 365 366 SUBROUTINE iom_set_rst_vars(fields) 367 !!--------------------------------------------------------------------- 368 !! *** SUBROUTINE iom_set_rstr_active *** 369 !! 370 !! ** Purpose : Fill array fields with the information about all 371 !! possible variables and corresponding grids definition 372 !! for reading/writing restart with XIOS 373 !!--------------------------------------------------------------------- 374 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 375 376 INTEGER :: i 377 i = 0 378 i = i + 1; fields(i)%vname="rdt"; fields(i)%grid="grid_scalar" 379 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 380 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 381 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 382 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 383 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 384 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 385 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 386 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 387 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 388 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 389 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 390 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 391 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 392 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 393 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 394 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 395 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 396 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 397 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 398 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 399 i = i + 1; fields(i)%vname="avt_k"; fields(i)%grid="grid_N_3D" 400 i = i + 1; fields(i)%vname="avm_k"; fields(i)%grid="grid_N_3D" 401 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 402 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 403 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 404 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 405 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 406 i = i + 1; fields(i)%vname="greenland_icesheet_mass" 407 fields(i)%grid="grid_scalar" 408 i = i + 1; fields(i)%vname="greenland_icesheet_timelapsed" 409 fields(i)%grid="grid_scalar" 410 i = i + 1; fields(i)%vname="greenland_icesheet_mass_roc" 411 fields(i)%grid="grid_scalar" 412 i = i + 1; fields(i)%vname="antarctica_icesheet_mass" 413 fields(i)%grid="grid_scalar" 414 i = i + 1; fields(i)%vname="antarctica_icesheet_timelapsed" 415 fields(i)%grid="grid_scalar" 416 i = i + 1; fields(i)%vname="antarctica_icesheet_mass_roc" 417 fields(i)%grid="grid_scalar" 418 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 419 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 420 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 421 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 422 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 423 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 424 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 425 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 426 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 427 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 428 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 429 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 430 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 431 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 432 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 433 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 434 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 435 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 436 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 437 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 438 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 439 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 440 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 441 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 442 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 443 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 444 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 445 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 446 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 447 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 448 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 449 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 451 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 452 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 453 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 454 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 455 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 456 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 457 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 458 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 459 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 460 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 461 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 463 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 464 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 465 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 466 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 467 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 468 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 469 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 470 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 471 i = i + 1; fields(i)%vname="hmxl_n"; fields(i)%grid="grid_N_3D" 472 i = i + 1; fields(i)%vname="un_bf"; fields(i)%grid="grid_N" 473 i = i + 1; fields(i)%vname="vn_bf"; fields(i)%grid="grid_N" 474 i = i + 1; fields(i)%vname="hbl"; fields(i)%grid="grid_N" 475 i = i + 1; fields(i)%vname="hbli"; fields(i)%grid="grid_N" 476 i = i + 1; fields(i)%vname="wn"; fields(i)%grid="grid_N_3D" 477 478 IF( i-1 > max_rst_fields) THEN 479 IF(lwp) write(numout,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 480 nstop = nstop + 1 481 ENDIF 482 483 END SUBROUTINE iom_set_rst_vars 484 485 486 SUBROUTINE iom_set_rstw_active(cdrst_file) 487 !!--------------------------------------------------------------------- 488 !! *** SUBROUTINE iom_set_rstr_active *** 489 !! 490 !! ** Purpose : define file name in XIOS context for writing restart 491 !! enable variables present in restart file for writing 492 !!--------------------------------------------------------------------- 493 !sets enabled = .TRUE. for each field in restart file 494 CHARACTER(len=*) :: cdrst_file 495 #if defined key_iomput 496 TYPE(xios_field) :: field_hdl 497 TYPE(xios_file) :: file_hdl 498 TYPE(xios_filegroup) :: filegroup_hdl 499 INTEGER :: i 500 CHARACTER(lc) :: clpath 501 502 !set name of the restart file and enable available fields 503 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 504 CALL xios_get_handle("file_definition", filegroup_hdl ) 505 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 506 IF(nxioso.eq.1) THEN 507 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 508 mode="write", output_freq=xios_timestep) 509 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 510 ELSE 511 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 512 mode="write", output_freq=xios_timestep) 513 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 514 ENDIF 515 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 516 !define fields for restart context 517 DO i = 1, max_rst_fields 518 IF( rst_wfields(i)%active ) THEN 519 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 520 SELECT CASE (TRIM(rst_wfields(i)%grid)) 521 CASE ("grid_N_3D") 522 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 523 domain_ref="grid_N", axis_ref="nav_lev", prec = 8, operation = "instant") 524 CASE ("grid_N") 525 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 526 domain_ref="grid_N", prec = 8, operation = "instant") 527 CASE ("grid_vector") 528 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 529 axis_ref="nav_lev", prec = 8, operation = "instant") 530 CASE ("grid_scalar") 531 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 532 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 533 END SELECT 534 ENDIF 535 END DO 536 #endif 537 END SUBROUTINE iom_set_rstw_active 538 539 SUBROUTINE iom_set_rst_context( ) 540 !!--------------------------------------------------------------------- 541 !! *** SUBROUTINE iom_set_rstr_active *** 542 !! 543 !! ** Purpose : Define domain, axis and grid for restart (read/write) 544 !! context 545 !! 546 !!--------------------------------------------------------------------- 547 #if defined key_iomput 548 TYPE(xios_domaingroup) :: domaingroup_hdl 549 TYPE(xios_domain) :: domain_hdl 550 TYPE(xios_axisgroup) :: axisgroup_hdl 551 TYPE(xios_axis) :: axis_hdl 552 TYPE(xios_scalar) :: scalar_hdl 553 TYPE(xios_scalargroup) :: scalargroup_hdl 554 555 CALL xios_get_handle("domain_definition",domaingroup_hdl) 556 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 557 CALL set_grid("N", glamt, gphit, .TRUE.) 558 559 CALL xios_get_handle("axis_definition",axisgroup_hdl) 560 CALL xios_add_child(axisgroup_hdl, axis_hdl, "nav_lev") 561 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 562 ! CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels", unit="m", positive="down") 563 CALL xios_set_axis_attr( "nav_lev", long_name="Vertical levels in meters", positive="down") 564 CALL iom_set_axis_attr( "nav_lev", paxis = gdept_1d ) 565 566 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 567 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 568 #endif 569 END SUBROUTINE iom_set_rst_context 217 570 218 571 SUBROUTINE iom_swap( cdname ) … … 347 700 icnt = icnt + 1 348 701 END DO 702 ELSE 703 lxios_sini = .TRUE. 349 704 ENDIF 350 705 IF( llwrt ) THEN … … 530 885 !! INTERFACE iom_get 531 886 !!---------------------------------------------------------------------- 532 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )887 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 533 888 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 534 889 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 535 890 REAL(wp) , INTENT( out) :: pvar ! read field 536 891 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 892 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 537 893 ! 538 894 INTEGER :: idvar ! variable id … … 542 898 CHARACTER(LEN=100) :: clname ! file name 543 899 CHARACTER(LEN=1) :: cldmspc ! 544 ! 545 itime = 1 546 IF( PRESENT(ktime) ) itime = ktime 547 ! 548 clname = iom_file(kiomid)%name 549 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 550 ! 551 IF( kiomid > 0 ) THEN 552 idvar = iom_varid( kiomid, cdvar ) 553 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 554 idmspc = iom_file ( kiomid )%ndims( idvar ) 555 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 556 WRITE(cldmspc , fmt='(i1)') idmspc 557 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 558 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 559 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 560 SELECT CASE (iom_file(kiomid)%iolib) 561 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 562 CASE DEFAULT 563 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 564 END SELECT 565 ENDIF 900 LOGICAL :: llxios 901 ! 902 llxios = .FALSE. 903 IF( PRESENT(ldxios) ) llxios = ldxios 904 905 IF(.NOT.llxios) THEN ! read data using default library 906 itime = 1 907 IF( PRESENT(ktime) ) itime = ktime 908 ! 909 clname = iom_file(kiomid)%name 910 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 911 ! 912 IF( kiomid > 0 ) THEN 913 idvar = iom_varid( kiomid, cdvar ) 914 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 915 idmspc = iom_file ( kiomid )%ndims( idvar ) 916 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 917 WRITE(cldmspc , fmt='(i1)') idmspc 918 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 919 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 920 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 921 SELECT CASE (iom_file(kiomid)%iolib) 922 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 923 CASE DEFAULT 924 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 925 END SELECT 926 ENDIF 927 ENDIF 928 ELSE 929 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 930 CALL iom_swap( TRIM(crxios_context) ) 931 CALL xios_recv_field( trim(cdvar), pvar) 932 CALL iom_swap( TRIM(cxios_context) ) 566 933 ENDIF 567 934 END SUBROUTINE iom_g0d 568 935 569 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )936 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 570 937 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 938 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 575 942 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 576 943 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 944 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 577 945 ! 578 946 IF( kiomid > 0 ) THEN 579 947 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 580 & ktime=ktime, kstart=kstart, kcount=kcount ) 948 & ktime=ktime, kstart=kstart, kcount=kcount, & 949 & ldxios=ldxios ) 581 950 ENDIF 582 951 END SUBROUTINE iom_g1d 583 952 584 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 953 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 585 954 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 586 955 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 594 963 ! called open_ocean_jstart to set the start 595 964 ! value for the 2nd dimension (netcdf only) 965 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 596 966 ! 597 967 IF( kiomid > 0 ) THEN 598 968 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 599 969 & ktime=ktime, kstart=kstart, kcount=kcount, & 600 & lrowattr=lrowattr 970 & lrowattr=lrowattr, ldxios=ldxios) 601 971 ENDIF 602 972 END SUBROUTINE iom_g2d 603 973 604 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )974 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 605 975 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 606 976 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 984 ! called open_ocean_jstart to set the start 615 985 ! value for the 2nd dimension (netcdf only) 986 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 616 987 ! 617 988 IF( kiomid > 0 ) THEN 618 989 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 619 990 & ktime=ktime, kstart=kstart, kcount=kcount, & 620 & lrowattr=lrowattr )991 & lrowattr=lrowattr, ldxios=ldxios ) 621 992 ENDIF 622 993 END SUBROUTINE iom_g3d … … 626 997 & pv_r1d, pv_r2d, pv_r3d, & 627 998 & ktime , kstart, kcount, & 628 & lrowattr 999 & lrowattr, ldxios ) 629 1000 !!----------------------------------------------------------------------- 630 1001 !! *** ROUTINE iom_get_123d *** … … 644 1015 INTEGER , DIMENSION(:) , INTENT(in ), OPTIONAL :: kcount ! number of points to be read in each axis 645 1016 LOGICAL , INTENT(in ), OPTIONAL :: lrowattr ! logical flag telling iom_get to 646 ! ! look for and use a file attribute 647 ! ! called open_ocean_jstart to set the start 648 ! ! value for the 2nd dimension (netcdf only) 649 ! 1017 ! look for and use a file attribute 1018 ! called open_ocean_jstart to set the start 1019 ! value for the 2nd dimension (netcdf only) 1020 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1021 ! 1022 LOGICAL :: llxios ! local definition for XIOS read 650 1023 LOGICAL :: llnoov ! local definition to read overlap 651 1024 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 673 1046 LOGICAL :: ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 674 1047 INTEGER :: inlev ! number of levels for 3D data 1048 REAL(wp) :: gma, gmi 675 1049 !--------------------------------------------------------------------- 676 1050 ! 677 1051 inlev = -1 678 1052 IF( PRESENT(pv_r3d) ) inlev = SIZE(pv_r3d, 3) 679 clname = iom_file(kiomid)%name ! esier to read 680 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 681 ! local definition of the domain ? 1053 ! 1054 llxios = .FALSE. 1055 if(PRESENT(ldxios)) llxios = ldxios 1056 idvar = iom_varid( kiomid, cdvar ) 682 1057 idom = kdom 683 ! do we read the overlap 684 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 685 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 686 ! check kcount and kstart optionals parameters... 687 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 688 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 689 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 690 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 691 692 luse_jattr = .false. 693 IF( PRESENT(lrowattr) ) THEN 694 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 695 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 696 ENDIF 697 IF( luse_jattr ) THEN 698 SELECT CASE (iom_file(kiomid)%iolib) 699 CASE (jpnf90 ) 700 ! Ok 701 CASE DEFAULT 702 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 703 END SELECT 704 ENDIF 705 706 ! Search for the variable in the data base (eventually actualize data) 707 istop = nstop 708 idvar = iom_varid( kiomid, cdvar ) 709 ! 710 IF( idvar > 0 ) THEN 711 ! to write iom_file(kiomid)%dimsz in a shorter way ! 712 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 713 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 714 idmspc = inbdim ! number of spatial dimensions in the file 715 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 716 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1058 ! 1059 IF(.NOT.llxios) THEN 1060 clname = iom_file(kiomid)%name ! esier to read 1061 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1062 ! local definition of the domain ? 1063 ! do we read the overlap 1064 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 1065 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 1066 ! check kcount and kstart optionals parameters... 1067 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1068 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1069 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1070 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 1071 1072 luse_jattr = .false. 1073 IF( PRESENT(lrowattr) ) THEN 1074 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 1075 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 1076 ENDIF 1077 IF( luse_jattr ) THEN 1078 SELECT CASE (iom_file(kiomid)%iolib) 1079 CASE (jpnf90 ) 1080 ! Ok 1081 CASE DEFAULT 1082 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1083 END SELECT 1084 ENDIF 1085 1086 ! Search for the variable in the data base (eventually actualize data) 1087 istop = nstop 717 1088 ! 718 ! update idom definition... 719 ! Identify the domain in case of jpdom_auto(glo/dta) definition 720 IF( idom == jpdom_autoglo_xy ) THEN 721 ll_depth_spec = .TRUE. 722 idom = jpdom_autoglo 723 ELSE 724 ll_depth_spec = .FALSE. 725 ENDIF 726 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 727 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 728 ELSE ; idom = jpdom_data 1089 IF( idvar > 0 ) THEN 1090 ! to write iom_file(kiomid)%dimsz in a shorter way ! 1091 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1092 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1093 idmspc = inbdim ! number of spatial dimensions in the file 1094 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1095 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1096 ! 1097 ! update idom definition... 1098 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1099 IF( idom == jpdom_autoglo_xy ) THEN 1100 ll_depth_spec = .TRUE. 1101 idom = jpdom_autoglo 1102 ELSE 1103 ll_depth_spec = .FALSE. 729 1104 ENDIF 730 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 731 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 732 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 733 ENDIF 734 ! Identify the domain in case of jpdom_local definition 735 IF( idom == jpdom_local ) THEN 736 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 737 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 738 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 739 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 1105 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1106 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1107 ELSE ; idom = jpdom_data 1108 ENDIF 1109 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1110 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1111 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 740 1112 ENDIF 741 ENDIF 742 ! 743 ! check the consistency between input array and data rank in the file 744 ! 745 ! initializations 746 itime = 1 747 IF( PRESENT(ktime) ) itime = ktime 748 749 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 750 WRITE(clrankpv, fmt='(i1)') irankpv 751 WRITE(cldmspc , fmt='(i1)') idmspc 752 ! 753 IF( idmspc < irankpv ) THEN 754 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 755 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 756 ELSEIF( idmspc == irankpv ) THEN 757 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 758 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 759 ELSEIF( idmspc > irankpv ) THEN 760 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 761 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 762 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 763 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 764 idmspc = idmspc - 1 765 ELSE 766 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 767 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 768 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1113 ! Identify the domain in case of jpdom_local definition 1114 IF( idom == jpdom_local ) THEN 1115 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 1116 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 1117 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 1118 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 769 1119 ENDIF 770 ENDIF 771 772 ! 773 ! definition of istart and icnt 774 ! 775 icnt (:) = 1 776 istart(:) = 1 777 istart(idmspc+1) = itime 778 779 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 780 istart(1:idmspc) = kstart(1:idmspc) 781 icnt (1:idmspc) = kcount(1:idmspc) 782 ELSE 783 IF(idom == jpdom_unknown ) THEN 784 icnt(1:idmspc) = idimsz(1:idmspc) 785 ELSE 786 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 787 IF( idom == jpdom_data ) THEN 788 jstartrow = 1 789 IF( luse_jattr ) THEN 790 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 791 jstartrow = MAX(1,jstartrow) 1120 ENDIF 1121 ! 1122 ! check the consistency between input array and data rank in the file 1123 ! 1124 ! initializations 1125 itime = 1 1126 IF( PRESENT(ktime) ) itime = ktime 1127 ! 1128 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 1129 WRITE(clrankpv, fmt='(i1)') irankpv 1130 WRITE(cldmspc , fmt='(i1)') idmspc 1131 ! 1132 IF( idmspc < irankpv ) THEN 1133 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1134 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 1135 ELSEIF( idmspc == irankpv ) THEN 1136 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 1137 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 1138 ELSEIF( idmspc > irankpv ) THEN 1139 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1140 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 1141 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 1142 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 1143 idmspc = idmspc - 1 1144 ELSE 1145 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 1146 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 1147 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 1148 ENDIF 1149 ENDIF 1150 ! 1151 ! definition of istart and icnt 1152 ! 1153 icnt (:) = 1 1154 istart(:) = 1 1155 istart(idmspc+1) = itime 1156 1157 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN 1158 istart(1:idmspc) = kstart(1:idmspc) 1159 icnt (1:idmspc) = kcount(1:idmspc) 1160 ELSE 1161 IF(idom == jpdom_unknown ) THEN 1162 icnt(1:idmspc) = idimsz(1:idmspc) 1163 ELSE 1164 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 1165 IF( idom == jpdom_data ) THEN 1166 jstartrow = 1 1167 IF( luse_jattr ) THEN 1168 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 1169 jstartrow = MAX(1,jstartrow) 1170 ENDIF 1171 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 1172 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 792 1173 ENDIF 793 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 794 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 795 ENDIF 796 ! we do not read the overlap -> we start to read at nldi, nldj 1174 ! we do not read the overlap -> we start to read at nldi, nldj 797 1175 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 798 1176 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 799 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)1177 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 800 1178 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 801 1179 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 802 1180 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 803 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 804 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 805 ENDIF 806 IF( PRESENT(pv_r3d) ) THEN 807 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 808 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 809 ELSE ; icnt(3) = inlev 1181 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 1182 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 1183 ENDIF 1184 IF( PRESENT(pv_r3d) ) THEN 1185 IF( idom == jpdom_data ) THEN ; icnt(3) = inlev 1186 ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3) ; icnt(3) = kcount(3) 1187 ELSE ; icnt(3) = inlev 1188 ENDIF 810 1189 ENDIF 811 1190 ENDIF 812 1191 ENDIF 813 1192 ENDIF 814 ENDIF 815 816 ! check that istart and icnt can be used with this file 817 !- 818 DO jl = 1, jpmax_dims 819 itmp = istart(jl)+icnt(jl)-1 820 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 821 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 822 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 823 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 824 ENDIF 825 END DO 826 827 ! check that icnt matches the input array 828 !- 829 IF( idom == jpdom_unknown ) THEN 830 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 831 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 832 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 833 ctmp1 = 'd' 834 ELSE 835 IF( irankpv == 2 ) THEN 1193 1194 ! check that istart and icnt can be used with this file 1195 !- 1196 DO jl = 1, jpmax_dims 1197 itmp = istart(jl)+icnt(jl)-1 1198 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 1199 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1200 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1201 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1202 ENDIF 1203 END DO 1204 1205 ! check that icnt matches the input array 1206 !- 1207 IF( idom == jpdom_unknown ) THEN 1208 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1209 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1210 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1211 ctmp1 = 'd' 1212 ELSE 1213 IF( irankpv == 2 ) THEN 836 1214 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 837 1215 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 838 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 839 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1216 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1217 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1218 ENDIF 1219 ENDIF 1220 IF( irankpv == 3 ) THEN 1221 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 1222 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 1223 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1224 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1225 ENDIF 840 1226 ENDIF 841 1227 ENDIF 842 IF( irankpv == 3 ) THEN843 ! JMM + SM: ugly patch before getting the new version of lib_mpp)844 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)'845 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'846 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'847 ENDIF848 ENDIF849 ENDIF850 1228 851 DO jl = 1, irankpv852 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)853 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )854 END DO855 856 ENDIF857 858 ! read the data859 !-860 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...861 !1229 DO jl = 1, irankpv 1230 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1231 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1232 END DO 1233 1234 ENDIF 1235 1236 ! read the data 1237 !- 1238 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1239 ! 862 1240 ! find the right index of the array to be read 863 1241 ! JMM + SM: ugly patch before getting the new version of lib_mpp) … … 865 1243 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 866 1244 ! ENDIF 867 IF( llnoov ) THEN 868 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 869 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1245 IF( llnoov ) THEN 1246 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1247 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1248 ENDIF 1249 ELSE 1250 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1251 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1252 ENDIF 1253 ENDIF 1254 1255 SELECT CASE (iom_file(kiomid)%iolib) 1256 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1257 & pv_r1d, pv_r2d, pv_r3d ) 1258 CASE DEFAULT 1259 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1260 END SELECT 1261 1262 IF( istop == nstop ) THEN ! no additional errors until this point... 1263 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 1264 1265 !--- overlap areas and extra hallows (mpp) 1266 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1267 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1268 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1269 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1270 IF( icnt(3) == inlev ) THEN 1271 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1272 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1273 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1274 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1275 ENDIF 1276 ENDIF 1277 ! 1278 ELSE 1279 ! return if istop == nstop is false 1280 RETURN 870 1281 ENDIF 871 1282 ELSE 872 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 873 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1283 ! return if statment idvar > 0 .AND. istop == nstop is false 1284 RETURN 1285 ENDIF 1286 ! 1287 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1288 #if defined key_iomput 1289 !would be good to be able to check which context is active and swap only if current is not restart 1290 CALL iom_swap( TRIM(crxios_context) ) 1291 IF( PRESENT(pv_r3d) ) THEN 1292 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1293 CALL xios_recv_field( trim(cdvar), pv_r3d) 1294 IF(idom /= jpdom_unknown ) then 1295 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 874 1296 ENDIF 875 ENDIF 876 877 SELECT CASE (iom_file(kiomid)%iolib) 878 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 879 & pv_r1d, pv_r2d, pv_r3d ) 880 CASE DEFAULT 881 CALL ctl_stop( TRIM(clinfo)//' accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 882 END SELECT 883 884 IF( istop == nstop ) THEN ! no additional errors until this point... 885 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 886 887 !--- overlap areas and extra hallows (mpp) 888 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 889 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 890 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 891 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 892 IF( icnt(3) == inlev ) THEN 893 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 894 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 895 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 896 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 897 ENDIF 1297 ELSEIF( PRESENT(pv_r2d) ) THEN 1298 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1299 CALL xios_recv_field( trim(cdvar), pv_r2d) 1300 IF(idom /= jpdom_unknown ) THEN 1301 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 898 1302 ENDIF 899 900 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 901 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 902 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 903 904 !--- Apply scale_factor and offset 905 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 906 zofs = iom_file(kiomid)%ofs(idvar) ! offset 907 IF( PRESENT(pv_r1d) ) THEN 908 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 909 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 910 ELSEIF( PRESENT(pv_r2d) ) THEN 911 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 912 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 913 ELSEIF( PRESENT(pv_r3d) ) THEN 914 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 915 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 916 ENDIF 917 ! 918 ENDIF 919 ! 1303 ELSEIF( PRESENT(pv_r1d) ) THEN 1304 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1305 CALL xios_recv_field( trim(cdvar), pv_r1d) 1306 ENDIF 1307 CALL iom_swap( TRIM(cxios_context) ) 1308 #else 1309 istop = istop + 1 1310 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1311 #endif 1312 ENDIF 1313 !some final adjustments 1314 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1315 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1316 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1317 1318 !--- Apply scale_factor and offset 1319 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1320 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1321 IF( PRESENT(pv_r1d) ) THEN 1322 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1323 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1324 ELSEIF( PRESENT(pv_r2d) ) THEN 1325 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1326 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1327 ELSEIF( PRESENT(pv_r3d) ) THEN 1328 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1329 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 920 1330 ENDIF 921 1331 ! … … 1119 1529 !! INTERFACE iom_rstput 1120 1530 !!---------------------------------------------------------------------- 1121 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )1531 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1122 1532 INTEGER , INTENT(in) :: kt ! ocean time-step 1123 1533 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1126 1536 REAL(wp) , INTENT(in) :: pvar ! written field 1127 1537 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1538 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1539 LOGICAL :: llx ! local xios write flag 1128 1540 INTEGER :: ivid ! variable id 1129 IF( kiomid > 0 ) THEN 1130 IF( iom_file(kiomid)%nfid > 0 ) THEN 1131 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1132 SELECT CASE (iom_file(kiomid)%iolib) 1133 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1134 CASE DEFAULT 1135 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1136 END SELECT 1541 1542 llx = .FALSE. 1543 IF(PRESENT(ldxios)) llx = ldxios 1544 IF( llx ) THEN 1545 #ifdef key_iomput 1546 IF( kt == kwrite ) THEN 1547 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1548 CALL xios_send_field(trim(cdvar), pvar) 1549 ENDIF 1550 #endif 1551 ELSE 1552 IF( kiomid > 0 ) THEN 1553 IF( iom_file(kiomid)%nfid > 0 ) THEN 1554 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1555 SELECT CASE (iom_file(kiomid)%iolib) 1556 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1557 CASE DEFAULT 1558 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1559 END SELECT 1560 ENDIF 1137 1561 ENDIF 1138 1562 ENDIF 1139 1563 END SUBROUTINE iom_rp0d 1140 1564 1141 1142 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1565 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1143 1566 INTEGER , INTENT(in) :: kt ! ocean time-step 1144 1567 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1147 1570 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1148 1571 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1572 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1573 LOGICAL :: llx ! local xios write flag 1149 1574 INTEGER :: ivid ! variable id 1150 IF( kiomid > 0 ) THEN 1151 IF( iom_file(kiomid)%nfid > 0 ) THEN 1152 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1153 SELECT CASE (iom_file(kiomid)%iolib) 1154 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1155 CASE DEFAULT 1156 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1157 END SELECT 1575 1576 llx = .FALSE. 1577 IF(PRESENT(ldxios)) llx = ldxios 1578 IF( llx ) THEN 1579 #ifdef key_iomput 1580 IF( kt == kwrite ) THEN 1581 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1582 CALL xios_send_field(trim(cdvar), pvar) 1583 ENDIF 1584 #endif 1585 ELSE 1586 IF( kiomid > 0 ) THEN 1587 IF( iom_file(kiomid)%nfid > 0 ) THEN 1588 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1589 SELECT CASE (iom_file(kiomid)%iolib) 1590 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1591 CASE DEFAULT 1592 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1593 END SELECT 1594 ENDIF 1158 1595 ENDIF 1159 1596 ENDIF 1160 1597 END SUBROUTINE iom_rp1d 1161 1598 1162 1163 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1599 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1164 1600 INTEGER , INTENT(in) :: kt ! ocean time-step 1165 1601 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1168 1604 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1169 1605 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1606 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1607 LOGICAL :: llx 1170 1608 INTEGER :: ivid ! variable id 1171 IF( kiomid > 0 ) THEN 1172 IF( iom_file(kiomid)%nfid > 0 ) THEN 1173 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1174 SELECT CASE (iom_file(kiomid)%iolib) 1175 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1176 CASE DEFAULT 1177 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1178 END SELECT 1609 1610 llx = .FALSE. 1611 IF(PRESENT(ldxios)) llx = ldxios 1612 IF( llx ) THEN 1613 #ifdef key_iomput 1614 IF( kt == kwrite ) THEN 1615 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1616 CALL xios_send_field(trim(cdvar), pvar) 1617 ENDIF 1618 #endif 1619 ELSE 1620 IF( kiomid > 0 ) THEN 1621 IF( iom_file(kiomid)%nfid > 0 ) THEN 1622 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1623 SELECT CASE (iom_file(kiomid)%iolib) 1624 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1625 CASE DEFAULT 1626 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1627 END SELECT 1628 ENDIF 1179 1629 ENDIF 1180 1630 ENDIF 1181 1631 END SUBROUTINE iom_rp2d 1182 1632 1183 1184 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 1633 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1185 1634 INTEGER , INTENT(in) :: kt ! ocean time-step 1186 1635 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1189 1638 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1190 1639 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1640 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1641 LOGICAL :: llx ! local xios write flag 1191 1642 INTEGER :: ivid ! variable id 1192 IF( kiomid > 0 ) THEN 1193 IF( iom_file(kiomid)%nfid > 0 ) THEN 1194 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1195 SELECT CASE (iom_file(kiomid)%iolib) 1196 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1197 CASE DEFAULT 1198 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1199 END SELECT 1643 1644 llx = .FALSE. 1645 IF(PRESENT(ldxios)) llx = ldxios 1646 IF( llx ) THEN 1647 #ifdef key_iomput 1648 IF( kt == kwrite ) THEN 1649 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1650 CALL xios_send_field(trim(cdvar), pvar) 1651 ENDIF 1652 #endif 1653 ELSE 1654 IF( kiomid > 0 ) THEN 1655 IF( iom_file(kiomid)%nfid > 0 ) THEN 1656 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1657 SELECT CASE (iom_file(kiomid)%iolib) 1658 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1659 CASE DEFAULT 1660 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1661 END SELECT 1662 ENDIF 1200 1663 ENDIF 1201 1664 ENDIF … … 1273 1736 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1274 1737 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1275 ENDIF1738 ENDIF 1276 1739 IF( xios_is_valid_domaingroup(cdid) ) THEN 1277 1740 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1392 1855 !!---------------------------------------------------------------------- 1393 1856 CHARACTER(LEN=*), INTENT(in) :: cdname 1394 !!---------------------------------------------------------------------- 1395 IF( xios_is_valid_context(cdname) ) THEN 1857 CHARACTER(LEN=120) :: clname 1858 !!---------------------------------------------------------------------- 1859 clname = cdname 1860 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 1861 IF( xios_is_valid_context(clname) ) THEN 1396 1862 CALL iom_swap( cdname ) ! swap to cdname context 1397 1863 CALL xios_context_finalize() ! finalize the context 1398 1864 IF( cdname /= TRIM(cxios_context) ) CALL iom_swap( TRIM(cxios_context) ) ! return back to nemo context 1399 1865 ENDIF 1866 ! 1400 1867 END SUBROUTINE iom_context_finalize 1401 1868 1402 1869 1403 SUBROUTINE set_grid( cdgrd, plon, plat )1870 SUBROUTINE set_grid( cdgrd, plon, plat, ldxios ) 1404 1871 !!---------------------------------------------------------------------- 1405 1872 !! *** ROUTINE set_grid *** … … 1413 1880 INTEGER :: ni, nj 1414 1881 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1882 LOGICAL, INTENT(IN) :: ldxios 1415 1883 !!---------------------------------------------------------------------- 1416 1884 ! … … 1423 1891 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1424 1892 ! 1425 IF ( ln_mskland ) THEN1893 IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 1426 1894 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1427 1895 SELECT CASE ( cdgrd )
Note: See TracChangeset
for help on using the changeset viewer.
