Changeset 7924
- Timestamp:
- 2017-04-18T15:42:46+02:00 (8 years ago)
- Location:
- branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r6487 r7924 32 32 USE timing ! preformance summary 33 33 USE wrk_nemo ! work arrays 34 USE iom_def, ONLY : lxios_read 34 35 35 36 IMPLICIT NONE … … 254 255 IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 255 256 IF(lwp) WRITE(numout,*) '~~~~~~~' 256 CALL iom_get( numror, 'frc_v', frc_v )257 CALL iom_get( numror, 'frc_t', frc_t )258 CALL iom_get( numror, 'frc_s', frc_s )257 CALL iom_get( numror, 'frc_v', frc_v, lrxios = lxios_read ) 258 CALL iom_get( numror, 'frc_t', frc_t, lrxios = lxios_read ) 259 CALL iom_get( numror, 'frc_s', frc_s, lrxios = lxios_read ) 259 260 IF( .NOT. lk_vvl ) THEN 260 CALL iom_get( numror, 'frc_wn_t', frc_wn_t )261 CALL iom_get( numror, 'frc_wn_s', frc_wn_s )261 CALL iom_get( numror, 'frc_wn_t', frc_wn_t, lrxios = lxios_read ) 262 CALL iom_get( numror, 'frc_wn_s', frc_wn_s, lrxios = lxios_read ) 262 263 ENDIF 263 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini )264 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini )265 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini )266 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini )264 CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini, lrxios = lxios_read ) 265 CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini, lrxios = lxios_read ) 266 CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, lrxios = lxios_read ) 267 CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, lrxios = lxios_read ) 267 268 IF( .NOT. lk_vvl ) THEN 268 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini )269 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini )269 CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, lrxios = lxios_read ) 270 CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, lrxios = lxios_read ) 270 271 ENDIF 271 272 ELSE -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r6487 r7924 35 35 USE timing ! Timing 36 36 USE restart ! restart 37 USE iom_def, ONLY : lxios_read 37 38 38 39 IMPLICIT NONE … … 309 310 IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 310 311 ! Get Calendar informations 311 CALL iom_get( numror, 'kt', zkt ) ! last time-step of previous run312 CALL iom_get( numror, 'kt', zkt, lrxios = lxios_read ) ! last time-step of previous run 312 313 IF(lwp) THEN 313 314 WRITE(numout,*) ' *** Info read in restart : ' … … 328 329 IF ( nrstdt == 2 ) THEN 329 330 ! read the parameters correspondting to nit000 - 1 (last time step of previous run) 330 CALL iom_get( numror, 'ndastp', zndastp )331 CALL iom_get( numror, 'ndastp', zndastp, lrxios = lxios_read ) 331 332 ndastp = NINT( zndastp ) 332 CALL iom_get( numror, 'adatrj', adatrj )333 CALL iom_get( numror, 'adatrj', adatrj, lrxios = lxios_read ) 333 334 ELSE 334 335 ! parameters correspondting to nit000 - 1 (as we start the step loop with a call to day) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90
r6491 r7924 38 38 USE timing ! Timing 39 39 USE lbclnk ! ocean lateral boundary condition (or mpp link) 40 USE iom_def, ONLY:lxios_read 40 41 41 42 IMPLICIT NONE … … 138 139 & nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , ln_rstdate, nn_rstctl, & 139 140 & nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , & 140 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler 141 & nn_write, ln_dimgnnn, ln_mskland , ln_cfmeta , ln_clobber, nn_chunksz, nn_euler, & 142 & lr_xios 141 143 NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin, & 142 144 & nn_acc , rn_atfp , rn_rdt , rn_rdtmin , & … … 193 195 WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber 194 196 WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz 197 WRITE(numout,*) ' READ restart for a single file using XIOS = ', lr_xios 195 198 ENDIF 196 199 … … 207 210 nwrite = nn_write 208 211 neuler = nn_euler 212 lxios_read = lr_xios 209 213 IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 210 214 WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r6498 r7924 33 33 USE wrk_nemo ! Memory allocation 34 34 USE timing ! Timing 35 USE iom_def, ONLY : lxios_read 35 36 36 37 IMPLICIT NONE … … 817 818 IF( ln_rstart ) THEN !* Read the restart file 818 819 CALL rst_read_open ! open the restart file if necessary 819 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn )820 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, lrxios = lxios_read ) 820 821 ! 821 822 id1 = iom_varid( numror, 'fse3t_b', ldstop = .FALSE. ) … … 828 829 ! ! --------- ! 829 830 IF( MIN( id1, id2 ) > 0 ) THEN ! all required arrays exist 830 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )831 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) )831 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:), lrxios = lxios_read ) 832 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:), lrxios = lxios_read ) 832 833 ! needed to restart if land processor not computed 833 834 IF(lwp) write(numout,*) 'dom_vvl_rst : fse3t_b and fse3t_n found in restart files' … … 843 844 IF(lwp) write(numout,*) 'fse3t_n set equal to fse3t_b.' 844 845 IF(lwp) write(numout,*) 'neuler is forced to 0' 845 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:) )846 CALL iom_get( numror, jpdom_autoglo, 'fse3t_b', fse3t_b(:,:,:), lrxios = lxios_read ) 846 847 fse3t_n(:,:,:) = fse3t_b(:,:,:) 847 848 neuler = 0 … … 850 851 IF(lwp) write(numout,*) 'fse3t_b set equal to fse3t_n.' 851 852 IF(lwp) write(numout,*) 'neuler is forced to 0' 852 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:) )853 CALL iom_get( numror, jpdom_autoglo, 'fse3t_n', fse3t_n(:,:,:), lrxios = lxios_read ) 853 854 fse3t_b(:,:,:) = fse3t_n(:,:,:) 854 855 neuler = 0 … … 875 876 ! ! ----------------------- ! 876 877 IF( MIN( id3, id4 ) > 0 ) THEN ! all required arrays exist 877 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) )878 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) )878 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), lrxios = lxios_read ) 879 CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), lrxios = lxios_read ) 879 880 ELSE ! one at least array is missing 880 881 tilde_e3t_b(:,:,:) = 0.0_wp … … 885 886 ! ! ------------ ! 886 887 IF( id5 > 0 ) THEN ! required array exists 887 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) )888 CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), lrxios = lxios_read ) 888 889 ELSE ! array is missing 889 890 hdiv_lf(:,:,:) = 0.0_wp -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r7923 r7924 51 51 USE agrif_opa_interp 52 52 #endif 53 USE iom_def, ONLY : lxios_read 53 54 54 55 IMPLICIT NONE … … 395 396 ! Caution : extra-hallow 396 397 ! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 397 CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )398 CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )398 CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj), lrxios = lxios_read ) ! make sure domain is fine!!!! 399 CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj), lrxios = lxios_read ) ! make sure domain is fine!!!! 399 400 IF( neuler == 0 ) gcxb(:,:) = gcx (:,:) 400 401 ELSE -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r6487 r7924 48 48 USE asminc ! Assimilation increment 49 49 #endif 50 USE iom_def, ONLY : lxios_read 50 51 51 52 IMPLICIT NONE … … 1019 1020 ! 1020 1021 IF( TRIM(cdrw) == 'READ' ) THEN 1021 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:) )1022 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:) )1022 CALL iom_get( numror, jpdom_autoglo, 'ub2_b' , ub2_b (:,:), lrxios = lxios_read ) 1023 CALL iom_get( numror, jpdom_autoglo, 'vb2_b' , vb2_b (:,:), lrxios = lxios_read ) 1023 1024 IF( .NOT.ln_bt_av ) THEN 1024 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:) )1025 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:) )1026 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:) )1027 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:) )1028 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:) )1029 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:) )1025 CALL iom_get( numror, jpdom_autoglo, 'sshbb_e' , sshbb_e(:,:), lrxios = lxios_read ) 1026 CALL iom_get( numror, jpdom_autoglo, 'ubb_e' , ubb_e(:,:), lrxios = lxios_read ) 1027 CALL iom_get( numror, jpdom_autoglo, 'vbb_e' , vbb_e(:,:), lrxios = lxios_read ) 1028 CALL iom_get( numror, jpdom_autoglo, 'sshb_e' , sshb_e(:,:), lrxios = lxios_read ) 1029 CALL iom_get( numror, jpdom_autoglo, 'ub_e' , ub_e(:,:), lrxios = lxios_read ) 1030 CALL iom_get( numror, jpdom_autoglo, 'vb_e' , vb_e(:,:), lrxios = lxios_read ) 1030 1031 ENDIF 1031 1032 #if defined key_agrif -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r6491 r7924 49 49 LOGICAL :: ln_clobber !: clobber (overwrite) an existing file 50 50 INTEGER :: nn_chunksz !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 51 LOGICAL :: lr_xios !: use xios to read single file restart 51 52 #if defined key_netcdf4 52 53 !!---------------------------------------------------------------------- … … 152 153 LOGICAL :: lsp_area = .TRUE. !: to make a control print over a specific area 153 154 CHARACTER(lc) :: cxios_context !: context name used in xios 155 CHARACTER(lc) :: rxios_context !: context name used in xios to read restart 154 156 155 157 !!---------------------------------------------------------------------- -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r7923 r7924 53 53 LOGICAL, PUBLIC, PARAMETER :: lk_iomput = .FALSE. !: iom_put flag 54 54 #endif 55 INTEGER, PRIVATE, PARAMETER :: max_rst_fields = 85 ! maximum number of variables in a restart file 55 56 PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 56 57 PUBLIC iom_getatt, iom_use, iom_context_finalize … … 62 63 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 63 64 PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 65 PRIVATE set_active_rst_fields 64 66 # endif 65 67 … … 141 143 CALL set_scalar 142 144 143 IF( TRIM(cdname) == TRIM(cxios_context) ) THEN145 IF( TRIM(cdname) == TRIM(cxios_context) .OR. TRIM(cdname) == TRIM(rxios_context)) THEN 144 146 CALL set_grid( "T", glamt, gphit ) 145 147 CALL set_grid( "U", glamu, gphiu ) … … 184 186 185 187 ! vertical grid definition 186 CALL iom_set_axis_attr( "deptht", gdept_1d )187 CALL iom_set_axis_attr( "depthu", gdept_1d )188 CALL iom_set_axis_attr( "depthv", gdept_1d )189 CALL iom_set_axis_attr( "depthw", gdepw_1d )188 CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 189 CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 190 CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 191 CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 190 192 191 193 ! Add vertical grid bounds … … 227 229 228 230 ! automatic definitions of some of the xml attributs 229 CALL set_xmlatt 231 IF( TRIM(cdname) == TRIM(rxios_context)) THEN 232 CALL set_active_rst_fields 233 ELSE 234 CALL set_xmlatt 235 ENDIF 230 236 231 237 CALL set_1point … … 241 247 242 248 #endif 243 249 244 250 END SUBROUTINE iom_init 245 251 252 SUBROUTINE set_active_rst_fields 253 !sets enabled = .TRUE. for each field in restart file 254 CHARACTER(len=30),DIMENSION(max_rst_fields) :: rst_fields 255 INTEGER :: i 256 257 rst_fields(:)="NO_NAME" 258 259 rst_fields(1)="rdt" 260 rst_fields(2)="rdttra1" 261 rst_fields(3)="un" 262 rst_fields(4)="ub" 263 rst_fields(5)="vn" 264 rst_fields(6)="vb" 265 rst_fields(7)="tn" 266 rst_fields(8)="tb" 267 rst_fields(9)="sn" 268 rst_fields(10)="sb" 269 rst_fields(11)="sshn" 270 rst_fields(12)="sshb" 271 rst_fields(13)="hdivn" 272 rst_fields(14)="hdivb" 273 rst_fields(15)="rhop" 274 rst_fields(16)="rotn" 275 rst_fields(17)="rotb" 276 rst_fields(18)="kt" 277 rst_fields(19)="ndastp" 278 rst_fields(20)="adatrj" 279 rst_fields(21)="utau_b" 280 rst_fields(22)="vtau_b" 281 rst_fields(23)="qns_b" 282 rst_fields(24)="emp_b" 283 rst_fields(25)="sfx_b" 284 rst_fields(26)="en" 285 rst_fields(27)="avt" 286 rst_fields(28)="avm" 287 rst_fields(29)="avmu" 288 rst_fields(30)="avmv" 289 rst_fields(31)="dissl" 290 rst_fields(32)="sbc_hc_b" 291 rst_fields(33)="sbc_sc_b" 292 rst_fields(34)="qsr_hc_b" 293 rst_fields(35)="gcx" 294 rst_fields(36)="gcxb" 295 rst_fields(37)="fraqsr_1lev" 296 rst_fields(38)="greenland_icesheet_mass" 297 rst_fields(39)="greenland_icesheet_timelapsed" 298 rst_fields(40)="greenland_icesheet_mass_roc" 299 rst_fields(41)="antarctica_icesheet_mass" 300 rst_fields(42)="antarctica_icesheet_timelapsed" 301 rst_fields(43)="antarctica_icesheet_mass_roc" 302 rst_fields(44)="rhd" 303 rst_fields(45)="frc_v" 304 rst_fields(46)="frc_t" 305 rst_fields(47)="frc_s" 306 rst_fields(48)="frc_wn_t" 307 rst_fields(49)="frc_wn_s" 308 rst_fields(50)="ssh_ini" 309 rst_fields(51)="e3t_ini" 310 rst_fields(52)="hc_loc_ini" 311 rst_fields(53)="sc_loc_ini" 312 rst_fields(54)="ssh_hc_loc_ini" 313 rst_fields(55)="ssh_sc_loc_ini" 314 rst_fields(56)="fse3t_b" 315 rst_fields(57)="fse3t_n" 316 rst_fields(58)="tilde_e3t_b" 317 rst_fields(59)="tilde_e3t_n" 318 rst_fields(60)="hdiv_lf" 319 rst_fields(61)="ub2_b" 320 rst_fields(62)="vb2_b" 321 rst_fields(63)="sshbb_e" 322 rst_fields(64)="ubb_e" 323 rst_fields(65)="vbb_e" 324 rst_fields(66)="sshb_e" 325 rst_fields(67)="ub_e" 326 rst_fields(68)="vb_e" 327 rst_fields(69)="fwf_isf_b" 328 rst_fields(70)="isf_sc_b" 329 rst_fields(71)="isf_hc_b" 330 rst_fields(72)="ssh_ibb" 331 rst_fields(73)="rnf_b" 332 rst_fields(74)="rnf_hc_b" 333 rst_fields(75)="rnf_sc_b" 334 rst_fields(76)="nn_fsbc" 335 rst_fields(77)="ssu_m" 336 rst_fields(78)="ssv_m" 337 rst_fields(79)="sst_m" 338 rst_fields(80)="sss_m" 339 rst_fields(81)="ssh_m" 340 rst_fields(82)="e3t_m" 341 rst_fields(83)="frq_m" 342 rst_fields(84)="avmb" 343 rst_fields(85)="avtb" 344 345 DO i = 1, max_rst_fields 346 IF( TRIM(rst_fields(i)) /= "NO_NAME") THEN 347 IF( iom_varid( numror, TRIM(rst_fields(i)), ldstop = .FALSE. ) > 0 ) THEN 348 IF ( xios_is_valid_field( TRIM(rst_fields(i)) ) ) & 349 & CALL xios_set_field_attr ( TRIM(rst_fields(i)), enabled = .TRUE. ) 350 ENDIF 351 ENDIF 352 END DO 353 354 END SUBROUTINE set_active_rst_fields 246 355 247 356 SUBROUTINE iom_swap( cdname ) … … 254 363 #if defined key_iomput 255 364 TYPE(xios_context) :: nemo_hdl 256 257 365 IF( TRIM(Agrif_CFixed()) == '0' ) THEN 258 366 CALL xios_get_handle(TRIM(cdname),nemo_hdl) … … 378 486 icnt = icnt + 1 379 487 END DO 488 ELSE 489 lxios_sini = .TRUE. 380 490 ENDIF 381 491 IF( llwrt ) THEN … … 567 677 !! INTERFACE iom_get 568 678 !!---------------------------------------------------------------------- 569 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime )679 SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, lrxios ) 570 680 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 571 681 CHARACTER(len=*), INTENT(in ) :: cdvar ! Name of the variable 572 682 REAL(wp) , INTENT( out) :: pvar ! read field 573 683 INTEGER , INTENT(in ), OPTIONAL :: ktime ! record number 684 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use xios to read restart 574 685 ! 575 686 INTEGER :: idvar ! variable id … … 579 690 CHARACTER(LEN=100) :: clname ! file name 580 691 CHARACTER(LEN=1) :: cldmspc ! 581 ! 582 itime = 1 583 IF( PRESENT(ktime) ) itime = ktime 584 ! 585 clname = iom_file(kiomid)%name 586 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 587 ! 588 IF( kiomid > 0 ) THEN 589 idvar = iom_varid( kiomid, cdvar ) 590 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 591 idmspc = iom_file ( kiomid )%ndims( idvar ) 592 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 593 WRITE(cldmspc , fmt='(i1)') idmspc 594 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 595 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 596 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 597 SELECT CASE (iom_file(kiomid)%iolib) 598 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime ) 599 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 600 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 601 CASE DEFAULT 602 CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 603 END SELECT 604 ENDIF 605 ENDIF 692 LOGICAL :: lxios 693 ! 694 lxios = .FALSE. 695 IF( PRESENT(lrxios) ) lxios = lrxios 696 697 IF(.NOT.lxios) THEN ! read data using default library 698 itime = 1 699 IF( PRESENT(ktime) ) itime = ktime 700 ! 701 clname = iom_file(kiomid)%name 702 clinfo = ' iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 703 ! 704 IF( kiomid > 0 ) THEN 705 idvar = iom_varid( kiomid, cdvar ) 706 IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 707 idmspc = iom_file ( kiomid )%ndims( idvar ) 708 IF( iom_file(kiomid)%luld(idvar) ) idmspc = idmspc - 1 709 WRITE(cldmspc , fmt='(i1)') idmspc 710 IF( idmspc > 0 ) CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 711 & 'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 712 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 713 SELECT CASE (iom_file(kiomid)%iolib) 714 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, pvar, itime ) 715 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, pvar, itime ) 716 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idvar, pvar ) 717 CASE DEFAULT 718 CALL ctl_stop( 'iom_g0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 719 END SELECT 720 ENDIF 721 ENDIF 722 ELSE 723 #if defined key_iomput 724 IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 725 CALL iom_swap( TRIM(rxios_context) ) 726 CALL xios_recv_field( trim(cdvar), pvar) 727 CALL iom_swap( TRIM(cxios_context) ) 728 #endif 729 ENDIF 606 730 END SUBROUTINE iom_g0d 607 731 608 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount )732 SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrxios ) 609 733 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 610 734 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 614 738 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kstart ! start axis position of the reading 615 739 INTEGER , INTENT(in ), DIMENSION(1), OPTIONAL :: kcount ! number of points in each axis 740 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 616 741 ! 617 742 IF( kiomid > 0 ) THEN 618 743 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r1d=pvar, & 619 & ktime=ktime, kstart=kstart, kcount=kcount ) 744 & ktime=ktime, kstart=kstart, kcount=kcount, & 745 & lrxios=lrxios ) 620 746 ENDIF 621 747 END SUBROUTINE iom_g1d 622 748 623 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr 749 SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios) 624 750 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 625 751 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 633 759 ! called open_ocean_jstart to set the start 634 760 ! value for the 2nd dimension (netcdf only) 761 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 635 762 ! 636 763 IF( kiomid > 0 ) THEN 637 764 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r2d=pvar, & 638 765 & ktime=ktime, kstart=kstart, kcount=kcount, & 639 & lrowattr=lrowattr 766 & lrowattr=lrowattr, lrxios=lrxios) 640 767 ENDIF 641 768 END SUBROUTINE iom_g2d 642 769 643 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr )770 SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, lrxios ) 644 771 INTEGER , INTENT(in ) :: kiomid ! Identifier of the file 645 772 INTEGER , INTENT(in ) :: kdom ! Type of domain to be read … … 653 780 ! called open_ocean_jstart to set the start 654 781 ! value for the 2nd dimension (netcdf only) 782 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! read data using XIOS 655 783 ! 656 784 IF( kiomid > 0 ) THEN 657 785 IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom , cdvar , pv_r3d=pvar, & 658 786 & ktime=ktime, kstart=kstart, kcount=kcount, & 659 & lrowattr=lrowattr )787 & lrowattr=lrowattr, lrxios=lrxios ) 660 788 ENDIF 661 789 END SUBROUTINE iom_g3d … … 665 793 & pv_r1d, pv_r2d, pv_r3d, & 666 794 & ktime , kstart, kcount, & 667 & lrowattr 795 & lrowattr, lrxios ) 668 796 !!----------------------------------------------------------------------- 669 797 !! *** ROUTINE iom_get_123d *** … … 686 814 ! called open_ocean_jstart to set the start 687 815 ! value for the 2nd dimension (netcdf only) 688 ! 816 LOGICAL , INTENT(in ), OPTIONAL :: lrxios ! use XIOS to read restart 817 ! 818 LOGICAL :: lxios 689 819 LOGICAL :: llnoov ! local definition to read overlap 690 820 LOGICAL :: luse_jattr ! local definition to read open_ocean_jstart file attribute … … 713 843 !--------------------------------------------------------------------- 714 844 ! 715 clname = iom_file(kiomid)%name ! esier to read 716 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 717 ! local definition of the domain ? 718 idom = kdom 719 ! do we read the overlap 720 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 721 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 722 ! check kcount and kstart optionals parameters... 723 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 724 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 725 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 845 lxios = .FALSE. 846 if(PRESENT(lrxios)) lxios = lrxios 847 idvar = iom_varid( kiomid, cdvar ) 848 IF(.NOT.lxios) THEN 849 clname = iom_file(kiomid)%name ! esier to read 850 clinfo = ' iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 851 ! local definition of the domain ? 852 idom = kdom 853 ! do we read the overlap 854 ! ugly patch SM+JMM+RB to overwrite global definition in some cases 855 llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 856 ! check kcount and kstart optionals parameters... 857 IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 858 IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 859 IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_autoglo_xy ) & 726 860 & CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 727 861 728 luse_jattr = .false. 729 IF( PRESENT(lrowattr) ) THEN 730 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 731 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 732 ENDIF 733 IF( luse_jattr ) THEN 734 SELECT CASE (iom_file(kiomid)%iolib) 735 CASE (jpioipsl, jprstdimg ) 736 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 737 luse_jattr = .false. 738 CASE (jpnf90 ) 739 ! Ok 740 CASE DEFAULT 741 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 742 END SELECT 743 ENDIF 744 745 ! Search for the variable in the data base (eventually actualize data) 746 istop = nstop 747 idvar = iom_varid( kiomid, cdvar ) 748 ! 749 IF( idvar > 0 ) THEN 750 ! to write iom_file(kiomid)%dimsz in a shorter way ! 751 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 752 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 753 idmspc = inbdim ! number of spatial dimensions in the file 754 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 755 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 756 ! 757 ! update idom definition... 758 ! Identify the domain in case of jpdom_auto(glo/dta) definition 759 IF( idom == jpdom_autoglo_xy ) THEN 760 ll_depth_spec = .TRUE. 761 idom = jpdom_autoglo 762 ELSE 763 ll_depth_spec = .FALSE. 764 ENDIF 765 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 766 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 767 ELSE ; idom = jpdom_data 768 ENDIF 769 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 770 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 771 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 772 ENDIF 773 ! Identify the domain in case of jpdom_local definition 774 IF( idom == jpdom_local ) THEN 775 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 776 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 777 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 778 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 779 ENDIF 780 ENDIF 781 ! 782 ! check the consistency between input array and data rank in the file 783 ! 784 ! initializations 785 itime = 1 786 IF( PRESENT(ktime) ) itime = ktime 787 788 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 789 WRITE(clrankpv, fmt='(i1)') irankpv 790 WRITE(cldmspc , fmt='(i1)') idmspc 791 ! 792 IF( idmspc < irankpv ) THEN 793 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 862 luse_jattr = .false. 863 IF( PRESENT(lrowattr) ) THEN 864 IF( lrowattr .AND. idom /= jpdom_data ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 865 IF( lrowattr .AND. idom == jpdom_data ) luse_jattr = .true. 866 ENDIF 867 IF( luse_jattr ) THEN 868 SELECT CASE (iom_file(kiomid)%iolib) 869 CASE (jpioipsl, jprstdimg ) 870 CALL ctl_warn(trim(clinfo), 'lrowattr present and true but this only works with netcdf (jpnf90)') 871 luse_jattr = .false. 872 CASE (jpnf90 ) 873 ! Ok 874 CASE DEFAULT 875 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 876 END SELECT 877 ENDIF 878 879 ! Search for the variable in the data base (eventually actualize data) 880 istop = nstop 881 ! 882 IF( idvar > 0 ) THEN 883 ! to write iom_file(kiomid)%dimsz in a shorter way ! 884 idimsz(:) = iom_file(kiomid)%dimsz(:, idvar) 885 inbdim = iom_file(kiomid)%ndims(idvar) ! number of dimensions in the file 886 idmspc = inbdim ! number of spatial dimensions in the file 887 IF( iom_file(kiomid)%luld(idvar) ) idmspc = inbdim - 1 888 IF( idmspc > 3 ) CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...') 889 ! 890 ! update idom definition... 891 ! Identify the domain in case of jpdom_auto(glo/dta) definition 892 IF( idom == jpdom_autoglo_xy ) THEN 893 ll_depth_spec = .TRUE. 894 idom = jpdom_autoglo 895 ELSE 896 ll_depth_spec = .FALSE. 897 ENDIF 898 IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN 899 IF( idom == jpdom_autoglo ) THEN ; idom = jpdom_global 900 ELSE ; idom = jpdom_data 901 ENDIF 902 ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 903 ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 904 IF( ind2 > ind1 ) THEN ; IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 ) idom = jpdom_local ; ENDIF 905 ENDIF 906 ! Identify the domain in case of jpdom_local definition 907 IF( idom == jpdom_local ) THEN 908 IF( idimsz(1) == jpi .AND. idimsz(2) == jpj ) THEN ; idom = jpdom_local_full 909 ELSEIF( idimsz(1) == nlci .AND. idimsz(2) == nlcj ) THEN ; idom = jpdom_local_noextra 910 ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN ; idom = jpdom_local_noovlap 911 ELSE ; CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 912 ENDIF 913 ENDIF 914 ! 915 ! check the consistency between input array and data rank in the file 916 ! 917 ! initializations 918 itime = 1 919 IF( PRESENT(ktime) ) itime = ktime 920 921 irankpv = 1 * COUNT( (/PRESENT(pv_r1d)/) ) + 2 * COUNT( (/PRESENT(pv_r2d)/) ) + 3 * COUNT( (/PRESENT(pv_r3d)/) ) 922 WRITE(clrankpv, fmt='(i1)') irankpv 923 WRITE(cldmspc , fmt='(i1)') idmspc 924 ! 925 IF( idmspc < irankpv ) THEN 926 CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension', & 794 927 & 'it is impossible to read a '//clrankpv//'D array from this file...' ) 795 ELSEIF( idmspc == irankpv ) THEN796 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) &928 ELSEIF( idmspc == irankpv ) THEN 929 IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown ) & 797 930 & CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 798 ELSEIF( idmspc > irankpv ) THEN799 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN800 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , &931 ELSEIF( idmspc > irankpv ) THEN 932 IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 933 CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...' , & 801 934 & 'As the size of the z dimension is 1 and as we try to read the first record, ', & 802 935 & 'we accept this case, even if there is a possible mix-up between z and time dimension' ) 803 idmspc = idmspc - 1804 ELSE805 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , &936 idmspc = idmspc - 1 937 ELSE 938 CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,' , & 806 939 & 'we do not accept data with '//cldmspc//' spatial dimensions', & 807 940 & 'Use ncwa -a to suppress the unnecessary dimensions' ) 808 ENDIF809 ENDIF810 811 !812 ! definition of istart and icnt813 !814 icnt (:) = 1815 istart(:) = 1816 istart(idmspc+1) = itime817 818 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc)819 ELSE820 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc)821 ELSE822 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array823 IF( idom == jpdom_data ) THEN824 jstartrow = 1825 IF( luse_jattr ) THEN826 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found827 jstartrow = MAX(1,jstartrow)828 ENDIF829 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below830 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below831 ENDIF832 ! we do not read the overlap -> we start to read at nldi, nldj941 ENDIF 942 ENDIF 943 944 ! 945 ! definition of istart and icnt 946 ! 947 icnt (:) = 1 948 istart(:) = 1 949 istart(idmspc+1) = itime 950 951 IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN ; istart(1:idmspc) = kstart(1:idmspc) ; icnt(1:idmspc) = kcount(1:idmspc) 952 ELSE 953 IF( idom == jpdom_unknown ) THEN ; icnt(1:idmspc) = idimsz(1:idmspc) 954 ELSE 955 IF( .NOT. PRESENT(pv_r1d) ) THEN ! not a 1D array 956 IF( idom == jpdom_data ) THEN 957 jstartrow = 1 958 IF( luse_jattr ) THEN 959 CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 960 jstartrow = MAX(1,jstartrow) 961 ENDIF 962 istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /) ! icnt(1:2) done below 963 ELSEIF( idom == jpdom_global ) THEN ; istart(1:2) = (/ nimpp , njmpp /) ! icnt(1:2) done below 964 ENDIF 965 ! we do not read the overlap -> we start to read at nldi, nldj 833 966 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 834 967 ! IF( idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 835 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /)968 IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 836 969 ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej 837 970 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 838 971 ! icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 839 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /)840 ELSE ; icnt(1:2) = (/ nlci , nlcj /)841 ENDIF842 IF( PRESENT(pv_r3d) ) THEN843 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta844 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3)845 ELSE ; icnt(3) = jpk846 ENDIF847 ENDIF848 ENDIF849 ENDIF850 ENDIF851 852 ! check that istart and icnt can be used with this file853 !-854 DO jl = 1, jpmax_dims855 itmp = istart(jl)+icnt(jl)-1856 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN857 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp858 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl)859 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 )860 ENDIF861 END DO862 863 ! check that icnt matches the input array864 !-865 IF( idom == jpdom_unknown ) THEN866 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d)867 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d)868 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d)869 ctmp1 = 'd'870 ELSE871 IF( irankpv == 2 ) THEN972 IF( llnoov ) THEN ; icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 973 ELSE ; icnt(1:2) = (/ nlci , nlcj /) 974 ENDIF 975 IF( PRESENT(pv_r3d) ) THEN 976 IF( idom == jpdom_data ) THEN ; icnt(3) = jpkdta 977 ELSE IF( ll_depth_spec .AND. PRESENT(kstart) ) THEN ; istart(3) = kstart(3); icnt(3) = kcount(3) 978 ELSE ; icnt(3) = jpk 979 ENDIF 980 ENDIF 981 ENDIF 982 ENDIF 983 ENDIF 984 985 ! check that istart and icnt can be used with this file 986 !- 987 DO jl = 1, jpmax_dims 988 itmp = istart(jl)+icnt(jl)-1 989 IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 990 WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 991 WRITE( ctmp2, FMT="(' is larger than idimsz(', i1,') = ', i5)" ) jl, idimsz(jl) 992 CALL ctl_stop( trim(clinfo), 'start and count too big regarding to the size of the data, ', ctmp1, ctmp2 ) 993 ENDIF 994 END DO 995 996 ! check that icnt matches the input array 997 !- 998 IF( idom == jpdom_unknown ) THEN 999 IF( irankpv == 1 ) ishape(1:1) = SHAPE(pv_r1d) 1000 IF( irankpv == 2 ) ishape(1:2) = SHAPE(pv_r2d) 1001 IF( irankpv == 3 ) ishape(1:3) = SHAPE(pv_r3d) 1002 ctmp1 = 'd' 1003 ELSE 1004 IF( irankpv == 2 ) THEN 872 1005 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 873 1006 ! ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1 = 'd(nldi:nlei,nldj:nlej)' 874 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)'875 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)'876 ENDIF877 ENDIF878 IF( irankpv == 3 ) THEN1007 IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 1008 ELSE ; ishape(1:2)=SHAPE(pv_r2d(1 :nlci,1 :nlcj )) ; ctmp1='d(1:nlci,1:nlcj)' 1009 ENDIF 1010 ENDIF 1011 IF( irankpv == 3 ) THEN 879 1012 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 880 1013 ! ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 881 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)'882 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)'883 ENDIF884 ENDIF885 ENDIF1014 IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 1015 ELSE ; ishape(1:3)=SHAPE(pv_r3d(1 :nlci,1 :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 1016 ENDIF 1017 ENDIF 1018 ENDIF 886 1019 887 DO jl = 1, irankpv888 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl)889 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) )890 END DO891 892 ENDIF893 894 ! read the data895 !-896 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point...897 !898 ! find the right index of the array to be read1020 DO jl = 1, irankpv 1021 WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 1022 IF( ishape(jl) /= icnt(jl) ) CALL ctl_stop( TRIM(clinfo), 'size(pv_r'//clrankpv//TRIM(ctmp1)//TRIM(ctmp2) ) 1023 END DO 1024 1025 ENDIF 1026 1027 ! read the data 1028 !- 1029 IF( idvar > 0 .AND. istop == nstop ) THEN ! no additional errors until this point... 1030 ! 1031 ! find the right index of the array to be read 899 1032 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 900 1033 ! IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 901 1034 ! ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 902 1035 ! ENDIF 903 IF( llnoov ) THEN904 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej905 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)906 ENDIF907 ELSE908 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj909 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2)910 ENDIF911 ENDIF1036 IF( llnoov ) THEN 1037 IF( idom /= jpdom_unknown ) THEN ; ix1 = nldi ; ix2 = nlei ; iy1 = nldj ; iy2 = nlej 1038 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1039 ENDIF 1040 ELSE 1041 IF( idom /= jpdom_unknown ) THEN ; ix1 = 1 ; ix2 = nlci ; iy1 = 1 ; iy2 = nlcj 1042 ELSE ; ix1 = 1 ; ix2 = icnt(1) ; iy1 = 1 ; iy2 = icnt(2) 1043 ENDIF 1044 ENDIF 912 1045 913 SELECT CASE (iom_file(kiomid)%iolib)914 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &915 & pv_r1d, pv_r2d, pv_r3d )916 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, &917 & pv_r1d, pv_r2d, pv_r3d )918 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, &919 & pv_r1d, pv_r2d, pv_r3d )920 CASE DEFAULT921 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' )922 END SELECT923 924 IF( istop == nstop ) THEN ! no additional errors until this point...925 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name)1046 SELECT CASE (iom_file(kiomid)%iolib) 1047 CASE (jpioipsl ) ; CALL iom_ioipsl_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1048 & pv_r1d, pv_r2d, pv_r3d ) 1049 CASE (jpnf90 ) ; CALL iom_nf90_get( kiomid, idvar, inbdim, istart, icnt, ix1, ix2, iy1, iy2, & 1050 & pv_r1d, pv_r2d, pv_r3d ) 1051 CASE (jprstdimg) ; CALL iom_rstdimg_get( kiomid, idom, idvar, ix1, ix2, iy1, iy2, & 1052 & pv_r1d, pv_r2d, pv_r3d ) 1053 CASE DEFAULT 1054 CALL ctl_stop( TRIM(clinfo)//' accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 1055 END SELECT 1056 1057 IF( istop == nstop ) THEN ! no additional errors until this point... 1058 IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 926 1059 927 !--- overlap areas and extra hallows (mpp) 928 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 929 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 930 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 931 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 932 IF( icnt(3) == jpk ) THEN 933 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 934 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 935 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 936 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 937 ENDIF 938 ENDIF 939 940 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 941 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 942 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 943 944 !--- Apply scale_factor and offset 945 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 946 zofs = iom_file(kiomid)%ofs(idvar) ! offset 947 IF( PRESENT(pv_r1d) ) THEN 948 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 949 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 950 ELSEIF( PRESENT(pv_r2d) ) THEN 1060 !--- overlap areas and extra hallows (mpp) 1061 IF( PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 1062 CALL lbc_lnk( pv_r2d,'Z',-999.,'no0' ) 1063 ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 1064 ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 1065 IF( icnt(3) == jpk ) THEN 1066 CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1067 ELSE ! put some arbitrary value (a call to lbc_lnk will be done later...) 1068 DO jj = nlcj+1, jpj ; pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :) ; END DO 1069 DO ji = nlci+1, jpi ; pv_r3d(ji , : , :) = pv_r3d(nlei , : , :) ; END DO 1070 ENDIF 1071 ENDIF 1072 ! 1073 ELSE 1074 ! return if istop == nstop is false 1075 RETURN 1076 ENDIF 1077 ELSE 1078 ! return if statment idvar > 0 .AND. istop == nstop is false 1079 RETURN 1080 ENDIF 1081 ! 1082 ELSE ! read using XIOS. Only if key_iomput is defined 1083 #if defined key_iomput 1084 ! will not handle scale factor and offset 1085 !would be good to be able to check which context is active and swap only if current is not restart 1086 CALL iom_swap( TRIM(rxios_context) ) 1087 IF( PRESENT(pv_r3d) ) THEN 1088 if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 1089 CALL xios_recv_field( trim(cdvar), pv_r3d) 1090 IF(idom /= jpdom_unknown ) CALL lbc_lnk( pv_r3d,'Z',-999.,'no0' ) 1091 ELSEIF( PRESENT(pv_r2d) ) THEN 1092 if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 1093 CALL xios_recv_field( trim(cdvar), pv_r2d) 1094 IF(idom /= jpdom_unknown ) CALL lbc_lnk(pv_r2d,'Z',-999.,'no0') 1095 ELSEIF( PRESENT(pv_r1d) ) THEN 1096 if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 1097 CALL xios_recv_field( trim(cdvar), pv_r1d) 1098 ENDIF 1099 if(lwp) write(numout,*) 'XIOS RST READ END: ',trim(cdvar) 1100 CALL iom_swap( TRIM(cxios_context) ) 1101 #else 1102 istop = istop + 1 1103 clinfo = 'Can not use XIOS in iom_get_123d, file: '//trim(clname)//', var:'//trim(cdvar) 1104 #endif 1105 ENDIF 1106 !some final adjustments 1107 ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 1108 IF( lk_c1d .AND. PRESENT(pv_r2d) ) CALL lbc_lnk( pv_r2d,'Z',1. ) 1109 IF( lk_c1d .AND. PRESENT(pv_r3d) ) CALL lbc_lnk( pv_r3d,'Z',1. ) 1110 1111 !--- Apply scale_factor and offset 1112 zscf = iom_file(kiomid)%scf(idvar) ! scale factor 1113 zofs = iom_file(kiomid)%ofs(idvar) ! offset 1114 IF( PRESENT(pv_r1d) ) THEN 1115 IF( zscf /= 1. ) pv_r1d(:) = pv_r1d(:) * zscf 1116 IF( zofs /= 0. ) pv_r1d(:) = pv_r1d(:) + zofs 1117 ELSEIF( PRESENT(pv_r2d) ) THEN 951 1118 !CDIR COLLAPSE 952 1119 IF( zscf /= 1.) pv_r2d(:,:) = pv_r2d(:,:) * zscf 953 1120 !CDIR COLLAPSE 954 955 1121 IF( zofs /= 0.) pv_r2d(:,:) = pv_r2d(:,:) + zofs 1122 ELSEIF( PRESENT(pv_r3d) ) THEN 956 1123 !CDIR COLLAPSE 957 1124 IF( zscf /= 1.) pv_r3d(:,:,:) = pv_r3d(:,:,:) * zscf 958 1125 !CDIR COLLAPSE 959 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 960 ENDIF 961 ! 962 ENDIF 963 ! 964 ENDIF 965 ! 1126 IF( zofs /= 0.) pv_r3d(:,:,:) = pv_r3d(:,:,:) + zofs 1127 ENDIF 1128 966 1129 END SUBROUTINE iom_get_123d 967 1130 … … 1230 1393 & lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon, & 1231 1394 & bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 1232 ENDIF1395 ENDIF 1233 1396 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1234 1397 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90
r6491 r7924 51 51 !$AGRIF_DO_NOT_TREAT 52 52 INTEGER, PUBLIC :: iom_open_init = 0 !: used to initialize iom_file(:)%nfid to 0 53 !XIOS read restart 54 LOGICAL, PUBLIC :: lxios_read = .FALSE. 55 LOGICAL, PUBLIC :: lxios_sini = .FALSE. ! is restart in a single file 56 LOGICAL, PUBLIC :: lxios_set = .FALSE. 53 57 54 58 TYPE, PUBLIC :: file_descriptor -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90
r6491 r7924 122 122 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1) , idmy ), clinfo) 123 123 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1) , idmy ), clinfo) 124 CALL iom_nf90_check(NF90_DEF_DIM( if90id, ' z', jpk , idmy ), clinfo)125 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't ', NF90_UNLIMITED, idmy ), clinfo)124 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk , idmy ), clinfo) 125 CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 126 126 ! global attributes 127 127 CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total' , jpnij ), clinfo) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r6755 r7924 26 26 USE divcur ! hor. divergence and curl (div & cur routines) 27 27 USE sbc_oce ! for icesheet freshwater input variables 28 USE iom_def, ONLY : lxios_read, lxios_set, lxios_sini 29 USE timing 28 30 29 31 IMPLICIT NONE … … 208 210 WRITE(numout,*) '~~~~~~~~' 209 211 ENDIF 210 212 lxios_sini = .FALSE. 211 213 clpath = TRIM(cn_ocerst_indir) 212 214 IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' … … 218 220 ENDIF 219 221 CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 220 ENDIF 222 ! are we using XIOS to read the data? Part above will have to modified once XIOS 223 ! can handle checking if variable is in the restart file (there will be no need to open 224 ! restart) 225 226 IF(.NOT.lxios_set) lxios_read = lxios_read.AND.lxios_sini 227 print *,'SINGLE FILE RESTART?: ',lxios_sini,' USE XIOS? :',lxios_read 228 IF( lxios_read) THEN 229 if(.NOT.lxios_set) then 230 rxios_context = 'nemo_rst' 231 call iom_init( rxios_context ) 232 lxios_set = .TRUE. 233 endif 234 ENDIF 235 236 ENDIF 237 221 238 END SUBROUTINE rst_read_open 222 239 … … 232 249 INTEGER :: jk 233 250 LOGICAL :: llok 251 TYPE(xios_duration):: dtime 252 integer::ni,nj,nk 234 253 !!---------------------------------------------------------------------- 235 254 … … 238 257 ! Check dynamics and tracer time-step consistency and force Euler restart if changed 239 258 IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 ) THEN 240 CALL iom_get( numror, 'rdt', zrdt )259 CALL iom_get( numror, 'rdt', zrdt, lrxios = lxios_read ) 241 260 IF( zrdt /= rdt ) neuler = 0 242 261 ENDIF 243 262 IF( iom_varid( numror, 'rdttra1', ldstop = .FALSE. ) > 0 ) THEN 244 CALL iom_get( numror, 'rdttra1', zrdttra1 )263 CALL iom_get( numror, 'rdttra1', zrdttra1, lrxios = lxios_read ) 245 264 IF( zrdttra1 /= rdttra(1) ) neuler = 0 246 265 ENDIF 247 266 ! 248 267 IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 249 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub 250 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb 251 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) )252 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) )253 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb 254 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb 255 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb 268 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub, lrxios = lxios_read ) ! before fields 269 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb, lrxios = lxios_read ) 270 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem), lrxios = lxios_read ) 271 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal), lrxios = lxios_read ) 272 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb, lrxios = lxios_read ) 273 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb, lrxios = lxios_read ) 274 CALL iom_get( numror, jpdom_autoglo, 'sshb' , sshb, lrxios = lxios_read ) 256 275 ELSE 257 276 neuler = 0 258 277 ENDIF 259 278 ! 260 CALL iom_get( numror, jpdom_autoglo, 'un' , un 261 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn 262 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem) )263 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) )264 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn 279 CALL iom_get( numror, jpdom_autoglo, 'un' , un, lrxios = lxios_read ) ! now fields 280 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn, lrxios = lxios_read ) 281 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem), lrxios = lxios_read ) 282 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal), lrxios = lxios_read ) 283 CALL iom_get( numror, jpdom_autoglo, 'sshn' , sshn, lrxios = lxios_read ) 265 284 IF( iom_varid( numror, 'rotn', ldstop = .FALSE. ) > 0 ) THEN 266 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn 267 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn 285 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn, lrxios = lxios_read ) 286 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn, lrxios = lxios_read ) 268 287 ELSE 269 288 CALL div_cur( 0 ) ! Horizontal divergence & Relative vorticity 270 289 ENDIF 271 290 IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 272 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop 291 CALL iom_get( numror, jpdom_autoglo, 'rhop' , rhop, lrxios = lxios_read ) ! now potential density 273 292 ELSE 274 293 CALL eos ( tsn, rhd, rhop, fsdept_n(:,:,:) ) … … 276 295 #if defined key_zdfkpp 277 296 IF( iom_varid( numror, 'rhd', ldstop = .FALSE. ) > 0 ) THEN 278 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd 297 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd, lrxios = lxios_read ) ! now in situ density anomaly 279 298 ELSE 280 299 CALL eos( tsn, rhd, fsdept_n(:,:,:) ) ! compute rhd … … 283 302 ! 284 303 IF( iom_varid( numror, 'greenland_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 285 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass )286 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed )287 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change )304 CALL iom_get( numror, 'greenland_icesheet_mass', greenland_icesheet_mass, lrxios = lxios_read ) 305 CALL iom_get( numror, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed, lrxios = lxios_read ) 306 CALL iom_get( numror, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change, lrxios = lxios_read ) 288 307 ELSE 289 308 greenland_icesheet_mass = 0.0 … … 292 311 ENDIF 293 312 IF( iom_varid( numror, 'antarctica_icesheet_mass', ldstop = .FALSE. ) > 0 ) THEN 294 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass )295 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed )296 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change )313 CALL iom_get( numror, 'antarctica_icesheet_mass', antarctica_icesheet_mass, lrxios = lxios_read ) 314 CALL iom_get( numror, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed, lrxios = lxios_read ) 315 CALL iom_get( numror, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change, lrxios = lxios_read ) 297 316 ELSE 298 317 antarctica_icesheet_mass = 0.0 … … 300 319 antarctica_icesheet_timelapsed = 0.0 301 320 ENDIF 321 ! IF( nn_timing == 1 ) CALL timing_stop('iom_read') 302 322 303 323 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90
r7923 r7924 27 27 USE fldread ! read input field at current time step 28 28 USE lib_fortran, ONLY: glob_sum 29 USE iom_def, ONLY : lxios_read 29 30 30 31 IMPLICIT NONE … … 409 410 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 410 411 IF(lwp) WRITE(numout,*) ' nit000-1 isf tracer content forcing fields read in the restart file' 411 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) ) ! before salt content isf_tsc trend412 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) ) ! before salt content isf_tsc trend413 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) ) ! before salt content isf_tsc trend412 CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:), lrxios = lxios_read ) ! before salt content isf_tsc trend 413 CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal), lrxios = lxios_read ) ! before salt content isf_tsc trend 414 CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem), lrxios = lxios_read ) ! before salt content isf_tsc trend 414 415 ELSE 415 416 fwfisf_b(:,:) = fwfisf(:,:) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r6498 r7924 54 54 USE sbcwave ! Wave module 55 55 USE bdy_par ! Require lk_bdy 56 USE iom_def, ONLY : lxios_read 56 57 57 58 IMPLICIT NONE … … 415 416 & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 416 417 IF(lwp) WRITE(numout,*) ' nit000-1 surface forcing fields red in the restart file' 417 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b ) ! before i-stress (U-point)418 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b ) ! before j-stress (V-point)419 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b ) ! before non solar heat flux (T-point)418 CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, lrxios = lxios_read ) ! before i-stress (U-point) 419 CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, lrxios = lxios_read ) ! before j-stress (V-point) 420 CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, lrxios = lxios_read ) ! before non solar heat flux (T-point) 420 421 ! The 3D heat content due to qsr forcing is treated in traqsr 421 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b ) ! before solar heat flux (T-point)422 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b ) ! before freshwater flux (T-point)422 ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, lrxios = lxios_read ) ! before solar heat flux (T-point) 423 CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, lrxios = lxios_read ) ! before freshwater flux (T-point) 423 424 ! To ensure restart capability with 3.3x/3.4 restart files !! to be removed in v3.6 424 425 IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 425 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b ) ! before salt flux (T-point)426 CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, lrxios = lxios_read ) ! before salt flux (T-point) 426 427 ELSE 427 428 sfx_b (:,:) = sfx(:,:) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90
r6498 r7924 27 27 USE eosbn2 28 28 USE wrk_nemo ! Memory allocation 29 USE iom_def, ONLY : lxios_read 29 30 30 31 IMPLICIT NONE … … 155 156 & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 156 157 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields red in the restart file' 157 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b ) ! before runoff158 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) ) ! before heat content of runoff159 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) ) ! before salinity content of runoff158 CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b, lrxios = lxios_read ) ! before runoff 159 CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), lrxios = lxios_read ) ! before heat content of runoff 160 CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), lrxios = lxios_read ) ! before salinity content of runoff 160 161 ELSE !* no restart: set from nit000 values 161 162 IF(lwp) WRITE(numout,*) ' nit000-1 runoff forcing fields set to nit000' -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90
r6486 r7924 21 21 USE prtctl ! Print control 22 22 USE iom ! IOM library 23 USE iom_def, ONLY : lxios_read 23 24 24 25 IMPLICIT NONE … … 206 207 IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 207 208 l_ssm_mean = .TRUE. 208 CALL iom_get( numror , 'nn_fsbc', zf_sbc ) ! sbc frequency of previous run209 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m ) ! sea surface mean velocity (T-point)210 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m ) ! " " velocity (V-point)211 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m ) ! " " temperature (T-point)212 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m ) ! " " salinity (T-point)213 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m ) ! " " height (T-point)214 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m )209 CALL iom_get( numror , 'nn_fsbc', zf_sbc, lrxios = lxios_read ) ! sbc frequency of previous run 210 CALL iom_get( numror, jpdom_autoglo, 'ssu_m' , ssu_m, lrxios = lxios_read ) ! sea surface mean velocity (T-point) 211 CALL iom_get( numror, jpdom_autoglo, 'ssv_m' , ssv_m, lrxios = lxios_read ) ! " " velocity (V-point) 212 CALL iom_get( numror, jpdom_autoglo, 'sst_m' , sst_m, lrxios = lxios_read ) ! " " temperature (T-point) 213 CALL iom_get( numror, jpdom_autoglo, 'sss_m' , sss_m, lrxios = lxios_read ) ! " " salinity (T-point) 214 CALL iom_get( numror, jpdom_autoglo, 'ssh_m' , ssh_m, lrxios = lxios_read ) ! " " height (T-point) 215 IF( lk_vvl ) CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m, lrxios = lxios_read ) 215 216 ! fraction of solar net radiation absorbed in 1st T level 216 217 IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 217 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m )218 CALL iom_get( numror, jpdom_autoglo, 'frq_m' , frq_m, lrxios = lxios_read ) 218 219 ELSE 219 220 frq_m(:,:) = 1._wp ! default definition -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90
r6498 r7924 33 33 USE wrk_nemo ! Memory Allocation 34 34 USE timing ! Timing 35 35 USE iom_def, ONLY : lxios_read 36 36 IMPLICIT NONE 37 37 PRIVATE … … 137 137 IF(lwp) WRITE(numout,*) ' nit000-1 qsr tracer content forcing field red in the restart file' 138 138 zfact = 0.5e0 139 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b ) ! before heat content trend due to Qsr flux139 CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, lrxios = lxios_read ) ! before heat content trend due to Qsr flux 140 140 ELSE ! No restart or restart not found: Euler forward time stepping 141 141 zfact = 1.e0 … … 607 607 ! initialisation of fraqsr_1lev used in sbcssm 608 608 IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 609 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev )609 CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev' , fraqsr_1lev, lrxios = lxios_read ) 610 610 ELSE 611 611 fraqsr_1lev(:,:) = 1._wp ! default definition -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r6793 r7924 33 33 USE timing ! Timing 34 34 USE eosbn2 35 USE iom_def, ONLY : lxios_read 35 36 36 37 IMPLICIT NONE … … 154 155 IF(lwp) WRITE(numout,*) ' nit000-1 surface tracer content forcing fields red in the restart file' 155 156 zfact = 0.5_wp 156 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) ) ! before heat content sbc trend157 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) ) ! before salt content sbc trend157 CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), lrxios = lxios_read ) ! before heat content sbc trend 158 CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), lrxios = lxios_read ) ! before salt content sbc trend 158 159 ELSE ! No restart or restart not found: Euler forward time stepping 159 160 zfact = 1._wp -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90
r6486 r7924 161 161 IF( ln_trdmxl_instant ) THEN 162 162 !-- Temperature 163 CALL iom_get( inum, jpdom_autoglo, 'tmlbb' , tmlbb 164 CALL iom_get( inum, jpdom_autoglo, 'tmlbn' , tmlbn 165 CALL iom_get( inum, jpdom_autoglo, 'tmlatfb' , tmlatfb 166 ! 167 !-- Salinity 168 CALL iom_get( inum, jpdom_autoglo, 'smlbb' , smlbb 169 CALL iom_get( inum, jpdom_autoglo, 'smlbn' , smlbn 170 CALL iom_get( inum, jpdom_autoglo, 'smlatfb' , smlatfb 163 CALL iom_get( inum, jpdom_autoglo, 'tmlbb' , tmlbb ) 164 CALL iom_get( inum, jpdom_autoglo, 'tmlbn' , tmlbn ) 165 CALL iom_get( inum, jpdom_autoglo, 'tmlatfb' , tmlatfb ) 166 ! 167 !-- Salinity 168 CALL iom_get( inum, jpdom_autoglo, 'smlbb' , smlbb ) 169 CALL iom_get( inum, jpdom_autoglo, 'smlbn' , smlbn ) 170 CALL iom_get( inum, jpdom_autoglo, 'smlatfb' , smlatfb ) 171 171 ELSE 172 CALL iom_get( inum, jpdom_autoglo, 'hmxlbn' , hmxlbn 173 ! 174 !-- Temperature 175 CALL iom_get( inum, jpdom_autoglo, 'tmlbn' , tmlbn 176 CALL iom_get( inum, jpdom_autoglo, 'tml_sumb' , tml_sumb 172 CALL iom_get( inum, jpdom_autoglo, 'hmxlbn' , hmxlbn ) ! needed for hmxl_sum 173 ! 174 !-- Temperature 175 CALL iom_get( inum, jpdom_autoglo, 'tmlbn' , tmlbn ) ! needed for tml_sum 176 CALL iom_get( inum, jpdom_autoglo, 'tml_sumb' , tml_sumb ) 177 177 DO jk = 1, jpltrd 178 178 IF( jk < 10 ) THEN ; WRITE(charout,FMT="('tmltrd_csum_ub_', I1)") jk … … 184 184 ! 185 185 !-- Salinity 186 CALL iom_get( inum, jpdom_autoglo, 'smlbn' , smlbn 187 CALL iom_get( inum, jpdom_autoglo, 'sml_sumb' , sml_sumb 186 CALL iom_get( inum, jpdom_autoglo, 'smlbn' , smlbn ) ! needed for sml_sum 187 CALL iom_get( inum, jpdom_autoglo, 'sml_sumb' , sml_sumb ) 188 188 DO jk = 1, jpltrd 189 189 IF( jk < 10 ) THEN ; WRITE(charout,FMT="('smltrd_csum_ub_', I1)") jk -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90
r6487 r7924 32 32 USE timing ! Timing 33 33 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 34 USE iom_def, ONLY : lxios_read 34 35 35 36 IMPLICIT NONE … … 1184 1185 ! 1185 1186 IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 1186 CALL iom_get( numror, jpdom_autoglo, 'en' , en )1187 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt )1188 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm )1189 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu )1190 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv )1191 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln )1187 CALL iom_get( numror, jpdom_autoglo, 'en' , en, lrxios = lxios_read ) 1188 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt, lrxios = lxios_read ) 1189 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm, lrxios = lxios_read ) 1190 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu, lrxios = lxios_read ) 1191 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv, lrxios = lxios_read ) 1192 CALL iom_get( numror, jpdom_autoglo, 'mxln' , mxln, lrxios = lxios_read ) 1192 1193 ELSE 1193 1194 IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r6486 r7924 29 29 USE in_out_manager ! I/O manager 30 30 USE iom ! IOM library 31 USE iom_def, ONLY : lxios_read 31 32 32 33 IMPLICIT NONE … … 170 171 ! file in traadv_cen2 end read here. 171 172 IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN 172 CALL iom_get( numror, jpdom_unknown, 'avmb', avmb )173 CALL iom_get( numror, jpdom_unknown, 'avtb', avtb )173 CALL iom_get( numror, jpdom_unknown, 'avmb', avmb, lrxios = lxios_read ) 174 CALL iom_get( numror, jpdom_unknown, 'avtb', avtb, lrxios = lxios_read ) 174 175 ENDIF 175 176 ENDIF -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r6498 r7924 57 57 USE agrif_opa_update 58 58 #endif 59 USE iom_def, ONLY : lxios_read 59 60 60 61 … … 935 936 ! 936 937 IF( id1 > 0 ) THEN ! 'en' exists 937 CALL iom_get( numror, jpdom_autoglo, 'en', en )938 CALL iom_get( numror, jpdom_autoglo, 'en', en, lrxios = lxios_read ) 938 939 IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN ! all required arrays exist 939 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt )940 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm )941 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu )942 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv )943 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl )940 CALL iom_get( numror, jpdom_autoglo, 'avt' , avt, lrxios = lxios_read ) 941 CALL iom_get( numror, jpdom_autoglo, 'avm' , avm, lrxios = lxios_read ) 942 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu, lrxios = lxios_read ) 943 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv, lrxios = lxios_read ) 944 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl, lrxios = lxios_read ) 944 945 ELSE ! one at least array is missing 945 946 CALL tke_avn ! compute avt, avm, avmu, avmv and dissl (approximation) -
branches/UKMO/dev_r5518_GO6_package_XIOS_read/NEMOGCM/NEMO/OPA_SRC/step.F90
r6755 r7924 385 385 IF( kstp == nitend .OR. indic < 0 ) THEN 386 386 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 387 CALL iom_context_finalize( rxios_context ) 387 388 IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) ! 388 389 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.