- Timestamp:
- 2017-10-11T13:03:17+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r8573 r8612 41 41 USE dianam ! build name of file 42 42 USE xios 43 USE iom_def, ONLY : max_rst_fields, rst_fields 43 44 # endif 44 45 USE ioipsl, ONLY : ju2ymds ! for calendar 45 46 USE crs ! Grid coarsening 47 USE lib_fortran 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 set_rst_vars, set_rstr_active, set_rst_context 65 68 # endif 66 69 … … 103 106 CHARACTER(len=10) :: clname 104 107 INTEGER :: ji, jkmin 108 LOGICAL :: lrst_context ! is context related to restart 105 109 ! 106 110 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds … … 113 117 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 114 118 CALL iom_swap( cdname ) 115 119 lrst_context = (TRIM(cdname) == TRIM(rxios_context)) 116 120 117 121 ! Calendar type is now defined in xml file … … 126 130 127 131 ! horizontal grid definition 128 CALL set_scalar132 IF(.NOT.lrst_context) CALL set_scalar 129 133 130 134 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 )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. ) 135 139 CALL set_grid_znl( gphit ) 136 140 ! … … 150 154 CALL dom_grid_crs ! Save the parent grid information & Switch to coarse grid domain 151 155 ! 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 )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. ) 156 160 CALL set_grid_znl( gphit_crs ) 157 161 ! 158 162 CALL dom_grid_glo ! Return to parent grid domain 159 163 ! 160 IF( ln_cfmeta ) THEN ! Add additional grid metadata164 IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN ! Add additional grid metadata 161 165 CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 162 166 CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) … … 171 175 172 176 ! 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 ) 177 IF(.NOT.lrst_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 ) 190 195 191 196 192 197 # if defined key_floats 193 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) )198 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 194 199 # endif 195 200 #if defined key_lim3 || defined key_lim2 196 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) )201 CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 197 202 #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 203 CALL iom_set_axis_attr( "icbcla", class_num ) 204 CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) ) 205 CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) ) 206 ENDIF 202 207 ! automatic definitions of some of the xml attributs 203 CALL set_xmlatt 208 IF( lrst_context ) THEN 209 !set names of the fields in restart file IF using XIOS to read/write data 210 CALL set_rst_context() 211 CALL set_rst_vars() 212 !set which fields are to be read from restart file 213 CALL set_rstr_active() 214 ELSE 215 CALL set_xmlatt 216 ENDIF 204 217 205 218 ! end file definition … … 213 226 214 227 #endif 215 228 216 229 END SUBROUTINE iom_init 217 230 231 232 SUBROUTINE set_rst_vars() 233 !set names for variables in restart file 234 INTEGER :: i 235 rst_fields(:)%vname="NO_NAME"; rst_fields(:)%grid="NO_GRID" 236 i = 0 237 i = i + 1; rst_fields(i)%vname="rdt"; rst_fields(i)% grid="grid_scalar" 238 i = i + 1; rst_fields(i)%vname="un"; rst_fields(i)% grid="grid_N_3D" 239 i = i + 1; rst_fields(i)%vname="ub"; rst_fields(i)% grid="grid_N_3D" 240 i = i + 1; rst_fields(i)%vname="vn"; rst_fields(i)% grid="grid_N_3D" 241 i = i + 1; rst_fields(i)%vname="vb"; rst_fields(i)% grid="grid_N_3D" 242 i = i + 1; rst_fields(i)%vname="tn"; rst_fields(i)% grid="grid_N_3D" 243 i = i + 1; rst_fields(i)%vname="tb"; rst_fields(i)% grid="grid_N_3D" 244 i = i + 1; rst_fields(i)%vname="sn"; rst_fields(i)% grid="grid_N_3D" 245 i = i + 1; rst_fields(i)%vname="sb"; rst_fields(i)%grid="grid_N_3D" 246 i = i + 1; rst_fields(i)%vname="sshn"; rst_fields(i)%grid="grid_N" 247 i = i + 1; rst_fields(i)%vname="sshb"; rst_fields(i)%grid="grid_N" 248 i = i + 1; rst_fields(i)%vname="rhop"; rst_fields(i)%grid="grid_N_3D" 249 i = i + 1; rst_fields(i)%vname="kt"; rst_fields(i)%grid="grid_scalar" 250 i = i + 1; rst_fields(i)%vname="ndastp"; rst_fields(i)%grid="grid_scalar" 251 i = i + 1; rst_fields(i)%vname="adatrj"; rst_fields(i)%grid="grid_scalar" 252 i = i + 1; rst_fields(i)%vname="utau_b"; rst_fields(i)%grid="grid_N" 253 i = i + 1; rst_fields(i)%vname="vtau_b"; rst_fields(i)%grid="grid_N" 254 i = i + 1; rst_fields(i)%vname="qns_b"; rst_fields(i)%grid="grid_N" 255 i = i + 1; rst_fields(i)%vname="emp_b"; rst_fields(i)%grid="grid_N" 256 i = i + 1; rst_fields(i)%vname="sfx_b"; rst_fields(i)%grid="grid_N" 257 i = i + 1; rst_fields(i)%vname="en" ; rst_fields(i)%grid="grid_N_3D" 258 i = i + 1; rst_fields(i)%vname="avt"; rst_fields(i)%grid="grid_N_3D" 259 i = i + 1; rst_fields(i)%vname="avm"; rst_fields(i)%grid="grid_N_3D" 260 i = i + 1; rst_fields(i)%vname="avmu"; rst_fields(i)%grid="grid_N_3D" 261 i = i + 1; rst_fields(i)%vname="avmv"; rst_fields(i)%grid="grid_N_3D" 262 i = i + 1; rst_fields(i)%vname="dissl"; rst_fields(i)%grid="grid_N_3D" 263 i = i + 1; rst_fields(i)%vname="sbc_hc_b"; rst_fields(i)%grid="grid_N" 264 i = i + 1; rst_fields(i)%vname="sbc_sc_b"; rst_fields(i)%grid="grid_N" 265 i = i + 1; rst_fields(i)%vname="qsr_hc_b"; rst_fields(i)%grid="grid_N_3D" 266 i = i + 1; rst_fields(i)%vname="fraqsr_1lev"; rst_fields(i)%grid="grid_N" 267 i = i + 1; rst_fields(i)%vname="greenland_icesheet_mass" 268 rst_fields(i)%grid="grid_scalar" 269 i = i + 1; rst_fields(i)%vname="greenland_icesheet_timelapsed" 270 rst_fields(i)%grid="grid_scalar" 271 i = i + 1; rst_fields(i)%vname="greenland_icesheet_mass_roc" 272 rst_fields(i)%grid="grid_scalar" 273 i = i + 1; rst_fields(i)%vname="antarctica_icesheet_mass" 274 rst_fields(i)%grid="grid_scalar" 275 i = i + 1; rst_fields(i)%vname="antarctica_icesheet_timelapsed" 276 rst_fields(i)%grid="grid_scalar" 277 i = i + 1; rst_fields(i)%vname="antarctica_icesheet_mass_roc" 278 rst_fields(i)%grid="grid_scalar" 279 i = i + 1; rst_fields(i)%vname="frc_v"; rst_fields(i)%grid="grid_scalar" 280 i = i + 1; rst_fields(i)%vname="frc_t"; rst_fields(i)%grid="grid_scalar" 281 i = i + 1; rst_fields(i)%vname="frc_s"; rst_fields(i)%grid="grid_scalar" 282 i = i + 1; rst_fields(i)%vname="frc_wn_t"; rst_fields(i)%grid="grid_scalar" 283 i = i + 1; rst_fields(i)%vname="frc_wn_s"; rst_fields(i)%grid="grid_scalar" 284 i = i + 1; rst_fields(i)%vname="ssh_ini"; rst_fields(i)%grid="grid_N" 285 i = i + 1; rst_fields(i)%vname="e3t_ini"; rst_fields(i)%grid="grid_N_3D" 286 i = i + 1; rst_fields(i)%vname="hc_loc_ini"; rst_fields(i)%grid="grid_N_3D" 287 i = i + 1; rst_fields(i)%vname="sc_loc_ini"; rst_fields(i)%grid="grid_N_3D" 288 i = i + 1; rst_fields(i)%vname="ssh_hc_loc_ini"; rst_fields(i)%grid="grid_N" 289 i = i + 1; rst_fields(i)%vname="ssh_sc_loc_ini"; rst_fields(i)%grid="grid_N" 290 i = i + 1; rst_fields(i)%vname="tilde_e3t_b"; rst_fields(i)%grid="grid_N" 291 i = i + 1; rst_fields(i)%vname="tilde_e3t_n"; rst_fields(i)%grid="grid_N" 292 i = i + 1; rst_fields(i)%vname="hdiv_lf"; rst_fields(i)%grid="grid_N" 293 i = i + 1; rst_fields(i)%vname="ub2_b"; rst_fields(i)%grid="grid_N" 294 i = i + 1; rst_fields(i)%vname="vb2_b"; rst_fields(i)%grid="grid_N" 295 i = i + 1; rst_fields(i)%vname="sshbb_e"; rst_fields(i)%grid="grid_N" 296 i = i + 1; rst_fields(i)%vname="ubb_e"; rst_fields(i)%grid="grid_N" 297 i = i + 1; rst_fields(i)%vname="vbb_e"; rst_fields(i)%grid="grid_N" 298 i = i + 1; rst_fields(i)%vname="sshb_e"; rst_fields(i)%grid="grid_N" 299 i = i + 1; rst_fields(i)%vname="ub_e"; rst_fields(i)%grid="grid_N" 300 i = i + 1; rst_fields(i)%vname="vb_e"; rst_fields(i)%grid="grid_N" 301 i = i + 1; rst_fields(i)%vname="fwf_isf_b"; rst_fields(i)%grid="grid_N" 302 i = i + 1; rst_fields(i)%vname="isf_sc_b"; rst_fields(i)%grid="grid_N" 303 i = i + 1; rst_fields(i)%vname="isf_hc_b"; rst_fields(i)%grid="grid_N" 304 i = i + 1; rst_fields(i)%vname="ssh_ibb"; rst_fields(i)%grid="grid_N" 305 i = i + 1; rst_fields(i)%vname="rnf_b"; rst_fields(i)%grid="grid_N" 306 i = i + 1; rst_fields(i)%vname="rnf_hc_b"; rst_fields(i)%grid="grid_N" 307 i = i + 1; rst_fields(i)%vname="rnf_sc_b"; rst_fields(i)%grid="grid_N" 308 i = i + 1; rst_fields(i)%vname="nn_fsbc"; rst_fields(i)%grid="grid_scalar" 309 i = i + 1; rst_fields(i)%vname="ssu_m"; rst_fields(i)%grid="grid_N" 310 i = i + 1; rst_fields(i)%vname="ssv_m"; rst_fields(i)%grid="grid_N" 311 i = i + 1; rst_fields(i)%vname="sst_m"; rst_fields(i)%grid="grid_N" 312 i = i + 1; rst_fields(i)%vname="sss_m"; rst_fields(i)%grid="grid_N" 313 i = i + 1; rst_fields(i)%vname="ssh_m"; rst_fields(i)%grid="grid_N" 314 i = i + 1; rst_fields(i)%vname="e3t_m"; rst_fields(i)%grid="grid_N" 315 i = i + 1; rst_fields(i)%vname="frq_m"; rst_fields(i)%grid="grid_N" 316 i = i + 1; rst_fields(i)%vname="avmb"; rst_fields(i)%grid="grid_vector" 317 i = i + 1; rst_fields(i)%vname="avtb"; rst_fields(i)%grid="grid_vector" 318 i = i + 1; rst_fields(i)%vname="ub2_i_b"; rst_fields(i)%grid="grid_N" 319 i = i + 1; rst_fields(i)%vname="vb2_i_b"; rst_fields(i)%grid="grid_N" 320 i = i + 1; rst_fields(i)%vname="ntime"; rst_fields(i)%grid="grid_scalar" 321 i = i + 1; rst_fields(i)%vname="Dsst"; rst_fields(i)%grid="grid_scalar" 322 i = i + 1; rst_fields(i)%vname="tmask"; rst_fields(i)%grid="grid_N_3D" 323 i = i + 1; rst_fields(i)%vname="umask"; rst_fields(i)%grid="grid_N_3D" 324 i = i + 1; rst_fields(i)%vname="vmask"; rst_fields(i)%grid="grid_N_3D" 325 i = i + 1; rst_fields(i)%vname="smask"; rst_fields(i)%grid="grid_N_3D" 326 i = i + 1; rst_fields(i)%vname="gdepw_n"; rst_fields(i)%grid="grid_N_3D" 327 i = i + 1; rst_fields(i)%vname="e3t_n"; rst_fields(i)%grid="grid_N_3D" 328 i = i + 1; rst_fields(i)%vname="e3u_n"; rst_fields(i)%grid="grid_N_3D" 329 i = i + 1; rst_fields(i)%vname="e3v_n"; rst_fields(i)%grid="grid_N_3D" 330 i = i + 1; rst_fields(i)%vname="surf_ini"; rst_fields(i)%grid="grid_N" 331 i = i + 1; rst_fields(i)%vname="e3t_b"; rst_fields(i)%grid="grid_N_3D" 332 i = i + 1; rst_fields(i)%vname="e3t_n"; rst_fields(i)%grid="grid_N_3D" 333 i = i + 1; rst_fields(i)%vname="mxln"; rst_fields(i)%grid="grid_N_3D" 334 i = i + 1; rst_fields(i)%vname="e3t_m"; rst_fields(i)%grid="grid_N_3D" 335 END SUBROUTINE set_rst_vars 336 337 338 SUBROUTINE set_rstr_active() 339 !sets enabled = .TRUE. for each field in restart file 340 CHARACTER(len=256) :: rst_file 341 TYPE(xios_field) :: field_hdl 342 TYPE(xios_file) :: file_hdl 343 TYPE(xios_filegroup) :: filegroup_hdl 344 INTEGER :: i 345 CHARACTER(lc) :: clpath 346 347 clpath = TRIM(cn_ocerst_indir) 348 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 349 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 350 rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 351 ELSE 352 rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 353 ENDIF 354 !set name of the restart file and enable available fields 355 if(lwp) WRITE(numout,*) 'Setting restart filename (for XIOS) to: ',rst_file 356 CALL xios_get_handle("file_definition", filegroup_hdl ) 357 CALL xios_add_child(filegroup_hdl, file_hdl, 'rrestart') 358 CALL xios_set_file_attr( "rrestart", name=trim(rst_file), type="one_file", & 359 par_access="collective", enabled=.TRUE., mode="read", & 360 output_freq=xios_timestep) 361 !defin files for restart context 362 DO i = 1, max_rst_fields 363 IF( TRIM(rst_fields(i)%vname) /= "NO_NAME") THEN 364 IF( iom_varid( numror, TRIM(rst_fields(i)%vname), ldstop = .FALSE. ) > 0 ) THEN 365 CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 366 SELECT CASE (TRIM(rst_fields(i)%grid)) 367 CASE ("grid_N_3D") 368 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_fields(i)%vname), & 369 domain_ref="grid_N", axis_ref="deptht", operation = "instant") 370 CASE ("grid_N") 371 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_fields(i)%vname), & 372 domain_ref="grid_N", operation = "instant") 373 CASE ("grid_vector") 374 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_fields(i)%vname), & 375 axis_ref="deptht", operation = "instant") 376 CASE ("grid_scalar") 377 CALL xios_set_attr (field_hdl, enabled = .TRUE., name = TRIM(rst_fields(i)%vname), & 378 scalar_ref = "grid_scalar", operation = "instant") 379 END SELECT 380 IF(lwp) WRITE(numout,*) 'XIOS read: ', TRIM(rst_fields(i)%vname), ' enabled in ', TRIM(rst_file) 381 ENDIF 382 ENDIF 383 END DO 384 END SUBROUTINE set_rstr_active 385 386 SUBROUTINE set_rst_context( ) 387 #if defined key_iomput 388 TYPE(xios_domaingroup) :: domaingroup_hdl 389 TYPE(xios_domain) :: domain_hdl 390 TYPE(xios_axisgroup) :: axisgroup_hdl 391 TYPE(xios_axis) :: axis_hdl 392 TYPE(xios_scalar) :: scalar_hdl 393 TYPE(xios_scalargroup) :: scalargroup_hdl 394 395 CALL xios_get_handle("domain_definition",domaingroup_hdl) 396 CALL xios_add_child(domaingroup_hdl, domain_hdl, "grid_N") 397 CALL set_grid("N", glamt, gphit, .TRUE.) 398 399 CALL xios_get_handle("axis_definition",axisgroup_hdl) 400 CALL xios_add_child(axisgroup_hdl, axis_hdl, "deptht") 401 !AGRIF fails to compile when unit= is in call to xios_set_axis_attr 402 ! CALL xios_set_axis_attr( "deptht", long_name="Vertical levels", unit="m", positive="down") 403 CALL xios_set_axis_attr( "deptht", long_name="Vertical levels in meters", positive="down") 404 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 405 406 CALL xios_get_handle("scalar_definition", scalargroup_hdl) 407 CALL xios_add_child(scalargroup_hdl, scalar_hdl, "grid_scalar") 408 #endif 409 END SUBROUTINE set_rst_context 218 410 219 411 SUBROUTINE iom_swap( cdname ) … … 347 539 icnt = icnt + 1 348 540 END DO 541 ELSE 542 lxios_sini = .TRUE. 349 543 ENDIF 350 544 IF( llwrt ) THEN … … 530 724 !! INTERFACE iom_get 531 725 !!---------------------------------------------------------------------- 532 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )726 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, lrxios ) 533 727 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 534 728 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 535 729 REAL(wp) , INTENT( out) :: pvar ! read field 536 730 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 731 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use xios to read restart 537 732 ! 538 733 INTEGER :: idvar ! variable id … … 542 737 CHARACTER(LEN=100) :: clname ! file name 543 738 CHARACTER(LEN=1) :: cldmspc ! 739 LOGICAL :: lxios 544 740 ! 545 741 itime = 1 … … 567 763 END SUBROUTINE iom_g0d 568 764 569 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )765 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrxios ) 570 766 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 767 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 575 771 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 576 772 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 773 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 577 774 ! 578 775 IF( kiomid > 0 ) THEN 579 776 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 580 & ktime=ktime, kstart=kstart, kcount=kcount ) 777 & ktime=ktime, kstart=kstart, kcount=kcount, & 778 & lrxios=lrxios ) 581 779 ENDIF 582 780 END SUBROUTINE iom_g1d 583 781 584 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 782 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios) 585 783 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 586 784 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 594 792 ! called open_ocean_jstart to set the start 595 793 ! value for the 2nd dimension (netcdf only) 794 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 596 795 ! 597 796 IF( kiomid > 0 ) THEN 598 797 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 599 798 & ktime=ktime, kstart=kstart, kcount=kcount, & 600 & lrowattr=lrowattr 799 & lrowattr=lrowattr, lrxios=lrxios) 601 800 ENDIF 602 801 END SUBROUTINE iom_g2d 603 802 604 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )803 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios ) 605 804 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 606 805 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 813 ! called open_ocean_jstart to set the start 615 814 ! value for the 2nd dimension (netcdf only) 815 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 616 816 ! 617 817 IF( kiomid > 0 ) THEN 618 818 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 619 819 & ktime=ktime, kstart=kstart, kcount=kcount, & 620 & lrowattr=lrowattr )820 & lrowattr=lrowattr, lrxios=lrxios ) 621 821 ENDIF 622 822 END SUBROUTINE iom_g3d … … 626 826 & pv_r1d, pv_r2d, pv_r3d, & 627 827 & ktime , kstart, kcount, & 628 & lrowattr 828 & lrowattr, lrxios ) 629 829 !!----------------------------------------------------------------------- 630 830 !! *** ROUTINE iom_get_123d *** … … 647 847 ! called open_ocean_jstart to set the start 648 848 ! value for the 2nd dimension (netcdf only) 649 ! 849 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use XIOS to read restart 850 ! 851 LOGICAL :: lxios ! local definition for XIOS read 650 852 LOGICAL :: llnoov ! local definition to read overlap 651 853 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 674 876 !--------------------------------------------------------------------- 675 877 ! 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 ? 878 REAL(wp) :: gma, gmi 879 lxios = .FALSE. 880 if(PRESENT(lrxios)) lxios = lrxios 881 idvar = iom_varid( kiomid, cdvar ) 679 882 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 ) & 883 884 IF(.NOT.lxios) THEN 885 clname = iom_file(kiomid)%name ! esier to read 886 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 887 ! local definition of the domain ? 888 ! do we read the overlap 889 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 890 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 891 ! check kcount and kstart optionals parameters... 892 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 893 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 894 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 687 895 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 688 896 … … 701 909 ENDIF 702 910 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', & 911 ! Search for the variable in the data base (eventually actualize data) 912 istop = nstop 913 ! 914 IF( idvar > 0 ) THEN 915 ! to write iom_file(kiomid)%dimsz in a shorter way ! 916 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 917 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 918 idmspc = inbdim ! number of spatial dimensions in the file 919 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 920 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 921 ! 922 ! update idom definition... 923 ! Identify the domain in case of jpdom_auto(glo/dta) definition 924 IF( idom == jpdom_autoglo_xy ) THEN 925 ll_depth_spec = .TRUE. 926 idom = jpdom_autoglo 927 ELSE 928 ll_depth_spec = .FALSE. 929 ENDIF 930 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 931 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 932 ELSE ; idom = jpdom_data 933 ENDIF 934 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 935 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 936 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 937 ENDIF 938 ! Identify the domain in case of jpdom_local definition 939 IF( idom == jpdom_local ) THEN 940 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 941 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 942 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 943 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 944 ENDIF 945 ENDIF 946 ! 947 ! check the consistency between input array and data rank in the file 948 ! 949 ! initializations 950 itime = 1 951 IF( PRESENT(ktime) ) itime = ktime 952 953 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 954 WRITE(clrankpv, fmt='(i1)') irankpv 955 WRITE(cldmspc , fmt='(i1)') idmspc 956 ! 957 IF( idmspc < irankpv ) THEN 958 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 752 959 & '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 ) &960 ELSEIF( idmspc == irankpv ) THEN 961 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 755 962 & 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...' , &963 ELSEIF( idmspc > irankpv ) THEN 964 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 965 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 759 966 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 760 967 & '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,' , &968 idmspc = idmspc - 1 969 ELSE 970 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 764 971 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 765 972 & '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) = itime973 ENDIF 974 ENDIF 975 976 ! 977 ! definition of istart and icnt 978 ! 979 icnt (:) = 1 980 istart(:) = 1 981 istart(idmspc+1) = itime 775 982 776 983 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN … … 793 1000 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 794 1001 ! 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 /)1002 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 796 1003 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 797 1004 ! JMM + SM: ugly patch before getting the new version of lib_mpp) … … 810 1017 ENDIF 811 1018 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 ) THEN1019 ! check that istart and icnt can be used with this file 1020 !- 1021 DO jl = 1, jpmax_dims 1022 itmp = istart(jl)+icnt(jl)-1 1023 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 1024 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 1025 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 1026 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 1027 ENDIF 1028 END DO 1029 1030 ! check that icnt matches the input array 1031 !- 1032 IF( idom == jpdom_unknown ) THEN 1033 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1034 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1035 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1036 ctmp1 = 'd' 1037 ELSE 1038 IF( irankpv == 2 ) THEN 832 1039 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 833 1040 ! 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 ) THEN1041 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1042 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1043 ENDIF 1044 ENDIF 1045 IF( irankpv == 3 ) THEN 839 1046 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 840 1047 ! 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 ENDIF1048 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1049 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1050 ENDIF 1051 ENDIF 1052 ENDIF 846 1053 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 read1054 DO jl = 1, irankpv 1055 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1056 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1057 END DO 1058 1059 ENDIF 1060 1061 ! read the data 1062 !- 1063 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1064 ! 1065 ! find the right index of the array to be read 859 1066 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 860 1067 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 861 1068 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 862 1069 ! 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 ENDIF1070 IF( llnoov ) THEN 1071 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1072 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1073 ENDIF 1074 ELSE 1075 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1076 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1077 ENDIF 1078 ENDIF 872 1079 873 1080 SELECT CASE (iom_file(kiomid)%iolib) … … 878 1085 END SELECT 879 1086 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)1087 IF( istop == nstop ) THEN ! no additional errors until this point... 1088 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 882 1089 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 ! 1090 !--- overlap areas and extra hallows (mpp) 1091 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1092 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1093 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1094 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1095 IF( icnt(3) == jpk ) THEN 1096 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1097 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1098 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1099 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1100 ENDIF 1101 ENDIF 1102 ! 1103 ELSE 1104 ! return if istop == nstop is false 1105 RETURN 1106 ENDIF 1107 ELSE 1108 ! return if statment idvar > 0 .AND. istop == nstop is false 1109 RETURN 1110 ENDIF 1111 ! 1112 ELSE ! read using XIOS. Only if KEY_IOMPUT is defined 1113 #if defined key_iomput 1114 !would be good to be able to check which context is active and swap only if current is not restart 1115 CALL iom_swap( TRIM(rxios_context) ) 1116 IF( PRESENT(pv_r3d) ) THEN 1117 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1118 CALL xios_recv_field( trim(cdvar), pv_r3d) 1119 IF(idom /= jpdom_unknown ) then 1120 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1121 ENDIF 1122 ELSEIF( PRESENT(pv_r2d) ) THEN 1123 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1124 CALL xios_recv_field( trim(cdvar), pv_r2d) 1125 IF(idom /= jpdom_unknown ) THEN 1126 CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1127 ENDIF 1128 ELSEIF( PRESENT(pv_r1d) ) THEN 1129 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1130 CALL xios_recv_field( trim(cdvar), pv_r1d) 1131 ENDIF 1132 CALL iom_swap( TRIM(cxios_context) ) 1133 #else 1134 istop = istop + 1 1135 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1136 #endif 1137 ENDIF 1138 !some final adjustments 1139 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1140 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1141 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1142 1143 !--- Apply scale_factor and offset 1144 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1145 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1146 IF( PRESENT(pv_r1d) ) THEN 1147 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1148 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1149 ELSEIF( PRESENT(pv_r2d) ) THEN 1150 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 1151 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1152 ELSEIF( PRESENT(pv_r3d) ) THEN 1153 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 1154 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1155 ENDIF 918 1156 END SUBROUTINE iom_get_123d 919 1157 … … 1262 1500 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1263 1501 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1264 ENDIF1502 ENDIF 1265 1503 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1266 1504 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & … … 1378 1616 1379 1617 1380 SUBROUTINE set_grid( cdgrd, plon, plat )1618 SUBROUTINE set_grid( cdgrd, plon, plat, lxios ) 1381 1619 !!---------------------------------------------------------------------- 1382 1620 !! *** ROUTINE set_grid *** … … 1391 1629 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask 1392 1630 INTEGER :: ni,nj 1631 LOGICAL, INTENT(IN) :: lxios 1393 1632 1394 1633 ni=nlei-nldi+1 ; nj=nlej-nldj+1 … … 1399 1638 & latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 1400 1639 1401 IF ( ln_mskland ) THEN1640 IF ( ln_mskland.AND.(.NOT.lxios) ) THEN 1402 1641 ! mask land points, keep values on coast line -> specific mask for U, V and W points 1403 1642 SELECT CASE ( cdgrd ) … … 1439 1678 ! Offset of coordinate representing bottom-left corner 1440 1679 SELECT CASE ( TRIM(cdgrd) ) 1441 CASE ('T', 'W' )1680 CASE ('T', 'W', 'N') 1442 1681 icnr = -1 ; jcnr = -1 1443 1682 CASE ('U')
Note: See TracChangeset
for help on using the changeset viewer.
