New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 8612 – NEMO

Changeset 8612


Ignore:
Timestamp:
2017-10-11T13:03:17+02:00 (6 years ago)
Author:
andmirek
Message:

#1953 read single file restart with XIOS

Location:
branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO
Files:
24 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r7753 r8612  
    3232   USE timing          ! preformance summary 
    3333   USE wrk_nemo        ! work arrays 
     34   USE iom_def, ONLY : lxios_read 
    3435 
    3536   IMPLICIT NONE 
     
    255256           IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    256257           IF(lwp) WRITE(numout,*) '~~~~~~~' 
    257            CALL iom_get( numror, 'frc_v', frc_v ) 
    258            CALL iom_get( numror, 'frc_t', frc_t ) 
    259            CALL iom_get( numror, 'frc_s', frc_s ) 
     258           CALL iom_get( numror, 'frc_v', frc_v, lrxios = lxios_read ) 
     259           CALL iom_get( numror, 'frc_t', frc_t, lrxios = lxios_read ) 
     260           CALL iom_get( numror, 'frc_s', frc_s, lrxios = lxios_read ) 
    260261           IF( ln_linssh ) THEN 
    261               CALL iom_get( numror, 'frc_wn_t', frc_wn_t ) 
    262               CALL iom_get( numror, 'frc_wn_s', frc_wn_s ) 
     262              CALL iom_get( numror, 'frc_wn_t', frc_wn_t, lrxios = lxios_read ) 
     263              CALL iom_get( numror, 'frc_wn_s', frc_wn_s, lrxios = lxios_read ) 
    263264           ENDIF 
    264            CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini ) ! ice sheet coupling 
    265            CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:) ) 
    266            CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:) ) 
    267            CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:) ) 
    268            CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:) ) 
     265           CALL iom_get( numror, jpdom_autoglo, 'surf_ini', surf_ini, lrxios = lxios_read ) ! ice sheet coupling 
     266           CALL iom_get( numror, jpdom_autoglo, 'ssh_ini', ssh_ini(:,:), lrxios = lxios_read ) 
     267           CALL iom_get( numror, jpdom_autoglo, 'e3t_ini', e3t_ini(:,:,:), lrxios = lxios_read ) 
     268           CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini(:,:,:), lrxios = lxios_read ) 
     269           CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini(:,:,:), lrxios = lxios_read ) 
    269270           IF( ln_linssh ) THEN 
    270               CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:) ) 
    271               CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:) ) 
     271              CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini(:,:), lrxios = lxios_read ) 
     272              CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini(:,:), lrxios = lxios_read ) 
    272273           ENDIF 
    273274       ELSE 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r8329 r8612  
    3333   USE timing         ! Timing 
    3434   USE restart        ! restart 
     35   USE iom_def, ONLY : lxios_read 
    3536 
    3637   IMPLICIT NONE 
     
    318319         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 
    319320            ! Get Calendar informations 
    320             CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run 
     321            CALL iom_get( numror, 'kt', zkt, lrxios = lxios_read )   ! last time-step of previous run 
    321322            IF(lwp) THEN 
    322323               WRITE(numout,*) ' *** Info read in restart : ' 
     
    337338            IF ( nrstdt == 2 ) THEN 
    338339               ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 
    339                CALL iom_get( numror, 'ndastp', zndastp ) 
     340               CALL iom_get( numror, 'ndastp', zndastp, lrxios = lxios_read ) 
    340341               ndastp = NINT( zndastp ) 
    341                CALL iom_get( numror, 'adatrj', adatrj  ) 
    342           CALL iom_get( numror, 'ntime', ktime ) 
     342               CALL iom_get( numror, 'adatrj', adatrj, lrxios = lxios_read ) 
     343          CALL iom_get( numror, 'ntime', ktime, lrxios = lxios_read ) 
    343344          nn_time0=INT(ktime) 
    344345               ! calculate start time in hours and minutes 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r7822 r8612  
    4747   USE wrk_nemo       ! Memory Allocation 
    4848   USE timing         ! Timing 
     49   USE iom_def, ONLY : lxios_read 
    4950 
    5051   IMPLICIT NONE 
     
    285286         &             nn_it000, nn_itend , nn_date0    , nn_time0     , nn_leapy  , nn_istate ,     & 
    286287         &             nn_stock, nn_write , ln_mskland  , ln_clobber   , nn_chunksz, nn_euler  ,     & 
    287          &             ln_cfmeta, ln_iscpl 
     288         &             ln_cfmeta, ln_iscpl, ln_xios_read 
    288289      NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs 
    289290#if defined key_netcdf4 
     
    293294      !!---------------------------------------------------------------------- 
    294295      ! 
     296      ln_xios_read = .false.            ! set in case ln_xios_read is not in namelist 
    295297      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    296298      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
     
    333335         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
    334336         WRITE(numout,*) '      IS coupling at the restart step ln_iscpl   = ', ln_iscpl 
     337         WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read 
     338      IF( TRIM(Agrif_CFixed()) == '0') THEN 
     339         WRITE(numout,*) '      READ restart for a single file using XIOS WILL use not use AGRIF setting.' 
     340      ENDIF 
    335341      ENDIF 
    336342 
     
    347353      nwrite = nn_write 
    348354      neuler = nn_euler 
     355      IF( TRIM(Agrif_CFixed()) == '0') THEN  
     356       lxios_read = ln_xios_read.AND.ln_rstart 
     357      ENDIF 
    349358      IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN 
    350359         WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 ' 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7753 r8612  
    3333   USE wrk_nemo        ! Memory allocation 
    3434   USE timing          ! Timing 
     35   USE iom_def, ONLY : lxios_read 
    3536 
    3637   IMPLICIT NONE 
     
    799800         IF( ln_rstart ) THEN                   !* Read the restart file 
    800801            CALL rst_read_open                  !  open the restart file if necessary 
    801             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
     802            CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, lrxios = lxios_read    ) 
    802803            ! 
    803804            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
     
    810811            !                             ! --------- ! 
    811812            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    812                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
    813                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
     813               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), lrxios = lxios_read ) 
     814               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), lrxios = lxios_read ) 
    814815               ! needed to restart if land processor not computed  
    815816               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t_b and e3t_n found in restart files' 
     
    825826               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    826827               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    827                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:) ) 
     828               CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t_b(:,:,:), lrxios = lxios_read ) 
    828829               e3t_n(:,:,:) = e3t_b(:,:,:) 
    829830               neuler = 0 
     
    832833               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    833834               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    834                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:) ) 
     835               CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t_n(:,:,:), lrxios = lxios_read ) 
    835836               e3t_b(:,:,:) = e3t_n(:,:,:) 
    836837               neuler = 0 
     
    857858               !                          ! ----------------------- ! 
    858859               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    859                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
    860                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
     860                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), lrxios = lxios_read ) 
     861                  CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), lrxios = lxios_read ) 
    861862               ELSE                            ! one at least array is missing 
    862863                  tilde_e3t_b(:,:,:) = 0.0_wp 
     
    867868                  !                       ! ------------ ! 
    868869                  IF( id5 > 0 ) THEN  ! required array exists 
    869                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:) ) 
     870                     CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), lrxios = lxios_read ) 
    870871                  ELSE                ! array is missing 
    871872                     hdiv_lf(:,:,:) = 0.0_wp 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DOM/iscplrst.F90

    r8329 r8612  
    2525   USE iscplini        ! ice sheet coupling: initialisation 
    2626   USE iscplhsb        ! ice sheet coupling: conservation 
     27   USE iom_def, ONLY : lxios_read 
    2728 
    2829   IMPLICIT NONE 
     
    6465 
    6566      !! get restart variable 
    66       CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b   ) ! need to extrapolate T/S 
    67       CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b   ) ! need to correct barotropic velocity 
    68       CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b   ) ! need to correct barotropic velocity 
    69       CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b   ) ! need to correct barotropic velocity 
    70       CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:) )  ! need to compute temperature correction 
    71       CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:) )  ! need to correct barotropic velocity 
    72       CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:) )  ! need to correct barotropic velocity 
    73       CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:) ) ! need to interpol vertical profile (vvl) 
     67      CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, lrxios = lxios_read   ) ! need to extrapolate T/S 
     68      CALL iom_get( numror, jpdom_autoglo, 'umask'  , zumask_b, lrxios = lxios_read   ) ! need to correct barotropic velocity 
     69      CALL iom_get( numror, jpdom_autoglo, 'vmask'  , zvmask_b, lrxios = lxios_read   ) ! need to correct barotropic velocity 
     70      CALL iom_get( numror, jpdom_autoglo, 'smask'  , zsmask_b, lrxios = lxios_read   ) ! need to correct barotropic velocity 
     71      CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:), lrxios = lxios_read )  ! need to compute temperature correction 
     72      CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b(:,:,:), lrxios = lxios_read )  ! need to correct barotropic velocity 
     73      CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b(:,:,:), lrxios = lxios_read )  ! need to correct barotropic velocity 
     74      CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), lrxios = lxios_read ) ! need to interpol vertical profile (vvl) 
    7475 
    7576      !! read namelist 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r7831 r8612  
    5656   USE asminc          ! Assimilation increment 
    5757#endif 
     58   USE iom_def, ONLY : lxios_read 
    5859 
    5960 
     
    11981199      ! 
    11991200      IF( TRIM(cdrw) == 'READ' ) THEN 
    1200          CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:) )    
    1201          CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:) )  
     1201         CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:), lrxios = lxios_read )    
     1202         CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:), lrxios = lxios_read )  
    12021203         IF( .NOT.ln_bt_av ) THEN 
    1203             CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:) )    
    1204             CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:) )    
    1205             CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:) ) 
    1206             CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:) )  
    1207             CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:) )    
    1208             CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:) ) 
     1204            CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:), lrxios = lxios_read )    
     1205            CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:), lrxios = lxios_read )    
     1206            CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:), lrxios = lxios_read ) 
     1207            CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:), lrxios = lxios_read )  
     1208            CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:), lrxios = lxios_read )    
     1209            CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:), lrxios = lxios_read ) 
    12091210         ENDIF 
    12101211#if defined key_agrif 
    12111212         ! Read time integrated fluxes 
    12121213         IF ( .NOT.Agrif_Root() ) THEN 
    1213             CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:) )    
    1214             CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:) ) 
     1214            CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:), lrxios = lxios_read )    
     1215            CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:), lrxios = lxios_read ) 
    12151216         ENDIF 
    12161217#endif 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r7646 r8612  
    4444   LOGICAL       ::   ln_clobber       !: clobber (overwrite) an existing file 
    4545   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
     46   LOGICAL       ::   ln_xios_read     !: use xios to read single file restart 
    4647 
    4748#if defined key_netcdf4 
     
    150151   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
    151152   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
     153   CHARACTER(lc) ::   rxios_context         !: context name used in xios to read restart 
    152154 
    153155   !!---------------------------------------------------------------------- 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8573 r8612  
    4141   USE dianam          ! build name of file 
    4242   USE xios 
     43   USE iom_def, ONLY : max_rst_fields, rst_fields 
    4344# endif 
    4445   USE ioipsl, ONLY :  ju2ymds    ! for calendar 
    4546   USE crs             ! Grid coarsening 
     47   USE lib_fortran  
    4648 
    4749   IMPLICIT NONE 
     
    6365   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 
    6466   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 
    6568# endif 
    6669 
     
    103106      CHARACTER(len=10) :: clname 
    104107      INTEGER           :: ji, jkmin 
     108      LOGICAL :: lrst_context              ! is context related to restart 
    105109      ! 
    106110      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
     
    113117      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
    114118      CALL iom_swap( cdname ) 
    115  
     119      lrst_context =  (TRIM(cdname) == TRIM(rxios_context)) 
    116120 
    117121      ! Calendar type is now defined in xml file  
     
    126130 
    127131      ! horizontal grid definition 
    128       CALL set_scalar 
     132      IF(.NOT.lrst_context) CALL set_scalar 
    129133 
    130134      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. ) 
    135139         CALL set_grid_znl( gphit ) 
    136140         ! 
     
    150154         CALL dom_grid_crs   ! Save the parent grid information  & Switch to coarse grid domain 
    151155         ! 
    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. )  
    156160         CALL set_grid_znl( gphit_crs ) 
    157161          ! 
    158162         CALL dom_grid_glo   ! Return to parent grid domain 
    159163         ! 
    160          IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
     164         IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN   ! Add additional grid metadata 
    161165            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
    162166            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
     
    171175 
    172176      ! 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 ) 
    190195 
    191196 
    192197# 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) /) ) 
    194199# endif 
    195200#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) /) ) 
    197202#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    
    202207      ! 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 
    204217 
    205218      ! end file definition 
     
    213226 
    214227#endif 
    215        
     228 
    216229   END SUBROUTINE iom_init 
    217230 
     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 
    218410 
    219411   SUBROUTINE iom_swap( cdname ) 
     
    347539            icnt = icnt + 1 
    348540         END DO 
     541      ELSE 
     542         lxios_sini = .TRUE. 
    349543      ENDIF 
    350544      IF( llwrt ) THEN 
     
    530724   !!                   INTERFACE iom_get 
    531725   !!---------------------------------------------------------------------- 
    532    SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime ) 
     726   SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, lrxios ) 
    533727      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    534728      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
    535729      REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field 
    536730      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
     731      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   lrxios    ! use xios to read restart 
    537732      ! 
    538733      INTEGER                                         ::   idvar     ! variable id 
     
    542737      CHARACTER(LEN=100)                              ::   clname    ! file name 
    543738      CHARACTER(LEN=1)                                ::   cldmspc   ! 
     739      LOGICAL                                         ::   lxios 
    544740      ! 
    545741      itime = 1 
     
    567763   END SUBROUTINE iom_g0d 
    568764 
    569    SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount ) 
     765   SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrxios ) 
    570766      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    571767      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     
    575771      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
    576772      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
     773      LOGICAL         , INTENT(in   ),               OPTIONAL ::   lrxios    ! read data using XIOS 
    577774      ! 
    578775      IF( kiomid > 0 ) THEN 
    579776         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 ) 
    581779      ENDIF 
    582780   END SUBROUTINE iom_g1d 
    583781 
    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) 
    585783      INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    586784      INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
     
    594792                                                                               ! called open_ocean_jstart to set the start 
    595793                                                                               ! value for the 2nd dimension (netcdf only) 
     794      LOGICAL         , INTENT(in   ),                 OPTIONAL ::   lrxios    ! read data using XIOS 
    596795      ! 
    597796      IF( kiomid > 0 ) THEN 
    598797         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    599798              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    600               &                                                     lrowattr=lrowattr ) 
     799              &                                                     lrowattr=lrowattr,  lrxios=lrxios) 
    601800      ENDIF 
    602801   END SUBROUTINE iom_g2d 
    603802 
    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 ) 
    605804      INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    606805      INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
     
    614813                                                                                 ! called open_ocean_jstart to set the start 
    615814                                                                                 ! value for the 2nd dimension (netcdf only) 
     815      LOGICAL         , INTENT(in   ),                   OPTIONAL ::   lrxios    ! read data using XIOS 
    616816      ! 
    617817      IF( kiomid > 0 ) THEN 
    618818         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    619819              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    620               &                                                     lrowattr=lrowattr ) 
     820              &                                                     lrowattr=lrowattr, lrxios=lrxios ) 
    621821      ENDIF 
    622822   END SUBROUTINE iom_g3d 
     
    626826         &                  pv_r1d, pv_r2d, pv_r3d,   & 
    627827         &                  ktime , kstart, kcount,   & 
    628          &                  lrowattr                ) 
     828         &                  lrowattr, lrxios        ) 
    629829      !!----------------------------------------------------------------------- 
    630830      !!                  ***  ROUTINE  iom_get_123d  *** 
     
    647847                                                                           ! called open_ocean_jstart to set the start 
    648848                                                                           ! 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 
    650852      LOGICAL                        ::   llnoov      ! local definition to read overlap 
    651853      LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
     
    674876      !--------------------------------------------------------------------- 
    675877      ! 
    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 )  
    679882      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  ) & 
    687895     &           CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    688896 
     
    701909      ENDIF 
    702910 
    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',   & 
    752959               &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    753          ELSEIF( idmspc == irankpv ) THEN 
    754             IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
     960             ELSEIF( idmspc == irankpv ) THEN 
     961                IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    755962               &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    756          ELSEIF( idmspc >  irankpv ) THEN 
    757                IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    758                   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...'              ,   & 
    759966                        &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    760967                        &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
    761                   idmspc = idmspc - 1 
    762                ELSE 
    763                   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,'         ,   & 
    764971                     &                         'we do not accept data with '//cldmspc//' spatial dimensions',   & 
    765972                     &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
    766                ENDIF 
    767          ENDIF 
    768  
    769          ! 
    770          ! definition of istart and icnt 
    771          ! 
    772          icnt  (:) = 1 
    773          istart(:) = 1 
    774          istart(idmspc+1) = itime 
     973                   ENDIF 
     974             ENDIF 
     975 
     976             ! 
     977             ! definition of istart and icnt 
     978             ! 
     979             icnt  (:) = 1 
     980             istart(:) = 1 
     981             istart(idmspc+1) = itime 
    775982 
    776983         IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
     
    7931000! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    7941001!                  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 /) 
    7961003                  ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    7971004! JMM + SM: ugly patch before getting the new version of lib_mpp) 
     
    8101017         ENDIF 
    8111018 
    812          ! check that istart and icnt can be used with this file 
    813          !- 
    814          DO jl = 1, jpmax_dims 
    815             itmp = istart(jl)+icnt(jl)-1 
    816             IF( itmp > idimsz(jl) .AND. idimsz(jl) /= 0 ) THEN 
    817                WRITE( ctmp1, FMT="('(istart(', i1, ') + icnt(', i1, ') - 1) = ', i5)" ) jl, jl, itmp 
    818                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             ENDIF 
    821          END DO 
    822  
    823          ! check that icnt matches the input array 
    824          !-      
    825          IF( idom == jpdom_unknown ) THEN 
    826             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          ELSE 
    831             IF( irankpv == 2 ) THEN 
     1019             ! 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 
    8321039! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    8331040!               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                ENDIF 
    837             ENDIF 
    838             IF( irankpv == 3 ) THEN  
     1041                   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  
    8391046! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    8401047!               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                ENDIF 
    844             ENDIF 
    845          ENDIF 
     1048                   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 
    8461053          
    847          DO jl = 1, irankpv 
    848             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 DO 
    851  
    852       ENDIF 
    853  
    854       ! read the data 
    855       !-      
    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 read 
     1054             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 
    8591066! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    8601067!         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    8611068!         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    8621069!         ENDIF 
    863          IF( llnoov ) THEN 
    864             IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    865             ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    866             ENDIF 
    867          ELSE 
    868             IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
    869             ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    870             ENDIF 
    871          ENDIF 
     1070             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 
    8721079       
    8731080         SELECT CASE (iom_file(kiomid)%iolib) 
     
    8781085         END SELECT 
    8791086 
    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) 
    8821089           
    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 
    9181156   END SUBROUTINE iom_get_123d 
    9191157 
     
    12621500            &    lonvalue_1D=lonvalue, latvalue_1D=latvalue, mask_1D=mask, nvertex=nvertex, bounds_lon_1D=bounds_lon,      & 
    12631501            &    bounds_lat_1D=bounds_lat, area=area, type='curvilinear') 
    1264      ENDIF 
     1502      ENDIF 
    12651503      IF ( xios_is_valid_domaingroup(cdid) ) THEN 
    12661504         CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj,   & 
     
    13781616 
    13791617 
    1380    SUBROUTINE set_grid( cdgrd, plon, plat ) 
     1618   SUBROUTINE set_grid( cdgrd, plon, plat, lxios ) 
    13811619      !!---------------------------------------------------------------------- 
    13821620      !!                     ***  ROUTINE set_grid  *** 
     
    13911629      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    13921630      INTEGER  :: ni,nj 
     1631      LOGICAL, INTENT(IN) :: lxios 
    13931632       
    13941633      ni=nlei-nldi+1 ; nj=nlej-nldj+1 
     
    13991638         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    14001639 
    1401       IF ( ln_mskland ) THEN 
     1640      IF ( ln_mskland.AND.(.NOT.lxios) ) THEN 
    14021641         ! mask land points, keep values on coast line -> specific mask for U, V and W points 
    14031642         SELECT CASE ( cdgrd ) 
     
    14391678      ! Offset of coordinate representing bottom-left corner 
    14401679      SELECT CASE ( TRIM(cdgrd) ) 
    1441          CASE ('T', 'W') 
     1680         CASE ('T', 'W', 'N') 
    14421681            icnr = -1 ; jcnr = -1 
    14431682         CASE ('U') 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r7646 r8612  
    4646!$AGRIF_DO_NOT_TREAT 
    4747   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0 
     48!XIOS read restart    
     49   LOGICAL, PUBLIC            ::   lxios_read          !: read single file restart using XIOS 
     50   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file 
     51   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE.  
    4852 
    4953   TYPE, PUBLIC ::   file_descriptor 
     
    6670   END TYPE file_descriptor 
    6771   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
     72 
     73   INTEGER, PARAMETER, PUBLIC                   :: max_rst_fields = 95   
     74!  CHARACTER(len=30),DIMENSION(max_rst_fields), PUBLIC   :: rst_fields ! names of variables in restart file 
     75 
     76   TYPE, PUBLIC :: RST_FIELD   
     77    CHARACTER(len=30) :: vname ! names of variables in restart file 
     78    CHARACTER(len=30) :: grid 
     79   END TYPE RST_FIELD 
     80   TYPE(RST_FIELD), PUBLIC :: rst_fields(max_rst_fields) 
     81 
    6882!$AGRIF_END_DO_NOT_TREAT 
    6983 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r7646 r8612  
    126126            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'x', kdompar(1,1)  , idmy ), clinfo) 
    127127            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'y', kdompar(2,1)  , idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'z', jpk           , idmy ), clinfo) 
    129             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 't', NF90_UNLIMITED, idmy ), clinfo) 
     128            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'nav_lev', jpk           , idmy ), clinfo) 
     129            CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    130130            ! global attributes 
    131131            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r6140 r8612  
    193193            WRITE(numout,*) '~~~~~~~~' 
    194194         ENDIF 
    195  
     195         lxios_sini = .FALSE. 
    196196         clpath = TRIM(cn_ocerst_indir) 
    197197         IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    198198         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 
    199       ENDIF 
     199! are we using XIOS to read the data? Part above will have to modified once XIOS 
     200! can handle checking if variable is in the restart file (there will be no need to open 
     201! restart) 
     202         IF(.NOT.lxios_set) lxios_read = lxios_read.AND.lxios_sini 
     203         IF( lxios_read) THEN 
     204           rxios_context = 'nemo_rst' 
     205         if(.NOT.lxios_set) then 
     206             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 
     207             CALL iom_init( rxios_context ) 
     208             lxios_set = .TRUE. 
     209         endif 
     210         ENDIF 
     211         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lxios_read) THEN 
     212            CALL iom_init( rxios_context ) 
     213            IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 
     214            lxios_set = .TRUE. 
     215         ENDIF  
     216      ENDIF 
     217 
    200218   END SUBROUTINE rst_read_open 
    201219 
     
    211229      REAL(wp) ::   zrdt 
    212230      INTEGER  ::   jk 
     231      TYPE(xios_duration):: dtime 
     232      integer::ni,nj,nk 
    213233      !!---------------------------------------------------------------------- 
    214234 
     
    217237      ! Check dynamics and tracer time-step consistency and force Euler restart if changed 
    218238      IF( iom_varid( numror, 'rdt', ldstop = .FALSE. ) > 0 )   THEN 
    219          CALL iom_get( numror, 'rdt', zrdt ) 
     239         CALL iom_get( numror, 'rdt', zrdt, lrxios = lxios_read ) 
    220240         IF( zrdt /= rdt )   neuler = 0 
    221241      ENDIF 
    222242 
    223243      ! Diurnal DSST  
    224       IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst  )  
     244      IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, lrxios = lxios_read )  
    225245      IF ( ln_diurnal_only ) THEN  
    226246         IF(lwp) WRITE( numout, * ) & 
    227247         &   "rst_read:- ln_diurnal_only set, setting rhop=rau0"  
    228248         rhop = rau0 
    229          CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem) )  
     249         CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,1,jp_tem), lrxios = lxios_read )  
    230250         RETURN  
    231251      ENDIF   
    232252       
    233253      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    234          CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub      )   ! before fields 
    235          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb      ) 
    236          CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem) ) 
    237          CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal) ) 
    238          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb    ) 
     254         CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, lrxios = lxios_read                )   ! before fields 
     255         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, lrxios = lxios_read                ) 
     256         CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), lrxios = lxios_read ) 
     257         CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), lrxios = lxios_read ) 
     258         CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, lrxios = lxios_read              ) 
    239259      ELSE 
    240260         neuler = 0 
    241261      ENDIF 
    242262      ! 
    243       CALL iom_get( numror, jpdom_autoglo, 'un'     , un      )   ! now    fields 
    244       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn      ) 
    245       CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem) ) 
    246       CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal) ) 
    247       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn    ) 
     263      CALL iom_get( numror, jpdom_autoglo, 'un'     , un, lrxios = lxios_read )   ! now    fields 
     264      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, lrxios = lxios_read ) 
     265      CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), lrxios = lxios_read ) 
     266      CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), lrxios = lxios_read ) 
     267      CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, lrxios = lxios_read ) 
    248268      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    249          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop    )   ! now    potential density 
     269         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, lrxios = lxios_read )   ! now    potential density 
    250270      ELSE 
    251271         CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )    
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r8524 r8612  
    6565      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    6666      TYPE(FLD_N)        ::  sn_apr   ! informations about the fields to be read 
     67      LOGICAL            ::  lxios_read ! read restart using XIOS? 
    6768      !! 
    6869      NAMELIST/namsbc_apr/ cn_dir, sn_apr, ln_ref_apr, rn_pref, ln_apr_obc 
     
    152153         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN  
    153154            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    154             CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb )   ! before inv. barometer ssh 
     155            CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, lrxios = lxios_read )   ! before inv. barometer ssh 
    155156            ! 
    156157         ELSE                                         !* no restart: set from nit000 values 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r8329 r8612  
    2727   USE timing          ! Timing 
    2828   USE lib_fortran     ! glob_sum 
     29   USE iom_def, ONLY : lxios_read 
    2930 
    3031   IMPLICIT NONE 
     
    218219                 & iom_varid( numror, 'fwf_isf_b', ldstop = .FALSE. ) > 0 ) THEN 
    219220               IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    220                CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:) )   ! before salt content isf_tsc trend 
    221                CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal) )   ! before salt content isf_tsc trend 
    222                CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem) )   ! before salt content isf_tsc trend 
     221               CALL iom_get( numror, jpdom_autoglo, 'fwf_isf_b', fwfisf_b(:,:), lrxios = lxios_read )   ! before salt content isf_tsc trend 
     222               CALL iom_get( numror, jpdom_autoglo, 'isf_sc_b', risf_tsc_b(:,:,jp_sal), lrxios = lxios_read )   ! before salt content isf_tsc trend 
     223               CALL iom_get( numror, jpdom_autoglo, 'isf_hc_b', risf_tsc_b(:,:,jp_tem), lrxios = lxios_read )   ! before salt content isf_tsc trend 
    223224           ELSE 
    224225               fwfisf_b(:,:)    = fwfisf(:,:) 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r8524 r8612  
    5858 
    5959   USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic 
     60   USE iom_def, ONLY : lxios_read 
    6061 
    6162   IMPLICIT NONE 
     
    457458            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    458459            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    459             CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b )   ! before i-stress  (U-point) 
    460             CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b )   ! before j-stress  (V-point) 
    461             CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b  )   ! before non solar heat flux (T-point) 
     460            CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, lrxios = lxios_read )   ! before i-stress  (U-point) 
     461            CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, lrxios = lxios_read )   ! before j-stress  (V-point) 
     462            CALL iom_get( numror, jpdom_autoglo, 'qns_b' , qns_b, lrxios = lxios_read  )   ! before non solar heat flux (T-point) 
    462463            ! The 3D heat content due to qsr forcing is treated in traqsr 
    463             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b  ) ! before     solar heat flux (T-point) 
    464             CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b  )    ! before     freshwater flux (T-point) 
     464            ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, lrxios = lxios_read  ) ! before     solar heat flux (T-point) 
     465            CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, lrxios = lxios_read  )    ! before     freshwater flux (T-point) 
    465466            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
    466467            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
    467                CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b )  ! before salt flux (T-point) 
     468               CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, lrxios = lxios_read )  ! before salt flux (T-point) 
    468469            ELSE 
    469470               sfx_b (:,:) = sfx(:,:) 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r7968 r8612  
    2828   USE lib_mpp        ! MPP library 
    2929   USE wrk_nemo       ! Memory allocation 
     30   USE iom_def, ONLY : lxios_read 
    3031 
    3132   IMPLICIT NONE 
     
    147148         IF( ln_rstart .AND.    &                               !* Restart: read in restart file 
    148149            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
    149             IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file' 
    150             CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b )     ! before runoff 
    151             CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem) )   ! before heat content of runoff 
    152             CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal) )   ! before salinity content of runoff 
     150            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file', lxios_read 
     151            CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b, lrxios = lxios_read )     ! before runoff 
     152            CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), lrxios = lxios_read )   ! before heat content of runoff 
     153            CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), lrxios = lxios_read )   ! before salinity content of runoff 
    153154         ELSE                                                   !* no restart: set from nit000 values 
    154155            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r7753 r8612  
    2222   USE prtctl         ! Print control 
    2323   USE iom            ! IOM library 
     24   USE iom_def, ONLY : lxios_read 
    2425 
    2526   IMPLICIT NONE 
     
    206207         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 
    207208            l_ssm_mean = .TRUE. 
    208             CALL iom_get( numror               , 'nn_fsbc', zf_sbc )    ! sbc frequency of previous run 
    209             CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m  )    ! sea surface mean velocity    (U-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             CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m  )    ! 1st level thickness          (T-point) 
     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    (U-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            CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m, lrxios = lxios_read  )    ! 1st level thickness          (T-point) 
     216            CALL iom_get( numror, jpdom_autoglo, 'e3t_m', e3t_m, lrxios = lxios_read ) 
    215217            ! fraction of solar net radiation absorbed in 1st T level 
    216218            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
    217                CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m  ) 
     219               CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m, lrxios = lxios_read  ) 
    218220            ELSE 
    219221               frq_m(:,:) = 1._wp   ! default definition 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r7753 r8612  
    3636   USE wrk_nemo       ! Memory Allocation 
    3737   USE timing         ! Timing 
    38  
     38   USE iom_def, ONLY : lxios_read 
    3939   IMPLICIT NONE 
    4040   PRIVATE 
     
    139139            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
    140140            z1_2 = 0.5_wp 
    141             CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b )   ! before heat content trend due to Qsr flux 
     141            CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, lrxios = lxios_read )   ! before heat content trend due to Qsr flux 
    142142         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    143143            z1_2 = 1._wp 
     
    430430      ! 1st ocean level attenuation coefficient (used in sbcssm) 
    431431      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 
    432          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev  ) 
     432         CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev, lrxios = lxios_read  ) 
    433433      ELSE 
    434434         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7788 r8612  
    3434   USE wrk_nemo       ! Memory Allocation 
    3535   USE timing         ! Timing 
     36   USE iom_def, ONLY : lxios_read 
    3637 
    3738   IMPLICIT NONE 
     
    108109            zfact = 0.5_wp 
    109110            sbc_tsc(:,:,:) = 0._wp 
    110             CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem) )   ! before heat content sbc trend 
    111             CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal) )   ! before salt content sbc trend 
     111            CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), lrxios = lxios_read )   ! before heat content sbc trend 
     112            CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), lrxios = lxios_read )   ! before salt content sbc trend 
    112113         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    113114            zfact = 1._wp 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/TRD/trdmxl_rst.F90

    r6140 r8612  
    150150      IF( ln_trdmxl_instant ) THEN  
    151151         !-- Temperature 
    152          CALL iom_get( inum, jpdom_autoglo, 'tmlbb'           , tmlbb          ) 
    153          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) 
    154          CALL iom_get( inum, jpdom_autoglo, 'tmlatfb'         , tmlatfb        ) 
     152         CALL iom_get( inum, jpdom_autoglo, 'tmlbb'           , tmlbb ) 
     153         CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn ) 
     154         CALL iom_get( inum, jpdom_autoglo, 'tmlatfb'         , tmlatfb ) 
    155155         ! 
    156156         !-- Salinity 
    157          CALL iom_get( inum, jpdom_autoglo, 'smlbb'           , smlbb          ) 
    158          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) 
    159          CALL iom_get( inum, jpdom_autoglo, 'smlatfb'         , smlatfb        ) 
     157         CALL iom_get( inum, jpdom_autoglo, 'smlbb'           , smlbb ) 
     158         CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn ) 
     159         CALL iom_get( inum, jpdom_autoglo, 'smlatfb'         , smlatfb ) 
    160160      ELSE 
    161          CALL iom_get( inum, jpdom_autoglo, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum 
     161         CALL iom_get( inum, jpdom_autoglo, 'hmxlbn'          , hmxlbn ) ! needed for hmxl_sum 
    162162         ! 
    163163         !-- Temperature 
    164          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) ! needed for tml_sum 
    165          CALL iom_get( inum, jpdom_autoglo, 'tml_sumb'        , tml_sumb       ) 
     164         CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn ) ! needed for tml_sum 
     165         CALL iom_get( inum, jpdom_autoglo, 'tml_sumb'        , tml_sumb ) 
    166166         DO jk = 1, jpltrd 
    167167            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I1)")   jk 
     
    173173         ! 
    174174         !-- Salinity 
    175          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) ! needed for sml_sum 
    176          CALL iom_get( inum, jpdom_autoglo, 'sml_sumb'        , sml_sumb       ) 
     175         CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn ) ! needed for sml_sum 
     176         CALL iom_get( inum, jpdom_autoglo, 'sml_sumb'        , sml_sumb ) 
    177177         DO jk = 1, jpltrd 
    178178            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('smltrd_csum_ub_', I1)")   jk 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfgls.F90

    r7646 r8612  
    3434   USE timing         ! Timing 
    3535   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     36   USE iom_def, ONLY : lxios_read 
    3637 
    3738   IMPLICIT NONE 
     
    11751176            ! 
    11761177            IF( MIN( id1, id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist 
    1177                CALL iom_get( numror, jpdom_autoglo, 'en'    , en     ) 
    1178                CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt    ) 
    1179                CALL iom_get( numror, jpdom_autoglo, 'avm'   , avm    ) 
    1180                CALL iom_get( numror, jpdom_autoglo, 'avmu'  , avmu   ) 
    1181                CALL iom_get( numror, jpdom_autoglo, 'avmv'  , avmv   ) 
    1182                CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln   ) 
     1178               CALL iom_get( numror, jpdom_autoglo, 'en'    , en, lrxios = lxios_read     ) 
     1179               CALL iom_get( numror, jpdom_autoglo, 'avt'   , avt, lrxios = lxios_read    ) 
     1180               CALL iom_get( numror, jpdom_autoglo, 'avm'   , avm, lrxios = lxios_read    ) 
     1181               CALL iom_get( numror, jpdom_autoglo, 'avmu'  , avmu, lrxios = lxios_read   ) 
     1182               CALL iom_get( numror, jpdom_autoglo, 'avmv'  , avmv, lrxios = lxios_read   ) 
     1183               CALL iom_get( numror, jpdom_autoglo, 'mxln'  , mxln, lrxios = lxios_read   ) 
    11831184            ELSE                         
    11841185               IF(lwp) WRITE(numout,*) ' ===>>>> : previous run without gls scheme, en and mxln computed by iterative loop' 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90

    r7646 r8612  
    2828   USE iom             ! IOM library 
    2929   USE lib_mpp         ! distribued memory computing 
     30   USE iom_def, ONLY : lxios_read 
    3031 
    3132   IMPLICIT NONE 
     
    159160         ! file in traadv_cen2 end read here.  
    160161         IF( iom_varid( numror, 'avmb', ldstop = .FALSE. ) > 0 ) THEN 
    161             CALL iom_get( numror, jpdom_unknown, 'avmb', avmb ) 
    162             CALL iom_get( numror, jpdom_unknown, 'avtb', avtb ) 
     162            CALL iom_get( numror, jpdom_unknown, 'avmb', avmb, lrxios = lxios_read ) 
     163            CALL iom_get( numror, jpdom_unknown, 'avtb', avtb, lrxios = lxios_read ) 
    163164         ENDIF 
    164165      ENDIF 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7813 r8612  
    5757   USE agrif_opa_update 
    5858#endif 
     59   USE iom_def, ONLY : lxios_read 
    5960 
    6061   IMPLICIT NONE 
     
    845846           ! 
    846847           IF( id1 > 0 ) THEN                       ! 'en' exists 
    847               CALL iom_get( numror, jpdom_autoglo, 'en', en ) 
     848              CALL iom_get( numror, jpdom_autoglo, 'en', en, lrxios = lxios_read ) 
    848849              IF( MIN( id2, id3, id4, id5, id6 ) > 0 ) THEN        ! all required arrays exist 
    849                  CALL iom_get( numror, jpdom_autoglo, 'avt'  , avt   ) 
    850                  CALL iom_get( numror, jpdom_autoglo, 'avm'  , avm   ) 
    851                  CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu  ) 
    852                  CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv  ) 
    853                  CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl ) 
     850                 CALL iom_get( numror, jpdom_autoglo, 'avt'  , avt, lrxios = lxios_read   ) 
     851                 CALL iom_get( numror, jpdom_autoglo, 'avm'  , avm, lrxios = lxios_read   ) 
     852                 CALL iom_get( numror, jpdom_autoglo, 'avmu' , avmu, lrxios = lxios_read  ) 
     853                 CALL iom_get( numror, jpdom_autoglo, 'avmv' , avmv, lrxios = lxios_read  ) 
     854                 CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl, lrxios = lxios_read ) 
    854855              ELSE                                                 ! one at least array is missing 
    855856                 CALL tke_avn                                          ! compute avt, avm, avmu, avmv and dissl (approximation) 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/OPA_SRC/step.F90

    r7753 r8612  
    345345      IF( kstp == nitend .OR. indic < 0 ) THEN  
    346346                      CALL iom_context_finalize(      cxios_context          ) ! needed for XIOS+AGRIF 
     347                      IF(lxios_read) CALL iom_context_finalize(      rxios_context          ) 
    347348         IF( ln_crs ) CALL iom_context_finalize( trim(cxios_context)//"_crs" ) !  
    348349      ENDIF 
  • branches/2017/dev_r8600_xios_read/NEMOGCM/NEMO/SAS_SRC/daymod.F90

    r8583 r8612  
    3333   USE timing         ! Timing 
    3434   USE restart        ! restart 
    35  
     35   USE iom_def, ONLY : lxios_read 
    3636   IMPLICIT NONE 
    3737   PRIVATE 
     
    318318         IF( iom_varid( numror, 'kt', ldstop = .FALSE. ) > 0 ) THEN 
    319319            ! Get Calendar informations 
    320             CALL iom_get( numror, 'kt', zkt )   ! last time-step of previous run 
     320            CALL iom_get( numror, 'kt', zk, lrxios = lxios_read )   ! last time-step of previous run 
    321321            IF(lwp) THEN 
    322322               WRITE(numout,*) ' *** Info read in restart : ' 
     
    337337            IF ( nrstdt == 2 ) THEN 
    338338               ! read the parameters corresponding to nit000 - 1 (last time step of previous run) 
    339                CALL iom_get( numror, 'ndastp', zndastp ) 
     339               CALL iom_get( numror, 'ndastp', zndastp, lrxios = lxios_read ) 
    340340               ndastp = NINT( zndastp ) 
    341                CALL iom_get( numror, 'adatrj', adatrj  ) 
    342           CALL iom_get( numror, 'ntime', ktime ) 
     341               CALL iom_get( numror, 'adatrj', adatrj, lrxios = lxios_read ) 
     342          CALL iom_get( numror, 'ntime', ktime, lrxios = lxios_read ) 
    343343          nn_time0=INT(ktime) 
    344344               ! calculate start time in hours and minutes 
Note: See TracChangeset for help on using the changeset viewer.