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 8243 – NEMO

Changeset 8243


Ignore:
Timestamp:
2017-06-29T11:41:55+02:00 (7 years ago)
Author:
andmirek
Message:

#1914 working XIOS read, XIOS write and single processor read

Location:
branches/UKMO/test_moci_test_suite/NEMOGCM
Files:
41 edited

Legend:

Unmodified
Added
Removed

  • branches/UKMO/test_moci_test_suite/NEMOGCM/CONFIG/SHARED/domain_def.xml

    r7923 r8243  
    193193        </domain_group> 
    194194 
     195     <domain_group id="grid_N"> 
     196      <domain id="grid_N" long_name="grid nomask"/> 
     197     </domain_group> 
     198 
    195199   </domain_definition>     
    196200  

  • branches/UKMO/test_moci_test_suite/NEMOGCM/CONFIG/SHARED/namelist_ref

    r8038 r8243  
    5151   nn_chunksz  =       0   !  chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    5252   ln_xios_read = .FALSE.  !  use XIOS to read restart file (only for a single file restart) 
     53   nn_wxios = 0      !  use XIOS to write restart file 0 - no, 1 - single file output, 2 - multiple file output 
    5354/ 
    5455! 
    … …  
    211212   ln_tsd_init   = .true.   !  Initialisation of ocean T & S with T &S input data (T) or not (F) 
    212213   ln_tsd_tradmp = .true.   !  damping of ocean T & S toward T &S input data (T) or not (F) 
     214   ln_tsd_sio   = .false. 
    213215/ 
    214216!!====================================================================== 
    … …  
    298300 
    299301   cn_dir      = './'      !  root directory for the location of the flux files 
     302   ln_lfx_sio   = .false.  ! read data using 1 processor only 
    300303/ 
    301304!----------------------------------------------------------------------- 
    … …  
    313316 
    314317   cn_dir      = './'      !  root directory for the location of the bulk files are 
     318   ln_clio_sio   = .false.   ! read data using 1 processor only 
    315319/ 
    316320!----------------------------------------------------------------------- 
    … …  
    337341   rn_vfac     = 0.        !  multiplicative factor for ocean/ice velocity 
    338342                           !  in the calculation of the wind stress (0.=absolute winds or 1.=relative winds) 
     343  ln_core_sio   = .false.   ! read data using 1 processor only 
    339344/ 
    340345!----------------------------------------------------------------------- 
    … …  
    352357 
    353358   cn_dir      = './ECMWF/'      !  root directory for the location of the bulk files 
     359   ln_msf_sio   = .false.   ! read data using 1 processor only 
    354360/ 
    355361!----------------------------------------------------------------------- 
    … …  
    421427   rn_si1      =   23.0    !  2 bands: longest depth of extinction 
    422428   ln_qsr_ice  = .true.    !  light penetration for ice-model LIM3 
     429   ln_qsr_sio   = .false. 
    423430/ 
    424431!----------------------------------------------------------------------- 
    … …  
    445452   rn_dep_max   = 150.      !  depth over which runoffs is spread ( ln_rnf_depth_ini = .true ) 
    446453   nn_rnf_depth_file = 0    !  create (=1) a runoff depth file or not (=0) 
     454   ln_rnf_sio   = .false.   ! read data using 1 processor only 
    447455/ 
    448456!----------------------------------------------------------------------- 
    … …  
    475483                          !     if you want to keep the cd as in global config, adjust rn_gammat0 to compensate 
    476484                          ! 2 = velocity and stability dependent Gamma    Holland et al. 1999 
     485   ln_isf_sio   = .false.   ! read data using 1 processor only 
    477486/ 
    478487!----------------------------------------------------------------------- 
    … …  
    487496   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F) 
    488497   ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data 
     498   ln_apr_sio   = .false. 
    489499/ 
    490500!----------------------------------------------------------------------- 
    … …  
    504514   ln_sssr_bnd =   .true.  !  flag to bound erp term (associated with nn_sssr=2) 
    505515   rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
     516   ln_ssr_sio   = .false.   ! read data using 1 processor only 
    506517/ 
    507518!----------------------------------------------------------------------- 
    … …  
    645656   cn_dir  =    'bdydta/' 
    646657   ln_full_vel = .false. 
     658   ln_bdy_sio = .false. 
    647659/ 
    648660!----------------------------------------------------------------------- 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r6487 r8243  
    4646   INTEGER, ALLOCATABLE, DIMENSION(:)   ::   nb_bdy_fld        ! Number of fields to update for each boundary set. 
    4747   INTEGER                              ::   nb_bdy_fld_sum    ! Total number of fields to update for all boundary sets. 
     48   LOGICAL                              ::   ln_bdy_sio        ! single processor read flag 
    4849 
    4950   LOGICAL,           DIMENSION(jp_bdy) ::   ln_full_vel_array ! =T => full velocities in 3D boundary conditions 
    … …  
    255256      ! update external data from files 
    256257      !-------------------------------- 
    257       
     258      lspr = ln_bdy_sio  
    258259      jstart = 1 
    259260      DO ib_bdy = 1, nb_bdy    
    … …  
    387388         END IF ! nn_dta(ib_bdy) = 1 
    388389      END DO  ! ib_bdy 
    389  
     390      lspr = .false. 
    390391      ! bg jchanut tschanges 
    391392#if defined key_tide 
    … …  
    427428      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices 
    428429      INTEGER      ::   ios                               ! Local integer output status for namelist read 
     430      LOGICAL      ::   ln_bdy_sio 
    429431      !! 
    430432      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    … …  
    452454      TYPE(FLD_N) ::   bn_a_i, bn_ht_i, bn_ht_s       
    453455#endif 
    454       NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d  
     456      NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d, ln_bdy_sio 
    455457#if defined key_lim2 
    456       NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif 
     458      NAMELIST/nambdy_dta/ bn_frld, bn_hicif, bn_hsnif, ln_bdy_sio 
    457459#elif defined key_lim3 
    458       NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s 
    459 #endif 
    460       NAMELIST/nambdy_dta/ ln_full_vel 
     460      NAMELIST/nambdy_dta/ bn_a_i, bn_ht_i, bn_ht_s, ln_bdy_sio 
     461#endif 
     462      NAMELIST/nambdy_dta/ ln_full_vel, ln_bdy_sio 
    461463      !!--------------------------------------------------------------------------- 
    462464 
    … …  
    516518         CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' )   ;   RETURN   
    517519      ENDIF 
    518       ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) )  
     520      ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 
    519521      ALLOCATE( ibdy(nb_bdy_fld_sum) )  
    520522      ALLOCATE( igrid(nb_bdy_fld_sum) )  

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90

    r7924 r8243  
    3333   USE wrk_nemo        ! work arrays 
    3434   USE iom_def, ONLY : lxios_read 
     35   USE iom_def, ONLY : lwxios 
    3536 
    3637   IMPLICIT NONE 
    … …  
    305306        IF(lwp) WRITE(numout,*) ' dia_hsb_rst at it= ', kt,' date= ', ndastp 
    306307        IF(lwp) WRITE(numout,*) '~~~~~~~' 
    307  
    308         CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v     ) 
    309         CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t     ) 
    310         CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s     ) 
     308        IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     309        CALL iom_rstput( kt, nitrst, numrow, 'frc_v'   , frc_v, lxios = lwxios) 
     310        CALL iom_rstput( kt, nitrst, numrow, 'frc_t'   , frc_t, lxios = lwxios) 
     311        CALL iom_rstput( kt, nitrst, numrow, 'frc_s'   , frc_s, lxios = lwxios) 
    311312        IF( .NOT. lk_vvl ) THEN 
    312            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t ) 
    313            CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s ) 
     313           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_t', frc_wn_t, lxios = lwxios) 
     314           CALL iom_rstput( kt, nitrst, numrow, 'frc_wn_s', frc_wn_s, lxios = lwxios ) 
    314315        ENDIF 
    315         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini ) 
    316         CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini ) 
    317         CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini ) 
    318         CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini ) 
     316        CALL iom_rstput( kt, nitrst, numrow, 'ssh_ini', ssh_ini, lxios = lwxios) 
     317        CALL iom_rstput( kt, nitrst, numrow, 'e3t_ini', e3t_ini, lxios = lwxios) 
     318        CALL iom_rstput( kt, nitrst, numrow, 'hc_loc_ini', hc_loc_ini, lxios = lwxios) 
     319        CALL iom_rstput( kt, nitrst, numrow, 'sc_loc_ini', sc_loc_ini, lxios = lwxios) 
    319320        IF( .NOT. lk_vvl ) THEN 
    320            CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini ) 
    321            CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini ) 
     321           CALL iom_rstput( kt, nitrst, numrow, 'ssh_hc_loc_ini', ssh_hc_loc_ini, lxios = lwxios ) 
     322           CALL iom_rstput( kt, nitrst, numrow, 'ssh_sc_loc_ini', ssh_sc_loc_ini, lxios = lwxios ) 
    322323        ENDIF 
    323324        ! 
     325        IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    324326     ENDIF 
    325327     ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90

    r8001 r8243  
    3636   USE restart         ! restart 
    3737   USE iom_def, ONLY : lxios_read 
     38   USE iom_def, ONLY : lwxios 
    3839 
    3940   IMPLICIT NONE 
    … …  
    360361         ENDIF 
    361362         ! calendar control 
    362          CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp) )   ! time-step 
    363          CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp) )   ! date 
    364          CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj            )   ! number of elapsed days since 
     363         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     364         CALL iom_rstput( kt, nitrst, numrow, 'kt'     , REAL( kt    , wp), lxios = lwxios )   ! time-step 
     365         CALL iom_rstput( kt, nitrst, numrow, 'ndastp' , REAL( ndastp, wp), lxios = lwxios )   ! date 
     366         CALL iom_rstput( kt, nitrst, numrow, 'adatrj' , adatrj, lxios = lwxios            )   ! number of elapsed days since 
    365367         !                                                                     ! the begining of the run [s] 
     368         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    366369      ENDIF 
    367370      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

    r8001 r8243  
    3838   USE timing          ! Timing 
    3939   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    40    USE iom_def, ONLY:lxios_read 
     40   USE iom_def, ONLY:lxios_read, lwxios, wxioso 
    4141 
    4242   IMPLICIT NONE 
    … …  
    140140         &             nn_it000, nn_itend  , nn_date0    , nn_leapy     , nn_istate , nn_stock ,   & 
    141141         &             nn_write, ln_dimgnnn, ln_mskland  , ln_cfmeta    , ln_clobber, nn_chunksz, nn_euler, & 
    142          &             ln_xios_read 
     142         &             ln_xios_read, nn_wxios 
    143143      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   & 
    144144         &             nn_acc   , rn_atfp     , rn_rdt      , rn_rdtmin ,                  & 
    … …  
    155155      !!---------------------------------------------------------------------- 
    156156      ln_xios_read = .false.            ! set in case ln_xios_read is not in namelist 
     157      nn_wxios = 0 
    157158      REWIND( numnam_ref )              ! Namelist namrun in reference namelist : Parameters of the run 
    158159      READ  ( numnam_ref, namrun, IOSTAT = ios, ERR = 901) 
    … …  
    196197         WRITE(numout,*) '      NetCDF chunksize (bytes)        nn_chunksz = ', nn_chunksz 
    197198         WRITE(numout,*) '      READ restart for a single file using XIOS ln_xios_read =', ln_xios_read 
     199         WRITE(numout,*) '      Write restart using XIOS        nn_wxios   = ', nn_wxios 
    198200      ENDIF 
    199201 
    … …  
    309311      rdtmax    = rn_rdtmin 
    310312      rdth      = rn_rdth 
     313      if (nn_wxios > 0) lwxios = .TRUE.  
     314      wxioso = nn_wxios 
    311315 
    312316      REWIND( numnam_ref )              ! Namelist namcla in reference namelist : Cross land advection 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r7924 r8243  
    135135      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    136136 
     137      ! Set variables needed in iom for reastart write with XIOS 
     138      lr_vvl_ztilde = ln_vvl_ztilde 
     139      lr_vvl_layer   = ln_vvl_layer 
    137140      ! choose vertical coordinate (z_star, z_tilde or layer) 
    138141      ! ========================== 
    … …  
    910913         !                                           ! all cases ! 
    911914         !                                           ! --------- ! 
    912          CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:) ) 
    913          CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:) ) 
     915         IF( lwxios ) CALL iom_swap(      wxios_context          )  
     916         CALL iom_rstput( kt, nitrst, numrow, 'fse3t_b', fse3t_b(:,:,:), lxios = lwxios ) 
     917         CALL iom_rstput( kt, nitrst, numrow, 'fse3t_n', fse3t_n(:,:,:), lxios = lwxios ) 
    914918         !                                           ! ----------------------- ! 
    915919         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN  ! z_tilde and layer cases ! 
    916920            !                                        ! ----------------------- ! 
    917             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:) ) 
    918             CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:) ) 
     921            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_b', tilde_e3t_b(:,:,:), lxios = lwxios) 
     922            CALL iom_rstput( kt, nitrst, numrow, 'tilde_e3t_n', tilde_e3t_n(:,:,:), lxios = lwxios) 
    919923         END IF 
    920924         !                                           ! -------------!     
    921925         IF( ln_vvl_ztilde ) THEN                    ! z_tilde case ! 
    922926            !                                        ! ------------ ! 
    923             CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:) ) 
     927            CALL iom_rstput( kt, nitrst, numrow, 'hdiv_lf', hdiv_lf(:,:,:), lxios = lwxios) 
    924928         ENDIF 
    925  
     929         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    926930      ENDIF 
    927931      IF( nn_timing == 1 )  CALL timing_stop('dom_vvl_rst') 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r6486 r8243  
    2323   USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
     25   USE iom_def, ONLY:lspr 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3233   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag 
    3334   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag 
     35   LOGICAL , PUBLIC ::   ln_tsd_sio       !: read file using 1 processor 
    3436 
    3537   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read) 
    … …  
    6163      TYPE(FLD_N)                   ::   sn_tem, sn_sal 
    6264      !! 
    63       NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
     65      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal, ln_tsd_sio 
    6466      INTEGER  ::   ios 
    6567      !!---------------------------------------------------------------------- 
    … …  
    7072      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
    7173      ! 
     74      ln_tsd_sio = .FALSE. 
    7275      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
    7376      READ  ( numnam_ref, namtsd, IOSTAT = ios, ERR = 901) 
    … …  
    154157      IF( nn_timing == 1 )  CALL timing_start('dta_tsd') 
    155158      ! 
     159      lspr = ln_tsd_sio 
    156160      CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==! 
     161      lspr = .false. 
    157162      ! 
    158163      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90

    r7924 r8243  
    5252#endif 
    5353   USE iom_def, ONLY : lxios_read 
     54   USE iom_def, ONLY : lwxios 
    5455 
    5556   IMPLICIT NONE 
    … …  
    406407! Caution : extra-hallow 
    407408! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj) 
    408          CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) ) 
    409          CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) ) 
     409         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     410         CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj), lxios = lwxios ) 
     411         CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj), lxios = lwxios ) 
     412         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    410413      ENDIF 
    411414      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r7924 r8243  
    4949#endif 
    5050   USE iom_def, ONLY : lxios_read 
     51   USE iom_def, ONLY : lwxios 
    5152 
    5253   IMPLICIT NONE 
    … …  
    10391040      ! 
    10401041      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    1041          CALL iom_rstput( kt, nitrst, numrow, 'ub2_b'   , ub2_b  (:,:) ) 
    1042          CALL iom_rstput( kt, nitrst, numrow, 'vb2_b'   , vb2_b  (:,:) ) 
     1042         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     1043         CALL iom_rstput( kt, nitrst, numrow, 'ub2_b'   , ub2_b  (:,:), lxios = lwxios ) 
     1044         CALL iom_rstput( kt, nitrst, numrow, 'vb2_b'   , vb2_b  (:,:), lxios = lwxios ) 
    10431045         ! 
    10441046         IF (.NOT.ln_bt_av) THEN 
    1045             CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e'  , sshbb_e(:,:) )  
    1046             CALL iom_rstput( kt, nitrst, numrow, 'ubb_e'    ,   ubb_e(:,:) ) 
    1047             CALL iom_rstput( kt, nitrst, numrow, 'vbb_e'    ,   vbb_e(:,:) ) 
    1048             CALL iom_rstput( kt, nitrst, numrow, 'sshb_e'   ,  sshb_e(:,:) ) 
    1049             CALL iom_rstput( kt, nitrst, numrow, 'ub_e'     ,    ub_e(:,:) ) 
    1050             CALL iom_rstput( kt, nitrst, numrow, 'vb_e'     ,    vb_e(:,:) ) 
     1047            CALL iom_rstput( kt, nitrst, numrow, 'sshbb_e'  , sshbb_e(:,:), lxios = lwxios )  
     1048            CALL iom_rstput( kt, nitrst, numrow, 'ubb_e'    ,   ubb_e(:,:), lxios = lwxios ) 
     1049            CALL iom_rstput( kt, nitrst, numrow, 'vbb_e'    ,   vbb_e(:,:), lxios = lwxios ) 
     1050            CALL iom_rstput( kt, nitrst, numrow, 'sshb_e'   ,  sshb_e(:,:), lxios = lwxios ) 
     1051            CALL iom_rstput( kt, nitrst, numrow, 'ub_e'     ,    ub_e(:,:), lxios = lwxios ) 
     1052            CALL iom_rstput( kt, nitrst, numrow, 'vb_e'     ,    vb_e(:,:), lxios = lwxios ) 
    10511053         ENDIF 
    10521054#if defined key_agrif 
    10531055         ! Save time integrated fluxes 
    10541056         IF ( .NOT.Agrif_Root() ) THEN 
    1055             CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b'  , ub2_i_b(:,:) ) 
    1056             CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b'  , vb2_i_b(:,:) ) 
    1057          ENDIF 
    1058 #endif 
     1057            CALL iom_rstput( kt, nitrst, numrow, 'ub2_i_b'  , ub2_i_b(:,:), lxios = lwxios ) 
     1058            CALL iom_rstput( kt, nitrst, numrow, 'vb2_i_b'  , vb2_i_b(:,:), lxios = lwxios ) 
     1059         ENDIF 
     1060#endif 
     1061         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    10591062      ENDIF 
    10601063      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90

    r8001 r8243  
    5050   INTEGER       ::   nn_chunksz       !: chunksize (bytes) for NetCDF file (works only with iom_nf90 routines) 
    5151   LOGICAL       ::   ln_xios_read     !: use xios to read single file restart 
     52   INTEGER       ::   nn_wxios         !: write resart using xios 0 - no, 1 - single, 2 - multiple file output 
    5253#if defined key_netcdf4 
    5354   !!---------------------------------------------------------------------- 
    … …  
    153154   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
    154155   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    155    CHARACTER(lc) ::   rxios_context         !: context name used in xios to read restart 
     156   CHARACTER(lc) ::   rxios_context = "nemo_rst"  !: context name used in xios to read restart 
     157   CHARACTER(lc) ::   wxios_context = "nemo_rstw" !: context name used in xios to write restart file 
    156158 
    157159   !!---------------------------------------------------------------------- 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90

    r8161 r8243  
    4141   USE dianam          ! build name of file 
    4242   USE xios 
    43    USE iom_def, ONLY : max_rst_fields, rst_fields 
     43   USE iom_def, ONLY : max_rst_fields, rst_fields, wxioso 
    4444# endif 
    4545   USE ioipsl, ONLY :  ju2ymds    ! for calendar 
    4646   USE crs             ! Grid coarsening 
    47    USE lib_fortran  
     47   USE sbc_oce, ONLY : lk_oasis, ln_coupled_iceshelf_fluxes, ln_apr_dyn, ln_rnf, nn_components, jp_iam_sas 
     48   USE diadct, ONLY : lk_diadct 
    4849 
    4950   IMPLICIT NONE 
     51   !  values needed to set correctlyfiles in reast file when using XIOS for writing 
     52   LOGICAL, PUBLIC :: lr_vvl_ztilde, lr_vvl_layer, lr_traadv_cen2 
     53 
    5054   PUBLIC   !   must be public to be able to access iom_def through iom 
    51     
    5255#if defined key_iomput 
    5356   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.        !: iom_put flag 
    … …  
    5558   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    5659#endif 
     60 
    5761   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    5862   PUBLIC iom_getatt, iom_use, iom_context_finalize 
    … …  
    6468   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 
    6569   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
    66    PRIVATE set_rst_vars, set_rstr_active 
     70   PRIVATE set_rst_vars, set_rstr_active, set_rstw_active 
    6771# endif 
    6872 
    … …  
    8892CONTAINS 
    8993 
    90    SUBROUTINE iom_init( cdname )  
     94   SUBROUTINE iom_init( cdname, filename, it )  
    9195      !!---------------------------------------------------------------------- 
    9296      !!                     ***  ROUTINE   *** 
    … …  
    108112      ! 
    109113      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_bnds 
     114      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: filename  
     115      LOGICAL :: lrst_context              ! is context related to restart 
     116      INTEGER, OPTIONAL :: it              ! timestep when subroutine was called 
    110117      !!---------------------------------------------------------------------- 
    111118#if ! defined key_xios2 
    … …  
    119126      CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 
    120127      CALL iom_swap( cdname ) 
     128      lrst_context =  (TRIM(cdname) == TRIM(wxios_context)).OR.(TRIM(cdname) == TRIM(rxios_context)) 
    121129 
    122130      ! calendar parameters 
    … …  
    145153      CALL set_scalar 
    146154 
    147       IF( TRIM(cdname) == TRIM(cxios_context) .OR. TRIM(cdname) == TRIM(rxios_context)) THEN   
     155      IF( TRIM(cdname) == TRIM(cxios_context) ) THEN   
    148156         CALL set_grid( "T", glamt, gphit, ln_mskland )  
    149157         CALL set_grid( "U", glamu, gphiu, ln_mskland ) 
    … …  
    151159         CALL set_grid( "W", glamt, gphit, ln_mskland ) 
    152160         CALL set_grid_znl( gphit ) 
    153          CALL set_grid("N",glamt, gphit, .FALSE.)        ! not masked values 
    154161         ! 
    155          IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN   ! Add additional grid metadata 
     162         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    156163            CALL iom_set_domain_attr("grid_T", area = e12t(nldi:nlei, nldj:nlej)) 
    157164            CALL iom_set_domain_attr("grid_U", area = e12u(nldi:nlei, nldj:nlej)) 
    … …  
    164171         ENDIF 
    165172      ENDIF 
     173 
     174     IF( lrst_context )  CALL set_grid("N",glamt, gphit, .FALSE.)        ! not masked values 
    166175 
    167176      IF( TRIM(cdname) == TRIM(cxios_context)//"_crs" ) THEN   
    … …  
    176185         CALL dom_grid_glo   ! Return to parent grid domain 
    177186         ! 
    178          IF( ln_cfmeta .AND. TRIM(cdname) .NE. TRIM(rxios_context)) THEN   ! Add additional grid metadata 
     187         IF( ln_cfmeta .AND. .NOT.lrst_context) THEN   ! Add additional grid metadata 
    179188            CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
    180189            CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
    … …  
    188197      ENDIF 
    189198 
    190       ! vertical grid definition 
    191       CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 
    192       CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 
    193       CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 
    194       CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 
    195  
     199          ! vertical grid definition 
     200          CALL iom_set_axis_attr( "deptht", paxis = gdept_1d ) 
     201          CALL iom_set_axis_attr( "depthu", paxis = gdept_1d ) 
     202          CALL iom_set_axis_attr( "depthv", paxis = gdept_1d ) 
     203          CALL iom_set_axis_attr( "depthw", paxis = gdepw_1d ) 
     204 
     205      IF(.NOT.lrst_context) THEN 
    196206      ! Add vertical grid bounds 
    197207#if ! defined key_xios2 
    198       z_bnds(:      ,1) = gdepw_1d(:) 
    199       z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
    200       z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
    201 #else 
    202       z_bnds(1      ,:) = gdepw_1d(:) 
    203       z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
    204       z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    205 #endif 
    206  
    207       CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
    208       CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
    209       CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
     208          z_bnds(:      ,1) = gdepw_1d(:) 
     209          z_bnds(1:jpkm1,2) = gdepw_1d(2:jpk) 
     210          z_bnds(jpk:   ,2) = gdepw_1d(jpk) + e3t_1d(jpk) 
     211#else 
     212          z_bnds(1      ,:) = gdepw_1d(:) 
     213          z_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     214          z_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     215#endif 
     216 
     217          CALL iom_set_axis_attr( "deptht", bounds=z_bnds ) 
     218          CALL iom_set_axis_attr( "depthu", bounds=z_bnds ) 
     219          CALL iom_set_axis_attr( "depthv", bounds=z_bnds ) 
    210220 
    211221#if ! defined key_xios2 
    212       z_bnds(:    ,2)  = gdept_1d(:) 
    213       z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1) 
    214       z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1) 
    215 #else 
    216       z_bnds(2,:    )  = gdept_1d(:) 
    217       z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1) 
    218       z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1) 
    219 #endif 
    220       CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
    221  
     222          z_bnds(:    ,2)  = gdept_1d(:) 
     223          z_bnds(2:jpk,1)  = gdept_1d(1:jpkm1) 
     224          z_bnds(1    ,1)  = gdept_1d(1) - e3w_1d(1) 
     225#else 
     226          z_bnds(2,:    )  = gdept_1d(:) 
     227          z_bnds(1,2:jpk)  = gdept_1d(1:jpkm1) 
     228          z_bnds(1,1    )  = gdept_1d(1) - e3w_1d(1) 
     229#endif 
     230          CALL iom_set_axis_attr( "depthw", bounds=z_bnds ) 
     231      ENDIF 
    222232 
    223233# if defined key_floats 
    … …  
    237247!set which fields are to be read from restart file 
    238248       CALL set_rstr_active() 
     249      ELSE IF ( TRIM(cdname) == TRIM(wxios_context)) THEN 
     250!set names of the fields in restart file IF using XIOS to read/write data 
     251       CALL set_rst_vars() 
     252!set which fields are to be read from restart file 
     253       CALL set_rstw_active(filename, it) 
    239254      ELSE 
    240255       CALL set_xmlatt 
    … …  
    255270 
    256271   END SUBROUTINE iom_init 
    257  
    258272    
    259273   SUBROUTINE set_rst_vars() 
    … …  
    370384        IF( clpath(LEN_TRIM(clpath):) /= '/' ) clpath = TRIM(clpath) // '/' 
    371385        IF( TRIM(Agrif_CFixed()) == '0' ) THEN 
    372            rst_file = TRIM(cn_ocerst_indir)//TRIM(cn_ocerst_in) 
     386           rst_file = TRIM(clpath)//TRIM(cn_ocerst_in) 
    373387        ELSE 
    374            rst_file = TRIM(cn_ocerst_indir)//'1_'//TRIM(cn_ocerst_in) 
     388           rst_file = TRIM(clpath)//'1_'//TRIM(cn_ocerst_in) 
    375389        ENDIF 
    376390!set name of the restart file and enable available fields 
    … …  
    394408#endif 
    395409   END SUBROUTINE set_rstr_active 
     410 
     411   SUBROUTINE set_rstw_active(rst_file, it) 
     412!sets enabled = .TRUE. for each field in restart file 
     413#if defined key_xios2 
     414   CHARACTER(len=*) :: rst_file 
     415   INTEGER, INTENT(in) :: it ! timestep when iom_init was called 
     416   TYPE(xios_field) :: field_hdl 
     417   TYPE(xios_file) :: file_hdl 
     418   TYPE(xios_filegroup) :: filegroup_hdl 
     419   INTEGER :: i 
     420 
     421!set then name of the restart file (OUTPUT!) and enable available fields 
     422        if(lwp) WRITE(numout,*) 'Setting (output) restart filename (for XIOS) to: ',TRIM(rst_file) 
     423        CALL xios_get_handle("file_definition", filegroup_hdl ) 
     424        CALL xios_add_child(filegroup_hdl, file_hdl, 'wrestart') 
     425        IF(wxioso.eq.1) THEN 
     426            CALL xios_set_file_attr( "wrestart", type="one_file", name = TRIM(rst_file), & 
     427               enabled=.TRUE., mode="write", output_freq=xios_timestep) 
     428            if(lwp) write(numout,*) 'OPEN ', trim(rst_file), ' in one_file mode' 
     429        ELSE  
     430            CALL xios_set_file_attr( "wrestart", type="multiple_file", name = TRIM(rst_file),& 
     431               enabled=.TRUE., mode="write", output_freq=xios_timestep) 
     432          if(lwp) write(numout,*) 'OPEN ', trim(rst_file), ' in multiple_file mode' 
     433        ENDIF 
     434 
     435        CALL xios_set_file_attr( "wrestart", name=trim(rst_file)) 
     436        call flush(numout)  
     437!      CALL xios_update_calendar(it+1)       ! + one because we open restart file  
     438                                              ! 1 timestep before write 
     439 
     440!define fields for restart write context 
     441!in restart.F90 
     442        DO i= 1, 17 
     443           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     444           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     445                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     446           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     447        ENDDO 
     448!in daymod.F90 
     449        DO i= 18, 20 
     450                      CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     451           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     452                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     453           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     454        ENDDO 
     455!end daymod.F90 
     456!sbcmod.F90 
     457        DO i= 21, 25 
     458           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     459           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     460                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     461           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     462        ENDDO 
     463!end sbcmod.F90 
     464!ALL FIELDS ABOUVE ALWAYS 
     465!zdftke.F90 
     466#if defined key_zdftke   ||   defined key_esopa 
     467        DO i= 26, 31 
     468           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     469           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     470                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     471           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     472        ENDDO 
     473#endif 
     474!end zdftke.F90 
     475!traqsr.F90 
     476       i = 34 
     477       CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     478       CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     479                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant")         
     480       if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     481       i = 37 
     482       CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     483       CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     484                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant")         
     485       if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     486!END traqsr.F90 
     487#if defined key_dynspg_flt   ||   defined key_esopa  
     488!dynspg_flt.F90 
     489        DO i= 35, 36 
     490           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     491           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     492                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     493           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     494        ENDDO 
     495!end dynspg_flt.F90 
     496#endif 
     497!trasbc.F90 START 
     498        DO i= 32, 33 
     499           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     500           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     501                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     502           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     503        ENDDO 
     504        DO i= 69, 71 
     505           CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     506           CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     507                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     508           if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     509        ENDDO 
     510!trasbc.F90 END 
     511        IF( lk_oasis) THEN 
     512        ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
     513          IF( ln_coupled_iceshelf_fluxes ) THEN 
     514             DO i= 38, 43 
     515                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     516                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     517                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     518                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     519             ENDDO 
     520          ENDIF 
     521        ENDIF 
     522#if defined key_zdfkpp 
     523        i = 44 
     524        CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     525        CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     526             grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     527        if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     528#endif 
     529!dia_hsb_rst 
     530#if defined key_diadct 
     531        IF( lk_diadct     ) THEN 
     532             DO i= 45, 47 
     533                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     534                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     535                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     536                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     537             ENDDO 
     538 
     539             DO i= 50, 53 
     540                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     541                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     542                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     543                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     544             ENDDO 
     545             IF( .NOT. lk_vvl ) THEN 
     546             DO i= 48, 48 
     547                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     548                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     549                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     550                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     551             ENDDO 
     552             DO i= 54, 55 
     553                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     554                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     555                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     556                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     557             ENDDO 
     558             ENDIF 
     559        ENDIF 
     560#endif 
     561!end dia_hsb_rst 
     562!domvvl.F90 
     563        IF( lk_vvl ) THEN 
     564             DO i= 56, 57 
     565                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     566                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     567                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     568                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     569             ENDDO 
     570           IF( lr_vvl_ztilde .OR. lr_vvl_layer ) THEN  ! z_tilde and layer cases ! 
     571             DO i= 58, 59 
     572                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     573                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     574                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     575                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     576             ENDDO 
     577            END IF 
     578            IF( lr_vvl_ztilde ) THEN                    ! z_tilde case ! 
     579            i=60 
     580            CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     581            CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     582                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     583            if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     584            ENDIF 
     585         ENDIF 
     586!end domvvl.F90 
     587!dynspg_ts.F90 
     588#if defined key_dynspg_ts   ||   defined key_esopa 
     589         DO i= 61, 62 
     590            CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     591            CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     592                 grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     593            if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     594         ENDDO 
     595         IF (.NOT.ln_bt_av) THEN 
     596            DO i= 63, 68 
     597               CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     598               CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     599                    grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     600               if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     601            ENDDO 
     602         ENDIF 
     603#if defined key_agrif 
     604         ! Save time integrated fluxes 
     605         IF ( .NOT.Agrif_Root() ) THEN 
     606            DO i= 84, 85 
     607               CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     608               CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     609                    grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     610               if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     611            ENDDO 
     612         ENDIF 
     613#endif 
     614#endif 
     615!end dynspg_ts.F90 
     616!sbcapr.F90 
     617          IF( ln_apr_dyn) THEN 
     618             i = 72 
     619             CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     620             CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     621                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     622             if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     623          ENDIF 
     624!end sbcapr.F90 
     625!sbcrnf.F90 
     626        IF( ln_rnf      ) THEN 
     627             DO i= 73, 75 
     628                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     629                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     630                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     631                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     632             ENDDO 
     633        ENDIF  
     634!end sbcrnf.F90 
     635!sbcssm.F90 
     636        IF( nn_components /= jp_iam_sas .AND. nn_fsbc .NE. 1) THEN 
     637             DO i= 76, 81 
     638                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     639                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     640                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     641                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     642             ENDDO 
     643             i = 83 
     644             CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     645             CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     646                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     647             if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     648             IF( lk_vvl )  THEN 
     649                i = 82 
     650                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     651                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     652                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     653                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     654             ENDIF  
     655        ENDIF 
     656!end sbcssm.F90 
     657       IF( lr_traadv_cen2   ) THEN 
     658            DO i= 84, 85 
     659                CALL xios_add_child(file_hdl, field_hdl, TRIM(rst_fields(i)%vname)) 
     660                CALL xios_set_attr (field_hdl, enabled = .TRUE., prec = 8,           & 
     661                     grid_ref = TRIM(rst_fields(i)%grid ), operation = "instant") 
     662                if(lwp) write(numout,*) 'id= ',i,' set ', TRIM(rst_fields(i)%vname), ' enabled' 
     663             ENDDO 
     664       ENDIF 
     665#endif 
     666   END SUBROUTINE set_rstw_active 
    396667 
    397668   SUBROUTINE iom_swap( cdname ) 
    … …  
    510781      ! try to find if the file to be opened already exist 
    511782      ! ============= 
    512       INQUIRE( FILE = clname, EXIST = llok ) 
     783      lxios_sini = .TRUE. 
     784      if(lwm) INQUIRE( FILE = clname, EXIST = llok ) 
     785      IF(lk_mpp) CALL mpp_bcast(llok) 
    513786      IF( .NOT.llok ) THEN 
    514787         ! we try to add the cpu number to the name 
    … …  
    528801            icnt = icnt + 1 
    529802         END DO 
    530       ELSE 
    531          lxios_sini = .TRUE. 
     803         lxios_sini = .FALSE. 
    532804      ENDIF 
    533805      IF( llwrt ) THEN 
    … …  
    12631535   !!                   INTERFACE iom_rstput 
    12641536   !!---------------------------------------------------------------------- 
    1265    SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     1537   SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, lxios ) 
    12661538      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    12671539      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    12701542      REAL(wp)        , INTENT(in)                         ::   pvar     ! written field 
    12711543      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1544      LOGICAL, OPTIONAL :: lxios   ! xios write flag 
     1545      LOGICAL :: lx                ! local xios write flag 
    12721546      INTEGER :: ivid   ! variable id 
    1273       IF( kiomid > 0 ) THEN 
    1274          IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1275             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1276             SELECT CASE (iom_file(kiomid)%iolib) 
    1277             CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
    1278             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
    1279             CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 
    1280             CASE DEFAULT      
    1281                CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    1282             END SELECT 
     1547 
     1548      lx = .FALSE. 
     1549      IF(PRESENT(lxios)) lx = lxios 
     1550      IF( lx ) THEN 
     1551#ifdef key_iomput 
     1552       IF( kt == kwrite ) THEN 
     1553          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 
     1554          CALL xios_send_field(trim(cdvar), pvar) 
     1555       ENDIF 
     1556#endif 
     1557      ELSE 
     1558         IF( kiomid > 0 ) THEN 
     1559            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1560               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1561               SELECT CASE (iom_file(kiomid)%iolib) 
     1562               CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1563               CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1564               CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pvar ) 
     1565               CASE DEFAULT      
     1566                  CALL ctl_stop( 'iom_rp0d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     1567               END SELECT 
     1568            ENDIF 
    12831569         ENDIF 
    12841570      ENDIF 
    12851571   END SUBROUTINE iom_rp0d 
    12861572 
    1287    SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     1573   SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, lxios ) 
    12881574      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    12891575      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    12921578      REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    12931579      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1580      LOGICAL, OPTIONAL :: lxios   ! xios write flag 
     1581      LOGICAL :: lx                ! local xios write flag 
    12941582      INTEGER :: ivid   ! variable id 
    1295       IF( kiomid > 0 ) THEN 
    1296          IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1297             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1298             SELECT CASE (iom_file(kiomid)%iolib) 
    1299             CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
    1300             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
    1301             CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 
    1302             CASE DEFAULT      
    1303                CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    1304             END SELECT 
     1583 
     1584      lx = .FALSE. 
     1585      IF(PRESENT(lxios)) lx = lxios 
     1586      IF( lx ) THEN 
     1587#ifdef key_iomput 
     1588       IF( kt == kwrite ) THEN 
     1589          IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 
     1590          CALL xios_send_field(trim(cdvar), pvar) 
     1591       ENDIF 
     1592#endif 
     1593      ELSE 
     1594         IF( kiomid > 0 ) THEN 
     1595            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1596               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1597               SELECT CASE (iom_file(kiomid)%iolib) 
     1598               CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1599               CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1600               CASE (jprstdimg)   ;   IF( kt == kwrite )    CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r1d = pvar ) 
     1601               CASE DEFAULT      
     1602                  CALL ctl_stop( 'iom_rp1d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     1603               END SELECT 
     1604            ENDIF 
    13051605         ENDIF 
    13061606      ENDIF 
    13071607   END SUBROUTINE iom_rp1d 
    13081608 
    1309    SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     1609   SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, lxios ) 
    13101610      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    13111611      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    13141614      REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    13151615      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1616      LOGICAL, OPTIONAL :: lxios   ! xios write flag 
     1617      LOGICAL :: lx                ! local xios write flag 
    13161618      INTEGER :: ivid   ! variable id 
    1317       IF( kiomid > 0 ) THEN 
    1318          IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1319             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1320             SELECT CASE (iom_file(kiomid)%iolib) 
    1321             CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
    1322             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
    1323             CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )  
    1324             CASE DEFAULT      
    1325                CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
    1326             END SELECT 
     1619 
     1620      lx = .FALSE. 
     1621      IF(PRESENT(lxios)) lx = lxios 
     1622      IF( lx ) THEN 
     1623#ifdef key_iomput 
     1624       IF( kt == kwrite ) THEN 
     1625          IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 
     1626          CALL xios_send_field(trim(cdvar), pvar) 
     1627       ENDIF 
     1628#endif 
     1629      ELSE 
     1630         IF( kiomid > 0 ) THEN 
     1631            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1632               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1633               SELECT CASE (iom_file(kiomid)%iolib) 
     1634               CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1635               CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1636               CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r2d = pvar )  
     1637               CASE DEFAULT      
     1638                  CALL ctl_stop( 'iom_rp2d: accepted IO library are only jpioipsl, jpnf90 and jprstdimg' ) 
     1639               END SELECT 
     1640            ENDIF 
    13271641         ENDIF 
    13281642      ENDIF 
    13291643   END SUBROUTINE iom_rp2d 
    13301644 
    1331    SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype ) 
     1645   SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, lxios ) 
    13321646      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    13331647      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    … …  
    13361650      REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    13371651      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1652      LOGICAL, OPTIONAL :: lxios   ! xios write flag 
     1653      LOGICAL :: lx                 ! local xios write flag 
    13381654      INTEGER :: ivid   ! variable id 
    1339       IF( kiomid > 0 ) THEN 
    1340          IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1341             ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1342             SELECT CASE (iom_file(kiomid)%iolib) 
    1343             CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    1344             CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    1345             CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 
    1346             CASE DEFAULT      
    1347                CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 
    1348             END SELECT 
     1655 
     1656      lx = .FALSE. 
     1657      IF(PRESENT(lxios)) lx = lxios 
     1658      IF( lx ) THEN 
     1659#ifdef key_iomput 
     1660      IF( kt == kwrite ) THEN 
     1661          IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 
     1662          CALL xios_send_field(trim(cdvar), pvar) 
     1663      ENDIF 
     1664#endif 
     1665      ELSE 
     1666         IF( kiomid > 0 ) THEN 
     1667            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1668               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1669               SELECT CASE (iom_file(kiomid)%iolib) 
     1670               CASE (jpioipsl )   ;   CALL iom_ioipsl_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
     1671               CASE (jpnf90   )   ;   CALL iom_nf90_rstput(   kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
     1672               CASE (jprstdimg)   ;   IF( kt == kwrite )   CALL iom_rstdimg_rstput( kiomid, cdvar, ivid, pv_r3d = pvar ) 
     1673               CASE DEFAULT      
     1674                  CALL ctl_stop( 'iom_rp3d: accepted IO library are only jpioipsl and jprstdimg' ) 
     1675               END SELECT 
     1676            ENDIF 
    13491677         ENDIF 
    13501678      ENDIF 
    … …  
    15981926#endif      
    15991927      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    1600       CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1601          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    16021928 
    16031929      IF ( lmask ) THEN 
     1930          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei,nldj:nlej),(/ ni*nj /)),   & 
     1931         &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /))) 
    16041932         ! mask land points, keep values on coast line -> specific mask for U, V and W points 
    16051933         SELECT CASE ( cdgrd ) 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/IOM/iom_def.F90

    r8038 r8243  
    5555   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file 
    5656   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE.  
     57!XIOS read restart    
     58   LOGICAL, PUBLIC            ::   lwxios          !: read single file restart using XIOS 
     59   INTEGER, PUBLIC            ::   wxioso          !: type of restart file when writing using XIOS 1 - single, 2 - multiple 
     60   LOGICAL, PUBLIC            ::   lspr            !: single processor read data flag 
     61 
    5762 
    5863   TYPE, PUBLIC ::   file_descriptor 
    … …  
    7277      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    7378      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
     79      LOGICAL                                   ::   lsngl = .FALSE.    !: one file flag 
    7480   END TYPE file_descriptor 
    7581   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/IOM/iom_nf90.F90

    r7924 r8243  
    7272      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7373      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
     74      INTEGER            ::   lng              ! length of the string - unlimited dimension 
    7475      !--------------------------------------------------------------------- 
    7576 
    … …  
    9293            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL, idmy                          ), clinfo) 
    9394         ELSE              ! ... in read mode 
    94             IF(lwp) WRITE(numout,*) TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode' 
    95             CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 
     95            IF(lwp) WRITE(numout,*) & 
     96               TRIM(clinfo)//' open existing file: '//TRIM(cdname)//' in READ mode (Single PE read ',lspr,')' 
     97            IF(lspr) THEN 
     98              IF(lwm) CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 
     99              IF(lk_mpp) call mpp_bcast(if90id) 
     100            ELSE 
     101              CALL iom_nf90_check(NF90_OPEN( TRIM(cdname), NF90_NOWRITE, if90id, chunksize = ichunk ), clinfo) 
     102            ENDIF 
    96103         ENDIF 
    97104      ELSE                                       ! the file does not exist (or we overwrite it) 
    … …  
    152159         iom_file(kiomid)%nvars  = 0 
    153160         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    154          CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
     161         IF(lwm) CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
     162         IF(lk_mpp) CALL mpp_bcast(iom_file(kiomid)%iduld) 
    155163         IF ( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    156            CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     &  
     164           IF(lwm) CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, iom_file(kiomid)%iduld,     &  
    157165        &                                               name = iom_file(kiomid)%uldname,  & 
    158166        &                                               len  = iom_file(kiomid)%lenuld ), clinfo ) 
    159          ENDIF 
    160          IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK' 
     167           IF(lk_mpp) THEN 
     168             lng = 32                                    ! from iom_file definition 
     169             CALL mpp_bcast(iom_file(kiomid)%uldname, lng) 
     170             CALL mpp_bcast(iom_file(kiomid)%lenuld) 
     171           ENDIF 
     172         ENDIF 
     173         iom_file(kiomid)%lsngl = lxios_sini.and.lspr 
     174         IF(lwp) WRITE(numout,*) '                   ---> '//TRIM(cdname)//' OK. Is one file?:', lxios_sini, '1PE read:',iom_file(kiomid)%lsngl 
    161175      ELSE 
    162176         kiomid = 0               ! return error flag 
    … …  
    177191      ! 
    178192      clinfo = '      iom_nf90_close    , file: '//TRIM(iom_file(kiomid)%name) 
    179       CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo) 
     193      IF(lwp.OR.(.NOT.lwp.AND..NOT.iom_file(kiomid)%lsngl)) CALL iom_nf90_check(NF90_CLOSE(iom_file(kiomid)%nfid), clinfo) 
    180194      !     
    181195   END SUBROUTINE iom_nf90_close 
    … …  
    202216      LOGICAL                        ::   llok             ! ok  test 
    203217      CHARACTER(LEN=100)             ::   clinfo           ! info character 
     218      REAL(wp)                       ::   rwp              ! real scratch variable 
    204219      !!----------------------------------------------------------------------- 
    205220      clinfo = '          iom_nf90_varid, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(cdvar) 
    … …  
    208223      if90id = iom_file(kiomid)%nfid        ! get back NetCDF file id 
    209224      ! 
    210       llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file 
     225      IF(lwm) llok = NF90_INQ_VARID( if90id, TRIM(cdvar), ivarid ) == nf90_noerr   ! does the variable exist in the file 
     226      IF(lk_mpp) CALL mpp_bcast(llok)  
    211227      IF( llok ) THEN 
    212228         iom_nf90_varid = kiv 
    213229         iom_file(kiomid)%nvars       = kiv 
     230         IF(lk_mpp) CALL mpp_bcast(ivarid) 
    214231         iom_file(kiomid)%nvid(kiv)   = ivarid 
    215232         iom_file(kiomid)%cn_var(kiv) = TRIM(cdvar) 
    216          CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions 
     233         IF(lwm) CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, ndims = i_nvd), clinfo)   ! number of dimensions 
     234         IF(lk_mpp) CALL mpp_bcast(i_nvd) 
    217235         iom_file(kiomid)%ndims(kiv)  = i_nvd 
    218          CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
     236         IF(lwm) CALL iom_nf90_check(NF90_Inquire_Variable(if90id, ivarid, dimids = idimid(1:i_nvd)), clinfo)   ! dimensions ids 
     237         IF(lk_mpp) CALL mpp_bcast(idimid(1:i_nvd), i_nvd) 
    219238         iom_file(kiomid)%luld(kiv) = .FALSE.   ! default value 
    220239         iom_file(kiomid)%dimsz(:,kiv) = 0      ! reset dimsz in case previously used 
    221240         DO ji = 1, i_nvd                       ! dimensions size 
    222             CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
     241            IF(iom_file(kiomid)%lsngl) THEN                  ! if single file  
     242               IF(lwm) CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo)    
     243               IF(lk_mpp) CALL mpp_bcast(iom_file(kiomid)%dimsz(ji,kiv)) 
     244            ELSE 
     245               CALL iom_nf90_check(NF90_Inquire_Dimension(if90id, idimid(ji), len = iom_file(kiomid)%dimsz(ji,kiv)), clinfo) 
     246            ENDIF 
    223247            IF( idimid(ji) == iom_file(kiomid)%iduld ) iom_file(kiomid)%luld(kiv) = .TRUE.   ! unlimited dimension?  
    224248         END DO 
    225249         !---------- Deal with scale_factor and add_offset 
    226          llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr 
     250         IF(lwm) llok = NF90_Inquire_attribute(if90id, ivarid, 'scale_factor') == nf90_noerr 
     251         IF(lk_mpp) CALL mpp_bcast(llok) 
    227252         IF( llok) THEN 
    228             CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', iom_file(kiomid)%scf(kiv)), clinfo) 
     253            IF(iom_file(kiomid)%lsngl) THEN                  ! if single file 
     254               IF(lwm) CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', rwp), clinfo) 
     255               IF(lk_mpp) CALL mpp_bcast(rwp) 
     256            ELSE 
     257               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'scale_factor', rwp), clinfo) 
     258            ENDIF 
     259            iom_file(kiomid)%scf(kiv) = rwp  
    229260         ELSE 
    230261            iom_file(kiomid)%scf(kiv) = 1. 
    231262         END IF 
    232          llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr 
     263         IF(lwm) llok = NF90_Inquire_attribute(if90id, ivarid, 'add_offset') == nf90_noerr 
     264         IF(lk_mpp) CALL mpp_bcast(llok) 
    233265         IF( llok ) THEN 
    234             CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', iom_file(kiomid)%ofs(kiv)), clinfo) 
     266            IF(iom_file(kiomid)%lsngl) THEN                  ! if single file 
     267               IF(lwm) CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', rwp), clinfo) 
     268               IF(lk_mpp) CALL mpp_bcast(rwp) 
     269            ELSE 
     270               CALL iom_nf90_check(NF90_GET_ATT(if90id, ivarid, 'add_offset', rwp), clinfo) 
     271            ENDIF 
     272            iom_file(kiomid)%ofs(kiv) = rwp 
    235273         ELSE 
    236274            iom_file(kiomid)%ofs(kiv) = 0. 
    237275         END IF 
    238          ! return the simension size 
     276         ! return the dimension size 
    239277         IF( PRESENT(kdimsz) ) THEN  
    240278            IF( i_nvd == SIZE(kdimsz) ) THEN 
    … …  
    267305      !--------------------------------------------------------------------- 
    268306      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    269       CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
     307      IF(lwm.OR.(.NOT.iom_file(kiomid)%lsngl)) & 
     308      & CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
     309      IF(lk_mpp.AND.iom_file(kiomid)%lsngl) call mpp_bcast(pvar) 
    270310      !  
    271311   END SUBROUTINE iom_nf90_g0d 
    … …  
    290330      REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    291331      REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     332      ! Temporary arrays 
     333      !  
     334      REAL(wp), ALLOCATABLE, DIMENSION(:)   ::   t_r1d 
     335      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   t_r2d    ! read field (2D case) 
     336      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   t_r3d    ! read field (3D case) 
    292337      ! 
    293338      CHARACTER(LEN=100) ::   clinfo               ! info character 
    294339      INTEGER            ::   if90id               ! nf90 identifier of the opened file 
    295340      INTEGER            ::   ivid                 ! nf90 variable id 
     341      INTEGER            ::   klev                 ! vertical level 
     342      REAL(wp)           ::   astart , mpi_wtime 
    296343      !--------------------------------------------------------------------- 
    297344      clinfo = 'iom_nf90_g123d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    … …  
    299346      ivid   = iom_file(kiomid)%nvid(kvid)   ! get back NetCDF var id 
    300347      ! 
     348      if(lwm) astart =  mpi_wtime() 
    301349      IF(     PRESENT(pv_r1d) ) THEN 
     350        IF(iom_file(kiomid)%lsngl) THEN 
     351            allocate(t_r1d(iom_file(kiomid)%dimsz(1,kvid))) 
     352            IF(lwm) THEN 
     353               if(lwp) write(numout,*) 'READ 1D SINGLE PROCESSOR: ',TRIM(iom_file(kiomid)%cn_var(kvid)) 
     354               IF(knbdim.EQ.2) THEN 
     355                  CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r1d, start = (/ 1, kstart(knbdim) /), & 
     356     &                 count = (/ iom_file(kiomid)%dimsz(1,kvid), 1 /)), clinfo) 
     357               ELSE 
     358                  CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r1d), clinfo) 
     359               ENDIF 
     360            ENDIF 
     361            if(lk_mpp) CALL mpp_bcast(t_r1d, iom_file(kiomid)%dimsz(1,kvid)) 
     362            pv_r1d(:) = t_r1d(kstart(1):kstart(1)+kcount(1)-1) 
     363            deallocate(t_r1d) 
     364        ELSE 
    302365         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r1d(:                ), start = kstart(1:knbdim),   & 
    303366            &                                                                       count = kcount(1:knbdim)), clinfo ) 
     367        ENDIF 
    304368      ELSEIF( PRESENT(pv_r2d) ) THEN 
    305          CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   & 
     369         IF(iom_file(kiomid)%lsngl) THEN 
     370            allocate(t_r2d(iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid))) 
     371            IF(lwm) THEN 
     372               if(lwp) write(numout,*) 'READ 2D SINGLE PROCESSOR: ',TRIM(iom_file(kiomid)%cn_var(kvid)) 
     373               IF(knbdim.EQ.3) THEN 
     374                  CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r2d, start = (/ 1, 1, kstart(knbdim) /), & 
     375     &                 count = (/ iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid), 1 /)), clinfo) 
     376               ELSE 
     377                  CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r2d), clinfo) 
     378               ENDIF 
     379            ENDIF 
     380            if(lk_mpp) CALL mpp_bcast(t_r2d, iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid)) 
     381            pv_r2d(kx1:kx2,ky1:ky2  ) = t_r2d(kstart(1):kstart(1)+kcount(1)-1, kstart(2):kstart(2)+kcount(2)-1) 
     382            deallocate(t_r2d) 
     383         ELSE 
     384            CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r2d(kx1:kx2,ky1:ky2  ), start = kstart(1:knbdim),   & 
    306385            &                                                                       count = kcount(1:knbdim)), clinfo ) 
     386         ENDIF 
    307387      ELSEIF( PRESENT(pv_r3d) ) THEN 
     388        IF(iom_file(kiomid)%lsngl) THEN 
     389            allocate(t_r3d(iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid), iom_file(kiomid)%dimsz(3,kvid))) 
     390            if(lwp) write(numout,*) 'READ 3D SINGLE PROCESSOR: ',TRIM(iom_file(kiomid)%cn_var(kvid)) 
     391            IF(lwm) THEN 
     392                IF(knbdim.EQ.4) THEN 
     393                     CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r3d, start = (/ 1, 1, 1, kstart(knbdim) /), & 
     394      &                  count = (/ iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid), & 
     395                                                                  iom_file(kiomid)%dimsz(3,kvid), 1 /)), clinfo) 
     396!                 do klev = 1, iom_file(kiomid)%dimsz(3,kvid) 
     397!                    CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r3d(:,:,klev), start = (/ 1, 1, klev, kstart(knbdim) /), & 
     398!    &                  count = (/ iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid), 1, 1 /)), clinfo) 
     399!                 enddo 
     400               ELSE 
     401                  CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, t_r3d), clinfo) 
     402               ENDIF 
     403            ENDIF 
     404            if(lk_mpp) CALL mpp_bcast(t_r3d, iom_file(kiomid)%dimsz(1,kvid), iom_file(kiomid)%dimsz(2,kvid), iom_file(kiomid)%dimsz(3,kvid)) 
     405            pv_r3d(kx1:kx2,ky1:ky2, :) = & 
     406               t_r3d(kstart(1):kstart(1)+kcount(1)-1, kstart(2):kstart(2)+kcount(2)-1, kstart(3):kstart(3)+kcount(3)-1) 
     407            deallocate(t_r3d) 
     408        ELSE 
    308409         CALL iom_nf90_check( NF90_GET_VAR(if90id, ivid, pv_r3d(kx1:kx2,ky1:ky2,:), start = kstart(1:knbdim),   & 
    309410            &                                                                       count = kcount(1:knbdim)), clinfo ) 
    310       ENDIF 
     411        ENDIF 
     412      ENDIF  
     413      if(lwm) write(*,*) 'IT took ', mpi_wtime() - astart ,' [s] to read ',TRIM(iom_file(kiomid)%cn_var(kvid)) 
    311414      ! 
    312415   END SUBROUTINE iom_nf90_g123d 
    … …  
    327430      CHARACTER(LEN=100)              ::   clinfo   ! info character 
    328431      !--------------------------------------------------------------------- 
    329       !  
    330       if90id = iom_file(kiomid)%nfid 
    331       llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
    332       IF( llok) THEN 
    333          clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 
    334          CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo) 
    335       ELSE 
    336          CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
    337          pvar = -999 
    338       ENDIF 
     432      ! 
     433      clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 
     434      IF(lwm) THEN  
     435         if90id = iom_file(kiomid)%nfid 
     436         llok = NF90_Inquire_attribute(if90id, NF90_GLOBAL, cdatt) == nf90_noerr 
     437         IF( llok) THEN 
     438            clinfo = 'iom_nf90_getatt, file: '//TRIM(iom_file(kiomid)%name)//', att: '//TRIM(cdatt) 
     439            CALL iom_nf90_check(NF90_GET_ATT(if90id, NF90_GLOBAL, cdatt, values=pvar), clinfo) 
     440         ELSE 
     441            pvar = -999 
     442         ENDIF 
     443      ENDIF 
     444 
     445      IF( lk_mpp ) call mpp_bcast(pvar) 
     446 
     447      IF( pvar .EQ. -999 ) CALL ctl_warn('iom_nf90_getatt: no attribute '//cdatt//' found') 
    339448      !  
    340449   END SUBROUTINE iom_nf90_intatt 
    … …  
    356465      !--------------------------------------------------------------------- 
    357466      clinfo = 'iom_nf90_gettime, file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    358       CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   & 
    359             &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo) 
    360       IF ( PRESENT(cdunits) ) THEN  
    361          CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", & 
    362             &                           values=cdunits), clinfo) 
    363       ENDIF 
    364       IF ( PRESENT(cdcalendar) ) THEN  
    365          CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", & 
    366             &                           values=cdcalendar), clinfo) 
     467      IF(lwm) THEN 
     468         CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), ptime(:),   & 
     469               &                           start=(/ 1 /), count=(/ iom_file(kiomid)%dimsz(1, kvid) /)), clinfo) 
     470         IF( lk_mpp ) CALL mpp_bcast(ptime, SIZE(ptime)) 
     471         IF ( PRESENT(cdunits) ) THEN  
     472            CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "units", & 
     473               &                           values=cdunits), clinfo) 
     474            IF( lk_mpp ) CALL mpp_bcast(cdunits, LEN(cdunits)) 
     475         ENDIF 
     476         IF ( PRESENT(cdcalendar) ) THEN  
     477            CALL iom_nf90_check(NF90_GET_ATT(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), "calendar", & 
     478               &                           values=cdcalendar), clinfo) 
     479            IF( lk_mpp ) CALL mpp_bcast(cdcalendar, LEN(cdcalendar)) 
     480         ENDIF 
     481      ELSE 
     482         IF( lk_mpp ) CALL mpp_bcast(ptime, SIZE(ptime)) 
     483         IF ( PRESENT(cdunits) .AND. lk_mpp ) CALL mpp_bcast(cdunits, LEN(cdunits)) 
     484         IF ( PRESENT(cdcalendar)  .AND. lk_mpp ) CALL mpp_bcast(cdcalendar, LEN(cdcalendar)) 
    367485      ENDIF 
    368486      ! 
    … …  
    576694      CHARACTER(LEN=*), INTENT(in) :: cdinfo 
    577695      !--------------------------------------------------------------------- 
    578       IF(kstatus /= nf90_noerr)   CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) ) 
     696      IF(kstatus /= nf90_noerr)   then 
     697        CALL ctl_stop( 'iom_nf90_check : '//TRIM(nf90_strerror(kstatus)), TRIM(cdinfo) ) 
     698      ENDIF 
    579699   END SUBROUTINE iom_nf90_check 
    580700 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90

    r8161 r8243  
    2626   USE divcur          ! hor. divergence and curl      (div & cur routines) 
    2727   USE sbc_oce         ! for icesheet freshwater input variables 
    28    USE iom_def, ONLY : lxios_read, lxios_set, lxios_sini 
     28   USE iom_def, ONLY : lxios_read, lxios_set, lxios_sini, lwxios 
    2929   USE timing 
    3030 
    … …  
    6767      !!---------------------------------------------------------------------- 
    6868      ! 
     69 
    6970      IF( kt == nit000 ) THEN   ! default definitions 
    7071         lrst_oce = .FALSE.    
    … …  
    105106            IF(lwp) THEN 
    106107               WRITE(numout,*) 
    107                SELECT CASE ( jprstlib ) 
    108                CASE ( jprstdimg )   ;   WRITE(numout,*)                            & 
    109                    '             open ocean restart binary file: ',TRIM(clpath)//clname 
    110                CASE DEFAULT         ;   WRITE(numout,*)                            & 
    111                    '             open ocean restart NetCDF file: ',TRIM(clpath)//clname 
    112                END SELECT 
    113                IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
    114                IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
    115                ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     108               IF(lwxios) THEN 
     109                  WRITE(numout,*)                                                     & 
     110                      '        XIOS open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(clname) 
     111               ELSE 
     112                  SELECT CASE ( jprstlib ) 
     113                  CASE ( jprstdimg )   ;   WRITE(numout,*)                            & 
     114                      '             open ocean restart binary file: ',TRIM(clpath)//TRIM(clname) 
     115                  CASE DEFAULT         ;   WRITE(numout,*)                            & 
     116                      '             open ocean restart NetCDF file: ',TRIM(clpath)//TRIM(clname) 
     117                  END SELECT 
     118                  IF ( snc4set%luse )      WRITE(numout,*) '             opened for NetCDF4 chunking and compression' 
     119                  IF( kt == nitrst - 1 ) THEN   ;   WRITE(numout,*) '             kt = nitrst - 1 = ', kt 
     120                  ELSE                          ;   WRITE(numout,*) '             kt = '             , kt 
     121                  ENDIF 
    116122               ENDIF 
    117123            ENDIF 
    118124            ! 
    119             CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
     125            IF(.NOT.lwxios) THEN 
     126               CALL iom_open( TRIM(clpath)//TRIM(clname), numrow, ldwrt = .TRUE., kiolib = jprstlib ) 
     127            ELSE 
     128               CALL iom_init( wxios_context, TRIM(clpath)//TRIM(clname) ) 
     129               CALL xios_update_calendar(nitrst) 
     130               CALL iom_swap(      cxios_context          ) 
     131            ENDIF 
    120132            lrst_oce = .TRUE. 
    121133         ENDIF 
    … …  
    136148      INTEGER, INTENT(in) ::   kt   ! ocean time-step 
    137149      !!---------------------------------------------------------------------- 
    138  
    139                      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       )   ! dynamics time step 
    140                      CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) )   ! surface tracer time step 
    141  
    142                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        )     ! before fields 
    143                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        ) 
    144                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) ) 
    145                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) ) 
    146                      CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      ) 
    147                      CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     ) 
    148                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      ) 
     150                     IF(lwxios) CALL iom_swap(      wxios_context          ) 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , lxios = lwxios)   ! dynamics time step 
     152                     CALL iom_rstput( kt, nitrst, numrow, 'rdttra1', rdttra(1) , lxios = lwxios)   ! surface tracer time step 
     153 
     154                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub        , lxios = lwxios)     ! before fields 
     155                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb        , lxios = lwxios) 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem) , lxios = lwxios) 
     157                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal) , lxios = lwxios) 
     158                     CALL iom_rstput( kt, nitrst, numrow, 'rotb'   , rotb      , lxios = lwxios) 
     159                     CALL iom_rstput( kt, nitrst, numrow, 'hdivb'  , hdivb     , lxios = lwxios) 
     160                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb      , lxios = lwxios) 
    149161                     ! 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        )     ! now fields 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        ) 
    152                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) ) 
    153                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) ) 
    154                      CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      ) 
    155                      CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     ) 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      ) 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      ) 
     162                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , un        , lxios = lwxios)     ! now fields 
     163                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn        , lxios = lwxios) 
     164                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem) , lxios = lwxios) 
     165                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal) , lxios = lwxios) 
     166                     CALL iom_rstput( kt, nitrst, numrow, 'rotn'   , rotn      , lxios = lwxios) 
     167                     CALL iom_rstput( kt, nitrst, numrow, 'hdivn'  , hdivn     , lxios = lwxios) 
     168                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn      , lxios = lwxios) 
     169                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop      , lxios = lwxios) 
    158170#if defined key_zdfkpp 
    159                      CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       ) 
     171                     CALL iom_rstput( kt, nitrst, numrow, 'rhd'    , rhd       , lxios = lwxios) 
    160172#endif 
    161173                     IF( lk_oasis) THEN 
    162174                     ! ln_coupled_iceshelf_fluxes uninitialised unless lk_oasis=true 
    163175                     IF( ln_coupled_iceshelf_fluxes ) THEN 
    164                         CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ) 
    165                         CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ) 
    166                         CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ) 
    167                         CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass ) 
    168                         CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ) 
    169                         CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', antarctica_icesheet_mass_rate_of_change ) 
     176                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass', greenland_icesheet_mass ,& 
     177      &                                   lxios = lwxios) 
     178                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_timelapsed', greenland_icesheet_timelapsed ,& 
     179      &                                   lxios = lwxios) 
     180                        CALL iom_rstput( kt, nitrst, numrow, 'greenland_icesheet_mass_roc', greenland_icesheet_mass_rate_of_change ,& 
     181      &                                   lxios = lwxios) 
     182                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass', antarctica_icesheet_mass , & 
     183      &                                  lxios = lwxios) 
     184                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_timelapsed', antarctica_icesheet_timelapsed ,& 
     185      &                                   lxios = lwxios) 
     186                        CALL iom_rstput( kt, nitrst, numrow, 'antarctica_icesheet_mass_roc', & 
     187      &                                  antarctica_icesheet_mass_rate_of_change , lxios = lwxios) 
    170188                     ENDIF 
    171189                     ENDIF 
    172190 
    173191      IF( kt == nitrst ) THEN 
    174          CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     192         IF(.NOT.lwxios) THEN 
     193            CALL iom_close( numrow )     ! close the restart file (only at last time step) 
     194         ELSE 
     195            CALL iom_context_finalize(      wxios_context          ) 
     196            CALL iom_swap(      cxios_context          ) 
     197         ENDIF 
    175198!!gm         IF( .NOT. lk_trdmld )   lrst_oce = .FALSE. 
    176199!!gm  not sure what to do here   ===>>>  ask to Sebastian 
    … …  
    180203               nitrst = nstocklist( nrst_lst ) 
    181204            ENDIF 
    182             lrst_oce = .FALSE. 
    183205      ENDIF 
    184206      ! 
    … …  
    219241           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    220242         ENDIF 
     243         lspr = .FALSE.                       ! do not read restart using single processor 
    221244         CALL iom_open( TRIM(clpath)//cn_ocerst_in, numror, kiolib = jlibalt ) 
    222245! are we using XIOS to read the data? Part above will have to modified once XIOS 
    … …  
    226249         IF( lxios_read) THEN 
    227250         if(.NOT.lxios_set) then 
    228              rxios_context = 'nemo_rst' 
    229251             call iom_init( rxios_context ) 
    230252             lxios_set = .TRUE. 
    … …  
    232254         ENDIF 
    233255         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lxios_read) THEN 
    234             rxios_context = 'nemo_rst' 
    235256            call iom_init( rxios_context ) 
    236257         ENDIF  
    … …  
    339360      ! 
    340361   END SUBROUTINE rst_read 
    341  
    342362   !!===================================================================== 
    343363END MODULE restart 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r6487 r8243  
    7878   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
    7979   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
     80   PUBLIC   mpp_bcast, mpp_barrier 
    8081 
    8182   TYPE arrayptr 
    … …  
    8788   !! with scalar arguments instead of array arguments, which causes problems 
    8889   !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ 
     90   INTERFACE mpp_bcast 
     91      MODULE PROCEDURE mpp_bcast_i1, mpp_bcast_da, mpp_bcast_ch, mpp_bcast_ia, mpp_bcast_l, & 
     92     &                 mpp_bcast_d, mpp_bcast_d2a, mpp_bcast_d3a 
     93   END INTERFACE 
    8994   INTERFACE mpp_min 
    9095      MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 
    … …  
    18381843   END SUBROUTINE mppsum_a_realdd 
    18391844 
     1845   SUBROUTINE mpp_bcast_i1(ival) 
     1846      !!------------------------------------------------------------------------ 
     1847      !!             ***  routine mpp_bcast_i1  *** 
     1848      !! 
     1849      !! ** Purpose :  lwm broadcasts integer value to all processors  
     1850      !! ** Method  :  it is assumed that some information is read only by 
     1851      !i!              processor 0 - lwm = .true.. 
     1852      !!-------------------------------------------------------------------------- 
     1853      INTEGER, INTENT(INOUT) :: ival  ! value to broadcast  
     1854      INTEGER :: ierror ! mpi error 
     1855      CALL MPI_BCAST(ival, 1, MPI_INTEGER4, 0, mpi_comm_opa, ierror) 
     1856   END SUBROUTINE mpp_bcast_i1 
     1857 
     1858   SUBROUTINE mpp_bcast_da(dvalv, lng) 
     1859      !!------------------------------------------------------------------------ 
     1860      !!             ***  routine mpp_bcast  *** 
     1861      !! 
     1862      !! ** Purpose :  lwm broadcasts double 1D array to all processors  
     1863      !! ** Method  :  it is assumed that some information is read only by 
     1864      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1865      !!-------------------------------------------------------------------------- 
     1866      REAL(wp), DIMENSION(lng), INTENT(INOUT) :: dvalv   ! real 1D array  
     1867      INTEGER, INTENT(IN)  :: lng          ! length of dval  
     1868      INTEGER              :: ierror       ! mpi error 
     1869      CALL MPI_BCAST(dvalv, lng, mpi_double_precision, 0, mpi_comm_opa, ierror)  
     1870   END SUBROUTINE mpp_bcast_da 
     1871 
     1872 
     1873   SUBROUTINE mpp_bcast_d2a(dvala, nx, ny) 
     1874      !!------------------------------------------------------------------------ 
     1875      !!             ***  routine mpp_bcast  *** 
     1876      !! 
     1877      !! ** Purpose :  lwm broadcasts double 2D array to all processors  
     1878      !! ** Method  :  it is assumed that some information is read only by 
     1879      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1880      !!-------------------------------------------------------------------------- 
     1881      REAL(wp), DIMENSION(nx, ny), INTENT(INOUT) :: dvala   ! real 2D array  
     1882      INTEGER, INTENT(IN)  :: nx, ny          ! size of dvala  
     1883      INTEGER              :: ierror          ! mpi error 
     1884      INTEGER              :: itotal          ! local variable 
     1885      itotal = nx*ny 
     1886      CALL MPI_BCAST(dvala, itotal, mpi_double_precision, 0, mpi_comm_opa, ierror)  
     1887   END SUBROUTINE mpp_bcast_d2a 
     1888 
     1889   SUBROUTINE mpp_bcast_d3a(dvala, nx, ny, nz) 
     1890      !!------------------------------------------------------------------------ 
     1891      !!             ***  routine mpp_bcast  *** 
     1892      !! 
     1893      !! ** Purpose :  lwm broadcasts double 3D array to all processors  
     1894      !! ** Method  :  it is assumed that some information is read only by 
     1895      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1896      !!-------------------------------------------------------------------------- 
     1897      REAL(wp), DIMENSION(nx, ny, nz), INTENT(INOUT) :: dvala   ! real 2D array  
     1898      INTEGER, INTENT(IN)  :: nx, ny, nz          ! size of dvala  
     1899      INTEGER              :: ierror          ! mpi error 
     1900      CALL MPI_BCAST(dvala, nx*ny*nz, mpi_double_precision, 0, mpi_comm_opa, ierror)  
     1901   END SUBROUTINE mpp_bcast_d3a 
     1902 
     1903   SUBROUTINE mpp_bcast_d(dval) 
     1904      !!------------------------------------------------------------------------ 
     1905      !!             ***  routine mpp_bcast  *** 
     1906      !! 
     1907      !! ** Purpose :  lwm broadcasts double value to all processors  
     1908      !! ** Method  :  it is assumed that some information is read only by 
     1909      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1910      !!-------------------------------------------------------------------------- 
     1911      REAL(wp), INTENT(INOUT) :: dval        ! real 1D array  
     1912      INTEGER              :: ierror       ! mpi error 
     1913      CALL MPI_BCAST(dval, 1, mpi_double_precision, 0, mpi_comm_opa, ierror)  
     1914   END SUBROUTINE mpp_bcast_d 
     1915 
     1916   SUBROUTINE mpp_bcast_ch(cstring, lng) 
     1917      !!------------------------------------------------------------------------ 
     1918      !!             ***  routine mpp_bcast  *** 
     1919      !! 
     1920      !! ** Purpose :  lwm broadcasts string value to all processors  
     1921      !! ** Method  :  it is assumed that some information is read only by 
     1922      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1923      !!-------------------------------------------------------------------------- 
     1924      CHARACTER(len=lng), INTENT(IN) :: cstring      ! string 1D array  
     1925      INTEGER, INTENT(IN)            :: lng          ! length of cstring  
     1926      INTEGER                        :: ierror       ! mpi error 
     1927      CALL MPI_BCAST(cstring, lng, MPI_CHARACTER, 0, mpi_comm_opa, ierror) 
     1928   END SUBROUTINE mpp_bcast_ch 
     1929 
     1930   SUBROUTINE mpp_bcast_ia(ivalv, lng) 
     1931      INTEGER, DIMENSION(lng), INTENT(INOUT) :: ivalv        ! value to broadcast  
     1932      INTEGER, INTENT (IN)                :: lng 
     1933      INTEGER                             :: ierror       ! mpi error 
     1934      CALL MPI_BCAST(ivalv, lng, MPI_INTEGER4, 0, mpi_comm_opa, ierror) 
     1935   END SUBROUTINE mpp_bcast_ia 
     1936 
     1937   SUBROUTINE mpp_bcast_l(lval) 
     1938      LOGICAL, INTENT(INOUT) :: lval  ! value to broadcast  
     1939      INTEGER             :: ierror       ! mpi error 
     1940      CALL MPI_BCAST(lval, 1, MPI_LOGICAL, 0, mpi_comm_opa, ierror) 
     1941   END SUBROUTINE mpp_bcast_l 
     1942 
     1943   SUBROUTINE mpp_bcast_d2d(dval, ni, nj) 
     1944      !!------------------------------------------------------------------------ 
     1945      !!             ***  routine mpp_bcast  *** 
     1946      !! 
     1947      !! ** Purpose :  lwm broadcasts wp array to all processors  
     1948      !! ** Method  :  it is assumed that some information is read only by 
     1949      !i!              processor 0 - lwm = .true.. NETCDF related call 
     1950      !!-------------------------------------------------------------------------- 
     1951      REAL(wp), DIMENSION(ni, nj), INTENT(INOUT) :: dval        ! real 1D array  
     1952      INTEGER, INTENT(IN)                        :: ni, nj 
     1953      INTEGER              :: ierror       ! mpi error 
     1954      CALL MPI_BCAST(dval, ni*nj, mpi_double_precision, 0, mpi_comm_opa, ierror)  
     1955   END SUBROUTINE mpp_bcast_d2d 
     1956 
     1957   SUBROUTINE mpp_barrier(kcom) 
     1958      !!------------------------------------------------------------------------ 
     1959      !!             ***  routine mpp_barrier  *** 
     1960      !! 
     1961      !! ** Purpose :  mpi barrier 
     1962      !!-------------------------------------------------------------------------- 
     1963      INTEGER , INTENT(in   ), OPTIONAL        ::   kcom 
     1964      !! 
     1965      INTEGER :: ierror, localcomm 
     1966      !!---------------------------------------------------------------------- 
     1967      ! 
     1968      localcomm = mpi_comm_opa 
     1969      IF( PRESENT(kcom) ) localcomm = kcom 
     1970      CALL MPI_Barrier(localcomm, ierror) 
     1971   END SUBROUTINE mpp_barrier 
     1972 
    18401973   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki,kj ) 
    18411974      !!------------------------------------------------------------------------ 
    … …  
    34653598   USE in_out_manager 
    34663599 
     3600   INTERFACE mpp_bcast 
     3601      MODULE PROCEDURE mpp_bcast_i1, mpp_bcast_da, mpp_bcast_ch, mpp_bcast_ia, mpp_bcast_l, & 
     3602     &                 mpp_bcast_d 
     3603   END INTERFACE 
    34673604   INTERFACE mpp_sum 
    34683605      MODULE PROCEDURE mpp_sum_a2s, mpp_sum_as, mpp_sum_ai, mpp_sum_s, mpp_sum_i, mppsum_realdd, mppsum_a_realdd 
    … …  
    36053742   END SUBROUTINE mppmin_int 
    36063743 
     3744   SUBROUTINE mpp_bcast_i1(ival) 
     3745      INTEGER, INTENT(IN) :: ivar  ! value to broadcast  
     3746 
     3747      WRITE(*,*) 'mpp_bcast_i1: You should not have seen this print! error?' 
     3748 
     3749   END SUBROUTINE mpp_bcast_i1 
     3750 
     3751   SUBROUTINE mpp_bcast_ia(ival, lng) 
     3752      INTEGER, DIMENSION(lng), INTENT(IN) :: ivar  ! value to broadcast  
     3753      INTEGER, INTENT (IN) :: lng 
     3754 
     3755      WRITE(*,*) 'mpp_bcast_ia: You should not have seen this print! error?' 
     3756 
     3757   END SUBROUTINE mpp_bcast_ia 
     3758 
     3759   SUBROUTINE mpp_bcast_l(lval) 
     3760      INTEGER, INTENT(IN) :: lvar  ! value to broadcast  
     3761 
     3762      WRITE(*,*) 'mpp_bcast_l: You should not have seen this print! error?' 
     3763 
     3764   END SUBROUTINE mpp_bcast_l 
     3765 
     3766   SUBROUTINE mpp_bcast_da(dval, lng) 
     3767      REAL(wp), INTENT(IN) :: dval(lng)    ! real 1D array  
     3768      INTEGER, INTENT(IN)  :: lng          ! length of dval  
     3769 
     3770      WRITE(*,*) 'mpp_bcast_da: You should not have seen this print! error?' 
     3771 
     3772   END SUBROUTINE mpp_bcast_da 
     3773 
     3774   SUBROUTINE mpp_bcast_d2a(dvala, nx, ny) 
     3775      REAL(wp), DIMENSION(nx, ny), INTENT(INOUT) :: dvala   ! real 2D array  
     3776      INTEGER, INTENT(IN)  :: nx, ny          ! size of dvala  
     3777      INTEGER              :: ierror          ! mpi error 
     3778      WRITE(*,*) 'mpp_bcast_d2a: You should not have seen this print! error?' 
     3779   END SUBROUTINE mpp_bcast_d2a 
     3780 
     3781   SUBROUTINE mpp_bcast_d3a(dvala, nx, ny) 
     3782      REAL(wp), DIMENSION(nx, ny), INTENT(INOUT) :: dvala   ! real 2D array  
     3783      INTEGER, INTENT(IN)  :: nx, ny          ! size of dvala  
     3784      INTEGER              :: ierror          ! mpi error 
     3785      WRITE(*,*) 'mpp_bcast_d2a: You should not have seen this print! error?' 
     3786   END SUBROUTINE mpp_bcast_d3a 
     3787 
     3788   SUBROUTINE mpp_bcast_d(dval) 
     3789      REAL(wp), INTENT(IN) :: dval         ! real 1D array  
     3790      INTEGER, INTENT(IN)  :: lng          ! length of dval  
     3791 
     3792      WRITE(*,*) 'mpp_bcast_d: You should not have seen this print! error?' 
     3793 
     3794   END SUBROUTINE mpp_bcast_d 
     3795 
     3796   SUBROUTINE mpp_bcast_ch(cstring, lng) 
     3797      CHARACTER(len=lng), INTENT(IN) :: cstring      ! string 1D array  
     3798      INTEGER, INTENT(IN)            :: lng          ! length of cstring  
     3799 
     3800      WRITE(*,*) 'mpp_bcast_da: You should not have seen this print! error?' 
     3801 
     3802   END SUBROUTINE mpp_bcast_ch 
     3803 
    36073804   SUBROUTINE mpp_minloc2d( ptab, pmask, pmin, ki, kj ) 
    36083805      REAL                   :: pmin 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/cyclone.F90

    r6486 r8243  
    120120      !       Interpolation of lon lat vmax... at the current timestep 
    121121      !       *************************************************************** 
    122  
     122      lspr = .false. 
    123123      CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step 
     124      lspr = .false. 
    124125 
    125126      ztct(:,:) = sf(1)%fnow(:,:,1) 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90

    r6487 r8243  
    334334      llprevday  = .FALSE. 
    335335      isec_week  = 0 
    336              
     336 
    337337      ! define record informations 
    338338      CALL fld_rec( kn_fsbc, sdjf, ldbefore = .TRUE. )  ! return before values in sdjf%nrec_a (as we will swap it later) 
    … …  
    941941               &                          ' data type: '      ,       sdf(jf)%cltype      ,   & 
    942942               &                          ' land/sea mask:'   , TRIM( sdf(jf)%lsmname    ) 
    943             call flush(numout) 
    944943         END DO 
    945944      ENDIF 
    … …  
    14341433           jpj1 = 2 + rec1(2) - jpjmin 
    14351434           jpj2 = jpj1 + recn(2) - 1 
    1436            IF( jpi1 == 2 ) THEN 
     1435 
    14371436              rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 
    14381437              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    … …  
    14421441                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    14431442              END SELECT       
     1443           IF( jpi1 == 2 ) THEN 
    14441444              ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    14451445           ENDIF 
    1446            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
     1446 
    14471447              rec1(1) = 1 + ref_wgts(kw)%overlap 
    14481448              SELECT CASE( SIZE( ref_wgts(kw)%col(:,jpj1:jpj2,:),3) ) 
    … …  
    14521452                   CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    14531453              END SELECT 
     1454           IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    14541455              ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    14551456           ENDIF 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcapr.F90

    r8161 r8243  
    1919   USE iom             ! IOM library 
    2020   USE lib_mpp         ! MPP library 
     21   USE iom_def, ONLY : lwxios 
    2122 
    2223   IMPLICIT NONE 
    … …  
    2930   LOGICAL, PUBLIC ::   ln_ref_apr   !: ref. pressure: global mean Patm (F) or a constant (F) 
    3031   REAL(wp)        ::   rn_pref      !  reference atmospheric pressure   [N/m2] 
     32   LOGICAL         ::   ln_apr_sio   ! single processor read flag 
    3133 
    3234   REAL(wp), ALLOCATABLE, SAVE, PUBLIC, DIMENSION(:,:) ::   ssh_ib    ! Inverse barometer now    sea surface height   [m] 
    … …  
    7779      IF( kt == nit000 ) THEN                   ! First call kt=nit000 ! 
    7880         !                                      ! -------------------- ! 
     81         ln_apr_sio = .FALSE. 
    7982         REWIND( numnam_ref )              ! Namelist namsbc_apr in reference namelist : File for atmospheric pressure forcing 
    8083         READ  ( numnam_ref, namsbc_apr, IOSTAT = ios, ERR = 901) 
    … …  
    126129         IF( kt /= nit000 )   ssh_ibb(:,:) = ssh_ib(:,:)    !* Swap of ssh_ib fields 
    127130         ! 
     131         lspr = ln_apr_sio 
    128132         CALL fld_read( kt, nn_fsbc, sf_apr )               !* input Patm provided at kt + nn_fsbc/2 
     133         lspr = .false. 
    129134         ! 
    130135         !                                                  !* update the reference atmospheric pressure (if necessary) 
    … …  
    157162         IF(lwp) WRITE(numout,*) 'sbc_apr : ssh_ib written in ocean restart file at it= ', kt,' date= ', ndastp 
    158163         IF(lwp) WRITE(numout,*) '~~~~' 
    159          CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib ) 
     164         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     165         CALL iom_rstput( kt, nitrst, numrow, 'ssh_ibb' , ssh_ib, lxios = lwxios ) 
     166         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    160167      ENDIF 
    161168      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_clio.F90

    r6498 r8243  
    8484    
    8585   REAL(wp) ::   eps20  = 1.e-20   ! constant values 
     86   LOGICAL ::    ln_clio_sio       ! single processor read 
    8687    
    8788   !! * Substitutions 
    … …  
    137138      !! 
    138139      NAMELIST/namsbc_clio/ cn_dir, sn_utau, sn_vtau, sn_wndm, sn_humi,   & 
    139          &                          sn_ccov, sn_tair, sn_prec 
     140         &                          sn_ccov, sn_tair, sn_prec, ln_clio_sio 
    140141      !!--------------------------------------------------------------------- 
    141142 
    … …  
    143144      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    144145         !                                      ! ====================== ! 
    145  
     146         ln_clio_sio = .FALSE. 
    146147         REWIND( numnam_ref )              ! Namelist namsbc_clio in reference namelist : CLIO files 
    147148         READ  ( numnam_ref, namsbc_clio, IOSTAT = ios, ERR = 901) 
    … …  
    180181      !                                         ! ====================== ! 
    181182      ! 
     183      lspr = ln_clio_sio 
    182184      CALL fld_read( kt, nn_fsbc, sf )                ! input fields provided at the current time-step 
     185      lspr = .false. 
    183186      ! 
    184187      IF( MOD( kt - 1, nn_fsbc ) == 0 )   CALL blk_oce_clio( sf, sst_m ) 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_core.F90

    r6823 r8243  
    9191   REAL(wp) ::   rn_zqt      ! z(q,t) : height of humidity and temperature measurements 
    9292   REAL(wp) ::   rn_zu       ! z(u)   : height of wind measurements 
     93   LOGICAL  ::   ln_core_sio ! single processor read flag 
    9394 
    9495   !! * Substitutions 
    … …  
    151152         &                  sn_wndi, sn_wndj, sn_humi  , sn_qsr ,           & 
    152153         &                  sn_qlw , sn_tair, sn_prec  , sn_snow,           & 
    153          &                  sn_tdif, rn_zqt,  rn_zu 
     154         &                  sn_tdif, rn_zqt,  rn_zu, ln_core_sio 
    154155      !!--------------------------------------------------------------------- 
    155156      ! 
    … …  
    158159         !                                      ! ====================== ! 
    159160         ! 
     161         ln_core_sio = .FALSE. 
    160162         REWIND( numnam_ref )              ! Namelist namsbc_core in reference namelist : CORE bulk parameters 
    161163         READ  ( numnam_ref, namsbc_core, IOSTAT = ios, ERR = 901) 
    … …  
    197199         ! 
    198200      ENDIF 
    199  
     201      lspr = ln_core_sio 
    200202      CALL fld_read( kt, nn_fsbc, sf )             ! input fields provided at the current time-step 
     203      lspr = .false. 
    201204 
    202205      !                                            ! compute the surface ocean fluxes using CORE bulk formulea 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcblk_mfs.F90

    r6486 r8243  
    4040   INTEGER , PARAMETER ::   jp_prec = 7         ! index of total precipitation (rain+snow) (Kg/m2/s) 
    4141   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf ! structure of input fields (file informations, fields read) 
     42   LOGICAL :: ln_msf_sio                        ! single processor read flag 
    4243          
    4344   !! * Substitutions 
    … …  
    120121      NAMELIST/namsbc_mfs/ cn_dir ,                                          & 
    121122         &                  sn_wndi , sn_wndj, sn_clc   , sn_msl ,           & 
    122          &                  sn_tair , sn_rhm , sn_prec  
     123         &                  sn_tair , sn_rhm , sn_prec, ln_msf_sio 
    123124      !!--------------------------------------------------------------------- 
    124125      ! 
    125126      IF( nn_timing == 1 )  CALL timing_start('sbc_blk_mfs') 
    126127      ! 
     128      ln_msf_sio = .FALSE. 
    127129      !                                         ! ====================== ! 
    128130      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    … …  
    161163            ! 
    162164      ENDIF 
    163  
     165         lspr = ln_msf_sio 
    164166         CALL fld_read( kt, nn_fsbc, sf )                   ! input fields provided at the current time-step 
     167         lspr = .false. 
    165168 
    166169         catm(:,:)   = 0.0    ! initializze cloud cover variable 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcflx.F90

    r6486 r8243  
    3535   INTEGER , PARAMETER ::   jp_emp  = 5   ! index of evaporation-precipation file 
    3636   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf    ! structure of input fields (file informations, fields read) 
     37   LOGICAL, PRIVATE    ::   ln_lfx_sio    ! single processor read flag 
    3738 
    3839   !! * Substitutions 
    … …  
    8687      TYPE(FLD_N), DIMENSION(jpfld) ::   slf_i                    ! array of namelist information structures 
    8788      TYPE(FLD_N) ::   sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp  ! informations about the fields to be read 
    88       NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp 
     89      NAMELIST/namsbc_flx/ cn_dir, sn_utau, sn_vtau, sn_qtot, sn_qsr, sn_emp, ln_lfx_sio 
    8990      !!--------------------------------------------------------------------- 
    9091      ! 
    9192      IF( kt == nit000 ) THEN                ! First call kt=nit000   
    9293         ! set file information 
     94         ln_lfx_sio = .FALSE. 
    9395         REWIND( numnam_ref )              ! Namelist namsbc_flx in reference namelist : Files for fluxes 
    9496         READ  ( numnam_ref, namsbc_flx, IOSTAT = ios, ERR = 901) 
    … …  
    124126      ENDIF 
    125127 
     128      lspr = ln_lfx_sio 
    126129      CALL fld_read( kt, nn_fsbc, sf )                            ! input fields provided at the current time-step 
     130      lspr = .false. 
    127131      
    128132      IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN                        ! update ocean fluxes at each SBC frequency 
    … …  
    170174               CALL prihre( sf(jf)%fnow, jpi, jpj, 1, jpi, 20, 1, jpj, 10, zfact, numout ) 
    171175            END DO 
    172             CALL FLUSH(numout) 
    173176         ENDIF 
    174177         ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90

    r6500 r8243  
    897897         ! 
    898898      ENDIF 
    899  
     899      lspr = .false. 
    900900      CALL fld_read( kt, nn_fsbc, sf )           ! Read input fields and provides the 
    901901      !                                          ! input fields at the current time-step 
     902      lspr = .false. 
    902903 
    903904      ! set the fluxes from read fields 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_if.F90

    r6498 r8243  
    2929   IMPLICIT NONE 
    3030   PRIVATE 
    31  
    3231   PUBLIC   sbc_ice_if      ! routine called in sbcmod 
    3332 
    … …  
    9392         ! 
    9493      ENDIF 
    95  
     94      lspr = .FALSE.  
    9695      CALL fld_read( kt, nn_fsbc, sf_ice )           ! Read input fields and provides the 
    9796      !                                              ! input fields at the current time-step 
     97      lspr = .FALSE. 
    9898       
    9999      IF( MOD( kt-1, nn_fsbc) == 0 ) THEN 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcisf.F90

    r7924 r8243  
    9292    CHARACTER (LEN=32)           :: cvarLeff                    ! variable name for efficient Length scale 
    9393    INTEGER           ::   ios           ! Local integer output status for namelist read 
    94  
     94    LOGICAL                      :: ln_isf_sio    ! single processor read 
    9595    REAL(wp), DIMENSION(:,:,:), POINTER :: zfwfisf3d, zqhcisf3d, zqlatisf3d 
    9696    REAL(wp), DIMENSION(:,:  ), POINTER :: zqhcisf2d 
    … …  
    9898      !!--------------------------------------------------------------------- 
    9999      NAMELIST/namsbc_isf/ nn_isfblk, rn_hisf_tbl, ln_divisf, ln_conserve, rn_gammat0, rn_gammas0, nn_gammablk, & 
    100                          & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf 
     100                         & sn_fwfisf, sn_qisf, sn_rnfisf, sn_depmax_isf, sn_depmin_isf, sn_Leff_isf, ln_isf_sio 
    101101      ! 
    102102      ! 
    … …  
    104104      IF( kt == nit000 ) THEN                   !  First call kt=nit000  ! 
    105105         !                                      ! ====================== ! 
     106         ln_isf_sio = .FALSE. 
    106107         REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    107108         READ  ( numnam_ref, namsbc_isf, IOSTAT = ios, ERR = 901) 
    … …  
    230231 
    231232         ! compute salf and heat flux 
     233         lspr = ln_isf_sio 
    232234         IF (nn_isf == 1) THEN 
    233235            ! realistic ice shelf formulation 
    … …  
    293295 
    294296            ENDIF 
     297            lspr = .FALSE. 
    295298            ENDIF 
    296299 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90

    r7924 r8243  
    5555   USE bdy_par          ! Require lk_bdy 
    5656   USE iom_def, ONLY : lxios_read 
     57   USE iom_def, ONLY : lwxios 
    5758 
    5859   IMPLICIT NONE 
    … …  
    444445            &                    'at it= ', kt,' date= ', ndastp 
    445446         IF(lwp) WRITE(numout,*) '~~~~' 
    446          CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau ) 
    447          CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau ) 
    448          CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns  ) 
     447         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     448         CALL iom_rstput( kt, nitrst, numrow, 'utau_b' , utau, lxios = lwxios ) 
     449         CALL iom_rstput( kt, nitrst, numrow, 'vtau_b' , vtau, lxios = lwxios ) 
     450         CALL iom_rstput( kt, nitrst, numrow, 'qns_b'  , qns, lxios = lwxios  ) 
    449451         ! The 3D heat content due to qsr forcing is treated in traqsr 
    450452         ! CALL iom_rstput( kt, nitrst, numrow, 'qsr_b'  , qsr  ) 
    451          CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp  ) 
    452          CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx  ) 
     453         CALL iom_rstput( kt, nitrst, numrow, 'emp_b'  , emp, lxios = lwxios  ) 
     454         CALL iom_rstput( kt, nitrst, numrow, 'sfx_b'  , sfx, lxios = lwxios  ) 
     455         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    453456      ENDIF 
    454457 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcrnf.F90

    r7924 r8243  
    2727   USE eosbn2 
    2828   USE wrk_nemo        ! Memory allocation 
    29    USE iom_def, ONLY : lxios_read 
     29   USE iom_def, ONLY : lxios_read, lwxios 
    3030 
    3131   IMPLICIT NONE 
    … …  
    5656 
    5757   LOGICAL           , PUBLIC ::   l_rnfcpl = .false.       ! runoffs recieved from oasis 
     58   LOGICAL                    ::   ln_rnf_sio      !: single processor read 
    5859 
    5960   INTEGER , PUBLIC  ::   nkrnf = 0         !: nb of levels over which Kz is increased at river mouths 
    … …  
    172173            &                    'at it= ', kt,' date= ', ndastp 
    173174         IF(lwp) WRITE(numout,*) '~~~~' 
    174          CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf ) 
    175          CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem) ) 
    176          CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal) ) 
     175         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     176         CALL iom_rstput( kt, nitrst, numrow, 'rnf_b' , rnf, lxios = lwxios ) 
     177         CALL iom_rstput( kt, nitrst, numrow, 'rnf_hc_b', rnf_tsc(:,:,jp_tem), lxios = lwxios ) 
     178         CALL iom_rstput( kt, nitrst, numrow, 'rnf_sc_b', rnf_tsc(:,:,jp_sal), lxios = lwxios ) 
     179         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    177180      ENDIF 
    178181      ! 
    … …  
    258261         &                 sn_rnf, sn_cnf    , sn_s_rnf    , sn_t_rnf  , sn_dep_rnf,   & 
    259262         &                 ln_rnf_mouth      , rn_hrnf     , rn_avt_rnf, rn_rfact,     & 
    260          &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file 
     263         &                 ln_rnf_depth_ini  , rn_dep_max  , rn_rnf_max, nn_rnf_depth_file, & 
     264         &                 ln_rnf_sio 
    261265      !!---------------------------------------------------------------------- 
    262266      ! 
    … …  
    278282      !                                   ! ============ 
    279283      ! 
     284      ln_rnf_sio = .FALSE. 
    280285      REWIND( numnam_ref )              ! Namelist namsbc_rnf in reference namelist : Runoffs  
    281286      READ  ( numnam_ref, namsbc_rnf, IOSTAT = ios, ERR = 901) 
    … …  
    302307      !                                   ! ================== 
    303308      ! 
     309      lspr = ln_rnf_sio 
    304310      IF( .NOT. l_rnfcpl ) THEN                     
    305311         ALLOCATE( sf_rnf(1), STAT=ierror )         ! Create sf_rnf structure (runoff inflow) 
    … …  
    482488      ENDIF 
    483489      ! 
     490   lspr = .false. 
    484491   END SUBROUTINE sbc_rnf_init 
    485492 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssm.F90

    r7924 r8243  
    2222   USE iom             ! IOM library 
    2323   USE iom_def, ONLY : lxios_read 
     24   USE iom_def, ONLY : lwxios 
    2425 
    2526   IMPLICIT NONE 
    … …  
    157158            IF(lwp) WRITE(numout,*) '~~~~~~~' 
    158159            zf_sbc = REAL( nn_fsbc, wp ) 
    159             CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc )    ! sbc frequency 
    160             CALL iom_rstput( kt, nitrst, numrow, 'ssu_m'  , ssu_m  )    ! sea surface mean fields 
    161             CALL iom_rstput( kt, nitrst, numrow, 'ssv_m'  , ssv_m  ) 
    162             CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m  ) 
    163             CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m  ) 
    164             CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m  ) 
    165             IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m  ) 
    166             CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m  ) 
    167             ! 
     160            IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     161            CALL iom_rstput( kt, nitrst, numrow, 'nn_fsbc', zf_sbc, lxios = lwxios )    ! sbc frequency 
     162            CALL iom_rstput( kt, nitrst, numrow, 'ssu_m'  , ssu_m, lxios = lwxios  )    ! sea surface mean fields 
     163            CALL iom_rstput( kt, nitrst, numrow, 'ssv_m'  , ssv_m, lxios = lwxios  ) 
     164            CALL iom_rstput( kt, nitrst, numrow, 'sst_m'  , sst_m, lxios = lwxios  ) 
     165            CALL iom_rstput( kt, nitrst, numrow, 'sss_m'  , sss_m, lxios = lwxios  ) 
     166            CALL iom_rstput( kt, nitrst, numrow, 'ssh_m'  , ssh_m, lxios = lwxios  ) 
     167            IF( lk_vvl )   CALL iom_rstput( kt, nitrst, numrow, 'e3t_m'  , e3t_m   ) 
     168            CALL iom_rstput( kt, nitrst, numrow, 'frq_m'  , frq_m, lxios = lwxios ) 
     169            ! 
     170            IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    168171         ENDIF 
    169172         ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcssr.F90

    r6486 r8243  
    4242   LOGICAL         ::   ln_sssr_bnd     ! flag to bound erp term  
    4343   REAL(wp)        ::   rn_sssr_bnd     ! ABS(Max./Min.) value of erp term [mm/day] 
     44   LOGICAL         ::   ln_ssr_sio      ! single processor read flag 
    4445 
    4546   REAL(wp) , ALLOCATABLE, DIMENSION(:) ::   buffer   ! Temporary buffer for exchange 
    … …  
    8788      IF( nn_sstr + nn_sssr /= 0 ) THEN 
    8889         ! 
     90         lspr = ln_ssr_sio 
    8991         IF( nn_sstr == 1)   CALL fld_read( kt, nn_fsbc, sf_sst )   ! Read SST data and provides it at kt 
    9092         IF( nn_sssr >= 1)   CALL fld_read( kt, nn_fsbc, sf_sss )   ! Read SSS data and provides it at kt 
     93         lspr = .false. 
    9194         ! 
    9295         !                                         ! ========================= ! 
    … …  
    163166      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
    164167      TYPE(FLD_N) ::   sn_sst, sn_sss        ! informations about the fields to be read 
    165       NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd 
     168      NAMELIST/namsbc_ssr/ cn_dir, nn_sstr, nn_sssr, rn_dqdt, rn_deds, sn_sst, sn_sss, ln_sssr_bnd, rn_sssr_bnd, & 
     169      &                    ln_ssr_sio 
    166170      INTEGER     ::  ios 
    167171      !!---------------------------------------------------------------------- 
    168172      ! 
    169173  
     174      ln_ssr_sio = .FALSE. 
    170175      REWIND( numnam_ref )              ! Namelist namsbc_ssr in reference namelist :  
    171176      READ  ( numnam_ref, namsbc_ssr, IOSTAT = ios, ERR = 901) 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90

    r6486 r8243  
    121121         ! 
    122122         ! 
     123      lspr = .false. 
    123124      IF ( ln_cdgw ) THEN 
    124125         CALL fld_read( kt, nn_fsbc, sf_cd )      !* read drag coefficient from external forcing 
    … …  
    189190          CALL wrk_dealloc( jpi,jpj,jpk,udummy,vdummy,hdivdummy,rotdummy) 
    190191      ENDIF 
     192      lspr = .false. 
    191193   END SUBROUTINE sbc_wave 
    192194       

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r7923 r8243  
    4646 
    4747   !                              !!* Namelist namtra_adv * 
    48    LOGICAL ::   ln_traadv_cen2     ! 2nd order centered scheme flag 
     48!make ln_traadv_cen2 public. It's needed when XIOS is used to write restart file 
     49   LOGICAL, PUBLIC ::   ln_traadv_cen2     ! 2nd order centered scheme flag 
    4950   LOGICAL ::   ln_traadv_tvd      ! TVD scheme flag 
    5051   LOGICAL ::   ln_traadv_tvd_zts  ! TVD scheme flag with vertical sub time-stepping 
    … …  
    257258      ! 
    258259      CALL tra_adv_mle_init          ! initialisation of the Mixed Layer Eddy parametrisation (MLE) 
     260      lr_traadv_cen2 = ln_traadv_cen2 
    259261      ! 
    260262   END SUBROUTINE tra_adv_init 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen2.F90

    r7923 r8243  
    3434   USE timing          ! Timing 
    3535   USE phycst 
     36   USE iom_def, ONLY : lwxios 
    3637 
    3738   IMPLICIT NONE 
    … …  
    286287      ! avmb, avtb will be read in zdfini in restart case as they are used in zdftke, kpp etc... 
    287288      IF( lrst_oce .AND. cdtype == 'TRA' ) THEN 
    288          CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb ) 
    289          CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb ) 
     289         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     290         CALL iom_rstput( kt, nitrst, numrow, 'avmb', avmb, lxios = lwxios ) 
     291         CALL iom_rstput( kt, nitrst, numrow, 'avtb', avtb, lxios = lwxios ) 
     292         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    290293      ENDIF 
    291294      ! 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/TRA/traqsr.F90

    r7924 r8243  
    3333   USE wrk_nemo       ! Memory Allocation 
    3434   USE timing         ! Timing 
    35    USE iom_def, ONLY : lxios_read 
     35   USE iom_def, ONLY : lxios_read, lwxios 
     36 
    3637   IMPLICIT NONE 
    3738   PRIVATE 
    … …  
    5051   REAL(wp), PUBLIC ::   rn_si0       !: very near surface depth of extinction      (RGB & 2 bands) 
    5152   REAL(wp), PUBLIC ::   rn_si1       !: deepest depth of extinction (water type I)       (2 bands) 
     53   LOGICAL          ::   ln_qsr_sio   !: single processor read flag 
    5254  
    5355   ! Module variables 
    … …  
    185187         IF( ln_qsr_rgb) THEN                             !  R-G-B  light penetration ! 
    186188            !                                             ! ------------------------- ! 
     189            lspr = ln_qsr_sio 
    187190            ! Set chlorophyl concentration 
    188191            IF( nn_chldta == 1 .OR. nn_chldta == 2 .OR. lk_vvl ) THEN    !*  Variable Chlorophyll or ocean volume 
    … …  
    304307               ENDIF 
    305308           ENDIF 
    306  
     309           lspr = .false. 
    307310         ENDIF 
    308311         !                                                ! ------------------------- ! 
    … …  
    368371            &                    'at it= ', kt,' date= ', ndastp 
    369372         IF(lwp) WRITE(numout,*) '~~~~' 
    370          CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b'   , qsr_hc      ) 
    371          CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev )   ! default definition in sbcssm  
     373         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     374         CALL iom_rstput( kt, nitrst, numrow, 'qsr_hc_b', qsr_hc, lxios = lwxios                ) 
     375         CALL iom_rstput( kt, nitrst, numrow, 'fraqsr_1lev', fraqsr_1lev, lxios = lwxios)   ! default definition in sbcssm  
     376         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    372377         ! 
    373378      ENDIF 
    … …  
    419424      !! 
    420425      NAMELIST/namtra_qsr/  sn_chl, cn_dir, ln_traqsr, ln_qsr_rgb, ln_qsr_2bd, ln_qsr_bio, ln_qsr_ice,  & 
    421          &                  nn_chldta, rn_abs, rn_si0, rn_si1 
     426         &                  nn_chldta, rn_abs, rn_si0, rn_si1, ln_qsr_sio 
    422427      !!---------------------------------------------------------------------- 
    423428 
    … …  
    428433      CALL wrk_alloc( jpi, jpj, jpk, ze0, ze1, ze2, ze3, zea )  
    429434      ! 
    430  
     435      ln_qsr_ice = .FALSE. 
    431436      REWIND( numnam_ref )              ! Namelist namtra_qsr in reference namelist : Ratio and length of penetration 
    432437      READ  ( numnam_ref, namtra_qsr, IOSTAT = ios, ERR = 901) 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90

    r7924 r8243  
    3434   USE eosbn2 
    3535   USE iom_def, ONLY : lxios_read 
     36   USE iom_def, ONLY : lwxios 
    3637 
    3738   IMPLICIT NONE 
    … …  
    210211            &                    'at it= ', kt,' date= ', ndastp 
    211212         IF(lwp) WRITE(numout,*) '~~~~' 
    212          CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem) ) 
    213          CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal) ) 
     213         IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     214         CALL iom_rstput( kt, nitrst, numrow, 'sbc_hc_b', sbc_tsc(:,:,jp_tem), lxios = lwxios ) 
     215         CALL iom_rstput( kt, nitrst, numrow, 'sbc_sc_b', sbc_tsc(:,:,jp_sal), lxios = lwxios ) 
     216         IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    214217      ENDIF 
    215218      ! 
    … …  
    254257               &                    'at it= ', kt,' date= ', ndastp 
    255258            IF(lwp) WRITE(numout,*) '~~~~' 
    256             CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)          ) 
    257             CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem) ) 
    258             CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal) ) 
     259            IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     260            CALL iom_rstput( kt, nitrst, numrow, 'fwf_isf_b', fwfisf(:,:)         , lxios = lwxios) 
     261            CALL iom_rstput( kt, nitrst, numrow, 'isf_hc_b' , risf_tsc(:,:,jp_tem), lxios = lwxios) 
     262            CALL iom_rstput( kt, nitrst, numrow, 'isf_sc_b' , risf_tsc(:,:,jp_sal), lxios = lwxios) 
     263            IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    259264         ENDIF 
    260265      END IF 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7924 r8243  
    5353   USE timing         ! Timing 
    5454   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     55   USE iom_def, ONLY : lwxios 
    5556#if defined key_agrif 
    5657   USE agrif_opa_interp 
    … …  
    971972        !                                   ! ------------------- 
    972973        IF(lwp) WRITE(numout,*) '---- tke-rst ----' 
    973         CALL iom_rstput( kt, nitrst, numrow, 'en'   , en     ) 
    974         CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k  ) 
    975         CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k  ) 
    976         CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k ) 
    977         CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k ) 
    978         CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl  ) 
     974        IF( lwxios ) CALL iom_swap(      wxios_context          ) 
     975        CALL iom_rstput( kt, nitrst, numrow, 'en'   , en    , lxios = lwxios ) 
     976        CALL iom_rstput( kt, nitrst, numrow, 'avt'  , avt_k , lxios = lwxios ) 
     977        CALL iom_rstput( kt, nitrst, numrow, 'avm'  , avm_k , lxios = lwxios ) 
     978        CALL iom_rstput( kt, nitrst, numrow, 'avmu' , avmu_k, lxios = lwxios ) 
     979        CALL iom_rstput( kt, nitrst, numrow, 'avmv' , avmv_k, lxios = lwxios ) 
     980        CALL iom_rstput( kt, nitrst, numrow, 'dissl', dissl , lxios = lwxios ) 
     981        IF( lwxios ) CALL iom_swap(      cxios_context          ) 
    979982        ! 
    980983     ENDIF 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90

    r6486 r8243  
    8181      ! 
    8282      IF( nn_timing == 1 )  CALL timing_start( 'sbc_ssm') 
    83  
     83      lspr = .false. 
    8484      IF( nfld_3d > 0 ) CALL fld_read( kt, 1, sf_ssm_3d )      !==   read data at kt time step   ==! 
    8585      IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d )      !==   read data at kt time step   ==! 
     86      lspr = .false. 
    8687      !  
    8788      IF( ln_3d_uve ) THEN 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r6498 r8243  
    374374      ! 
    375375      IF( ln_presatm ) THEN 
     376         lspr = .false. 
    376377         CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2 
     378         lspr = .false. 
    377379         patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure 
    378380      ENDIF 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r6793 r8243  
    335335      IF( ln_varpar ) THEN 
    336336         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 
     337            lspr = .false. 
    337338            CALL fld_read( kt, 1, sf_par ) 
     339            lspr = .false. 
    338340            par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 
    339341         ENDIF 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r6487 r8243  
    114114      ! 
    115115      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
     116      lspr = .false. 
    116117      IF( ln_dust ) THEN 
    117118         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
    … …  
    167168         ENDIF 
    168169      ENDIF 
     170      lspr = .false. 
    169171      ! 
    170172      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc') 

  • branches/UKMO/test_moci_test_suite/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r6486 r8243  
    274274         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    275275      ENDIF 
    276  
     276      lspr = .false. 
    277277      ! OPEN boundary conditions: DOES NOT WORK. Waiting for stable BDY 
    278278      IF( nb_trcobc > 0 ) THEN 
    … …  
    293293        CALL fld_read(kt,1,sf_trccbc) 
    294294      ENDIF    
     295      lspr = .false. 
    295296      ! 
    296297      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
Note: See TracChangeset for help on using the changeset viewer.