- Timestamp:
- 2017-12-12T11:41:19+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_METO_2017/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8924 r8987 44 44 USE ioipsl, ONLY : ju2ymds ! for calendar 45 45 USE crs ! Grid coarsening 46 USE lib_fortran 47 USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 46 48 47 49 IMPLICIT NONE … … 63 65 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 64 66 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 67 PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 68 PUBLIC iom_set_rstw_var_active, iom_set_rst_vars 65 69 # endif 66 70 … … 89 93 CONTAINS 90 94 91 SUBROUTINE iom_init( cdname )95 SUBROUTINE iom_init( cdname, fname ) 92 96 !!---------------------------------------------------------------------- 93 97 !! *** ROUTINE *** … … 97 101 !!---------------------------------------------------------------------- 98 102 CHARACTER(len=*), INTENT(in) :: cdname 103 CHARACTER(len=*), OPTIONAL, INTENT(in) :: fname 99 104 #if defined key_iomput 100 105 101 106 TYPE(xios_duration) :: dtime = xios_duration(0, 0, 0, 0, 0, 0) 102 107 TYPE(xios_date) :: start_date 103 CHARACTER(len= 10) :: clname108 CHARACTER(len=lc) :: clname 104 109 INTEGER :: ji, jkmin 110 LOGICAL :: llrst_context ! is context related to restart 105 111 ! 106 112 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 113 119 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 114 120 CALL iom_swap( cdname ) 115 121 llrst_context = (TRIM(cdname) == TRIM(crxios_context) .OR. TRIM(cdname) == TRIM(cwxios_context)) 116 122 117 123 ! Calendar type is now defined in xml file … … 126 132 127 133 ! horizontal grid definition 128 CALL set_scalar134 IF(.NOT.llrst_context) CALL set_scalar 129 135 130 136 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN 131 CALL set_grid( "T", glamt, gphit )132 CALL set_grid( "U", glamu, gphiu )133 CALL set_grid( "V", glamv, gphiv )134 CALL set_grid( "W", glamt, gphit )137 CALL set_grid( "T", glamt, gphit, .FALSE. ) 138 CALL set_grid( "U", glamu, gphiu, .FALSE. ) 139 CALL set_grid( "V", glamv, gphiv, .FALSE. ) 140 CALL set_grid( "W", glamt, gphit, .FALSE. ) 135 141 CALL set_grid_znl( gphit ) 136 142 ! … … 150 156 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 151 157 ! 152 CALL set_grid( "T", glamt_crs, gphit_crs )153 CALL set_grid( "U", glamu_crs, gphiu_crs )154 CALL set_grid( "V", glamv_crs, gphiv_crs )155 CALL set_grid( "W", glamt_crs, gphit_crs )158 CALL set_grid( "T", glamt_crs, gphit_crs, .FALSE. ) 159 CALL set_grid( "U", glamu_crs, gphiu_crs, .FALSE. ) 160 CALL set_grid( "V", glamv_crs, gphiv_crs, .FALSE. ) 161 CALL set_grid( "W", glamt_crs, gphit_crs, .FALSE. ) 156 162 CALL set_grid_znl( gphit_crs ) 157 163 ! 158 164 CALL dom_grid_glo ! Return to parent grid domain 159 165 ! 160 IF( ln_cfmeta ) THEN ! Add additional grid metadata166 IF( ln_cfmeta .AND. .NOT. llrst_context) THEN ! Add additional grid metadata 161 167 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 162 168 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 171 177 172 178 ! vertical grid definition 173 CALL iom_set_axis_attr( "deptht", gdept_1d ) 174 CALL iom_set_axis_attr( "depthu", gdept_1d ) 175 CALL iom_set_axis_attr( "depthv", gdept_1d ) 176 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 177 178 ! Add vertical grid bounds 179 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 180 zt_bnds(2,: ) = gdept_1d(:) 181 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 182 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 183 zw_bnds(1,: ) = gdepw_1d(:) 184 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 185 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 186 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 187 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 188 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 189 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 179 IF(.NOT.llrst_context) THEN 180 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 181 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 182 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 183 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 184 185 ! Add vertical grid bounds 186 jkmin = MIN(2,jpk) ! in case jpk=1 (i.e. sas2D) 187 zt_bnds(2,: ) = gdept_1d(:) 188 zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 189 zt_bnds(1,1 ) = gdept_1d(1) - e3w_1d(1) 190 zw_bnds(1,: ) = gdepw_1d(:) 191 zw_bnds(2,1:jpkm1 ) = gdepw_1d(jkmin:jpk) 192 zw_bnds(2,jpk: ) = gdepw_1d(jpk) + e3t_1d(jpk) 193 CALL iom_set_axis_attr( "deptht", bounds=zt_bnds ) 194 CALL iom_set_axis_attr( "depthu", bounds=zt_bnds ) 195 CALL iom_set_axis_attr( "depthv", bounds=zt_bnds ) 196 CALL iom_set_axis_attr( "depthw", bounds=zw_bnds ) 190 197 191 198 192 199 # if defined key_floats 193 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )200 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 194 201 # endif 195 202 #if defined key_lim3 || defined key_lim2 196 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )203 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 197 204 #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 205 CALL iom_set_axis_attr( "icbcla", class_num ) 206 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 207 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 208 ENDIF 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 read from restart file 221 CALL iom_set_rstw_active(fname) 222 ELSE 223 CALL set_xmlatt 224 ENDIF 204 225 205 226 ! end file definition … … 213 234 214 235 #endif 215 236 216 237 END SUBROUTINE iom_init 217 238 239 SUBROUTINE iom_set_rstw_var_active(field) 240 !!--------------------------------------------------------------------- 241 !! *** SUBROUTINE iom_set_rstw_var_active *** 242 !! 243 !! ** Purpose : enable variable in restart file when writing with XIOS 244 !!--------------------------------------------------------------------- 245 CHARACTER(len = *), INTENT(IN) :: field 246 INTEGER :: i 247 LOGICAL :: llis_set 248 249 llis_set = .FALSE. 250 251 DO i = 1, max_rst_fields 252 IF(TRIM(rst_wfields(i)%vname) == field) THEN 253 rst_wfields(i)%active = .TRUE. 254 llis_set = .TRUE. 255 EXIT 256 ENDIF 257 ENDDO 258 !Warn if variable is not in defined in rst_wfields 259 IF(.NOT.llis_set) THEN 260 IF(lwp) THEN 261 write(numout,cform_err) 262 write(numout,*) 'iom_set_rstw_var_active: variable ', field ,' is available for writing but not defined' 263 ENDIF 264 nstop = nstop + 1 265 ENDIF 266 267 END SUBROUTINE iom_set_rstw_var_active 268 269 SUBROUTINE iom_set_rstr_active() 270 !!--------------------------------------------------------------------- 271 !! *** SUBROUTINE iom_set_rstr_active *** 272 !! 273 !! ** Purpose : define file name in XIOS context for reading restart file, 274 !! enable variables present in restart file for reading with XIOS 275 !!--------------------------------------------------------------------- 276 277 !sets enabled = .TRUE. for each field in restart file 278 CHARACTER(len=256) :: rst_file 279 TYPE(xios_field) :: field_hdl 280 TYPE(xios_file) :: file_hdl 281 TYPE(xios_filegroup) :: filegroup_hdl 282 INTEGER :: i 283 CHARACTER(lc) :: clpath 284 285 clpath = TRIM(cn_ocerst_indir) 286 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 287 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 288 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 289 ELSE 290 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 291 ENDIF 292 !set name of the restart file and enable available fields 293 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 294 CALL xios_get_handle("file_definition", filegroup_hdl ) 295 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 296 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 297 par_access="collective", enabled=.TRUE., mode="read", & 298 output_freq=xios_timestep) 299 !define variables for restart context 300 DO i = 1, max_rst_fields 301 IF( TRIM(rst_rfields(i)%vname) /= "NO_NAME") THEN 302 IF( iom_varid( numror, TRIM(rst_rfields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 303 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_rfields(i)%vname)) 304 SELECT CASE (TRIM(rst_rfields(i)%grid)) 305 CASE ("grid_N_3D") 306 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 307 domain_ref="grid_N", axis_ref="deptht", operation = "instant") 308 CASE ("grid_N") 309 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 310 domain_ref="grid_N", operation = "instant") 311 CASE ("grid_vector") 312 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 313 axis_ref="deptht", operation = "instant") 314 CASE ("grid_scalar") 315 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_rfields(i)%vname), & 316 scalar_ref = "grid_scalar", operation = "instant") 317 END SELECT 318 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_rfields(i)%vname), ' enabled in ', TRIM(rst_file) 319 ENDIF 320 ENDIF 321 END DO 322 END SUBROUTINE iom_set_rstr_active 323 324 SUBROUTINE iom_set_rstw_core(cdmdl) 325 !!--------------------------------------------------------------------- 326 !! *** SUBROUTINE iom_set_rstw_core *** 327 !! 328 !! ** Purpose : set variables which are always in restart file 329 !!--------------------------------------------------------------------- 330 CHARACTER (len=*), INTENT (IN) :: cdmdl ! model OPA or SAS 331 332 IF(cdmdl == "OPA") THEN 333 !from restart.F90 334 CALL iom_set_rstw_var_active("rdt") 335 IF ( .NOT. ln_diurnal_only ) THEN 336 CALL iom_set_rstw_var_active('ub' ) 337 CALL iom_set_rstw_var_active('vb' ) 338 CALL iom_set_rstw_var_active('tb' ) 339 CALL iom_set_rstw_var_active('sb' ) 340 CALL iom_set_rstw_var_active('sshb') 341 ! 342 CALL iom_set_rstw_var_active('un' ) 343 CALL iom_set_rstw_var_active('vn' ) 344 CALL iom_set_rstw_var_active('tn' ) 345 CALL iom_set_rstw_var_active('sn' ) 346 CALL iom_set_rstw_var_active('sshn') 347 CALL iom_set_rstw_var_active('rhop') 348 ! extra variable needed for the ice sheet coupling 349 IF ( ln_iscpl ) THEN 350 CALL iom_set_rstw_var_active('tmask') 351 CALL iom_set_rstw_var_active('umask') 352 CALL iom_set_rstw_var_active('vmask') 353 CALL iom_set_rstw_var_active('smask') 354 CALL iom_set_rstw_var_active('e3t_n') 355 CALL iom_set_rstw_var_active('e3u_n') 356 CALL iom_set_rstw_var_active('e3v_n') 357 CALL iom_set_rstw_var_active('gdepw_n') 358 END IF 359 ENDIF 360 IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 361 !from trasbc.F90 362 CALL iom_set_rstw_var_active('sbc_hc_b') 363 CALL iom_set_rstw_var_active('sbc_sc_b') 364 ENDIF 365 END SUBROUTINE iom_set_rstw_core 366 367 SUBROUTINE iom_set_rst_vars(fields) 368 !!--------------------------------------------------------------------- 369 !! *** SUBROUTINE iom_set_rstr_active *** 370 !! 371 !! ** Purpose : Fill array fields with the information about all 372 !! possible variables and corresponding grids definition 373 !! for reading/writing restart with XIOS 374 !!--------------------------------------------------------------------- 375 TYPE(RST_FIELD), INTENT(INOUT) :: fields(max_rst_fields) 376 377 INTEGER :: i 378 i = 0 379 i = i + 1; fields(i)%vname="rdt"; fields(i)%grid="grid_scalar" 380 i = i + 1; fields(i)%vname="un"; fields(i)%grid="grid_N_3D" 381 i = i + 1; fields(i)%vname="ub"; fields(i)%grid="grid_N_3D" 382 i = i + 1; fields(i)%vname="vn"; fields(i)%grid="grid_N_3D" 383 i = i + 1; fields(i)%vname="vb"; fields(i)%grid="grid_N_3D" 384 i = i + 1; fields(i)%vname="tn"; fields(i)%grid="grid_N_3D" 385 i = i + 1; fields(i)%vname="tb"; fields(i)%grid="grid_N_3D" 386 i = i + 1; fields(i)%vname="sn"; fields(i)%grid="grid_N_3D" 387 i = i + 1; fields(i)%vname="sb"; fields(i)%grid="grid_N_3D" 388 i = i + 1; fields(i)%vname="sshn"; fields(i)%grid="grid_N" 389 i = i + 1; fields(i)%vname="sshb"; fields(i)%grid="grid_N" 390 i = i + 1; fields(i)%vname="rhop"; fields(i)%grid="grid_N_3D" 391 i = i + 1; fields(i)%vname="kt"; fields(i)%grid="grid_scalar" 392 i = i + 1; fields(i)%vname="ndastp"; fields(i)%grid="grid_scalar" 393 i = i + 1; fields(i)%vname="adatrj"; fields(i)%grid="grid_scalar" 394 i = i + 1; fields(i)%vname="utau_b"; fields(i)%grid="grid_N" 395 i = i + 1; fields(i)%vname="vtau_b"; fields(i)%grid="grid_N" 396 i = i + 1; fields(i)%vname="qns_b"; fields(i)%grid="grid_N" 397 i = i + 1; fields(i)%vname="emp_b"; fields(i)%grid="grid_N" 398 i = i + 1; fields(i)%vname="sfx_b"; fields(i)%grid="grid_N" 399 i = i + 1; fields(i)%vname="en" ; fields(i)%grid="grid_N_3D" 400 i = i + 1; fields(i)%vname="avt"; fields(i)%grid="grid_N_3D" 401 i = i + 1; fields(i)%vname="avm"; fields(i)%grid="grid_N_3D" 402 i = i + 1; fields(i)%vname="avmu"; fields(i)%grid="grid_N_3D" 403 i = i + 1; fields(i)%vname="avmv"; fields(i)%grid="grid_N_3D" 404 i = i + 1; fields(i)%vname="dissl"; fields(i)%grid="grid_N_3D" 405 i = i + 1; fields(i)%vname="sbc_hc_b"; fields(i)%grid="grid_N" 406 i = i + 1; fields(i)%vname="sbc_sc_b"; fields(i)%grid="grid_N" 407 i = i + 1; fields(i)%vname="qsr_hc_b"; fields(i)%grid="grid_N_3D" 408 i = i + 1; fields(i)%vname="fraqsr_1lev"; fields(i)%grid="grid_N" 409 i = i + 1; fields(i)%vname="frc_v"; fields(i)%grid="grid_scalar" 410 i = i + 1; fields(i)%vname="frc_t"; fields(i)%grid="grid_scalar" 411 i = i + 1; fields(i)%vname="frc_s"; fields(i)%grid="grid_scalar" 412 i = i + 1; fields(i)%vname="frc_wn_t"; fields(i)%grid="grid_scalar" 413 i = i + 1; fields(i)%vname="frc_wn_s"; fields(i)%grid="grid_scalar" 414 i = i + 1; fields(i)%vname="ssh_ini"; fields(i)%grid="grid_N" 415 i = i + 1; fields(i)%vname="e3t_ini"; fields(i)%grid="grid_N_3D" 416 i = i + 1; fields(i)%vname="hc_loc_ini"; fields(i)%grid="grid_N_3D" 417 i = i + 1; fields(i)%vname="sc_loc_ini"; fields(i)%grid="grid_N_3D" 418 i = i + 1; fields(i)%vname="ssh_hc_loc_ini"; fields(i)%grid="grid_N" 419 i = i + 1; fields(i)%vname="ssh_sc_loc_ini"; fields(i)%grid="grid_N" 420 i = i + 1; fields(i)%vname="tilde_e3t_b"; fields(i)%grid="grid_N" 421 i = i + 1; fields(i)%vname="tilde_e3t_n"; fields(i)%grid="grid_N" 422 i = i + 1; fields(i)%vname="hdiv_lf"; fields(i)%grid="grid_N" 423 i = i + 1; fields(i)%vname="ub2_b"; fields(i)%grid="grid_N" 424 i = i + 1; fields(i)%vname="vb2_b"; fields(i)%grid="grid_N" 425 i = i + 1; fields(i)%vname="sshbb_e"; fields(i)%grid="grid_N" 426 i = i + 1; fields(i)%vname="ubb_e"; fields(i)%grid="grid_N" 427 i = i + 1; fields(i)%vname="vbb_e"; fields(i)%grid="grid_N" 428 i = i + 1; fields(i)%vname="sshb_e"; fields(i)%grid="grid_N" 429 i = i + 1; fields(i)%vname="ub_e"; fields(i)%grid="grid_N" 430 i = i + 1; fields(i)%vname="vb_e"; fields(i)%grid="grid_N" 431 i = i + 1; fields(i)%vname="fwf_isf_b"; fields(i)%grid="grid_N" 432 i = i + 1; fields(i)%vname="isf_sc_b"; fields(i)%grid="grid_N" 433 i = i + 1; fields(i)%vname="isf_hc_b"; fields(i)%grid="grid_N" 434 i = i + 1; fields(i)%vname="ssh_ibb"; fields(i)%grid="grid_N" 435 i = i + 1; fields(i)%vname="rnf_b"; fields(i)%grid="grid_N" 436 i = i + 1; fields(i)%vname="rnf_hc_b"; fields(i)%grid="grid_N" 437 i = i + 1; fields(i)%vname="rnf_sc_b"; fields(i)%grid="grid_N" 438 i = i + 1; fields(i)%vname="nn_fsbc"; fields(i)%grid="grid_scalar" 439 i = i + 1; fields(i)%vname="ssu_m"; fields(i)%grid="grid_N" 440 i = i + 1; fields(i)%vname="ssv_m"; fields(i)%grid="grid_N" 441 i = i + 1; fields(i)%vname="sst_m"; fields(i)%grid="grid_N" 442 i = i + 1; fields(i)%vname="sss_m"; fields(i)%grid="grid_N" 443 i = i + 1; fields(i)%vname="ssh_m"; fields(i)%grid="grid_N" 444 i = i + 1; fields(i)%vname="e3t_m"; fields(i)%grid="grid_N" 445 i = i + 1; fields(i)%vname="frq_m"; fields(i)%grid="grid_N" 446 i = i + 1; fields(i)%vname="avmb"; fields(i)%grid="grid_vector" 447 i = i + 1; fields(i)%vname="avtb"; fields(i)%grid="grid_vector" 448 i = i + 1; fields(i)%vname="ub2_i_b"; fields(i)%grid="grid_N" 449 i = i + 1; fields(i)%vname="vb2_i_b"; fields(i)%grid="grid_N" 450 i = i + 1; fields(i)%vname="ntime"; fields(i)%grid="grid_scalar" 451 i = i + 1; fields(i)%vname="Dsst"; fields(i)%grid="grid_scalar" 452 i = i + 1; fields(i)%vname="tmask"; fields(i)%grid="grid_N_3D" 453 i = i + 1; fields(i)%vname="umask"; fields(i)%grid="grid_N_3D" 454 i = i + 1; fields(i)%vname="vmask"; fields(i)%grid="grid_N_3D" 455 i = i + 1; fields(i)%vname="smask"; fields(i)%grid="grid_N_3D" 456 i = i + 1; fields(i)%vname="gdepw_n"; fields(i)%grid="grid_N_3D" 457 i = i + 1; fields(i)%vname="e3t_n"; fields(i)%grid="grid_N_3D" 458 i = i + 1; fields(i)%vname="e3u_n"; fields(i)%grid="grid_N_3D" 459 i = i + 1; fields(i)%vname="e3v_n"; fields(i)%grid="grid_N_3D" 460 i = i + 1; fields(i)%vname="surf_ini"; fields(i)%grid="grid_N" 461 i = i + 1; fields(i)%vname="e3t_b"; fields(i)%grid="grid_N_3D" 462 i = i + 1; fields(i)%vname="mxln"; fields(i)%grid="grid_N_3D" 463 464 IF( i-1 > max_rst_fields) THEN 465 IF(lwp) write(numout,*) 'E R R O R : iom_set_rst_vars SIZE of RST_FIELD array is too small' 466 nstop = nstop + 1 467 ENDIF 468 469 END SUBROUTINE iom_set_rst_vars 470 471 472 SUBROUTINE iom_set_rstw_active(cdrst_file) 473 !!--------------------------------------------------------------------- 474 !! *** SUBROUTINE iom_set_rstr_active *** 475 !! 476 !! ** Purpose : define file name in XIOS context for writing restart 477 !! enable variables present in restart file for writing 478 !!--------------------------------------------------------------------- 479 !sets enabled = .TRUE. for each field in restart file 480 CHARACTER(len=*) :: cdrst_file 481 #if defined key_iomput 482 TYPE(xios_field) :: field_hdl 483 TYPE(xios_file) :: file_hdl 484 TYPE(xios_filegroup) :: filegroup_hdl 485 INTEGER :: i 486 CHARACTER(lc) :: clpath 487 488 !set name of the restart file and enable available fields 489 IF(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS write) to: ',cdrst_file 490 CALL xios_get_handle("file_definition", filegroup_hdl ) 491 CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 492 IF(nxioso.eq.1) THEN 493 CALL xios_set_file_attr( "wrestart", type="one_file", enabled=.TRUE.,& 494 mode="write", output_freq=xios_timestep) 495 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in one_file mode' 496 ELSE 497 CALL xios_set_file_attr( "wrestart", type="multiple_file", enabled=.TRUE.,& 498 mode="write", output_freq=xios_timestep) 499 if(lwp) write(numout,*) 'OPEN ', trim(cdrst_file), ' in multiple_file mode' 500 ENDIF 501 CALL xios_set_file_attr( "wrestart", name=trim(cdrst_file)) 502 !defin files for restart context 503 DO i = 1, max_rst_fields 504 IF( rst_wfields(i)%active ) THEN 505 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_wfields(i)%vname)) 506 SELECT CASE (TRIM(rst_wfields(i)%grid)) 507 CASE ("grid_N_3D") 508 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 509 domain_ref="grid_N", axis_ref="deptht", prec = 8, operation = "instant") 510 CASE ("grid_N") 511 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 512 domain_ref="grid_N", prec = 8, operation = "instant") 513 CASE ("grid_vector") 514 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 515 axis_ref="deptht", prec = 8, operation = "instant") 516 CASE ("grid_scalar") 517 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_wfields(i)%vname), & 518 scalar_ref = "grid_scalar", prec = 8, operation = "instant") 519 END SELECT 520 ENDIF 521 END DO 522 #endif 523 END SUBROUTINE iom_set_rstw_active 524 525 SUBROUTINE iom_set_rst_context( ) 526 !!--------------------------------------------------------------------- 527 !! *** SUBROUTINE iom_set_rstr_active *** 528 !! 529 !! ** Purpose : Define domain, axis and grid for restart (read/write) 530 !! context 531 !! 532 !!--------------------------------------------------------------------- 533 #if defined key_iomput 534 TYPE(xios_domaingroup) :: domaingroup_hdl 535 TYPE(xios_domain) :: domain_hdl 536 TYPE(xios_axisgroup) :: axisgroup_hdl 537 TYPE(xios_axis) :: axis_hdl 538 TYPE(xios_scalar) :: scalar_hdl 539 TYPE(xios_scalargroup) :: scalargroup_hdl 540 541 CALL xios_get_handle("domain_definition",domaingroup_hdl) 542 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 543 CALL set_grid("N", glamt, gphit, .TRUE.) 544 545 CALL xios_get_handle("axis_definition",axisgroup_hdl) 546 CALL xios_add_child(axisgroup_hdl, axis_hdl, "deptht") 547 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 548 ! CALL xios_set_axis_attr( "deptht", long_name="Vertical levels", unit="m", positive="down") 549 CALL xios_set_axis_attr( "deptht", long_name="Vertical levels in meters", positive="down") 550 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 551 552 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 553 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 554 #endif 555 END SUBROUTINE iom_set_rst_context 218 556 219 557 SUBROUTINE iom_swap( cdname ) … … 226 564 #if defined key_iomput 227 565 TYPE(xios_context) :: nemo_hdl 228 229 566 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 230 567 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 347 684 icnt = icnt + 1 348 685 END DO 686 ELSE 687 lxios_sini = .TRUE. 349 688 ENDIF 350 689 IF( llwrt ) THEN … … 530 869 !! INTERFACE iom_get 531 870 !!---------------------------------------------------------------------- 532 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )871 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 533 872 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 534 873 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 535 874 REAL(wp) , INTENT( out) :: pvar ! read field 536 875 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 876 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use xios to read restart 537 877 ! 538 878 INTEGER :: idvar ! variable id … … 542 882 CHARACTER(LEN=100) :: clname ! file name 543 883 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 884 LOGICAL :: llxios 885 ! 886 llxios = .FALSE. 887 IF( PRESENT(ldxios) ) llxios = ldxios 888 889 IF(.NOT.llxios) THEN ! read data using default library 890 itime = 1 891 IF( PRESENT(ktime) ) itime = ktime 892 ! 893 clname = iom_file(kiomid)%name 894 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 895 ! 896 IF( kiomid > 0 ) THEN 897 idvar = iom_varid( kiomid, cdvar ) 898 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 899 idmspc = iom_file ( kiomid )%ndims( idvar ) 900 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 901 WRITE(cldmspc , fmt='(i1)') idmspc 902 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 903 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 904 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 905 SELECT CASE (iom_file(kiomid)%iolib) 906 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 907 CASE DEFAULT 908 CALL ctl_stop( 'iom_g0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 909 END SELECT 910 ENDIF 911 ENDIF 912 ELSE 913 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 914 CALL iom_swap( TRIM(crxios_context) ) 915 CALL xios_recv_field( trim(cdvar), pvar) 916 CALL iom_swap( TRIM(cxios_context) ) 566 917 ENDIF 567 918 END SUBROUTINE iom_g0d 568 919 569 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )920 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 570 921 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 922 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 575 926 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 576 927 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 928 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 577 929 ! 578 930 IF( kiomid > 0 ) THEN 579 931 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 580 & ktime=ktime, kstart=kstart, kcount=kcount ) 932 & ktime=ktime, kstart=kstart, kcount=kcount, & 933 & ldxios=ldxios ) 581 934 ENDIF 582 935 END SUBROUTINE iom_g1d 583 936 584 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 937 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 585 938 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 586 939 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 594 947 ! called open_ocean_jstart to set the start 595 948 ! value for the 2nd dimension (netcdf only) 949 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 596 950 ! 597 951 IF( kiomid > 0 ) THEN 598 952 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 599 953 & ktime=ktime, kstart=kstart, kcount=kcount, & 600 & lrowattr=lrowattr 954 & lrowattr=lrowattr, ldxios=ldxios) 601 955 ENDIF 602 956 END SUBROUTINE iom_g2d 603 957 604 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )958 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 605 959 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 606 960 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 968 ! called open_ocean_jstart to set the start 615 969 ! value for the 2nd dimension (netcdf only) 970 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! read data using XIOS 616 971 ! 617 972 IF( kiomid > 0 ) THEN 618 973 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 619 974 & ktime=ktime, kstart=kstart, kcount=kcount, & 620 & lrowattr=lrowattr )975 & lrowattr=lrowattr, ldxios=ldxios ) 621 976 ENDIF 622 977 END SUBROUTINE iom_g3d … … 626 981 & pv_r1d, pv_r2d, pv_r3d, & 627 982 & ktime , kstart, kcount, & 628 & lrowattr 983 & lrowattr, ldxios ) 629 984 !!----------------------------------------------------------------------- 630 985 !! *** ROUTINE iom_get_123d *** … … 647 1002 ! called open_ocean_jstart to set the start 648 1003 ! value for the 2nd dimension (netcdf only) 649 ! 1004 LOGICAL , INTENT(in ), OPTIONAL :: ldxios ! use XIOS to read restart 1005 ! 1006 LOGICAL :: llxios ! local definition for XIOS read 650 1007 LOGICAL :: llnoov ! local definition to read overlap 651 1008 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 674 1031 !--------------------------------------------------------------------- 675 1032 ! 676 clname = iom_file(kiomid)%name ! esier to read 677 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 678 ! local definition of the domain ? 1033 REAL(wp) :: gma, gmi 1034 llxios = .FALSE. 1035 if(PRESENT(ldxios)) llxios = ldxios 1036 idvar = iom_varid( kiomid, cdvar ) 679 1037 idom = kdom 680 ! do we read the overlap 681 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 682 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 683 ! check kcount and kstart optionals parameters... 684 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 685 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 686 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 1038 1039 IF(.NOT.llxios) THEN 1040 clname = iom_file(kiomid)%name ! esier to read 1041 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 1042 ! local definition of the domain ? 1043 ! do we read the overlap 1044 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 1045 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 1046 ! check kcount and kstart optionals parameters... 1047 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 1048 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 1049 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 687 1050 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 688 1051 … … 701 1064 ENDIF 702 1065 703 ! Search for the variable in the data base (eventually actualize data) 704 istop = nstop 705 idvar = iom_varid( kiomid, cdvar ) 706 ! 707 IF( idvar > 0 ) THEN 708 ! to write iom_file(kiomid)%dimsz in a shorter way ! 709 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 710 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 711 idmspc = inbdim ! number of spatial dimensions in the file 712 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 713 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 714 ! 715 ! update idom definition... 716 ! Identify the domain in case of jpdom_auto(glo/dta) definition 717 IF( idom == jpdom_autoglo_xy ) THEN 718 ll_depth_spec = .TRUE. 719 idom = jpdom_autoglo 720 ELSE 721 ll_depth_spec = .FALSE. 722 ENDIF 723 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 724 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 725 ELSE ; idom = jpdom_data 726 ENDIF 727 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 728 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 729 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 730 ENDIF 731 ! Identify the domain in case of jpdom_local definition 732 IF( idom == jpdom_local ) THEN 733 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 734 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 735 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 736 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 737 ENDIF 738 ENDIF 739 ! 740 ! check the consistency between input array and data rank in the file 741 ! 742 ! initializations 743 itime = 1 744 IF( PRESENT(ktime) ) itime = ktime 745 746 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 747 WRITE(clrankpv, fmt='(i1)') irankpv 748 WRITE(cldmspc , fmt='(i1)') idmspc 749 ! 750 IF( idmspc < irankpv ) THEN 751 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 1066 ! Search for the variable in the data base (eventually actualize data) 1067 istop = nstop 1068 ! 1069 IF( idvar > 0 ) THEN 1070 ! to write iom_file(kiomid)%dimsz in a shorter way ! 1071 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 1072 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 1073 idmspc = inbdim ! number of spatial dimensions in the file 1074 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 1075 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 1076 ! 1077 ! update idom definition... 1078 ! Identify the domain in case of jpdom_auto(glo/dta) definition 1079 IF( idom == jpdom_autoglo_xy ) THEN 1080 ll_depth_spec = .TRUE. 1081 idom = jpdom_autoglo 1082 ELSE 1083 ll_depth_spec = .FALSE. 1084 ENDIF 1085 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 1086 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 1087 ELSE ; idom = jpdom_data 1088 ENDIF 1089 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 1090 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 1091 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 1092 ENDIF 1093 ! Identify the domain in case of jpdom_local definition 1094 IF( idom == jpdom_local ) THEN 1095 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 1096 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 1097 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 1098 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 1099 ENDIF 1100 ENDIF 1101 ! 1102 ! check the consistency between input array and data rank in the file 1103 ! 1104 ! initializations 1105 itime = 1 1106 IF( PRESENT(ktime) ) itime = ktime 1107 1108 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 1109 WRITE(clrankpv, fmt='(i1)') irankpv 1110 WRITE(cldmspc , fmt='(i1)') idmspc 1111 ! 1112 IF( idmspc < irankpv ) THEN 1113 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 752 1114 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 753 ELSEIF( idmspc == irankpv ) THEN754 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &1115 ELSEIF( idmspc == irankpv ) THEN 1116 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 755 1117 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 756 ELSEIF( idmspc > irankpv ) THEN757 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN758 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &1118 ELSEIF( idmspc > irankpv ) THEN 1119 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 1120 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 759 1121 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 760 1122 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 761 idmspc = idmspc - 1762 ELSE763 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &1123 idmspc = idmspc - 1 1124 ELSE 1125 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 764 1126 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 765 1127 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 766 ENDIF767 ENDIF768 769 !770 ! definition of istart and icnt771 !772 icnt (:) = 1773 istart(:) = 1774 istart(idmspc+1) = itime1128 ENDIF 1129 ENDIF 1130 1131 ! 1132 ! definition of istart and icnt 1133 ! 1134 icnt (:) = 1 1135 istart(:) = 1 1136 istart(idmspc+1) = itime 775 1137 776 1138 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN … … 793 1155 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 794 1156 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 795 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)1157 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 796 1158 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 797 1159 ! JMM + SM: ugly patch before getting the new version of lib_mpp) … … 810 1172 ENDIF 811 1173 812 ! check that istart and icnt can be used with this file813 !-814 DO jl = 1, jpmax_dims815 itmp = istart(jl)+icnt(jl)-1816 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN817 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp818 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)819 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )820 ENDIF821 END DO822 823 ! check that icnt matches the input array824 !-825 IF( idom == jpdom_unknown ) THEN826 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)827 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)828 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)829 ctmp1 = 'd'830 ELSE831 IF( irankpv == 2 ) THEN1174 ! check that istart and icnt can be used with this file 1175 !- 1176 DO jl = 1, jpmax_dims 1177 itmp = istart(jl)+icnt(jl)-1 1178 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 1179 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1180 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1181 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1182 ENDIF 1183 END DO 1184 1185 ! check that icnt matches the input array 1186 !- 1187 IF( idom == jpdom_unknown ) THEN 1188 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1189 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1190 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1191 ctmp1 = 'd' 1192 ELSE 1193 IF( irankpv == 2 ) THEN 832 1194 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 833 1195 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 834 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'835 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'836 ENDIF837 ENDIF838 IF( irankpv == 3 ) THEN1196 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1197 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1198 ENDIF 1199 ENDIF 1200 IF( irankpv == 3 ) THEN 839 1201 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 840 1202 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 841 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'842 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'843 ENDIF844 ENDIF845 ENDIF1203 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1204 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1205 ENDIF 1206 ENDIF 1207 ENDIF 846 1208 847 DO jl = 1, irankpv848 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)849 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )850 END DO851 852 ENDIF853 854 ! read the data855 !-856 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...857 !858 ! find the right index of the array to be read1209 DO jl = 1, irankpv 1210 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1211 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1212 END DO 1213 1214 ENDIF 1215 1216 ! read the data 1217 !- 1218 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1219 ! 1220 ! find the right index of the array to be read 859 1221 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 860 1222 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 861 1223 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 862 1224 ! ENDIF 863 IF( llnoov ) THEN864 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej865 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)866 ENDIF867 ELSE868 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj869 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)870 ENDIF871 ENDIF1225 IF( llnoov ) THEN 1226 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1227 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1228 ENDIF 1229 ELSE 1230 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1231 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1232 ENDIF 1233 ENDIF 872 1234 873 1235 SELECT CASE (iom_file(kiomid)%iolib) … … 878 1240 END SELECT 879 1241 880 IF( istop == nstop ) THEN ! no additional errors until this point...881 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)1242 IF( istop == nstop ) THEN ! no additional errors until this point... 1243 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 882 1244 883 !--- overlap areas and extra hallows (mpp) 884 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 885 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 886 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 887 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 888 IF( icnt(3) == jpk ) THEN 889 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 890 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 891 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 892 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 893 ENDIF 894 ENDIF 895 896 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 897 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 898 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 899 900 !--- Apply scale_factor and offset 901 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 902 zofs = iom_file(kiomid)%ofs(idvar) ! offset 903 IF( PRESENT(pv_r1d) ) THEN 904 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 905 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 906 ELSEIF( PRESENT(pv_r2d) ) THEN 907 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 908 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 909 ELSEIF( PRESENT(pv_r3d) ) THEN 910 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 911 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 912 ENDIF 913 ! 914 ENDIF 915 ! 916 ENDIF 917 ! 1245 !--- overlap areas and extra hallows (mpp) 1246 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1247 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1248 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1249 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1250 IF( icnt(3) == jpk ) THEN 1251 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1252 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1253 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1254 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1255 ENDIF 1256 ENDIF 1257 ! 1258 ELSE 1259 ! return if istop == nstop is false 1260 RETURN 1261 ENDIF 1262 ELSE 1263 ! return if statment idvar > 0 .AND. istop == nstop is false 1264 RETURN 1265 ENDIF 1266 ! 1267 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1268 #if defined key_iomput 1269 !would be good to be able to check which context is active and swap only if current is not restart 1270 CALL iom_swap( TRIM(crxios_context) ) 1271 IF( PRESENT(pv_r3d) ) THEN 1272 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1273 CALL xios_recv_field( trim(cdvar), pv_r3d) 1274 IF(idom /= jpdom_unknown ) then 1275 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1276 ENDIF 1277 ELSEIF( PRESENT(pv_r2d) ) THEN 1278 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1279 CALL xios_recv_field( trim(cdvar), pv_r2d) 1280 IF(idom /= jpdom_unknown ) THEN 1281 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1282 ENDIF 1283 ELSEIF( PRESENT(pv_r1d) ) THEN 1284 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1285 CALL xios_recv_field( trim(cdvar), pv_r1d) 1286 ENDIF 1287 CALL iom_swap( TRIM(cxios_context) ) 1288 #else 1289 istop = istop + 1 1290 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1291 #endif 1292 ENDIF 1293 !some final adjustments 1294 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1295 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1296 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1297 1298 !--- Apply scale_factor and offset 1299 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1300 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1301 IF( PRESENT(pv_r1d) ) THEN 1302 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1303 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1304 ELSEIF( PRESENT(pv_r2d) ) THEN 1305 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1306 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1307 ELSEIF( PRESENT(pv_r3d) ) THEN 1308 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1309 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1310 ENDIF 918 1311 END SUBROUTINE iom_get_123d 919 1312 … … 1115 1508 !! INTERFACE iom_rstput 1116 1509 !!---------------------------------------------------------------------- 1117 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype )1510 SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1118 1511 INTEGER , INTENT(in) :: kt ! ocean time-step 1119 1512 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1122 1515 REAL(wp) , INTENT(in) :: pvar ! written field 1123 1516 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1517 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1518 LOGICAL :: llx ! local xios write flag 1124 1519 INTEGER :: ivid ! variable id 1125 IF( kiomid > 0 ) THEN 1126 IF( iom_file(kiomid)%nfid > 0 ) THEN 1127 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1128 SELECT CASE (iom_file(kiomid)%iolib) 1129 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1130 CASE DEFAULT 1131 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1132 END SELECT 1520 1521 llx = .FALSE. 1522 IF(PRESENT(ldxios)) llx = ldxios 1523 IF( llx ) THEN 1524 #ifdef key_iomput 1525 IF( kt == kwrite ) THEN 1526 IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 1527 CALL xios_send_field(trim(cdvar), pvar) 1528 ENDIF 1529 #endif 1530 ELSE 1531 IF( kiomid > 0 ) THEN 1532 IF( iom_file(kiomid)%nfid > 0 ) THEN 1533 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1534 SELECT CASE (iom_file(kiomid)%iolib) 1535 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 1536 CASE DEFAULT 1537 CALL ctl_stop( 'iom_rp0d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1538 END SELECT 1539 ENDIF 1133 1540 ENDIF 1134 1541 ENDIF 1135 1542 END SUBROUTINE iom_rp0d 1136 1543 1137 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype )1544 SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1138 1545 INTEGER , INTENT(in) :: kt ! ocean time-step 1139 1546 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1142 1549 REAL(wp) , INTENT(in), DIMENSION( :) :: pvar ! written field 1143 1550 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1551 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1552 LOGICAL :: llx ! local xios write flag 1144 1553 INTEGER :: ivid ! variable id 1145 IF( kiomid > 0 ) THEN 1146 IF( iom_file(kiomid)%nfid > 0 ) THEN 1147 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1148 SELECT CASE (iom_file(kiomid)%iolib) 1149 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1150 CASE DEFAULT 1151 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1152 END SELECT 1554 1555 llx = .FALSE. 1556 IF(PRESENT(ldxios)) llx = ldxios 1557 IF( llx ) THEN 1558 #ifdef key_iomput 1559 IF( kt == kwrite ) THEN 1560 IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 1561 CALL xios_send_field(trim(cdvar), pvar) 1562 ENDIF 1563 #endif 1564 ELSE 1565 IF( kiomid > 0 ) THEN 1566 IF( iom_file(kiomid)%nfid > 0 ) THEN 1567 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1568 SELECT CASE (iom_file(kiomid)%iolib) 1569 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 1570 CASE DEFAULT 1571 CALL ctl_stop( 'iom_rp1d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1572 END SELECT 1573 ENDIF 1153 1574 ENDIF 1154 1575 ENDIF 1155 1576 END SUBROUTINE iom_rp1d 1156 1577 1157 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype )1578 SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1158 1579 INTEGER , INTENT(in) :: kt ! ocean time-step 1159 1580 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1162 1583 REAL(wp) , INTENT(in), DIMENSION(:, : ) :: pvar ! written field 1163 1584 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1585 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1586 LOGICAL :: llx 1164 1587 INTEGER :: ivid ! variable id 1165 IF( kiomid > 0 ) THEN 1166 IF( iom_file(kiomid)%nfid > 0 ) THEN 1167 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1168 SELECT CASE (iom_file(kiomid)%iolib) 1169 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1170 CASE DEFAULT 1171 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1172 END SELECT 1588 1589 llx = .FALSE. 1590 IF(PRESENT(ldxios)) llx = ldxios 1591 IF( llx ) THEN 1592 #ifdef key_iomput 1593 IF( kt == kwrite ) THEN 1594 IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 1595 CALL xios_send_field(trim(cdvar), pvar) 1596 ENDIF 1597 #endif 1598 ELSE 1599 IF( kiomid > 0 ) THEN 1600 IF( iom_file(kiomid)%nfid > 0 ) THEN 1601 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1602 SELECT CASE (iom_file(kiomid)%iolib) 1603 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 1604 CASE DEFAULT 1605 CALL ctl_stop( 'iom_rp2d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1606 END SELECT 1607 ENDIF 1173 1608 ENDIF 1174 1609 ENDIF 1175 1610 END SUBROUTINE iom_rp2d 1176 1611 1177 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype )1612 SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 1178 1613 INTEGER , INTENT(in) :: kt ! ocean time-step 1179 1614 INTEGER , INTENT(in) :: kwrite ! writing time-step … … 1182 1617 REAL(wp) , INTENT(in), DIMENSION(:,:,:) :: pvar ! written field 1183 1618 INTEGER , INTENT(in), OPTIONAL :: ktype ! variable external type 1619 LOGICAL, OPTIONAL :: ldxios ! xios write flag 1620 LOGICAL :: llx ! local xios write flag 1184 1621 INTEGER :: ivid ! variable id 1185 IF( kiomid > 0 ) THEN 1186 IF( iom_file(kiomid)%nfid > 0 ) THEN 1187 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1188 SELECT CASE (iom_file(kiomid)%iolib) 1189 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1190 CASE DEFAULT 1191 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1192 END SELECT 1622 1623 llx = .FALSE. 1624 IF(PRESENT(ldxios)) llx = ldxios 1625 IF( llx ) THEN 1626 #ifdef key_iomput 1627 IF( kt == kwrite ) THEN 1628 IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 1629 CALL xios_send_field(trim(cdvar), pvar) 1630 ENDIF 1631 #endif 1632 ELSE 1633 IF( kiomid > 0 ) THEN 1634 IF( iom_file(kiomid)%nfid > 0 ) THEN 1635 ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 1636 SELECT CASE (iom_file(kiomid)%iolib) 1637 CASE (jpnf90 ) ; CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 1638 CASE DEFAULT 1639 CALL ctl_stop( 'iom_rp3d: accepted IO library is only jpnf90 (jpioipsl option has been removed)' ) 1640 END SELECT 1641 ENDIF 1193 1642 ENDIF 1194 1643 ENDIF … … 1262 1711 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1263 1712 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1264 ENDIF1713 ENDIF 1265 1714 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1266 1715 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1368 1817 SUBROUTINE iom_context_finalize( cdname ) 1369 1818 CHARACTER(LEN=*), INTENT(in) :: cdname 1370 ! 1371 IF( xios_is_valid_context(cdname) ) THEN 1819 CHARACTER(LEN=120) :: clname 1820 ! 1821 clname = cdname 1822 IF( TRIM(Agrif_CFixed()) .NE. '0' ) clname = TRIM(Agrif_CFixed())//"_"//clname 1823 1824 IF( xios_is_valid_context(clname) ) THEN 1372 1825 CALL iom_swap( cdname ) ! swap to cdname context 1373 1826 CALL xios_context_finalize() ! finalize the context … … 1378 1831 1379 1832 1380 SUBROUTINE set_grid( cdgrd, plon, plat )1833 SUBROUTINE set_grid( cdgrd, plon, plat, ldxios ) 1381 1834 !!---------------------------------------------------------------------- 1382 1835 !! *** ROUTINE set_grid *** … … 1391 1844 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1392 1845 INTEGER :: ni,nj 1846 LOGICAL, INTENT(IN) :: ldxios 1393 1847 1394 1848 ni=nlei-nldi+1 ; nj=nlej-nldj+1 … … 1396 1850 CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 1397 1851 CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 1398 CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), &1852 if(.NOT.ldxios) CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), & 1399 1853 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1400 1854 1401 IF ( ln_mskland ) THEN1855 IF ( ln_mskland.AND.(.NOT.ldxios) ) THEN 1402 1856 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1403 1857 SELECT CASE ( cdgrd ) … … 1439 1893 ! Offset of coordinate representing bottom-left corner 1440 1894 SELECT CASE ( TRIM(cdgrd) ) 1441 CASE ('T', 'W' )1895 CASE ('T', 'W', 'N') 1442 1896 icnr = -1 ; jcnr = -1 1443 1897 CASE ('U')
Note: See TracChangeset
for help on using the changeset viewer.
