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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
7 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/in_out_manager.F90

    r11405 r13463  
    8080   INTEGER       ::   nleapy                      !: Leap year calendar flag (0/1 or 30) 
    8181   INTEGER       ::   ninist                      !: initial state output flag (0/1) 
    82    INTEGER       ::   nwrite                      !: model standard output frequency 
    83    INTEGER       ::   nstock                      !: restart file frequency 
    84    INTEGER, DIMENSION(10) :: nstocklist           !: restart dump times 
    8582 
    8683   !!---------------------------------------------------------------------- 
    … …  
    9087   LOGICAL ::   lrst_oce              !: logical to control the oce restart write  
    9188   LOGICAL ::   lrst_ice              !: logical to control the ice restart write  
     89   LOGICAL ::   lrst_abl              !: logical to control the abl restart write  
    9290   INTEGER ::   numror = 0            !: logical unit for ocean restart (read). Init to 0 is needed for SAS (in daymod.F90) 
    9391   INTEGER ::   numrir                !: logical unit for ice   restart (read) 
     92   INTEGER ::   numrar                !: logical unit for abl   restart (read) 
    9493   INTEGER ::   numrow                !: logical unit for ocean restart (write) 
    9594   INTEGER ::   numriw                !: logical unit for ice   restart (write) 
     95   INTEGER ::   numraw                !: logical unit for abl   restart (write) 
    9696   INTEGER ::   nrst_lst              !: number of restart to output next 
    9797 
    … …  
    9999   !!                    output monitoring 
    100100   !!---------------------------------------------------------------------- 
    101    LOGICAL ::   ln_ctl           !: run control for debugging 
    102    TYPE :: sn_ctl                !: optional use structure for finer control over output selection 
    103       LOGICAL :: l_config  = .FALSE.  !: activate/deactivate finer control 
    104                                       !  Note if l_config is True then ln_ctl is ignored. 
    105                                       !  Otherwise setting ln_ctl True is equivalent to setting 
    106                                       !  all the following logicals in this structure True 
     101   TYPE :: sn_ctl                !: structure for control over output selection 
    107102      LOGICAL :: l_runstat = .FALSE.  !: Produce/do not produce run.stat file (T/F) 
    108103      LOGICAL :: l_trcstat = .FALSE.  !: Produce/do not produce tracer.stat file (T/F) 
    109104      LOGICAL :: l_oceout  = .FALSE.  !: Produce all ocean.outputs    (T) or just one (F) 
    110105      LOGICAL :: l_layout  = .FALSE.  !: Produce all layout.dat files (T) or just one (F) 
    111       LOGICAL :: l_mppout  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F) 
    112       LOGICAL :: l_mpptop  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F) 
     106      LOGICAL :: l_prtctl  = .FALSE.  !: Produce/do not produce mpp.output_XXXX files (T/F) 
     107      LOGICAL :: l_prttrc  = .FALSE.  !: Produce/do not produce mpp.top.output_XXXX files (T/F) 
     108      LOGICAL :: l_oasout  = .FALSE.  !: Produce/do not write oasis setup info to ocean.output (T/F) 
    113109                                      !  Optional subsetting of processor report files 
    114110                                      !  Default settings of 0/1000000/1 should ensure all areas report. 
    … …  
    122118   LOGICAL ::   ln_timing        !: run control for timing 
    123119   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    124    INTEGER ::   nn_print         !: level of print (0 no print) 
    125120   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
    126121   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
    … …  
    129124   INTEGER ::   nn_isplt         !: number of processors following i 
    130125   INTEGER ::   nn_jsplt         !: number of processors following j 
    131    !                                           
    132    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    133  
    134    INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    135126 
    136127   !!---------------------------------------------------------------------- 
    … …  
    142133   INTEGER ::   numnul          =   -1      !: logical unit for /dev/null 
    143134      !                                     !  early output can be collected; do not change 
    144    INTEGER ::   numnam_ref      =   -1      !: logical unit for reference namelist 
    145    INTEGER ::   numnam_cfg      =   -1      !: logical unit for configuration specific namelist 
    146135   INTEGER ::   numond          =   -1      !: logical unit for Output Namelist Dynamics 
    147    INTEGER ::   numnam_ice_ref  =   -1      !: logical unit for ice reference namelist 
    148    INTEGER ::   numnam_ice_cfg  =   -1      !: logical unit for ice reference namelist 
    149136   INTEGER ::   numoni          =   -1      !: logical unit for Output Namelist Ice 
    150137   INTEGER ::   numevo_ice      =   -1      !: logical unit for ice variables (temp. evolution) 
    151138   INTEGER ::   numrun          =   -1      !: logical unit for run statistics 
    152139   INTEGER ::   numdct_in       =   -1      !: logical unit for transports computing 
    153    INTEGER ::   numdct_vol      =   -1      !: logical unit for voulume transports output 
    154    INTEGER ::   numdct_heat     =   -1      !: logical unit for heat    transports output 
    155    INTEGER ::   numdct_salt     =   -1      !: logical unit for salt    transports output 
     140   INTEGER ::   numdct_vol      =   -1      !: logical unit for volume transports output 
     141   INTEGER ::   numdct_heat     =   -1      !: logical unit for heat   transports output 
     142   INTEGER ::   numdct_salt     =   -1      !: logical unit for salt   transports output 
    156143   INTEGER ::   numfl           =   -1      !: logical unit for floats ascii output 
    157144   INTEGER ::   numflo          =   -1      !: logical unit for floats ascii output 
     145      ! 
     146   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ref      !: character buffer for reference namelist 
     147   CHARACTER(LEN=:), ALLOCATABLE :: numnam_cfg      !: character buffer for configuration specific namelist 
     148   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_ref  !: character buffer for ice reference namelist 
     149   CHARACTER(LEN=:), ALLOCATABLE :: numnam_ice_cfg  !: character buffer for ice configuration specific namelist 
    158150 
    159151   !!---------------------------------------------------------------------- 
    … …  
    162154   INTEGER       ::   no_print = 0          !: optional argument of fld_fill (if present, suppress some control print) 
    163155   INTEGER       ::   nstop = 0             !: error flag (=number of reason for a premature stop run) 
     156!$AGRIF_DO_NOT_TREAT 
     157   INTEGER       ::   ngrdstop = -1         !: grid number having nstop > 1 
     158!$AGRIF_END_DO_NOT_TREAT 
    164159   INTEGER       ::   nwarn = 0             !: warning flag (=number of warning found during the run) 
    165160   CHARACTER(lc) ::   ctmp1, ctmp2, ctmp3   !: temporary characters 1 to 3 
    … …  
    167162   CHARACTER(lc) ::   ctmp7, ctmp8, ctmp9   !: temporary characters 7 to 9 
    168163   CHARACTER(lc) ::   ctmp10                !: temporary character 10 
    169    CHARACTER(lc) ::   cform_err = "(/,' ===>>> : E R R O R',     /,'         ===========',/)"       !: 
    170    CHARACTER(lc) ::   cform_war = "(/,' ===>>> : W A R N I N G', /,'         ===============',/)"   !: 
    171164   LOGICAL       ::   lwm      = .FALSE.    !: boolean : true on the 1st processor only (always) 
    172    LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. ln_ctl 
     165   LOGICAL       ::   lwp      = .FALSE.    !: boolean : true on the 1st processor only .OR. sn_cfctl%l_oceout=T 
    173166   LOGICAL       ::   lsp_area = .TRUE.     !: to make a control print over a specific area 
    174167   CHARACTER(lc) ::   cxios_context         !: context name used in xios 
    … …  
    178171   LOGICAL, PARAMETER, PUBLIC :: lxios_blkw    = .TRUE. 
    179172 
     173   !! * Substitutions 
     174#  include "do_loop_substitute.h90" 
    180175   !!---------------------------------------------------------------------- 
    181176   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/iom.F90

    r11482 r13463  
    2121   !!---------------------------------------------------------------------- 
    2222   USE dom_oce         ! ocean space and time domain 
     23   USE domutl          !  
    2324   USE c1d             ! 1D vertical configuration 
    2425   USE flo_oce         ! floats module declarations 
    … …  
    2930   USE lib_mpp           ! MPP library 
    3031#if defined key_iomput 
    31    USE sbc_oce  , ONLY :   nn_fsbc         ! ocean space and time domain 
    32    USE trc_oce  , ONLY :   nn_dttrc        !  !: frequency of step on passive tracers 
     32   USE sbc_oce  , ONLY :   nn_fsbc, ght_abl, ghw_abl, e3t_abl, e3w_abl, jpka, jpkam1 
    3333   USE icb_oce  , ONLY :   nclasses, class_num       !  !: iceberg classes 
    3434#if defined key_si3 
    3535   USE ice      , ONLY :   jpl 
    3636#endif 
    37    USE domngb          ! ocean space and time domain 
    3837   USE phycst          ! physical constants 
    3938   USE dianam          ! build name of file 
    … …  
    4645#endif 
    4746   USE lib_fortran  
    48    USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     47   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 
    4948 
    5049   IMPLICIT NONE 
    … …  
    5655   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
    5756#endif 
    58    PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get 
     57   PUBLIC iom_init, iom_init_closedef, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_get_var 
    5958   PUBLIC iom_chkatt, iom_getatt, iom_putatt, iom_getszuld, iom_rstput, iom_delay_rst, iom_put 
    60    PUBLIC iom_use, iom_context_finalize 
    61  
    62    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
    63    PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 
    64    PRIVATE iom_p1d, iom_p2d, iom_p3d 
     59   PUBLIC iom_use, iom_context_finalize, iom_update_file_name, iom_miss_val 
     60 
     61   PRIVATE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 
     62   PRIVATE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 
     63   PRIVATE iom_get_123d 
     64   PRIVATE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 
     65   PRIVATE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 
     66   PRIVATE iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 
     67   PRIVATE iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 
    6568#if defined key_iomput 
    6669   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 
    67    PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 
     70   PRIVATE set_grid, set_grid_bounds, set_scalar, set_xmlatt, set_mooring, iom_sdate 
    6871   PRIVATE iom_set_rst_context, iom_set_rstw_active, iom_set_rstr_active 
    6972# endif 
    … …  
    7174 
    7275   INTERFACE iom_get 
    73       MODULE PROCEDURE iom_g0d, iom_g1d, iom_g2d, iom_g3d 
     76      MODULE PROCEDURE iom_g0d_sp, iom_g1d_sp, iom_g2d_sp, iom_g3d_sp 
     77      MODULE PROCEDURE iom_g0d_dp, iom_g1d_dp, iom_g2d_dp, iom_g3d_dp 
    7478   END INTERFACE 
    7579   INTERFACE iom_getatt 
    … …  
    8084   END INTERFACE 
    8185   INTERFACE iom_rstput 
    82       MODULE PROCEDURE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 
     86      MODULE PROCEDURE iom_rp0d_sp, iom_rp1d_sp, iom_rp2d_sp, iom_rp3d_sp 
     87      MODULE PROCEDURE iom_rp0d_dp, iom_rp1d_dp, iom_rp2d_dp, iom_rp3d_dp 
    8388   END INTERFACE 
    8489   INTERFACE iom_put 
    85       MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 
     90      MODULE PROCEDURE iom_p0d_sp, iom_p1d_sp, iom_p2d_sp, iom_p3d_sp, iom_p4d_sp 
     91      MODULE PROCEDURE iom_p0d_dp, iom_p1d_dp, iom_p2d_dp, iom_p3d_dp, iom_p4d_dp 
    8692   END INTERFACE iom_put 
    8793   
     94   !! * Substitutions 
     95#  include "do_loop_substitute.h90" 
    8896   !!---------------------------------------------------------------------- 
    8997   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    93101CONTAINS 
    94102 
    95    SUBROUTINE iom_init( cdname, fname, ld_tmppatch )  
     103   SUBROUTINE iom_init( cdname, fname, ld_closedef )  
    96104      !!---------------------------------------------------------------------- 
    97105      !!                     ***  ROUTINE   *** 
    … …  
    102110      CHARACTER(len=*),           INTENT(in)  :: cdname 
    103111      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
    104       LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
     112      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    105113#if defined key_iomput 
    106114      ! 
    … …  
    108116      TYPE(xios_date)     :: start_date 
    109117      CHARACTER(len=lc) :: clname 
    110       INTEGER           :: ji, jkmin 
     118      INTEGER             :: irefyear, irefmonth, irefday 
     119      INTEGER           :: ji 
    111120      LOGICAL :: llrst_context              ! is context related to restart 
    112121      ! 
    113122      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    114       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    115       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    116       INTEGER ::   nldj_save, nlej_save    !: 
    117       !!---------------------------------------------------------------------- 
    118       ! 
    119       ! seb: patch before we remove periodicity and close boundaries in output files 
    120       IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch 
    121       ELSE                              ;   ll_tmppatch = .TRUE. 
    122       ENDIF 
    123       IF ( ll_tmppatch ) THEN 
    124          nldi_save = nldi   ;   nlei_save = nlei 
    125          nldj_save = nldj   ;   nlej_save = nlej 
    126          IF( nimpp           ==      1 ) nldi = 1 
    127          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    128          IF( njmpp           ==      1 ) nldj = 1 
    129          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    130       ENDIF 
     123      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
     124      LOGICAL ::   ll_closedef = .TRUE. 
     125      !!---------------------------------------------------------------------- 
     126      ! 
     127      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    131128      ! 
    132129      ALLOCATE( zt_bnds(2,jpk), zw_bnds(2,jpk) ) 
    … …  
    139136 
    140137      ! Calendar type is now defined in xml file  
     138      IF (.NOT.(xios_getvar('ref_year' ,irefyear ))) irefyear  = 1900 
     139      IF (.NOT.(xios_getvar('ref_month',irefmonth))) irefmonth = 01 
     140      IF (.NOT.(xios_getvar('ref_day'  ,irefday  ))) irefday   = 01 
     141 
    141142      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    142       CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(1900,01,01,00,00,00), & 
    143           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    144       CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(1900,01,01,00,00,00), & 
    145           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    146       CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(1900,01,01,00,00,00), & 
    147           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
     143      CASE ( 1)   ;   CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     144          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
     145      CASE ( 0)   ;   CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     146          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
     147      CASE (30)   ;   CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,0,0,0),  & 
     148          &                                                          start_date  = xios_date(   nyear,   nmonth,   nday,0,0,0) ) 
    148149      END SELECT 
    149150 
    … …  
    159160         ! 
    160161         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    161             CALL iom_set_domain_attr("grid_T", area = e1e2t(nldi:nlei, nldj:nlej)) 
    162             CALL iom_set_domain_attr("grid_U", area = e1e2u(nldi:nlei, nldj:nlej)) 
    163             CALL iom_set_domain_attr("grid_V", area = e1e2v(nldi:nlei, nldj:nlej)) 
    164             CALL iom_set_domain_attr("grid_W", area = e1e2t(nldi:nlei, nldj:nlej)) 
     162            CALL iom_set_domain_attr("grid_T", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
     163            CALL iom_set_domain_attr("grid_U", area = real( e1e2u(Nis0:Nie0, Njs0:Nje0), dp)) 
     164            CALL iom_set_domain_attr("grid_V", area = real( e1e2v(Nis0:Nie0, Njs0:Nje0), dp)) 
     165            CALL iom_set_domain_attr("grid_W", area = real( e1e2t(Nis0:Nie0, Njs0:Nje0), dp)) 
    165166            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    166167            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    … …  
    182183         ! 
    183184         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    184             CALL iom_set_domain_attr("grid_T", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
    185             CALL iom_set_domain_attr("grid_U", area = e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej)) 
    186             CALL iom_set_domain_attr("grid_V", area = e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej)) 
    187             CALL iom_set_domain_attr("grid_W", area = e1e2t_crs(nldi:nlei, nldj:nlej)) 
     185            CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     186            CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(Nis0:Nie0, Njs0:Nje0) * e2u_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     187            CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(Nis0:Nie0, Njs0:Nje0) * e2v_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
     188            CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(Nis0:Nie0, Njs0:Nje0), dp)) 
    188189            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    189190            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
    … …  
    195196      ! vertical grid definition 
    196197      IF(.NOT.llrst_context) THEN 
    197           CALL iom_set_axis_attr( "deptht",  paxis = gdept_1d ) 
    198           CALL iom_set_axis_attr( "depthu",  paxis = gdept_1d ) 
    199           CALL iom_set_axis_attr( "depthv",  paxis = gdept_1d ) 
    200           CALL iom_set_axis_attr( "depthw",  paxis = gdepw_1d ) 
    201  
     198          CALL iom_set_axis_attr(  "deptht", paxis = gdept_1d ) 
     199          CALL iom_set_axis_attr(  "depthu", paxis = gdept_1d ) 
     200          CALL iom_set_axis_attr(  "depthv", paxis = gdept_1d ) 
     201          CALL iom_set_axis_attr(  "depthw", paxis = gdepw_1d ) 
     202 
     203          ! ABL 
     204          IF( .NOT. ALLOCATED(ght_abl) ) THEN   ! force definition for xml files (xios)  
     205             ALLOCATE( ght_abl(jpka), ghw_abl(jpka), e3t_abl(jpka), e3w_abl(jpka) )   ! default allocation needed by iom 
     206             ght_abl(:) = -1._wp   ;   ghw_abl(:) = -1._wp 
     207             e3t_abl(:) = -1._wp   ;   e3w_abl(:) = -1._wp 
     208          ENDIF 
     209          CALL iom_set_axis_attr( "ght_abl", ght_abl(2:jpka) ) 
     210          CALL iom_set_axis_attr( "ghw_abl", ghw_abl(2:jpka) ) 
     211           
    202212          ! Add vertical grid bounds 
    203           jkmin = MIN(2,jpk)  ! in case jpk=1 (i.e. sas2D) 
    204           zt_bnds(2,:        ) = gdept_1d(:) 
    205           zt_bnds(1,jkmin:jpk) = gdept_1d(1:jpkm1) 
    206           zt_bnds(1,1        ) = gdept_1d(1) - e3w_1d(1) 
    207           zw_bnds(1,:        ) = gdepw_1d(:) 
    208           zw_bnds(2,1:jpkm1  ) = gdepw_1d(jkmin:jpk) 
    209           zw_bnds(2,jpk:     ) = gdepw_1d(jpk) + e3t_1d(jpk) 
    210           CALL iom_set_axis_attr( "deptht", bounds=zw_bnds ) 
    211           CALL iom_set_axis_attr( "depthu", bounds=zw_bnds ) 
    212           CALL iom_set_axis_attr( "depthv", bounds=zw_bnds ) 
    213           CALL iom_set_axis_attr( "depthw", bounds=zt_bnds ) 
    214           ! 
    215 # if defined key_floats 
     213          zt_bnds(2,:      ) = gdept_1d(:) 
     214          zt_bnds(1,2:jpk  ) = gdept_1d(1:jpkm1) 
     215          zt_bnds(1,1      ) = gdept_1d(1) - e3w_1d(1) 
     216          zw_bnds(1,:      ) = gdepw_1d(:) 
     217          zw_bnds(2,1:jpkm1) = gdepw_1d(2:jpk) 
     218          zw_bnds(2,jpk:   ) = gdepw_1d(jpk) + e3t_1d(jpk) 
     219          CALL iom_set_axis_attr(  "deptht", bounds=zw_bnds ) 
     220          CALL iom_set_axis_attr(  "depthu", bounds=zw_bnds ) 
     221          CALL iom_set_axis_attr(  "depthv", bounds=zw_bnds ) 
     222          CALL iom_set_axis_attr(  "depthw", bounds=zt_bnds ) 
     223 
     224          ! ABL 
     225          za_bnds(1,:) = ghw_abl(1:jpkam1) 
     226          za_bnds(2,:) = ghw_abl(2:jpka  ) 
     227          CALL iom_set_axis_attr( "ght_abl", bounds=za_bnds ) 
     228          za_bnds(1,:) = ght_abl(2:jpka  ) 
     229          za_bnds(2,:) = ght_abl(2:jpka  ) + e3w_abl(2:jpka) 
     230          CALL iom_set_axis_attr( "ghw_abl", bounds=za_bnds ) 
     231 
    216232          CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,jpnfl) /) ) 
    217 # endif 
    218233# if defined key_si3 
    219234          CALL iom_set_axis_attr( "ncatice", (/ (REAL(ji,wp), ji=1,jpl) /) ) 
    … …  
    226241          CALL iom_set_axis_attr( "icbcla", class_num ) 
    227242          CALL iom_set_axis_attr( "iax_20C", (/ REAL(20,wp) /) )   ! strange syntaxe and idea... 
     243          CALL iom_set_axis_attr( "iax_26C", (/ REAL(26,wp) /) )   ! strange syntaxe and idea... 
    228244          CALL iom_set_axis_attr( "iax_28C", (/ REAL(28,wp) /) )   ! strange syntaxe and idea... 
     245          CALL iom_set_axis_attr( "basin"  , (/ (REAL(ji,wp), ji=1,5) /) ) 
    229246      ENDIF 
    230247      ! 
    … …  
    246263      ENDIF 
    247264      ! 
    248       ! end file definition 
    249       dtime%second = rdt 
     265      ! set time step length 
     266      dtime%second = rn_Dt 
    250267      CALL xios_set_timestep( dtime ) 
     268      ! 
     269      ! conditional closure of context definition 
     270      IF ( ll_closedef ) CALL iom_init_closedef 
     271      ! 
     272      DEALLOCATE( zt_bnds, zw_bnds ) 
     273      ! 
     274#endif 
     275      ! 
     276   END SUBROUTINE iom_init 
     277 
     278   SUBROUTINE iom_init_closedef 
     279      !!---------------------------------------------------------------------- 
     280      !!            ***  SUBROUTINE iom_init_closedef  *** 
     281      !!---------------------------------------------------------------------- 
     282      !! 
     283      !! ** Purpose : Closure of context definition 
     284      !! 
     285      !!---------------------------------------------------------------------- 
     286 
     287#if defined key_iomput 
    251288      CALL xios_close_context_definition() 
    252289      CALL xios_update_calendar( 0 ) 
    253       ! 
    254       DEALLOCATE( zt_bnds, zw_bnds ) 
    255       ! 
    256       IF ( ll_tmppatch ) THEN 
    257          nldi = nldi_save   ;   nlei = nlei_save 
    258          nldj = nldj_save   ;   nlej = nlej_save 
    259       ENDIF 
    260 #endif 
    261       ! 
    262    END SUBROUTINE iom_init 
     290#else 
     291      IF( .FALSE. )   WRITE(numout,*) 'iom_init_closedef: should not see this'   ! useless statement to avoid compilation warnings 
     292#endif 
     293 
     294   END SUBROUTINE iom_init_closedef 
    263295 
    264296   SUBROUTINE iom_set_rstw_var_active(field) 
    … …  
    364396   IF(cdmdl == "OPA") THEN 
    365397!from restart.F90 
    366    CALL iom_set_rstw_var_active("rdt") 
     398   CALL iom_set_rstw_var_active("rn_Dt") 
    367399   IF ( .NOT. ln_diurnal_only ) THEN 
    368400        CALL iom_set_rstw_var_active('ub'  ) 
    … …  
    378410        CALL iom_set_rstw_var_active('sshn') 
    379411        CALL iom_set_rstw_var_active('rhop') 
    380      ! extra variable needed for the ice sheet coupling 
    381         IF ( ln_iscpl ) THEN 
    382              CALL iom_set_rstw_var_active('tmask') 
    383              CALL iom_set_rstw_var_active('umask') 
    384              CALL iom_set_rstw_var_active('vmask') 
    385              CALL iom_set_rstw_var_active('smask') 
    386              CALL iom_set_rstw_var_active('e3t_n') 
    387              CALL iom_set_rstw_var_active('e3u_n') 
    388              CALL iom_set_rstw_var_active('e3v_n') 
    389              CALL iom_set_rstw_var_active('gdepw_n') 
    390         END IF 
    391412      ENDIF 
    392413      IF(ln_diurnal) CALL iom_set_rstw_var_active('Dsst') 
    … …  
    413434 
    414435        i = 0 
    415         i = i + 1; fields(i)%vname="rdt";            fields(i)%grid="grid_scalar" 
     436        i = i + 1; fields(i)%vname="rn_Dt";            fields(i)%grid="grid_scalar" 
    416437        i = i + 1; fields(i)%vname="un";             fields(i)%grid="grid_N_3D" 
    417438        i = i + 1; fields(i)%vname="ub";             fields(i)%grid="grid_N_3D" 
    … …  
    630651 
    631652 
    632    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev ) 
     653   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp ) 
    633654      !!--------------------------------------------------------------------- 
    634655      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    639660      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file 
    640661      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.) 
    641       INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap) 
    642662      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    643663      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    644664      INTEGER         , INTENT(in   ), OPTIONAL ::   kdlev    ! number of vertical levels 
     665      CHARACTER(len=3), INTENT(in   ), OPTIONAL ::   cdcomp   ! name of component calling iom_nf90_open 
    645666      ! 
    646667      CHARACTER(LEN=256)    ::   clname    ! the name of the file based on cdname [[+clcpu]+clcpu] 
    … …  
    651672      LOGICAL               ::   llok      ! check the existence  
    652673      LOGICAL               ::   llwrt     ! local definition of ldwrt 
    653       LOGICAL               ::   llnoov    ! local definition to read overlap 
    654674      LOGICAL               ::   llstop    ! local definition of ldstop 
    655675      LOGICAL               ::   lliof     ! local definition of ldiof 
    656676      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    657677      INTEGER               ::   iln, ils  ! lengths of character 
    658       INTEGER               ::   idom      ! type of domain 
    659678      INTEGER               ::   istop     !  
    660       INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:  
    661679      ! local number of points for x,y dimensions 
    662680      ! position of first local point for x,y dimensions 
    … …  
    690708      ELSE                        ;   lliof = .FALSE. 
    691709      ENDIF 
    692       ! do we read the overlap  
    693       ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    694       llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
    695710      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    696711      ! ============= 
    … …  
    732747         lxios_sini = .TRUE. 
    733748      ENDIF 
    734       IF( llwrt ) THEN 
    735          ! check the domain definition 
    736 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    737 !         idom = jpdom_local_noovlap   ! default definition 
    738          IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition 
    739          ELSE                ;   idom = jpdom_local_full      ! default definition 
    740          ENDIF 
    741          IF( PRESENT(kdom) )   idom = kdom 
    742          ! create the domain informations 
    743          ! ============= 
    744          SELECT CASE (idom) 
    745          CASE (jpdom_local_full) 
    746             idompar(:,1) = (/ jpi             , jpj              /) 
    747             idompar(:,2) = (/ nimpp           , njmpp            /) 
    748             idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
    749             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    750             idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
    751          CASE (jpdom_local_noextra) 
    752             idompar(:,1) = (/ nlci            , nlcj             /) 
    753             idompar(:,2) = (/ nimpp           , njmpp            /) 
    754             idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
    755             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    756             idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
    757          CASE (jpdom_local_noovlap) 
    758             idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
    759             idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
    760             idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
    761             idompar(:,4) = (/ 0               , 0                /) 
    762             idompar(:,5) = (/ 0               , 0                /) 
    763          CASE DEFAULT 
    764             CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
    765          END SELECT 
    766       ENDIF 
    767749      ! Open the NetCDF file 
    768750      ! ============= 
    … …  
    788770      ENDIF 
    789771      IF( istop == nstop ) THEN   ! no error within this routine 
    790          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev ) 
     772         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 
    791773      ENDIF 
    792774      ! 
    … …  
    808790      CHARACTER(LEN=100)    ::   clinfo    ! info character 
    809791      !--------------------------------------------------------------------- 
     792      ! 
     793      IF( iom_open_init == 0 )   RETURN   ! avoid to use iom_file(jf)%nfid that us not yet initialized 
    810794      ! 
    811795      clinfo = '                    iom_close ~~~  ' 
    … …  
    835819 
    836820 
    837    FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, ldstop )   
     821   FUNCTION iom_varid ( kiomid, cdvar, kdimsz, kndims, lduld, ldstop )   
    838822      !!----------------------------------------------------------------------- 
    839823      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    844828      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    845829      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
    846       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     830      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
     831      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    847832      LOGICAL              , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if looking for non-existing variable (default = .TRUE.) 
    848833      ! 
    … …  
    874859               iiv = iiv + 1 
    875860               IF( iiv <= jpmax_vars ) THEN 
    876                   iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims ) 
     861                  iom_varid = iom_nf90_varid( kiomid, cdvar, iiv, kdimsz, kndims, lduld ) 
    877862               ELSE 
    878863                  CALL ctl_stop( trim(clinfo), 'Too many variables in the file '//iom_file(kiomid)%name,   & 
    … …  
    892877               ENDIF 
    893878               IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(iiv) 
     879               IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld( iiv) 
    894880            ENDIF 
    895881         ENDIF 
    … …  
    902888   !!                   INTERFACE iom_get 
    903889   !!---------------------------------------------------------------------- 
    904    SUBROUTINE iom_g0d( kiomid, cdvar, pvar, ktime, ldxios ) 
     890   SUBROUTINE iom_g0d_sp( kiomid, cdvar, pvar, ktime, ldxios ) 
    905891      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
    906892      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
    907       REAL(wp)        , INTENT(  out)                 ::   pvar      ! read field 
     893      REAL(sp)        , INTENT(  out)                 ::   pvar      ! read field 
     894      REAL(dp)                                        ::   ztmp_pvar ! tmp var to read field 
     895      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
     896      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
     897      ! 
     898      INTEGER                                         ::   idvar     ! variable id 
     899      INTEGER                                         ::   idmspc    ! number of spatial dimensions 
     900      INTEGER         , DIMENSION(1)                  ::   itime     ! record number 
     901      CHARACTER(LEN=100)                              ::   clinfo    ! info character 
     902      CHARACTER(LEN=100)                              ::   clname    ! file name 
     903      CHARACTER(LEN=1)                                ::   cldmspc   ! 
     904      LOGICAL                                         ::   llxios 
     905      ! 
     906      llxios = .FALSE. 
     907      IF( PRESENT(ldxios) ) llxios = ldxios 
     908 
     909      IF(.NOT.llxios) THEN  ! read data using default library 
     910         itime = 1 
     911         IF( PRESENT(ktime) ) itime = ktime 
     912         ! 
     913         clname = iom_file(kiomid)%name 
     914         clinfo = '          iom_g0d, file: '//trim(clname)//', var: '//trim(cdvar) 
     915         ! 
     916         IF( kiomid > 0 ) THEN 
     917            idvar = iom_varid( kiomid, cdvar ) 
     918            IF( iom_file(kiomid)%nfid > 0 .AND. idvar > 0 ) THEN 
     919               idmspc = iom_file ( kiomid )%ndims( idvar ) 
     920               IF( iom_file(kiomid)%luld(idvar) )  idmspc = idmspc - 1 
     921               WRITE(cldmspc , fmt='(i1)') idmspc 
     922               IF( idmspc > 0 )  CALL ctl_stop( TRIM(clinfo), 'When reading to a 0D array, we do not accept data', & 
     923                                    &                         'with 1 or more spatial dimensions: '//cldmspc//' were found.' , & 
     924                                    &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     925               CALL iom_nf90_get( kiomid, idvar, ztmp_pvar, itime ) 
     926               pvar = ztmp_pvar 
     927            ENDIF 
     928         ENDIF 
     929      ELSE 
     930#if defined key_iomput 
     931         IF(lwp) WRITE(numout,*) 'XIOS RST READ (0D): ', trim(cdvar) 
     932         CALL iom_swap( TRIM(crxios_context) ) 
     933         CALL xios_recv_field( trim(cdvar), pvar) 
     934         CALL iom_swap( TRIM(cxios_context) ) 
     935#else 
     936         WRITE(ctmp1,*) 'Can not use XIOS in iom_g0d, file: '//trim(clname)//', var:'//trim(cdvar) 
     937         CALL ctl_stop( 'iom_g0d', ctmp1 ) 
     938#endif 
     939      ENDIF 
     940   END SUBROUTINE iom_g0d_sp 
     941 
     942   SUBROUTINE iom_g0d_dp( kiomid, cdvar, pvar, ktime, ldxios ) 
     943      INTEGER         , INTENT(in   )                 ::   kiomid    ! Identifier of the file 
     944      CHARACTER(len=*), INTENT(in   )                 ::   cdvar     ! Name of the variable 
     945      REAL(dp)        , INTENT(  out)                 ::   pvar      ! read field 
    908946      INTEGER         , INTENT(in   ),     OPTIONAL   ::   ktime     ! record number 
    909947      LOGICAL         , INTENT(in   ),     OPTIONAL   ::   ldxios    ! use xios to read restart 
    … …  
    950988#endif 
    951989      ENDIF 
    952    END SUBROUTINE iom_g0d 
    953  
    954    SUBROUTINE iom_g1d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
     990   END SUBROUTINE iom_g0d_dp 
     991 
     992   SUBROUTINE iom_g1d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
    955993      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
    956994      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
    957995      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
    958       REAL(wp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     996      REAL(sp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     997      REAL(dp)        , ALLOCATABLE  , DIMENSION(:)           ::   ztmp_pvar ! tmp var to read field 
    959998      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
    960999      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
    … …  
    9631002      ! 
    9641003      IF( kiomid > 0 ) THEN 
     1004         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1005            ALLOCATE(ztmp_pvar(size(pvar,1))) 
     1006            CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=ztmp_pvar,   & 
     1007              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
     1008              &                                                     ldxios=ldxios ) 
     1009            pvar = ztmp_pvar 
     1010            DEALLOCATE(ztmp_pvar) 
     1011         END IF 
     1012      ENDIF 
     1013   END SUBROUTINE iom_g1d_sp 
     1014 
     1015 
     1016   SUBROUTINE iom_g1d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, ldxios ) 
     1017      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1018      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1019      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1020      REAL(dp)        , INTENT(  out), DIMENSION(:)           ::   pvar      ! read field 
     1021      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1022      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kstart    ! start axis position of the reading  
     1023      INTEGER         , INTENT(in   ), DIMENSION(1), OPTIONAL ::   kcount    ! number of points in each axis 
     1024      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1025      ! 
     1026      IF( kiomid > 0 ) THEN 
    9651027         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r1d=pvar,   & 
    9661028              &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    9671029              &                                                     ldxios=ldxios ) 
    9681030      ENDIF 
    969    END SUBROUTINE iom_g1d 
    970  
    971    SUBROUTINE iom_g2d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    972       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    973       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    974       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    975       REAL(wp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    976       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    977       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    978       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    979       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    980                                                                                ! look for and use a file attribute 
    981                                                                                ! called open_ocean_jstart to set the start 
    982                                                                                ! value for the 2nd dimension (netcdf only) 
    983       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
     1031   END SUBROUTINE iom_g1d_dp 
     1032 
     1033   SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1034      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1035      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1036      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1037      REAL(sp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1038      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)         ::   ztmp_pvar ! tmp var to read field 
     1039      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1040      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1041      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1042      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1043      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1044      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     1045      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    9841046      ! 
    9851047      IF( kiomid > 0 ) THEN 
    986          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    987               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    988               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
    989       ENDIF 
    990    END SUBROUTINE iom_g2d 
    991  
    992    SUBROUTINE iom_g3d( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    993       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    994       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    995       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    996       REAL(wp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    997       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    998       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    999       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1000       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1001                                                                                  ! look for and use a file attribute 
    1002                                                                                  ! called open_ocean_jstart to set the start 
    1003                                                                                  ! value for the 2nd dimension (netcdf only) 
    1004       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
     1048         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1049            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 
     1050            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = ztmp_pvar  , ktime = ktime,   & 
     1051             &                                                      cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1052             &                                                      kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1053            pvar = ztmp_pvar 
     1054            DEALLOCATE(ztmp_pvar) 
     1055         ENDIF 
     1056      ENDIF 
     1057   END SUBROUTINE iom_g2d_sp 
     1058 
     1059   SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios) 
     1060      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1061      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1062      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1063      REAL(dp)        , INTENT(  out), DIMENSION(:,:)         ::   pvar      ! read field 
     1064      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1065      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1066      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.): (not) change sign across the north fold 
     1067      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1068      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kstart    ! start axis position of the reading  
     1069      INTEGER         , INTENT(in   ), DIMENSION(2), OPTIONAL ::   kcount    ! number of points in each axis 
     1070      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
    10051071      ! 
    10061072      IF( kiomid > 0 ) THEN 
    1007          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    1008               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1009               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    1010       ENDIF 
    1011    END SUBROUTINE iom_g3d 
     1073         IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r2d = pvar  , ktime = ktime,   & 
     1074            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1075            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1076      ENDIF 
     1077   END SUBROUTINE iom_g2d_dp 
     1078 
     1079   SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1080      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1081      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1082      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1083      REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1084      REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)       ::   ztmp_pvar ! tmp var to read field 
     1085      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1086      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1087      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1088      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1089      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1090      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1091      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1092      ! 
     1093      IF( kiomid > 0 ) THEN 
     1094         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1095            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
     1096            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = ztmp_pvar  , ktime = ktime,   & 
     1097            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1098            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1099            pvar = ztmp_pvar 
     1100            DEALLOCATE(ztmp_pvar) 
     1101         END IF 
     1102      ENDIF 
     1103   END SUBROUTINE iom_g3d_sp 
     1104 
     1105   SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, cd_type, psgn, kfill, kstart, kcount, ldxios ) 
     1106      INTEGER         , INTENT(in   )                         ::   kiomid    ! Identifier of the file 
     1107      INTEGER         , INTENT(in   )                         ::   kdom      ! Type of domain to be read 
     1108      CHARACTER(len=*), INTENT(in   )                         ::   cdvar     ! Name of the variable 
     1109      REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)       ::   pvar      ! read field 
     1110      INTEGER         , INTENT(in   )              , OPTIONAL ::   ktime     ! record number 
     1111      CHARACTER(len=1), INTENT(in   )              , OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1112      REAL(dp)        , INTENT(in   )              , OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1113      INTEGER         , INTENT(in   )              , OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1114      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kstart    ! start axis position of the reading  
     1115      INTEGER         , INTENT(in   ), DIMENSION(3), OPTIONAL ::   kcount    ! number of points in each axis 
     1116      LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios    ! read data using XIOS 
     1117      ! 
     1118      IF( kiomid > 0 ) THEN 
     1119         IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1120            CALL iom_get_123d( kiomid, kdom, cdvar      , pv_r3d = pvar  , ktime = ktime,   & 
     1121            &                                                       cd_type = cd_type, psgn   = psgn  , kfill = kfill,   & 
     1122            &                                                       kstart  = kstart , kcount = kcount, ldxios=ldxios  ) 
     1123         END IF 
     1124      ENDIF 
     1125   END SUBROUTINE iom_g3d_dp 
     1126 
    10121127   !!---------------------------------------------------------------------- 
    10131128 
    1014    SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    1015          &                  pv_r1d, pv_r2d, pv_r3d,   & 
    1016          &                  ktime , kstart, kcount,   & 
    1017          &                  lrowattr, ldxios        ) 
     1129   SUBROUTINE iom_get_123d( kiomid , kdom, cdvar, pv_r1d, pv_r2d, pv_r3d, ktime ,   & 
     1130         &                  cd_type, psgn, kfill, kstart, kcount, ldxios ) 
    10181131      !!----------------------------------------------------------------------- 
    10191132      !!                  ***  ROUTINE  iom_get_123d  *** 
    … …  
    10231136      !! ** Method : read ONE record at each CALL 
    10241137      !!----------------------------------------------------------------------- 
    1025       INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file 
    1026       INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    1027       CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable 
    1028       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    1029       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    1030       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    1031       INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number 
    1032       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    1033       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    1034       LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
    1035                                                                            ! look for and use a file attribute 
    1036                                                                            ! called open_ocean_jstart to set the start 
    1037                                                                            ! value for the 2nd dimension (netcdf only) 
    1038       LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart 
    1039       ! 
    1040       LOGICAL                        ::   llxios       ! local definition for XIOS read 
    1041       LOGICAL                        ::   llnoov      ! local definition to read overlap 
    1042       LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
    1043       INTEGER                        ::   jstartrow   ! start point for 2nd dimension optionally set by file attribute 
     1138      INTEGER                    , INTENT(in   )           ::   kiomid    ! Identifier of the file 
     1139      INTEGER                    , INTENT(in   )           ::   kdom      ! Type of domain to be read 
     1140      CHARACTER(len=*)           , INTENT(in   )           ::   cdvar     ! Name of the variable 
     1141      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     1142      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     1143      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     1144      INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime     ! record number 
     1145      CHARACTER(len=1)           , INTENT(in   ), OPTIONAL ::   cd_type   ! nature of grid-points (T, U, V, F, W) 
     1146      REAL(dp)                   , INTENT(in   ), OPTIONAL ::   psgn      ! -1.(1.) : (not) change sign across the north fold 
     1147      INTEGER                    , INTENT(in   ), OPTIONAL ::   kfill     ! value of kfillmode in lbc_lbk 
     1148      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart    ! start position of the reading in each axis  
     1149      INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount    ! number of points to be read in each axis 
     1150      LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios    ! use XIOS to read restart 
     1151      ! 
     1152      LOGICAL                        ::   llok        ! true if ok! 
     1153      LOGICAL                        ::   llxios      ! local definition for XIOS read 
    10441154      INTEGER                        ::   jl          ! loop on number of dimension  
    10451155      INTEGER                        ::   idom        ! type of domain 
    … …  
    10571167      INTEGER, DIMENSION(jpmax_dims) ::   idimsz      ! size of the dimensions of the variable 
    10581168      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    1059       REAL(wp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1169      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1170      REAL(wp)                       ::   zsgn        ! local value of psgn 
    10601171      INTEGER                        ::   itmp        ! temporary integer 
    10611172      CHARACTER(LEN=256)             ::   clinfo      ! info character 
    10621173      CHARACTER(LEN=256)             ::   clname      ! file name 
    10631174      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    1064       LOGICAL                        ::   ll_depth_spec ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
     1175      CHARACTER(LEN=1)               ::   cl_type     ! local value of cd_type 
     1176      LOGICAL                        ::   ll_only3rd  ! T => if kstart, kcount present then *only* use values for 3rd spatial dimension. 
    10651177      INTEGER                        ::   inlev       ! number of levels for 3D data 
    1066       REAL(wp)                       ::   gma, gmi 
     1178      REAL(dp)                       ::   gma, gmi 
    10671179      !--------------------------------------------------------------------- 
    10681180      ! 
    … …  
    10721184      llxios = .FALSE. 
    10731185      if(PRESENT(ldxios)) llxios = ldxios 
     1186      idvar = iom_varid( kiomid, cdvar )  
    10741187      idom = kdom 
     1188      istop = nstop 
    10751189      ! 
    10761190      IF(.NOT.llxios) THEN 
    … …  
    10781192         clname = iom_file(kiomid)%name   !   esier to read 
    10791193         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
    1080          ! local definition of the domain ? 
    1081          ! do we read the overlap  
    1082          ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    1083          llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif  
    10841194         ! check kcount and kstart optionals parameters... 
    1085          IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    1086          IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    1087          IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
    1088      &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    1089  
    1090          luse_jattr = .false. 
    1091          IF( PRESENT(lrowattr) ) THEN 
    1092             IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
    1093             IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
    1094          ENDIF 
    1095  
     1195         IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
     1196         IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
     1197         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 
     1198            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 
     1199         IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) & 
     1200            &          CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present') 
     1201         ! 
    10961202         ! Search for the variable in the data base (eventually actualize data) 
    1097          istop = nstop 
    10981203         ! 
     1204         idvar = iom_varid( kiomid, cdvar )  
    10991205         IF( idvar > 0 ) THEN 
    1100             ! to write iom_file(kiomid)%dimsz in a shorter way ! 
    1101             idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)  
     1206            ! 
     1207            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way 
    11021208            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file 
    11031209            idmspc = inbdim                                   ! number of spatial dimensions in the file 
    … …  
    11051211            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
    11061212            ! 
    1107             ! update idom definition... 
    1108             ! Identify the domain in case of jpdom_auto(glo/dta) definition 
    1109             IF( idom == jpdom_autoglo_xy ) THEN 
    1110                ll_depth_spec = .TRUE. 
    1111                idom = jpdom_autoglo 
    1112             ELSE 
    1113                ll_depth_spec = .FALSE. 
    1114             ENDIF 
    1115             IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    1116                IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
    1117                ELSE                               ;   idom = jpdom_data 
    1118                ENDIF 
     1213            ! Identify the domain in case of jpdom_auto definition 
     1214            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN             
     1215               idom = jpdom_global   ! default 
     1216               ! else: if the file name finishes with _xxxx.nc with xxxx any number 
    11191217               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 
    11201218               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 
    11211219               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF 
    1122             ENDIF 
    1123             ! Identify the domain in case of jpdom_local definition 
    1124             IF( idom == jpdom_local ) THEN 
    1125                IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full 
    1126                ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra 
    1127                ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap 
    1128                ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
    1129                ENDIF 
    11301220            ENDIF 
    11311221            ! 
    … …  
    11401230            WRITE(cldmspc , fmt='(i1)') idmspc 
    11411231            ! 
    1142             IF(     idmspc <  irankpv ) THEN  
    1143                CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1144                   &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
     1232            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can... 
     1233               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file: 
     1234                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1 
     1235               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file: 
     1236                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1 
     1237               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file: 
     1238                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1 
     1239               ELSE 
     1240                  llok = .FALSE. 
     1241               ENDIF 
     1242               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1243                  &                                            '=> cannot read a true '//clrankpv//'D array from this file...' ) 
    11451244            ELSEIF( idmspc == irankpv ) THEN 
    11461245               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    11471246                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    1148             ELSEIF( idmspc >  irankpv ) THEN 
     1247            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should... 
    11491248                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    1150                      CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   & 
     1249                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   & 
    11511250                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    11521251                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
    11531252                     idmspc = idmspc - 1 
    1154                   ELSE 
    1155                      CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,'         ,   & 
    1156                         &                         'we do not accept data with '//cldmspc//' spatial dimensions',   & 
    1157                         &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
     1253                  !!GS: possibility to read 3D ABL atmopsheric forcing and use 1st level to force BULK simulation 
     1254                  !ELSE 
     1255                  !   CALL ctl_stop( TRIM(clinfo), 'To keep iom lisibility, when reading a '//clrankpv//'D array,',   & 
     1256                  !      &                         'we do not accept data with '//cldmspc//' spatial dimensions'  ,   & 
     1257                  !      &                         'Use ncwa -a to suppress the unnecessary dimensions' ) 
    11581258                  ENDIF 
    11591259            ENDIF 
    … …  
    11611261            ! definition of istart and icnt 
    11621262            ! 
    1163             icnt  (:) = 1 
    1164             istart(:) = 1 
    1165             istart(idmspc+1) = itime 
    1166     
    1167             IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
    1168                istart(1:idmspc) = kstart(1:idmspc)  
    1169                icnt  (1:idmspc) = kcount(1:idmspc) 
    1170             ELSE 
    1171                IF(idom == jpdom_unknown ) THEN 
    1172                   icnt(1:idmspc) = idimsz(1:idmspc) 
    1173                ELSE  
    1174                   IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    1175                      IF(     idom == jpdom_data    ) THEN 
    1176                         jstartrow = 1 
    1177                         IF( luse_jattr ) THEN 
    1178                            CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    1179                            jstartrow = MAX(1,jstartrow) 
    1180                         ENDIF 
    1181                         istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
    1182                      ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    1183                      ENDIF 
    1184                      ! we do not read the overlap                     -> we start to read at nldi, nldj 
    1185 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1186 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1187                      IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1188                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    1189 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1190 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1191                      IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1192                      ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /) 
    1193                      ENDIF 
    1194                      IF( PRESENT(pv_r3d) ) THEN 
    1195                         IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev 
    1196                         ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3) 
    1197                         ELSE                                                 ;                               icnt(3) = inlev 
    1198                         ENDIF 
    1199                      ENDIF 
     1263            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1264            istart(:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1265            istart(idmspc+1) = itime   ! temporal dimenstion 
     1266            ! 
     1267            IF( idom == jpdom_unknown ) THEN 
     1268               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN  
     1269                  istart(1:idmspc) = kstart(1:idmspc)  
     1270                  icnt  (1:idmspc) = kcount(1:idmspc) 
     1271               ELSE 
     1272                  icnt  (1:idmspc) = idimsz(1:idmspc) 
     1273               ENDIF 
     1274            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown 
     1275               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0  
     1276               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 
     1277               icnt(1:2) = (/ Ni_0, Nj_0 /) 
     1278               IF( PRESENT(pv_r3d) ) THEN 
     1279                  IF( idom == jpdom_auto_xy ) THEN 
     1280                     istart(3) = kstart(3) 
     1281                     icnt  (3) = kcount(3) 
     1282                  ELSE 
     1283                     icnt  (3) = inlev 
    12001284                  ENDIF 
    12011285               ENDIF 
    12021286            ENDIF 
    1203  
     1287            ! 
    12041288            ! check that istart and icnt can be used with this file 
    12051289            !- 
    … …  
    12121296               ENDIF 
    12131297            END DO 
    1214  
     1298            ! 
    12151299            ! check that icnt matches the input array 
    12161300            !-      
    … …  
    12221306            ELSE 
    12231307               IF( irankpv == 2 ) THEN 
    1224 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1225 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
    1226                   IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 
    1227                   ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)' 
    1228                   ENDIF 
     1308                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 
    12291309               ENDIF 
    12301310               IF( irankpv == 3 ) THEN  
    1231 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1232 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
    1233                   IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 
    1234                   ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 
    1235                   ENDIF 
     1311                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 
    12361312               ENDIF 
    1237             ENDIF 
    1238           
     1313            ENDIF          
    12391314            DO jl = 1, irankpv 
    12401315               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
    … …  
    12481323         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point... 
    12491324            ! 
    1250          ! find the right index of the array to be read 
    1251 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1252 !         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1253 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1254 !         ENDIF 
    1255             IF( llnoov ) THEN 
    1256                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1257                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1258                ENDIF 
    1259             ELSE 
    1260                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
    1261                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1262                ENDIF 
     1325            ! find the right index of the array to be read 
     1326            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0 
     1327            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    12631328            ENDIF 
    12641329       
    … …  
    12671332            IF( istop == nstop ) THEN   ! no additional errors until this point... 
    12681333               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 
    1269               
     1334 
     1335               cl_type = 'T' 
     1336               IF( PRESENT(cd_type) )   cl_type = cd_type 
     1337               zsgn = 1._wp 
     1338               IF( PRESENT(psgn   ) )   zsgn    = psgn 
    12701339               !--- overlap areas and extra hallows (mpp) 
    1271                IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1272                   CALL lbc_lnk( 'iom', pv_r2d,'Z',-999.,'no0' ) 
    1273                ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    1274                   ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    1275                   IF( icnt(3) == inlev ) THEN 
    1276                      CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
    1277                   ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    1278                      DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    1279                      DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO 
    1280                   ENDIF 
     1340               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1341                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 
     1342               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1343                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 
    12811344               ENDIF 
    12821345               ! 
    … …  
    13111374         IF( PRESENT(pv_r3d) ) THEN 
    13121375            pv_r3d(:, :, :) = 0. 
    1313             if(lwp) write(numout,*) 'XIOS READ (3D): ',trim(cdvar) 
     1376            IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 
    13141377            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    1315             IF(idom /= jpdom_unknown ) then 
    1316                 CALL lbc_lnk( 'iom', pv_r3d,'Z',-999.,'no0' ) 
    1317             ENDIF 
     1378            IF(idom /= jpdom_unknown )   CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    13181379         ELSEIF( PRESENT(pv_r2d) ) THEN 
    13191380            pv_r2d(:, :) = 0. 
    1320             if(lwp) write(numout,*) 'XIOS READ (2D): ', trim(cdvar) 
     1381            IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 
    13211382            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    1322             IF(idom /= jpdom_unknown ) THEN 
    1323                 CALL lbc_lnk('iom', pv_r2d,'Z',-999.,'no0') 
    1324             ENDIF 
     1383            IF(idom /= jpdom_unknown )   CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    13251384         ELSEIF( PRESENT(pv_r1d) ) THEN 
    13261385            pv_r1d(:) = 0. 
    1327             if(lwp) write(numout,*) 'XIOS READ (1D): ', trim(cdvar) 
     1386            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 
    13281387            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    13291388         ENDIF 
    … …  
    13351394!some final adjustments 
    13361395      ! C1D case : always call lbc_lnk to replicate the central value over the whole 3X3 domain 
    1337       IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1. ) 
    1338       IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1. ) 
     1396      IF( lk_c1d .AND. PRESENT(pv_r2d) )   CALL lbc_lnk( 'iom', pv_r2d,'Z',1.0_wp ) 
     1397      IF( lk_c1d .AND. PRESENT(pv_r3d) )   CALL lbc_lnk( 'iom', pv_r3d,'Z',1.0_wp ) 
    13391398      ! 
    13401399   END SUBROUTINE iom_get_123d 
     1400 
     1401   SUBROUTINE iom_get_var( cdname, z2d) 
     1402      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
     1403      REAL(wp), DIMENSION(jpi,jpj) ::   z2d  
     1404#if defined key_iomput 
     1405      IF( xios_field_is_active( cdname, at_current_timestep_arg = .TRUE. ) ) THEN 
     1406         z2d(:,:) = 0._wp 
     1407         CALL xios_recv_field( cdname, z2d) 
     1408      ENDIF 
     1409#else 
     1410      IF( .FALSE. )   WRITE(numout,*) cdname, z2d ! useless test to avoid compilation warnings 
     1411#endif 
     1412   END SUBROUTINE iom_get_var 
    13411413 
    13421414 
    … …  
    14961568   !!                   INTERFACE iom_rstput 
    14971569   !!---------------------------------------------------------------------- 
    1498    SUBROUTINE iom_rp0d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1570   SUBROUTINE iom_rp0d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    14991571      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15001572      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15011573      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15021574      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1503       REAL(wp)        , INTENT(in)                         ::   pvar     ! written field 
     1575      REAL(sp)        , INTENT(in)                         ::   pvar     ! written field 
    15041576      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15051577      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
    … …  
    15201592            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15211593               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1522                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1594               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = real(pvar, dp) ) 
    15231595            ENDIF 
    15241596         ENDIF 
    15251597      ENDIF 
    1526    END SUBROUTINE iom_rp0d 
    1527  
    1528    SUBROUTINE iom_rp1d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1598   END SUBROUTINE iom_rp0d_sp 
     1599 
     1600   SUBROUTINE iom_rp0d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15291601      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15301602      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15311603      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15321604      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1533       REAL(wp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1605      REAL(dp)        , INTENT(in)                         ::   pvar     ! written field 
     1606      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1607      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1608      LOGICAL :: llx                ! local xios write flag 
     1609      INTEGER :: ivid   ! variable id 
     1610 
     1611      llx = .FALSE. 
     1612      IF(PRESENT(ldxios)) llx = ldxios 
     1613      IF( llx ) THEN 
     1614#ifdef key_iomput 
     1615      IF( kt == kwrite ) THEN 
     1616          IF(lwp) write(numout,*) 'RESTART: write (XIOS 0D) ',trim(cdvar) 
     1617          CALL xios_send_field(trim(cdvar), pvar) 
     1618      ENDIF 
     1619#endif 
     1620      ELSE 
     1621         IF( kiomid > 0 ) THEN 
     1622            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1623               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1624               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r0d = pvar ) 
     1625            ENDIF 
     1626         ENDIF 
     1627      ENDIF 
     1628   END SUBROUTINE iom_rp0d_dp 
     1629 
     1630 
     1631   SUBROUTINE iom_rp1d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1632      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1633      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1634      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1635      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1636      REAL(sp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
    15341637      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15351638      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
    … …  
    15501653            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15511654               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1552                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1655               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = real(pvar, dp) ) 
    15531656            ENDIF 
    15541657         ENDIF 
    15551658      ENDIF 
    1556    END SUBROUTINE iom_rp1d 
    1557  
    1558    SUBROUTINE iom_rp2d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1659   END SUBROUTINE iom_rp1d_sp 
     1660 
     1661   SUBROUTINE iom_rp1d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15591662      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15601663      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15611664      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15621665      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1563       REAL(wp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1666      REAL(dp)        , INTENT(in), DIMENSION(          :) ::   pvar     ! written field 
     1667      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1668      LOGICAL, OPTIONAL                                    ::   ldxios   ! xios write flag 
     1669      LOGICAL :: llx                ! local xios write flag 
     1670      INTEGER :: ivid   ! variable id 
     1671 
     1672      llx = .FALSE. 
     1673      IF(PRESENT(ldxios)) llx = ldxios 
     1674      IF( llx ) THEN 
     1675#ifdef key_iomput 
     1676      IF( kt == kwrite ) THEN 
     1677         IF(lwp) write(numout,*) 'RESTART: write (XIOS 1D) ',trim(cdvar) 
     1678         CALL xios_send_field(trim(cdvar), pvar) 
     1679      ENDIF 
     1680#endif 
     1681      ELSE 
     1682         IF( kiomid > 0 ) THEN 
     1683            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1684               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1685               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r1d = pvar ) 
     1686            ENDIF 
     1687         ENDIF 
     1688      ENDIF 
     1689   END SUBROUTINE iom_rp1d_dp 
     1690 
     1691 
     1692   SUBROUTINE iom_rp2d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1693      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1694      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1695      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1696      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1697      REAL(sp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
    15641698      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15651699      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
    … …  
    15801714            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    15811715               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    1582                CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1716               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = real(pvar, dp) ) 
    15831717            ENDIF 
    15841718         ENDIF 
    15851719      ENDIF 
    1586    END SUBROUTINE iom_rp2d 
    1587  
    1588    SUBROUTINE iom_rp3d( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1720   END SUBROUTINE iom_rp2d_sp 
     1721 
     1722   SUBROUTINE iom_rp2d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
    15891723      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
    15901724      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
    15911725      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
    15921726      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
    1593       REAL(wp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1727      REAL(dp)        , INTENT(in), DIMENSION(:,    :    ) ::   pvar     ! written field 
     1728      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1729      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1730      LOGICAL :: llx 
     1731      INTEGER :: ivid   ! variable id 
     1732 
     1733      llx = .FALSE. 
     1734      IF(PRESENT(ldxios)) llx = ldxios 
     1735      IF( llx ) THEN 
     1736#ifdef key_iomput 
     1737      IF( kt == kwrite ) THEN 
     1738         IF(lwp) write(numout,*) 'RESTART: write (XIOS 2D) ',trim(cdvar) 
     1739         CALL xios_send_field(trim(cdvar), pvar) 
     1740      ENDIF 
     1741#endif 
     1742      ELSE 
     1743         IF( kiomid > 0 ) THEN 
     1744            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1745               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1746               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r2d = pvar ) 
     1747            ENDIF 
     1748         ENDIF 
     1749      ENDIF 
     1750   END SUBROUTINE iom_rp2d_dp 
     1751 
     1752 
     1753   SUBROUTINE iom_rp3d_sp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1754      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1755      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1756      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1757      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1758      REAL(sp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
    15941759      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
    15951760      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
    … …  
    16101775            IF( iom_file(kiomid)%nfid > 0 ) THEN 
    16111776               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
     1777               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = real(pvar, dp) ) 
     1778            ENDIF 
     1779         ENDIF 
     1780      ENDIF 
     1781   END SUBROUTINE iom_rp3d_sp 
     1782 
     1783   SUBROUTINE iom_rp3d_dp( kt, kwrite, kiomid, cdvar, pvar, ktype, ldxios ) 
     1784      INTEGER         , INTENT(in)                         ::   kt       ! ocean time-step 
     1785      INTEGER         , INTENT(in)                         ::   kwrite   ! writing time-step 
     1786      INTEGER         , INTENT(in)                         ::   kiomid   ! Identifier of the file  
     1787      CHARACTER(len=*), INTENT(in)                         ::   cdvar    ! time axis name 
     1788      REAL(dp)        , INTENT(in),       DIMENSION(:,:,:) ::   pvar     ! written field 
     1789      INTEGER         , INTENT(in), OPTIONAL               ::   ktype    ! variable external type 
     1790      LOGICAL, OPTIONAL :: ldxios   ! xios write flag 
     1791      LOGICAL :: llx                 ! local xios write flag 
     1792      INTEGER :: ivid   ! variable id 
     1793 
     1794      llx = .FALSE. 
     1795      IF(PRESENT(ldxios)) llx = ldxios 
     1796      IF( llx ) THEN 
     1797#ifdef key_iomput 
     1798      IF( kt == kwrite ) THEN 
     1799         IF(lwp) write(numout,*) 'RESTART: write (XIOS 3D) ',trim(cdvar) 
     1800         CALL xios_send_field(trim(cdvar), pvar) 
     1801      ENDIF 
     1802#endif 
     1803      ELSE 
     1804         IF( kiomid > 0 ) THEN 
     1805            IF( iom_file(kiomid)%nfid > 0 ) THEN 
     1806               ivid = iom_varid( kiomid, cdvar, ldstop = .FALSE. ) 
    16121807               CALL iom_nf90_rstput( kt, kwrite, kiomid, cdvar, ivid, ktype, pv_r3d = pvar ) 
    16131808            ENDIF 
    16141809         ENDIF 
    16151810      ENDIF 
    1616    END SUBROUTINE iom_rp3d 
     1811   END SUBROUTINE iom_rp3d_dp 
     1812 
    16171813 
    16181814 
    … …  
    16661862   !!                   INTERFACE iom_put 
    16671863   !!---------------------------------------------------------------------- 
    1668    SUBROUTINE iom_p0d( cdname, pfield0d ) 
     1864   SUBROUTINE iom_p0d_sp( cdname, pfield0d ) 
    16691865      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    1670       REAL(wp)        , INTENT(in) ::   pfield0d 
    1671       REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
    1672 #if defined key_iomput 
    1673       zz(:,:)=pfield0d 
    1674       CALL xios_send_field(cdname, zz) 
    1675       !CALL xios_send_field(cdname, (/pfield0d/))  
     1866      REAL(sp)        , INTENT(in) ::   pfield0d 
     1867!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     1868#if defined key_iomput 
     1869!!clem      zz(:,:)=pfield0d 
     1870!!clem      CALL xios_send_field(cdname, zz) 
     1871      CALL xios_send_field(cdname, (/pfield0d/))  
    16761872#else 
    16771873      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
    16781874#endif 
    1679    END SUBROUTINE iom_p0d 
    1680  
    1681    SUBROUTINE iom_p1d( cdname, pfield1d ) 
     1875   END SUBROUTINE iom_p0d_sp 
     1876 
     1877   SUBROUTINE iom_p0d_dp( cdname, pfield0d ) 
     1878      CHARACTER(LEN=*), INTENT(in) ::   cdname 
     1879      REAL(dp)        , INTENT(in) ::   pfield0d 
     1880!!      REAL(wp)        , DIMENSION(jpi,jpj) ::   zz     ! masson 
     1881#if defined key_iomput 
     1882!!clem      zz(:,:)=pfield0d 
     1883!!clem      CALL xios_send_field(cdname, zz) 
     1884      CALL xios_send_field(cdname, (/pfield0d/))  
     1885#else 
     1886      IF( .FALSE. )   WRITE(numout,*) cdname, pfield0d   ! useless test to avoid compilation warnings 
     1887#endif 
     1888   END SUBROUTINE iom_p0d_dp 
     1889 
     1890 
     1891   SUBROUTINE iom_p1d_sp( cdname, pfield1d ) 
    16821892      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
    1683       REAL(wp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     1893      REAL(sp),     DIMENSION(:), INTENT(in) ::   pfield1d 
    16841894#if defined key_iomput 
    16851895      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
    … …  
    16871897      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
    16881898#endif 
    1689    END SUBROUTINE iom_p1d 
    1690  
    1691    SUBROUTINE iom_p2d( cdname, pfield2d ) 
     1899   END SUBROUTINE iom_p1d_sp 
     1900 
     1901   SUBROUTINE iom_p1d_dp( cdname, pfield1d ) 
     1902      CHARACTER(LEN=*)          , INTENT(in) ::   cdname 
     1903      REAL(dp),     DIMENSION(:), INTENT(in) ::   pfield1d 
     1904#if defined key_iomput 
     1905      CALL xios_send_field( cdname, RESHAPE( (/pfield1d/), (/1,1,SIZE(pfield1d)/) ) ) 
     1906#else 
     1907      IF( .FALSE. )   WRITE(numout,*) cdname, pfield1d   ! useless test to avoid compilation warnings 
     1908#endif 
     1909   END SUBROUTINE iom_p1d_dp 
     1910 
     1911   SUBROUTINE iom_p2d_sp( cdname, pfield2d ) 
    16921912      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    1693       REAL(wp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    1694 #if defined key_iomput 
    1695       CALL xios_send_field(cdname, pfield2d) 
     1913      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     1914      IF( iom_use(cdname) ) THEN 
     1915#if defined key_iomput 
     1916         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1917            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1918         ELSE 
     1919            CALL xios_send_field( cdname, pfield2d ) 
     1920         ENDIF 
    16961921#else 
    1697       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    1698 #endif 
    1699    END SUBROUTINE iom_p2d 
    1700  
    1701    SUBROUTINE iom_p3d( cdname, pfield3d ) 
     1922         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1923#endif 
     1924      ENDIF 
     1925   END SUBROUTINE iom_p2d_sp 
     1926 
     1927   SUBROUTINE iom_p2d_dp( cdname, pfield2d ) 
     1928      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
     1929      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
     1930      IF( iom_use(cdname) ) THEN 
     1931#if defined key_iomput 
     1932         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1933            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1934         ELSE 
     1935            CALL xios_send_field( cdname, pfield2d ) 
     1936         ENDIF 
     1937#else 
     1938         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1939#endif 
     1940      ENDIF 
     1941   END SUBROUTINE iom_p2d_dp 
     1942 
     1943   SUBROUTINE iom_p3d_sp( cdname, pfield3d ) 
    17021944      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    1703       REAL(wp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    1704 #if defined key_iomput 
    1705       CALL xios_send_field( cdname, pfield3d ) 
     1945      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1946      IF( iom_use(cdname) ) THEN 
     1947#if defined key_iomput 
     1948         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1949            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1950         ELSE 
     1951            CALL xios_send_field( cdname, pfield3d ) 
     1952         ENDIF 
    17061953#else 
    1707       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    1708 #endif 
    1709    END SUBROUTINE iom_p3d 
     1954         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1955#endif 
     1956      ENDIF 
     1957   END SUBROUTINE iom_p3d_sp 
     1958 
     1959   SUBROUTINE iom_p3d_dp( cdname, pfield3d ) 
     1960      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1961      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
     1962      IF( iom_use(cdname) ) THEN 
     1963#if defined key_iomput 
     1964         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1965            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1966         ELSE 
     1967            CALL xios_send_field( cdname, pfield3d ) 
     1968         ENDIF 
     1969#else 
     1970         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1971#endif 
     1972      ENDIF 
     1973   END SUBROUTINE iom_p3d_dp 
     1974 
     1975   SUBROUTINE iom_p4d_sp( cdname, pfield4d ) 
     1976      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1977      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1978      IF( iom_use(cdname) ) THEN 
     1979#if defined key_iomput 
     1980         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1981            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1982         ELSE 
     1983            CALL xios_send_field (cdname, pfield4d ) 
     1984         ENDIF 
     1985#else 
     1986         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1987#endif 
     1988      ENDIF 
     1989   END SUBROUTINE iom_p4d_sp 
     1990 
     1991   SUBROUTINE iom_p4d_dp( cdname, pfield4d ) 
     1992      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
     1993      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
     1994      IF( iom_use(cdname) ) THEN 
     1995#if defined key_iomput 
     1996         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1997            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1998         ELSE 
     1999            CALL xios_send_field (cdname, pfield4d ) 
     2000         ENDIF 
     2001#else 
     2002         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     2003#endif 
     2004      ENDIF 
     2005   END SUBROUTINE iom_p4d_dp 
    17102006 
    17112007#if defined key_iomput 
    … …  
    17232019      INTEGER                 , OPTIONAL, INTENT(in) ::   data_dim, data_ibegin, data_ni, data_jbegin, data_nj 
    17242020      INTEGER                 , OPTIONAL, INTENT(in) ::   nvertex 
    1725       REAL(wp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
    1726       REAL(wp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
     2021      REAL(dp), DIMENSION(:)  , OPTIONAL, INTENT(in) ::   lonvalue, latvalue 
     2022      REAL(dp), DIMENSION(:,:), OPTIONAL, INTENT(in) ::   bounds_lon, bounds_lat, area 
    17272023      LOGICAL , DIMENSION(:)  , OPTIONAL, INTENT(in) ::   mask 
    17282024      !!---------------------------------------------------------------------- 
    … …  
    17872083      !!---------------------------------------------------------------------- 
    17882084      IF( PRESENT(paxis) ) THEN 
    1789          IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1790          IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=paxis ) 
    1791       ENDIF 
    1792       IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=bounds ) 
    1793       IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=bounds ) 
     2085         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2086         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, n_glo=SIZE(paxis), value=real(paxis, dp) ) 
     2087      ENDIF 
     2088      IF( PRESENT(bounds) ) THEN 
     2089         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid, bounds=real(bounds, dp) ) 
     2090         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid, bounds=real(bounds, dp) ) 
     2091      ELSE 
     2092         IF( xios_is_valid_axis     (cdid) )   CALL xios_set_axis_attr     ( cdid) 
     2093         IF( xios_is_valid_axisgroup(cdid) )   CALL xios_set_axisgroup_attr( cdid) 
     2094      END IF 
    17942095      CALL xios_solve_inheritance() 
    17952096   END SUBROUTINE iom_set_axis_attr 
    … …  
    18982199      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    18992200      ! 
    1900       INTEGER  :: ni, nj 
    19012201      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    19022202      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    19032203      !!---------------------------------------------------------------------- 
    19042204      ! 
    1905       ni = nlei-nldi+1 
    1906       nj = nlej-nldj+1 
    1907       ! 
    1908       CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    1909       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2205      CALL iom_set_domain_attr("grid_"//cdgrd, ni_glo=Ni0glo,nj_glo=Nj0glo,ibegin=mig0(Nis0)-1,jbegin=mjg0(Njs0)-1,ni=Ni_0,nj=Nj_0) 
     2206      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    19102207!don't define lon and lat for restart reading context.  
    19112208      IF ( .NOT.ldrxios ) & 
    1912          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)),   & 
    1913          &                                     latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
     2209         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
     2210         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))   
    19142211      ! 
    19152212      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
    … …  
    19172214         SELECT CASE ( cdgrd ) 
    19182215         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    1919          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1. ) 
    1920          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1. ) 
     2216         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 
     2217         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 
    19212218         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    19222219         END SELECT 
    19232220         ! 
    1924          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
    1925          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
     2221         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. ) 
     2222         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 
    19262223      ENDIF 
    19272224      ! 
    19282225   END SUBROUTINE set_grid 
    1929  
    19302226 
    19312227   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
    … …  
    19402236      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j) 
    19412237      ! 
    1942       INTEGER :: ji, jj, jn, ni, nj 
    1943       INTEGER :: icnr, jcnr                                    ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    1944       !                                                        ! represents the bottom-left corner of cell (i,j) 
     2238      INTEGER :: ji, jj, jn 
     2239      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
     2240      !                                                 ! represents the 
     2241      !                                                 bottom-left corner of 
     2242      !                                                 cell (i,j) 
    19452243      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    19462244      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
    … …  
    19572255      END SELECT 
    19582256      ! 
    1959       ni = nlei-nldi+1   ! Dimensions of subdomain interior 
    1960       nj = nlej-nldj+1 
    1961       ! 
    19622257      z_fld(:,:) = 1._wp 
    1963       CALL lbc_lnk( 'iom', z_fld, cdgrd, -1. )    ! Working array for location of northfold 
     2258      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    19642259      ! 
    19652260      ! Cell vertices that can be defined 
    1966       DO jj = 2, jpjm1 
    1967          DO ji = 2, jpim1 
    1968             z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1969             z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1970             z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1971             z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1972             z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    1973             z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    1974             z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    1975             z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    1976          END DO 
    1977       END DO 
    1978       ! 
    1979       ! Cell vertices on boundries 
    1980       DO jn = 1, 4 
    1981          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1., pval=999._wp ) 
    1982          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1., pval=999._wp ) 
    1983       END DO 
    1984       ! 
    1985       ! Zero-size cells at closed boundaries if cell points provided, 
    1986       ! otherwise they are closed cells with unrealistic bounds 
    1987       IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
    1988          IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1989             DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
    1990                z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
    1991             END DO 
    1992          ENDIF 
    1993          IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    1994             DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    1995                z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
    1996             END DO 
    1997          ENDIF 
    1998          IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
    1999             DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
    2000                z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
    2001             END DO 
    2002          ENDIF 
    2003          IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    2004             DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    2005                z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
    2006             END DO 
    2007          ENDIF 
    2008       ENDIF 
    2009       ! 
    2010       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold 
    2011          DO jj = 1, jpj 
    2012             DO ji = 1, jpi 
    2013                IF( z_fld(ji,jj) == -1. ) THEN 
    2014                   z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
    2015                   z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
    2016                   z_bnds(:,ji,jj,:) = z_rot(:,:) 
    2017                ENDIF 
    2018             END DO 
    2019          END DO 
    2020       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator 
    2021          DO ji = 1, jpi 
    2022             z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
    2023             z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
    2024             z_bnds(:,ji,1,:) = z_rot(:,:) 
    2025          END DO 
    2026       ENDIF 
    2027       ! 
    2028       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)),           & 
    2029           &                                    bounds_lon = RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), nvertex=4 ) 
    2030       ! 
    2031       DEALLOCATE( z_bnds, z_fld, z_rot )  
     2261      DO_2D( 0, 0, 0, 0 ) 
     2262         z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2263         z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2264         z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2265         z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2266         z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2267         z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2268         z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2269         z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2270      END_2D 
     2271      ! 
     2272      DO_2D( 0, 0, 0, 0 ) 
     2273         IF( z_fld(ji,jj) == -1. ) THEN 
     2274            z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     2275            z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     2276            z_bnds(:,ji,jj,:) = z_rot(:,:) 
     2277         ENDIF 
     2278      END_2D 
     2279      ! 
     2280      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           & 
     2281          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 
     2282      ! 
     2283      DEALLOCATE( z_bnds, z_fld, z_rot ) 
    20322284      ! 
    20332285   END SUBROUTINE set_grid_bounds 
    20342286 
    2035  
    20362287   SUBROUTINE set_grid_znl( plat ) 
    20372288      !!---------------------------------------------------------------------- 
    … …  
    20432294      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    20442295      ! 
    2045       INTEGER  :: ni, nj, ix, iy 
     2296      INTEGER  :: ix, iy 
    20462297      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    20472298      !!---------------------------------------------------------------------- 
    20482299      ! 
    2049       ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
    2050       nj=nlej-nldj+1 
    2051       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
    2052       ! 
    2053       CALL dom_ngb( -168.53, 65.03, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    2054 !      CALL dom_ngb( 180., 90., ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
    2055       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    2056       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
    2057       CALL iom_set_domain_attr("gznl", lonvalue = zlon,   & 
    2058          &                             latvalue = RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)))   
    2059       CALL iom_set_zoom_domain_attr("znl_T", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
    2060       CALL iom_set_zoom_domain_attr("znl_W", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     2300      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp 
     2301      ! 
     2302!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
     2303      CALL dom_ngb( 180.0_wp, 90.0_wp, ix, iy, 'T' ) !  i-line that passes near the North Pole : Reference latitude (used in plots) 
     2304      CALL iom_set_domain_attr("gznl", ni_glo=Ni0glo, nj_glo=Nj0glo, ibegin=mig0(Nis0)-1, jbegin=mjg0(Njs0)-1, ni=Ni_0, nj=Nj_0) 
     2305      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
     2306      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
     2307         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))   
     2308      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 
    20612309      ! 
    20622310      CALL iom_update_file_name('ptr') 
    … …  
    20722320      !! 
    20732321      !!---------------------------------------------------------------------- 
    2074       REAL(wp), DIMENSION(1)   ::   zz = 1. 
     2322      REAL(dp), DIMENSION(1)   ::   zz = 1. 
    20752323      !!---------------------------------------------------------------------- 
    20762324      ! 
    … …  
    21132361      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC'             , freq_op=f_op, freq_offset=f_of) 
    21142362      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('SBC_scalar'      , freq_op=f_op, freq_offset=f_of) 
    2115       f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ptrc_T'          , freq_op=f_op, freq_offset=f_of) 
    2116       f_op%timestep = nn_dttrc ;  f_of%timestep =  0  ; CALL iom_set_field_attr('diad_T'          , freq_op=f_op, freq_offset=f_of) 
     2363      f_op%timestep = nn_fsbc  ;  f_of%timestep =  0  ; CALL iom_set_field_attr('ABL'             , freq_op=f_op, freq_offset=f_of) 
    21172364 
    21182365      ! output file names (attribut: name) 
    … …  
    21352382         cl1 = clgrd(jg) 
    21362383         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    2137          CALL dom_ngb( 0., 0., ix, iy, cl1 ) 
    2138          CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
     2384         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
     2385         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 
    21392386         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    21402387         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 
    … …  
    22952542            idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    22962543            DO WHILE ( idx /= 0 )  
    2297                cldate = iom_sdate( fjulday - rdt / rday ) 
     2544               cldate = iom_sdate( fjulday - rn_Dt / rday ) 
    22982545               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 
    22992546               idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 
    … …  
    23022549            idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    23032550            DO WHILE ( idx /= 0 )  
    2304                cldate = iom_sdate( fjulday - rdt / rday, ldfull = .TRUE. ) 
     2551               cldate = iom_sdate( fjulday - rn_Dt / rday, ldfull = .TRUE. ) 
    23052552               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 
    23062553               idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 
    … …  
    23092556            idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    23102557            DO WHILE ( idx /= 0 )  
    2311                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
     2558               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 
    23122559               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 
    23132560               idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 
    … …  
    23162563            idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    23172564            DO WHILE ( idx /= 0 )  
    2318                cldate = iom_sdate( fjulday + rdt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
     2565               cldate = iom_sdate( fjulday + rn_Dt / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 
    23192566               clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 
    23202567               idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 
    … …  
    23612608      ! 
    23622609      IF ( ll24 .AND. isec == 0 ) THEN   ! 00:00 of the next day -> move to 24:00 of the current day 
    2363          CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 
     2610         CALL ju2ymds( pjday - 1.0_wp, iyear, imonth, iday, zsec ) 
    23642611         isec = 86400 
    23652612      ENDIF 
    … …  
    23892636   !!   NOT 'key_iomput'                               a few dummy routines 
    23902637   !!---------------------------------------------------------------------- 
    2391  
    23922638   SUBROUTINE iom_setkt( kt, cdname ) 
    23932639      INTEGER         , INTENT(in)::   kt  
    … …  
    24012647   END SUBROUTINE iom_context_finalize 
    24022648 
     2649   SUBROUTINE iom_update_file_name( cdid ) 
     2650      CHARACTER(LEN=*), INTENT(in) ::   cdid 
     2651      IF( .FALSE. )   WRITE(numout,*)  cdid   ! useless test to avoid compilation warnings 
     2652   END SUBROUTINE iom_update_file_name 
     2653 
    24032654#endif 
    24042655 
    24052656   LOGICAL FUNCTION iom_use( cdname ) 
    2406       !!---------------------------------------------------------------------- 
    2407       !!---------------------------------------------------------------------- 
    24082657      CHARACTER(LEN=*), INTENT(in) ::   cdname 
    2409       !!---------------------------------------------------------------------- 
    24102658#if defined key_iomput 
    24112659      iom_use = xios_field_is_active( cdname ) 
    … …  
    24142662#endif 
    24152663   END FUNCTION iom_use 
    2416     
     2664 
     2665   SUBROUTINE iom_miss_val( cdname, pmiss_val ) 
     2666      CHARACTER(LEN=*), INTENT(in ) ::   cdname 
     2667      REAL(wp)        , INTENT(out) ::   pmiss_val    
     2668      REAL(dp)                      ::   ztmp_pmiss_val    
     2669#if defined key_iomput 
     2670      ! get missing value 
     2671      CALL xios_get_field_attr( cdname, default_value = ztmp_pmiss_val ) 
     2672      pmiss_val = ztmp_pmiss_val 
     2673#else 
     2674      IF( .FALSE. )   WRITE(numout,*) cdname, pmiss_val   ! useless test to avoid compilation warnings 
     2675      IF( .FALSE. )   pmiss_val = 0._wp                   ! useless assignment to avoid compilation warnings 
     2676#endif 
     2677   END SUBROUTINE iom_miss_val 
     2678   
    24172679   !!====================================================================== 
    24182680END MODULE iom 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/iom_def.F90

    r10425 r13463  
    1313   PRIVATE 
    1414 
    15    INTEGER, PARAMETER, PUBLIC ::   jpdom_data          = 1   !: ( 1  :jpiglo, 1  :jpjglo)    !!gm to be suppressed 
    16    INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 2   !: ( 1  :jpiglo, 1  :jpjglo) 
    17    INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 3   !: One of the 3 following cases 
    18    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_full    = 4   !: ( 1  :jpi   , 1  :jpi   ) 
    19    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noextra = 5   !: ( 1  :nlci  , 1  :nlcj  ) 
    20    INTEGER, PARAMETER, PUBLIC ::   jpdom_local_noovlap = 6   !: (nldi:nlei  ,nldj:nlej  ) 
    21    INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 7   !: No dimension checking 
    22    INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo       = 8   !:  
    23    INTEGER, PARAMETER, PUBLIC ::   jpdom_autoglo_xy    = 9   !: Automatically set horizontal dimensions only 
    24    INTEGER, PARAMETER, PUBLIC ::   jpdom_autodta       = 10  !:  
     15   INTEGER, PARAMETER, PUBLIC ::   jpdom_global        = 1   !: ( 1  :Ni0glo, 1  :Nj0glo) 
     16   INTEGER, PARAMETER, PUBLIC ::   jpdom_local         = 2   !: (Nis0: Nie0 ,Njs0: Nje0 ) 
     17   INTEGER, PARAMETER, PUBLIC ::   jpdom_unknown       = 3   !: No dimension checking 
     18   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto          = 4   !:  
     19   INTEGER, PARAMETER, PUBLIC ::   jpdom_auto_xy       = 5   !: Automatically set horizontal dimensions only 
    2520 
    2621   INTEGER, PARAMETER, PUBLIC ::   jp_r8    = 200      !: write REAL(8) 
    … …  
    3328   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    3429   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
    35    INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  5   !: maximum number of digits for the cpu number in the file name 
    36  
     30   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3731 
    3832!$AGRIF_DO_NOT_TREAT 
    … …  
    4640   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE.  
    4741 
    48  
    49  
    5042   TYPE, PUBLIC ::   file_descriptor 
    5143      CHARACTER(LEN=240)                        ::   name     !: name of the file 
     44      CHARACTER(LEN=3  )                        ::   comp     !: name of component opening the file ('OCE', 'ICE'...) 
    5245      INTEGER                                   ::   nfid     !: identifier of the file (0 if closed) 
    5346                                                              !: jpioipsl option has been removed) 
    … …  
    6457      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   scf      !: scale_factor of the variables 
    6558      REAL(kind=wp), DIMENSION(jpmax_vars)      ::   ofs      !: add_offset of the variables 
    66       INTEGER                                   ::   nlev     ! number of vertical levels 
    6759   END TYPE file_descriptor 
    6860   TYPE(file_descriptor), DIMENSION(jpmax_files), PUBLIC ::   iom_file !: array containing the info for all opened files 
    … …  
    7769   TYPE(RST_FIELD), PUBLIC, SAVE :: rst_wfields(max_rst_fields), rst_rfields(max_rst_fields) 
    7870   ! 
     71   !! * Substitutions 
     72#  include "do_loop_substitute.h90" 
    7973   !!---------------------------------------------------------------------- 
    8074   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/iom_nf90.F90

    r10522 r13463  
    1919   !!---------------------------------------------------------------------- 
    2020   USE dom_oce         ! ocean space and time domain 
     21   USE sbc_oce, ONLY: ght_abl ! abl vertical level number and height 
    2122   USE lbclnk          ! lateal boundary condition / mpp exchanges 
    2223   USE iom_def         ! iom variables definitions 
    … …  
    3233 
    3334   INTERFACE iom_nf90_get 
    34       MODULE PROCEDURE iom_nf90_g0d, iom_nf90_g123d 
     35      MODULE PROCEDURE iom_nf90_g0d_sp                    
     36      MODULE PROCEDURE iom_nf90_g0d_dp, iom_nf90_g123d_dp 
    3537   END INTERFACE 
    3638   INTERFACE iom_nf90_rstput 
    37       MODULE PROCEDURE iom_nf90_rp0123d 
     39      MODULE PROCEDURE iom_nf90_rp0123d_dp 
    3840   END INTERFACE 
    3941 
    … …  
    4547CONTAINS 
    4648 
    47    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev ) 
     49   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp ) 
    4850      !!--------------------------------------------------------------------- 
    4951      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5557      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file? 
    5658      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    57       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    58       INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the third dimension 
     59      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
     60      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    5961 
    6062      CHARACTER(LEN=256) ::   clinfo           ! info character 
    6163      CHARACTER(LEN=256) ::   cltmp            ! temporary character 
     64      CHARACTER(LEN=12 ) ::   clfmt            ! writing format 
     65      CHARACTER(LEN=3  ) ::   clcomp           ! name of component calling iom_nf90_open 
     66      INTEGER            ::   idg              ! number of digits 
    6267      INTEGER            ::   iln              ! lengths of character 
    6368      INTEGER            ::   istop            ! temporary storage of nstop 
    … …  
    6974      INTEGER            ::   ihdf5            ! local variable for retrieval of value for NF90_HDF5 
    7075      LOGICAL            ::   llclobber        ! local definition of ln_clobber 
    71       INTEGER            ::   ilevels           ! vertical levels 
    7276      !--------------------------------------------------------------------- 
    7377      ! 
    … …  
    7680      ! 
    7781      !                 !number of vertical levels 
    78       IF( PRESENT(kdlev) ) THEN   ;   ilevels = kdlev    ! use input value (useful for sea-ice) 
    79       ELSE                        ;   ilevels = jpk      ! by default jpk 
     82      IF( PRESENT(cdcomp) )   THEN 
     83         IF( .NOT. PRESENT(kdlev) ) CALL ctl_stop( 'iom_nf90_open: cdcomp and kdlev must both be present' ) 
     84         clcomp = cdcomp    ! use input value 
     85      ELSE 
     86         clcomp = 'OCE'     ! by default  
    8087      ENDIF 
    8188      ! 
    … …  
    104111         IF( ldwrt ) THEN              !* the file should be open in write mode so we create it... 
    105112            IF( jpnij > 1 ) THEN 
    106                WRITE(cltmp,'(a,a,i4.4,a)') cdname(1:iln-1), '_', narea-1, '.nc' 
     113               idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )          ! how many digits to we need to write? min=4, max=9 
     114               WRITE(clfmt, "('(a,a,i', i1, '.', i1, ',a)')") idg, idg          ! '(a,a,ix.x,a)' 
     115               WRITE(cltmp,clfmt) cdname(1:iln-1), '_', narea-1, '.nc' 
    107116               cdname = TRIM(cltmp) 
    108117            ENDIF 
    … …  
    124133            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    125134            ! define dimensions 
    126             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    127             CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), idmy ), clinfo) 
    128             CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    129             CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    130             IF( PRESENT(kdlev) )   & 
    131                CALL iom_nf90_check(NF90_DEF_DIM( if90id,    'numcat',          kdlev, idmy ), clinfo) 
     135                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',  Ni_0, idmy ), clinfo) 
     136                               CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',  Nj_0, idmy ), clinfo) 
     137            SELECT CASE (clcomp) 
     138            CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',   jpk, idmy ), clinfo) 
     139            CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat', kdlev, idmy ), clinfo) 
     140            CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev', kdlev, idmy ), clinfo) 
     141            CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed', kdlev, idmy ), clinfo) 
     142            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
     143            END SELECT 
     144                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    132145            ! global attributes 
    133             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    134             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo) 
    135             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo) 
    136             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo) 
    137             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)      ), clinfo) 
    138             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)      ), clinfo) 
    139             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)      ), clinfo) 
    140             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)      ), clinfo) 
    141             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)      ), clinfo) 
    142             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ), clinfo) 
     146            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij                        ), clinfo) 
     147            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1                      ), clinfo) 
     148            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1        , 2           /) ), clinfo) 
     149            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ Ni0glo    , Nj0glo     /) ), clinfo) 
     150            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0      , Nj_0       /) ), clinfo) 
     151            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ), clinfo) 
     152            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig0(Nie0), mjg0(Nje0) /) ), clinfo) 
     153            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0         , 0          /) ), clinfo) 
     154            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0         , 0          /) ), clinfo) 
     155            CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'                        ), clinfo) 
    143156         ELSE                          !* the file should be open for read mode so it must exist... 
    144157            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    … …  
    155168         ENDDO 
    156169         iom_file(kiomid)%name   = TRIM(cdname) 
     170         iom_file(kiomid)%comp   = clcomp 
    157171         iom_file(kiomid)%nfid   = if90id 
    158172         iom_file(kiomid)%nvars  = 0 
    159173         iom_file(kiomid)%irec   = -1   ! useless for NetCDF files, used to know if the file is in define mode  
    160          iom_file(kiomid)%nlev   = ilevels 
    161174         CALL iom_nf90_check(NF90_Inquire(if90id, unlimitedDimId = iom_file(kiomid)%iduld), clinfo) 
    162175         IF( iom_file(kiomid)%iduld .GE. 0 ) THEN 
    … …  
    187200 
    188201 
    189    FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims )   
     202   FUNCTION iom_nf90_varid ( kiomid, cdvar, kiv, kdimsz, kndims, lduld )   
    190203      !!----------------------------------------------------------------------- 
    191204      !!                  ***  FUNCTION  iom_varid  *** 
    … …  
    196209      CHARACTER(len=*)     , INTENT(in   )           ::   cdvar    ! name of the variable 
    197210      INTEGER              , INTENT(in   )           ::   kiv   !  
    198       INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of the dimensions 
    199       INTEGER,               INTENT(  out), OPTIONAL ::   kndims   ! size of the dimensions 
     211      INTEGER, DIMENSION(:), INTENT(  out), OPTIONAL ::   kdimsz   ! size of each dimension 
     212      INTEGER              , INTENT(  out), OPTIONAL ::   kndims   ! number of dimensions 
     213      LOGICAL              , INTENT(  out), OPTIONAL ::   lduld    ! true if the last dimension is unlimited (time) 
    200214      ! 
    201215      INTEGER                        ::   iom_nf90_varid   ! iom variable Id 
    … …  
    251265         ENDIF 
    252266         IF( PRESENT(kndims) )  kndims = iom_file(kiomid)%ndims(kiv) 
     267         IF( PRESENT( lduld) )  lduld  = iom_file(kiomid)%luld(kiv) 
    253268      ELSE   
    254269         iom_nf90_varid = -1   !   variable not found, return error code: -1 
    … …  
    261276   !!---------------------------------------------------------------------- 
    262277 
    263    SUBROUTINE iom_nf90_g0d( kiomid, kvid, pvar, kstart ) 
     278   SUBROUTINE iom_nf90_g0d_sp( kiomid, kvid, pvar, kstart ) 
    264279      !!----------------------------------------------------------------------- 
    265280      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
    … …  
    269284      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
    270285      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
    271       REAL(wp),               INTENT(  out)            ::   pvar     ! read field 
     286      REAL(sp),               INTENT(  out)            ::   pvar     ! read field 
    272287      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
    273288      ! 
    … …  
    276291      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
    277292      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
    278    END SUBROUTINE iom_nf90_g0d 
    279  
    280  
    281    SUBROUTINE iom_nf90_g123d( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
     293   END SUBROUTINE iom_nf90_g0d_sp 
     294 
     295   SUBROUTINE iom_nf90_g0d_dp( kiomid, kvid, pvar, kstart ) 
     296      !!----------------------------------------------------------------------- 
     297      !!                  ***  ROUTINE  iom_nf90_g0d  *** 
     298      !! 
     299      !! ** Purpose : read a scalar with NF90 
     300      !!----------------------------------------------------------------------- 
     301      INTEGER ,               INTENT(in   )            ::   kiomid   ! Identifier of the file 
     302      INTEGER ,               INTENT(in   )            ::   kvid     ! variable id 
     303      REAL(dp),               INTENT(  out)            ::   pvar     ! read field 
     304      INTEGER , DIMENSION(1), INTENT(in   ), OPTIONAL  ::   kstart   ! start position of the reading in each axis 
     305      ! 
     306      CHARACTER(LEN=100)      ::   clinfo   ! info character 
     307      !--------------------------------------------------------------------- 
     308      clinfo = 'iom_nf90_g0d , file: '//TRIM(iom_file(kiomid)%name)//', var: '//TRIM(iom_file(kiomid)%cn_var(kvid)) 
     309      CALL iom_nf90_check(NF90_GET_VAR(iom_file(kiomid)%nfid, iom_file(kiomid)%nvid(kvid), pvar, start = kstart), clinfo ) 
     310   END SUBROUTINE iom_nf90_g0d_dp 
     311 
     312   SUBROUTINE iom_nf90_g123d_dp( kiomid, kvid, knbdim, kstart, kcount, kx1, kx2, ky1, ky2,   & 
    282313         &                    pv_r1d, pv_r2d, pv_r3d ) 
    283314      !!----------------------------------------------------------------------- 
    … …  
    294325      INTEGER , DIMENSION(:)     , INTENT(in   )           ::   kcount    ! number of points to be read in each axis 
    295326      INTEGER ,                    INTENT(in   )           ::   kx1, kx2, ky1, ky2   ! subdomain indexes 
    296       REAL(wp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
    297       REAL(wp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
    298       REAL(wp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
     327      REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d    ! read field (1D case) 
     328      REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d    ! read field (2D case) 
     329      REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d    ! read field (3D case) 
    299330      ! 
    300331      CHARACTER(LEN=100) ::   clinfo               ! info character 
    … …  
    317348      ENDIF 
    318349      ! 
    319    END SUBROUTINE iom_nf90_g123d 
     350   END SUBROUTINE iom_nf90_g123d_dp 
     351 
    320352 
    321353 
    … …  
    491523   END SUBROUTINE iom_nf90_putatt 
    492524 
    493  
    494    SUBROUTINE iom_nf90_rp0123d( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
     525   SUBROUTINE iom_nf90_rp0123d_dp( kt, kwrite, kiomid, cdvar , kvid  , ktype,   & 
    495526         &                                  pv_r0d, pv_r1d, pv_r2d, pv_r3d ) 
    496527      !!-------------------------------------------------------------------- 
    … …  
    505536      INTEGER                     , INTENT(in)           ::   kvid     ! variable id 
    506537      INTEGER                     , INTENT(in), OPTIONAL ::   ktype    ! variable type (default R8) 
    507       REAL(wp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
    508       REAL(wp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
    509       REAL(wp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
    510       REAL(wp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
     538      REAL(dp)                    , INTENT(in), OPTIONAL ::   pv_r0d   ! written Od field 
     539      REAL(dp), DIMENSION(      :), INTENT(in), OPTIONAL ::   pv_r1d   ! written 1d field 
     540      REAL(dp), DIMENSION(:, :   ), INTENT(in), OPTIONAL ::   pv_r2d   ! written 2d field 
     541      REAL(dp), DIMENSION(:, :, :), INTENT(in), OPTIONAL ::   pv_r3d   ! written 3d field 
    511542      ! 
    512543      INTEGER               :: idims                ! number of dimension 
    … …  
    517548      INTEGER, DIMENSION(4) :: idimid               ! dimensions id 
    518549      CHARACTER(LEN=256)    :: clinfo               ! info character 
    519       CHARACTER(LEN= 12), DIMENSION(5) :: cltmp     ! temporary character 
    520550      INTEGER               :: if90id               ! nf90 file identifier 
    521       INTEGER               :: idmy                 ! dummy variable 
    522551      INTEGER               :: itype                ! variable type 
    523552      INTEGER, DIMENSION(4) :: ichunksz             ! NetCDF4 chunk sizes. Will be computed using 
    … …  
    528557      !                                             ! when appropriate (currently chunking is applied to 4d fields only) 
    529558      INTEGER               :: idlv                 ! local variable 
    530       INTEGER               :: idim3                ! id of the third dimension 
    531559      !--------------------------------------------------------------------- 
    532560      ! 
    … …  
    542570         ENDIF 
    543571         ! define the dimension variables if it is not already done 
    544          ! Warning: we must use the same character length in an array constructor (at least for gcc compiler) 
    545          cltmp = (/ 'nav_lon     ', 'nav_lat     ', 'nav_lev     ', 'time_counter', 'numcat      ' /)    
    546          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(1)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(1) ), clinfo) 
    547          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(2)), NF90_FLOAT , (/ 1, 2 /), iom_file(kiomid)%nvid(2) ), clinfo) 
    548          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(3)), NF90_FLOAT , (/ 3    /), iom_file(kiomid)%nvid(3) ), clinfo) 
    549          CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(4)), NF90_DOUBLE, (/ 4    /), iom_file(kiomid)%nvid(4) ), clinfo) 
     572         DO jd = 1, 2 
     573            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(jd,jd)),clinfo) 
     574            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ 1, 2 /),   & 
     575               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     576         END DO 
     577         iom_file(kiomid)%dimsz(2,1) = iom_file(kiomid)%dimsz(2,2)   ! second dim of first  variable 
     578         iom_file(kiomid)%dimsz(1,2) = iom_file(kiomid)%dimsz(1,1)   ! first  dim of second variable 
     579         DO jd = 3, 4 
     580            CALL iom_nf90_check(NF90_INQUIRE_DIMENSION(if90id,jd,iom_file(kiomid)%cn_var(jd),iom_file(kiomid)%dimsz(1,jd)), clinfo) 
     581            CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(iom_file(kiomid)%cn_var(jd)), NF90_FLOAT , (/ jd   /),   & 
     582               &                              iom_file(kiomid)%nvid(jd) ), clinfo) 
     583         END DO 
    550584         ! update informations structure related the dimension variable we just added... 
    551585         iom_file(kiomid)%nvars       = 4 
    552586         iom_file(kiomid)%luld(1:4)   = (/ .FALSE., .FALSE., .FALSE., .TRUE. /) 
    553          iom_file(kiomid)%cn_var(1:4) = cltmp(1:4) 
    554587         iom_file(kiomid)%ndims(1:4)  = (/ 2, 2, 1, 1 /) 
    555          IF( NF90_INQ_DIMID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN   ! add a 5th variable corresponding to the 5th dimension 
    556             CALL iom_nf90_check(NF90_DEF_VAR( if90id, TRIM(cltmp(5)), NF90_FLOAT , (/ 5 /), iom_file(kiomid)%nvid(5) ), clinfo) 
    557             iom_file(kiomid)%nvars     = 5 
    558             iom_file(kiomid)%luld(5)   = .FALSE. 
    559             iom_file(kiomid)%cn_var(5) = cltmp(5) 
    560             iom_file(kiomid)%ndims(5)  = 1 
    561          ENDIF 
    562          ! trick: defined to 0 to say that dimension variables are defined but not yet written 
    563          iom_file(kiomid)%dimsz(1, 1)  = 0    
    564588         IF(lwp) WRITE(numout,*) TRIM(clinfo)//' define dimension variables done' 
    565589      ENDIF 
    … …  
    582606         IF(     PRESENT(pv_r0d) ) THEN   ;   idims = 0 
    583607         ELSEIF( PRESENT(pv_r1d) ) THEN 
    584             IF( SIZE(pv_r1d,1) == jpk ) THEN   ;   idim3 = 3 
    585             ELSE                               ;   idim3 = 5 
    586             ENDIF 
    587                                               idims = 2   ;   idimid(1:idims) = (/idim3,4/) 
    588          ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2  ,4/) 
     608                                              idims = 2   ;   idimid(1:idims) = (/3,4/) 
     609         ELSEIF( PRESENT(pv_r2d) ) THEN   ;   idims = 3   ;   idimid(1:idims) = (/1,2,4/) 
    589610         ELSEIF( PRESENT(pv_r3d) ) THEN 
    590             IF( SIZE(pv_r3d,3) == jpk ) THEN   ;   idim3 = 3 
    591             ELSE                               ;   idim3 = 5 
    592             ENDIF 
    593                                               idims = 4   ;   idimid(1:idims) = (/1,2,idim3,4/) 
     611                                              idims = 4   ;   idimid(1:idims) = (/1,2,3,4/) 
    594612         ENDIF 
    595613         IF( PRESENT(ktype) ) THEN   ! variable external type 
    … …  
    653671         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 
    654672            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 
    655             IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 
    656                ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    657             ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN 
    658                ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    659             ELSEIF( idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN 
     673            IF(     idimsz(1) == Ni_0 .AND. idimsz(2) == Nj_0 ) THEN 
     674               ix1 = Nis0   ;   ix2 = Nie0   ;   iy1 = Njs0   ;   iy2 = Nje0 
     675            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
     676               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
     677            ELSEIF( idimsz(1) == jpi  .AND. idimsz(2) == jpj  ) THEN 
    660678               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    661679            ELSE  
    … …  
    666684            ! ============= 
    667685            ! trick: is defined to 0 => dimension variable are defined but not yet written 
    668             IF( iom_file(kiomid)%dimsz(1, 1) == 0 ) THEN 
    669                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lon'     , idmy )         , clinfo ) 
    670                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
    671                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lat'     , idmy )         , clinfo ) 
    672                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
    673                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'nav_lev'     , idmy ), clinfo ) 
    674                CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, gdept_1d       ), clinfo ) 
    675                IF( NF90_INQ_VARID( if90id, 'numcat', idmy ) == nf90_noerr ) THEN 
    676                   CALL iom_nf90_check( NF90_PUT_VAR  ( if90id, idmy, (/ (idlv, idlv = 1,iom_file(kiomid)%nlev) /)), clinfo ) 
    677                ENDIF 
    678                ! +++ WRONG VALUE: to be improved but not really useful... 
    679                CALL iom_nf90_check( NF90_INQ_VARID( if90id, 'time_counter', idmy ), clinfo ) 
    680                CALL iom_nf90_check( NF90_PUT_VAR( if90id, idmy, kt                      ), clinfo )    
    681                ! update the values of the variables dimensions size 
    682                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 1, len = iom_file(kiomid)%dimsz(1,1) ), clinfo ) 
    683                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 2, len = iom_file(kiomid)%dimsz(2,1) ), clinfo ) 
    684                iom_file(kiomid)%dimsz(1:2, 2) = iom_file(kiomid)%dimsz(1:2, 1) 
    685                CALL iom_nf90_check( NF90_INQUIRE_DIMENSION( if90id, 3, len = iom_file(kiomid)%dimsz(1,3) ), clinfo ) 
    686                iom_file(kiomid)%dimsz(1  , 4) = 1   ! unlimited dimension 
     686            IF( iom_file(kiomid)%dimsz(1, 4) == 0 ) THEN   ! time_counter = 0 
     687               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 1,                            glamt(ix1:ix2, iy1:iy2) ), clinfo ) 
     688               CALL iom_nf90_check(    NF90_PUT_VAR( if90id, 2,                            gphit(ix1:ix2, iy1:iy2) ), clinfo ) 
     689               SELECT CASE (iom_file(kiomid)%comp) 
     690               CASE ('OCE')   
     691                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                           gdept_1d ), clinfo ) 
     692               CASE ('ABL') 
     693                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3,                                            ght_abl ), clinfo ) 
     694               CASE DEFAULT 
     695                  CALL iom_nf90_check( NF90_PUT_VAR( if90id, 3, (/ (idlv, idlv = 1,iom_file(kiomid)%dimsz(1,3)) /) ), clinfo ) 
     696               END SELECT 
     697               ! "wrong" value: to be improved but not really useful... 
     698               CALL iom_nf90_check(   NF90_PUT_VAR( if90id, 4,                                                  kt ), clinfo )    
     699               ! update the size of the variable corresponding to the unlimited dimension 
     700               iom_file(kiomid)%dimsz(1, 4) = 1   ! so we don't enter this IF case any more... 
    687701               IF(lwp) WRITE(numout,*) TRIM(clinfo)//' write dimension variables done' 
    688702            ENDIF 
    … …  
    706720      ENDIF 
    707721      !      
    708    END SUBROUTINE iom_nf90_rp0123d 
     722   END SUBROUTINE iom_nf90_rp0123d_dp 
    709723 
    710724 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/prtctl.F90

    r10068 r13463  
    88   !!---------------------------------------------------------------------- 
    99   USE dom_oce          ! ocean space and time domain variables 
    10 #if defined key_nemocice_decomp 
    11    USE ice_domain_size, only: nx_global, ny_global 
    12 #endif 
    1310   USE in_out_manager   ! I/O manager 
     11   USE mppini           ! distributed memory computing 
    1412   USE lib_mpp          ! distributed memory computing 
    1513 
    1614   IMPLICIT NONE 
    1715   PRIVATE 
    18  
    19    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   numid 
    20    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlditl , nldjtl    ! first, last indoor index for each i-domain 
    21    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nleitl , nlejtl    ! first, last indoor index for each j-domain 
    22    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nimpptl, njmpptl   ! i-, j-indexes for each processor 
    23    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   nlcitl , nlcjtl    ! dimensions of every subdomain 
    24    INTEGER , DIMENSION(:), ALLOCATABLE, SAVE ::   ibonitl, ibonjtl   ! 
    25  
    26    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   t_ctll , s_ctll    ! previous tracer trend values 
    27    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   u_ctll , v_ctll    ! previous velocity trend values 
    28  
    29    INTEGER ::   ktime   ! time step 
    30  
     16    
     17   INTEGER , DIMENSION(  :), ALLOCATABLE ::   numprt_oce, numprt_top 
     18   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_ictls, nall_ictle   ! first, last indoor index for each i-domain 
     19   INTEGER , DIMENSION(  :), ALLOCATABLE ::   nall_jctls, nall_jctle   ! first, last indoor index for each j-domain 
     20   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   t_ctl , s_ctl            ! previous tracer trend values 
     21   REAL(wp), DIMENSION(  :), ALLOCATABLE ::   u_ctl , v_ctl            ! previous velocity trend values 
     22   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   tra_ctl                  ! previous top trend values 
     23   !                                           
    3124   PUBLIC prt_ctl         ! called by all subroutines 
    3225   PUBLIC prt_ctl_info    ! called by all subroutines 
    33    PUBLIC prt_ctl_init    ! called by opa.F90 
    34    PUBLIC sub_dom         ! called by opa.F90 
     26   PUBLIC prt_ctl_init    ! called by nemogcm.F90 and prt_ctl_trc_init 
    3527 
    3628   !!---------------------------------------------------------------------- 
    … …  
    4133CONTAINS 
    4234 
    43    SUBROUTINE prt_ctl (tab2d_1, tab3d_1, mask1, clinfo1, tab2d_2, tab3d_2,   & 
    44       &                                  mask2, clinfo2, kdim, clinfo3 ) 
     35   SUBROUTINE prt_ctl (tab2d_1, tab3d_1, tab4d_1, tab2d_2, tab3d_2, mask1, mask2,   & 
     36      &                 clinfo, clinfo1, clinfo2, clinfo3, kdim ) 
    4537      !!---------------------------------------------------------------------- 
    4638      !!                     ***  ROUTINE prt_ctl  *** 
    … …  
    5042      !!                debugging a new parametrization in mono or mpp.  
    5143      !! 
    52       !! ** Method  : 2 possibilities exist when setting the ln_ctl parameter to 
     44      !! ** Method  : 2 possibilities exist when setting the sn_cfctl%prtctl parameter to 
    5345      !!                .true. in the ocean namelist: 
    5446      !!              - to debug a MPI run .vs. a mono-processor one;  
    … …  
    6456      !!                name must be explicitly typed if used. For instance if the 3D 
    6557      !!                array tn(:,:,:) must be passed through the prt_ctl subroutine,  
    66       !!                it must looks like: CALL prt_ctl(tab3d_1=tn). 
     58      !!                it must look like: CALL prt_ctl(tab3d_1=tn). 
    6759      !! 
    6860      !!                    tab2d_1 : first 2D array 
    6961      !!                    tab3d_1 : first 3D array 
     62      !!                    tab4d_1 : first 4D array 
    7063      !!                    mask1   : mask (3D) to apply to the tab[23]d_1 array 
    7164      !!                    clinfo1 : information about the tab[23]d_1 array 
    … …  
    7770      !!                    clinfo3 : additional information  
    7871      !!---------------------------------------------------------------------- 
    79       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_1 
    80       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_1 
    81       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask1 
    82       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo1 
    83       REAL(wp), DIMENSION(:,:)  , INTENT(in), OPTIONAL ::   tab2d_2 
    84       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   tab3d_2 
    85       REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL ::   mask2 
    86       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo2 
    87       INTEGER                   , INTENT(in), OPTIONAL ::   kdim 
    88       CHARACTER (len=*)         , INTENT(in), OPTIONAL ::   clinfo3 
    89       ! 
    90       CHARACTER (len=15) :: cl2 
    91       INTEGER ::  jn, sind, eind, kdir,j_id 
     72      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_1 
     73      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_1 
     74      REAL(wp),         DIMENSION(:,:,:,:), INTENT(in), OPTIONAL ::   tab4d_1 
     75      REAL(wp),         DIMENSION(:,:)    , INTENT(in), OPTIONAL ::   tab2d_2 
     76      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   tab3d_2 
     77      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask1 
     78      REAL(wp),         DIMENSION(:,:,:)  , INTENT(in), OPTIONAL ::   mask2 
     79      CHARACTER(len=*), DIMENSION(:)      , INTENT(in), OPTIONAL ::   clinfo    ! information about the tab3d array 
     80      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo1 
     81      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo2 
     82      CHARACTER(len=*)                    , INTENT(in), OPTIONAL ::   clinfo3 
     83      INTEGER                             , INTENT(in), OPTIONAL ::   kdim 
     84      ! 
     85      CHARACTER(len=30) :: cl1, cl2 
     86      INTEGER ::  jn, jl, kdir 
     87      INTEGER ::  iis, iie, jjs, jje 
     88      INTEGER ::  itra, inum 
    9289      REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 
    93       REAL(wp), DIMENSION(jpi,jpj)     :: ztab2d_1, ztab2d_2 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask1, zmask2, ztab3d_1, ztab3d_2 
    95       !!---------------------------------------------------------------------- 
    96  
     90      !!---------------------------------------------------------------------- 
     91      ! 
    9792      ! Arrays, scalars initialization  
    98       kdir      = jpkm1 
    99       cl2       = '' 
    100       zsum1     = 0.e0 
    101       zsum2     = 0.e0 
    102       zvctl1    = 0.e0 
    103       zvctl2    = 0.e0 
    104       ztab2d_1(:,:)   = 0.e0 
    105       ztab2d_2(:,:)   = 0.e0 
    106       ztab3d_1(:,:,:) = 0.e0 
    107       ztab3d_2(:,:,:) = 0.e0 
    108       zmask1  (:,:,:) = 1.e0 
    109       zmask2  (:,:,:) = 1.e0 
     93      cl1  = '' 
     94      cl2  = '' 
     95      kdir = jpkm1 
     96      itra = 1 
    11097 
    11198      ! Control of optional arguments 
    112       IF( PRESENT(clinfo2) )   cl2                  = clinfo2 
    113       IF( PRESENT(kdim)    )   kdir                 = kdim 
    114       IF( PRESENT(tab2d_1) )   ztab2d_1(:,:)        = tab2d_1(:,:) 
    115       IF( PRESENT(tab2d_2) )   ztab2d_2(:,:)        = tab2d_2(:,:) 
    116       IF( PRESENT(tab3d_1) )   ztab3d_1(:,:,1:kdir) = tab3d_1(:,:,1:kdir) 
    117       IF( PRESENT(tab3d_2) )   ztab3d_2(:,:,1:kdir) = tab3d_2(:,:,1:kdir) 
    118       IF( PRESENT(mask1)   )   zmask1  (:,:,:)      = mask1  (:,:,:) 
    119       IF( PRESENT(mask2)   )   zmask2  (:,:,:)      = mask2  (:,:,:) 
    120  
    121       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    122          sind = narea 
    123          eind = narea 
    124       ELSE                                    ! processors total number 
    125          sind = 1 
    126          eind = ijsplt 
    127       ENDIF 
     99      IF( PRESENT(clinfo1) )   cl1  = clinfo1 
     100      IF( PRESENT(clinfo2) )   cl2  = clinfo2 
     101      IF( PRESENT(kdim)    )   kdir = kdim 
     102      IF( PRESENT(tab4d_1) )   itra = SIZE(tab4d_1,dim=4) 
    128103 
    129104      ! Loop over each sub-domain, i.e. the total number of processors ijsplt 
    130       DO jn = sind, eind 
    131          ! Set logical unit 
    132          j_id = numid(jn - narea + 1) 
    133          ! Set indices for the SUM control 
    134          IF( .NOT. lsp_area ) THEN 
    135             IF (lk_mpp .AND. jpnij > 1)   THEN 
    136                nictls = MAX(  1, nlditl(jn) ) 
    137                nictle = MIN(jpi, nleitl(jn) ) 
    138                njctls = MAX(  1, nldjtl(jn) ) 
    139                njctle = MIN(jpj, nlejtl(jn) ) 
    140                ! Do not take into account the bound of the domain 
    141                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    142                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    143                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nleitl(jn) - 1) 
    144                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, nlejtl(jn) - 1) 
     105      DO jl = 1, SIZE(nall_ictls) 
     106 
     107         ! define shoter names... 
     108         iis = nall_ictls(jl) 
     109         iie = nall_ictle(jl) 
     110         jjs = nall_jctls(jl) 
     111         jje = nall_jctle(jl) 
     112 
     113         IF( PRESENT(clinfo) ) THEN   ;   inum = numprt_top(jl) 
     114         ELSE                         ;   inum = numprt_oce(jl) 
     115         ENDIF 
     116 
     117         DO jn = 1, itra 
     118 
     119            IF( PRESENT(clinfo3) ) THEN 
     120               IF    ( clinfo3 == 'tra-ta' )   THEN 
     121                  zvctl1 = t_ctl(jl) 
     122               ELSEIF( clinfo3 == 'tra'    )   THEN 
     123                  zvctl1 = t_ctl(jl) 
     124                  zvctl2 = s_ctl(jl) 
     125               ELSEIF( clinfo3 == 'dyn'    )   THEN 
     126                  zvctl1 = u_ctl(jl) 
     127                  zvctl2 = v_ctl(jl) 
     128               ELSE 
     129                  zvctl1 = tra_ctl(jn,jl) 
     130               ENDIF 
     131            ENDIF 
     132 
     133            ! 2D arrays 
     134            IF( PRESENT(tab2d_1) ) THEN 
     135               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje) * mask1(iis:iie,jjs:jje,1) ) 
     136               ELSE                        ;   zsum1 = SUM( tab2d_1(iis:iie,jjs:jje)                            ) 
     137               ENDIF 
     138            ENDIF 
     139            IF( PRESENT(tab2d_2) ) THEN 
     140               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje) * mask2(iis:iie,jjs:jje,1) ) 
     141               ELSE                        ;   zsum2 = SUM( tab2d_2(iis:iie,jjs:jje)                            ) 
     142               ENDIF 
     143            ENDIF 
     144 
     145            ! 3D arrays 
     146            IF( PRESENT(tab3d_1) ) THEN 
     147               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     148               ELSE                        ;   zsum1 = SUM( tab3d_1(iis:iie,jjs:jje,1:kdir)                                 ) 
     149               ENDIF 
     150            ENDIF 
     151            IF( PRESENT(tab3d_2) ) THEN 
     152               IF( PRESENT(mask2) ) THEN   ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir) * mask2(iis:iie,jjs:jje,1:kdir) ) 
     153               ELSE                        ;   zsum2 = SUM( tab3d_2(iis:iie,jjs:jje,1:kdir)                                 ) 
     154               ENDIF 
     155            ENDIF 
     156 
     157            ! 4D arrays 
     158            IF( PRESENT(tab4d_1) ) THEN 
     159               IF( PRESENT(mask1) ) THEN   ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn) * mask1(iis:iie,jjs:jje,1:kdir) ) 
     160               ELSE                        ;   zsum1 = SUM( tab4d_1(iis:iie,jjs:jje,1:kdir,jn)                                 ) 
     161               ENDIF 
     162            ENDIF 
     163 
     164            ! Print the result 
     165            IF( PRESENT(clinfo ) )   cl1  = clinfo(jn) 
     166            IF( PRESENT(clinfo3) )   THEN 
     167               ! 
     168               IF( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) ) THEN 
     169                  WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1 - zvctl1, cl2, zsum2 - zvctl2 
     170               ELSE 
     171                  WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 - zvctl1 
     172               ENDIF 
     173               ! 
     174               SELECT CASE( clinfo3 ) 
     175               CASE ( 'tra-ta' )  
     176                  t_ctl(jl) = zsum1 
     177               CASE ( 'tra' )  
     178                  t_ctl(jl) = zsum1 
     179                  s_ctl(jl) = zsum2 
     180               CASE ( 'dyn' )  
     181                  u_ctl(jl) = zsum1 
     182                  v_ctl(jl) = zsum2 
     183               CASE default 
     184                  tra_ctl(jn,jl) = zsum1 
     185               END SELECT 
     186            ELSEIF ( PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
     187               WRITE(inum, "(3x,a,' : ',D23.16,3x,a,' : ',D23.16)") cl1, zsum1, cl2, zsum2 
    145188            ELSE 
    146                nictls = MAX(  1, nimpptl(jn) - 1 + nlditl(jn) ) 
    147                nictle = MIN(jpi, nimpptl(jn) - 1 + nleitl(jn) ) 
    148                njctls = MAX(  1, njmpptl(jn) - 1 + nldjtl(jn) ) 
    149                njctle = MIN(jpj, njmpptl(jn) - 1 + nlejtl(jn) ) 
    150                ! Do not take into account the bound of the domain 
    151                IF( ibonitl(jn) == -1 .OR. ibonitl(jn) == 2 ) nictls = MAX(2, nictls) 
    152                IF( ibonjtl(jn) == -1 .OR. ibonjtl(jn) == 2 ) njctls = MAX(2, njctls) 
    153                IF( ibonitl(jn) ==  1 .OR. ibonitl(jn) == 2 ) nictle = MIN(nictle, nimpptl(jn) + nleitl(jn) - 2) 
    154                IF( ibonjtl(jn) ==  1 .OR. ibonjtl(jn) == 2 ) njctle = MIN(njctle, njmpptl(jn) + nlejtl(jn) - 2) 
    155             ENDIF 
    156          ENDIF 
    157  
    158          IF( PRESENT(clinfo3)) THEN 
    159             IF ( clinfo3 == 'tra' )  THEN 
    160                zvctl1 = t_ctll(jn) 
    161                zvctl2 = s_ctll(jn) 
    162             ELSEIF ( clinfo3 == 'dyn' )   THEN 
    163                zvctl1 = u_ctll(jn) 
    164                zvctl2 = v_ctll(jn) 
    165             ENDIF 
    166          ENDIF 
    167  
    168          ! Compute the sum control 
    169          ! 2D arrays 
    170          IF( PRESENT(tab2d_1) )   THEN 
    171             zsum1 = SUM( ztab2d_1(nictls:nictle,njctls:njctle)*zmask1(nictls:nictle,njctls:njctle,1) ) 
    172             zsum2 = SUM( ztab2d_2(nictls:nictle,njctls:njctle)*zmask2(nictls:nictle,njctls:njctle,1) ) 
    173          ENDIF 
    174  
    175          ! 3D arrays 
    176          IF( PRESENT(tab3d_1) )   THEN 
    177             zsum1 = SUM( ztab3d_1(nictls:nictle,njctls:njctle,1:kdir)*zmask1(nictls:nictle,njctls:njctle,1:kdir) ) 
    178             zsum2 = SUM( ztab3d_2(nictls:nictle,njctls:njctle,1:kdir)*zmask2(nictls:nictle,njctls:njctle,1:kdir) ) 
    179          ENDIF 
    180  
    181          ! Print the result 
    182          IF( PRESENT(clinfo3) )   THEN 
    183             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1-zvctl1, cl2, zsum2-zvctl2 
    184             SELECT CASE( clinfo3 ) 
    185             CASE ( 'tra-ta' )  
    186                t_ctll(jn) = zsum1 
    187             CASE ( 'tra' )  
    188                 t_ctll(jn) = zsum1 
    189                 s_ctll(jn) = zsum2 
    190             CASE ( 'dyn' )  
    191                 u_ctll(jn) = zsum1 
    192                 v_ctll(jn) = zsum2  
    193             END SELECT 
    194          ELSEIF ( PRESENT(clinfo2) .OR. PRESENT(tab2d_2) .OR. PRESENT(tab3d_2) )   THEN 
    195             WRITE(j_id,FMT='(a,D23.16,3x,a,D23.16)')clinfo1, zsum1, cl2, zsum2 
    196          ELSE 
    197             WRITE(j_id,FMT='(a,D23.16)')clinfo1, zsum1 
    198          ENDIF 
    199  
    200       ENDDO 
    201       ! 
    202    END SUBROUTINE prt_ctl 
    203  
    204  
    205    SUBROUTINE prt_ctl_info (clinfo1, ivar1, clinfo2, ivar2, itime) 
    206       !!---------------------------------------------------------------------- 
    207       !!                     ***  ROUTINE prt_ctl_info  *** 
    208       !! 
    209       !! ** Purpose : - print information without any computation 
    210       !! 
    211       !! ** Action  : - input arguments 
    212       !!                    clinfo1 : information about the ivar1 
    213       !!                    ivar1   : value to print 
    214       !!                    clinfo2 : information about the ivar2 
    215       !!                    ivar2   : value to print 
    216       !!---------------------------------------------------------------------- 
    217       CHARACTER (len=*), INTENT(in)           ::   clinfo1 
    218       INTEGER          , INTENT(in), OPTIONAL ::   ivar1 
    219       CHARACTER (len=*), INTENT(in), OPTIONAL ::   clinfo2 
    220       INTEGER          , INTENT(in), OPTIONAL ::   ivar2 
    221       INTEGER          , INTENT(in), OPTIONAL ::   itime 
    222       ! 
    223       INTEGER :: jn, sind, eind, iltime, j_id 
    224       !!---------------------------------------------------------------------- 
    225  
    226       IF( lk_mpp .AND. jpnij > 1 ) THEN       ! processor number 
    227          sind = narea 
    228          eind = narea 
    229       ELSE                                    ! total number of processors 
    230          sind = 1 
    231          eind = ijsplt 
    232       ENDIF 
    233  
    234       ! Set to zero arrays at each new time step 
    235       IF( PRESENT(itime) )   THEN 
    236          iltime = itime 
    237          IF( iltime > ktime )   THEN 
    238             t_ctll(:) = 0.e0   ;   s_ctll(:) = 0.e0 
    239             u_ctll(:) = 0.e0   ;   v_ctll(:) = 0.e0 
    240             ktime = iltime 
    241          ENDIF 
    242       ENDIF 
    243  
    244       ! Loop over each sub-domain, i.e. number of processors ijsplt 
    245       DO jn = sind, eind 
    246          ! 
    247          j_id = numid(jn - narea + 1)         ! Set logical unit 
    248          ! 
    249          IF( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    250             WRITE(j_id,*)clinfo1, ivar1, clinfo2, ivar2 
    251          ELSEIF ( PRESENT(ivar1) .AND. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    252             WRITE(j_id,*)clinfo1, ivar1, clinfo2 
    253          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. PRESENT(ivar2) )   THEN 
    254             WRITE(j_id,*)clinfo1, ivar1, ivar2 
    255          ELSEIF ( PRESENT(ivar1) .AND. .NOT. PRESENT(clinfo2) .AND. .NOT. PRESENT(ivar2) )   THEN 
    256             WRITE(j_id,*)clinfo1, ivar1 
    257          ELSE 
    258             WRITE(j_id,*)clinfo1 
    259          ENDIF 
    260          ! 
    261       END DO 
    262       ! 
    263    END SUBROUTINE prt_ctl_info 
    264  
    265  
    266    SUBROUTINE prt_ctl_init 
    267       !!---------------------------------------------------------------------- 
    268       !!                     ***  ROUTINE prt_ctl_init  *** 
    269       !! 
    270       !! ** Purpose :   open ASCII files & compute indices 
    271       !!---------------------------------------------------------------------- 
    272       INTEGER ::   jn, sind, eind, j_id 
    273       CHARACTER (len=28) :: clfile_out 
    274       CHARACTER (len=23) :: clb_name 
    275       CHARACTER (len=19) :: cl_run 
    276       !!---------------------------------------------------------------------- 
    277  
    278       ! Allocate arrays 
    279       ALLOCATE( nlditl(ijsplt) , nleitl(ijsplt) , nimpptl(ijsplt) , ibonitl(ijsplt) ,   & 
    280          &      nldjtl(ijsplt) , nlejtl(ijsplt) , njmpptl(ijsplt) , ibonjtl(ijsplt) ,   & 
    281          &      nlcitl(ijsplt) , t_ctll(ijsplt) , u_ctll (ijsplt) ,                     & 
    282          &      nlcjtl(ijsplt) , s_ctll(ijsplt) , v_ctll (ijsplt)                       ) 
    283  
    284       ! Initialization  
    285       t_ctll(:) = 0.e0 
    286       s_ctll(:) = 0.e0 
    287       u_ctll(:) = 0.e0 
    288       v_ctll(:) = 0.e0 
    289       ktime = 1 
    290  
    291       IF( lk_mpp .AND. jpnij > 1 ) THEN 
    292          sind = narea 
    293          eind = narea 
    294          clb_name = "('mpp.output_',I4.4)" 
    295          cl_run = 'MULTI processor run' 
    296          ! use indices for each area computed by mpp_init subroutine 
    297          nlditl(1:jpnij) = nldit(:)  
    298          nleitl(1:jpnij) = nleit(:)  
    299          nldjtl(1:jpnij) = nldjt(:)  
    300          nlejtl(1:jpnij) = nlejt(:)  
    301          ! 
    302          nimpptl(1:jpnij) = nimppt(:) 
    303          njmpptl(1:jpnij) = njmppt(:) 
    304          ! 
    305          nlcitl(1:jpnij) = nlcit(:) 
    306          nlcjtl(1:jpnij) = nlcjt(:) 
    307          ! 
    308          ibonitl(1:jpnij) = ibonit(:) 
    309          ibonjtl(1:jpnij) = ibonjt(:) 
    310       ELSE 
    311          sind = 1 
    312          eind = ijsplt 
    313          clb_name = "('mono.output_',I4.4)" 
    314          cl_run = 'MONO processor run ' 
    315          ! compute indices for each area as done in mpp_init subroutine 
    316          CALL sub_dom 
    317       ENDIF 
    318  
    319       ALLOCATE( numid(eind-sind+1) ) 
    320  
    321       DO jn = sind, eind 
    322          WRITE(clfile_out,FMT=clb_name) jn-1 
    323          CALL ctl_opn( numid(jn -narea + 1), clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
    324          j_id = numid(jn -narea + 1) 
    325          WRITE(j_id,*) 
    326          WRITE(j_id,*) '                 L O D Y C - I P S L' 
    327          WRITE(j_id,*) '                     O P A model' 
    328          WRITE(j_id,*) '            Ocean General Circulation Model' 
    329          WRITE(j_id,*) '               version OPA 9.0  (2005) ' 
    330          WRITE(j_id,*) 
    331          WRITE(j_id,*) '                   PROC number: ', jn 
    332          WRITE(j_id,*) 
    333          WRITE(j_id,FMT="(19x,a20)")cl_run 
    334  
    335          ! Print the SUM control indices 
    336          IF( .NOT. lsp_area )   THEN 
    337             nictls = nimpptl(jn) + nlditl(jn) - 1 
    338             nictle = nimpptl(jn) + nleitl(jn) - 1 
    339             njctls = njmpptl(jn) + nldjtl(jn) - 1 
    340             njctle = njmpptl(jn) + nlejtl(jn) - 1 
    341          ENDIF 
    342          WRITE(j_id,*)  
    343          WRITE(j_id,*) 'prt_ctl :  Sum control indices' 
    344          WRITE(j_id,*) '~~~~~~~' 
    345          WRITE(j_id,*) 
    346          WRITE(j_id,9000)'                                nlej   = ', nlejtl(jn), '              ' 
    347          WRITE(j_id,9000)'                  ------------- njctle = ', njctle, ' -------------' 
    348          WRITE(j_id,9001)'                  |                                       |' 
    349          WRITE(j_id,9001)'                  |                                       |' 
    350          WRITE(j_id,9001)'                  |                                       |' 
    351          WRITE(j_id,9002)'           nictls = ', nictls,  '                           nictle = ', nictle 
    352          WRITE(j_id,9002)'           nldi   = ', nlditl(jn),  '                           nlei   = ', nleitl(jn) 
    353          WRITE(j_id,9001)'                  |                                       |' 
    354          WRITE(j_id,9001)'                  |                                       |' 
    355          WRITE(j_id,9001)'                  |                                       |' 
    356          WRITE(j_id,9004)'  njmpp  = ',njmpptl(jn),'   ------------- njctls = ', njctls, ' -------------' 
    357          WRITE(j_id,9003)'           nimpp  = ', nimpptl(jn), '        nldj   = ', nldjtl(jn), '              ' 
    358          WRITE(j_id,*) 
    359          WRITE(j_id,*) 
    360  
    361 9000     FORMAT(a41,i4.4,a14) 
    362 9001     FORMAT(a59) 
    363 9002     FORMAT(a20,i4.4,a36,i3.3) 
    364 9003     FORMAT(a20,i4.4,a17,i4.4) 
    365 9004     FORMAT(a11,i4.4,a26,i4.4,a14) 
    366       END DO 
    367       ! 
    368    END SUBROUTINE prt_ctl_init 
    369  
    370  
    371    SUBROUTINE sub_dom 
    372       !!---------------------------------------------------------------------- 
    373       !!                  ***  ROUTINE sub_dom  *** 
    374       !!                     
    375       !! ** Purpose :   Lay out the global domain over processors.  
    376       !!                CAUTION:  
    377       !!                This part has been extracted from the mpp_init 
    378       !!                subroutine and names of variables/arrays have been  
    379       !!                slightly changed to avoid confusion but the computation 
    380       !!                is exactly the same. Any modification about indices of 
    381       !!                each sub-domain in the mppini.F90 module should be reported  
    382       !!                here. 
    383       !! 
    384       !! ** Method  :   Global domain is distributed in smaller local domains. 
    385       !!                Periodic condition is a function of the local domain position 
    386       !!                (global boundary or neighbouring domain) and of the global 
    387       !!                periodic 
    388       !!                Type :         jperio global periodic condition 
    389       !! 
    390       !! ** Action  : - set domain parameters 
    391       !!                    nimpp     : longitudinal index  
    392       !!                    njmpp     : latitudinal  index 
    393       !!                    narea     : number for local area 
    394       !!                    nlcil      : first dimension 
    395       !!                    nlcjl      : second dimension 
    396       !!                    nbondil    : mark for "east-west local boundary" 
    397       !!                    nbondjl    : mark for "north-south local boundary" 
    398       !! 
    399       !! History : 
    400       !!        !  94-11  (M. Guyon)  Original code 
    401       !!        !  95-04  (J. Escobar, M. Imbard) 
    402       !!        !  98-02  (M. Guyon)  FETI method 
    403       !!        !  98-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    404       !!   8.5  !  02-08  (G. Madec)  F90 : free form 
    405       !!---------------------------------------------------------------------- 
    406       INTEGER ::   ji, jj, jn               ! dummy loop indices 
    407       INTEGER ::   & 
    408          ii, ij,                         &  ! temporary integers 
    409          irestil, irestjl,               &  !    "          " 
    410          ijpi  , ijpj, nlcil,            &  ! temporary logical unit 
    411          nlcjl , nbondil, nbondjl,       & 
    412          nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    413  
    414       INTEGER, DIMENSION(jpi,jpj) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! workspace 
    415       REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    416       INTEGER ::   inum                     ! local logical unit 
    417       !!---------------------------------------------------------------------- 
    418  
    419       ! 
    420       ! 
    421       !  1. Dimension arrays for subdomains 
    422       ! ----------------------------------- 
    423       !  Computation of local domain sizes ilcitl() ilcjtl() 
    424       !  These dimensions depend on global sizes isplt,jsplt and jpiglo,jpjglo 
    425       !  The subdomains are squares leeser than or equal to the global 
    426       !  dimensions divided by the number of processors minus the overlap 
    427       !  array (cf. par_oce.F90). 
    428  
    429 #if defined key_nemocice_decomp 
    430       ijpi = ( nx_global+2-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    431       ijpj = ( ny_global+2-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls  
    432 #else 
    433       ijpi = ( jpiglo-2*nn_hls + (isplt-1) ) / isplt + 2*nn_hls 
    434       ijpj = ( jpjglo-2*nn_hls + (jsplt-1) ) / jsplt + 2*nn_hls 
    435 #endif 
    436  
    437  
    438       nrecil  = 2 * nn_hls 
    439       nrecjl  = 2 * nn_hls 
    440       irestil = MOD( jpiglo - nrecil , isplt ) 
    441       irestjl = MOD( jpjglo - nrecjl , jsplt ) 
    442  
    443       IF(  irestil == 0 )   irestil = isplt 
    444 #if defined key_nemocice_decomp 
    445  
    446       ! In order to match CICE the size of domains in NEMO has to be changed 
    447       ! The last line of blocks (west) will have fewer points  
    448       DO jj = 1, jsplt  
    449          DO ji=1, isplt-1  
    450             ilcitl(ji,jj) = ijpi  
    451          END DO  
    452          ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 
    453       END DO  
    454  
    455 #else  
    456  
    457       DO jj = 1, jsplt 
    458          DO ji = 1, irestil 
    459             ilcitl(ji,jj) = ijpi 
    460          END DO 
    461          DO ji = irestil+1, isplt 
    462             ilcitl(ji,jj) = ijpi -1 
     189               WRITE(inum, "(3x,a,' : ',D23.16                  )") cl1, zsum1 
     190            ENDIF 
     191 
    463192         END DO 
    464193      END DO 
    465  
    466 #endif 
    467        
    468       IF( irestjl == 0 )   irestjl = jsplt 
    469 #if defined key_nemocice_decomp  
    470  
    471       ! Same change to domains in North-South direction as in East-West.  
    472       DO ji = 1, isplt  
    473          DO jj=1, jsplt-1  
    474             ilcjtl(ji,jj) = ijpj  
    475          END DO  
    476          ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 
    477       END DO  
    478  
    479 #else  
    480  
    481       DO ji = 1, isplt 
    482          DO jj = 1, irestjl 
    483             ilcjtl(ji,jj) = ijpj 
    484          END DO 
    485          DO jj = irestjl+1, jsplt 
    486             ilcjtl(ji,jj) = ijpj -1 
    487          END DO 
     194      ! 
     195   END SUBROUTINE prt_ctl 
     196 
     197 
     198   SUBROUTINE prt_ctl_info (clinfo, ivar, cdcomp ) 
     199      !!---------------------------------------------------------------------- 
     200      !!                     ***  ROUTINE prt_ctl_info  *** 
     201      !! 
     202      !! ** Purpose : - print information without any computation 
     203      !! 
     204      !! ** Action  : - input arguments 
     205      !!                    clinfo : information about the ivar 
     206      !!                    ivar   : value to print 
     207      !!---------------------------------------------------------------------- 
     208      CHARACTER(len=*),           INTENT(in) ::   clinfo 
     209      INTEGER         , OPTIONAL, INTENT(in) ::   ivar 
     210      CHARACTER(len=3), OPTIONAL, INTENT(in) ::   cdcomp   ! only 'top' is accepted 
     211      ! 
     212      CHARACTER(len=3) :: clcomp 
     213      INTEGER ::  jl, inum 
     214      !!---------------------------------------------------------------------- 
     215      ! 
     216      IF( PRESENT(cdcomp) ) THEN   ;   clcomp = cdcomp 
     217      ELSE                         ;   clcomp = 'oce' 
     218      ENDIF 
     219      ! 
     220      DO jl = 1, SIZE(nall_ictls) 
     221         ! 
     222         IF( clcomp == 'oce' )   inum = numprt_oce(jl) 
     223         IF( clcomp == 'top' )   inum = numprt_top(jl) 
     224         ! 
     225         IF ( PRESENT(ivar) ) THEN   ;   WRITE(inum,*) clinfo, ivar 
     226         ELSE                        ;   WRITE(inum,*) clinfo 
     227         ENDIF 
     228         ! 
    488229      END DO 
    489  
    490 #endif 
    491       zidom = nrecil 
    492       DO ji = 1, isplt 
    493          zidom = zidom + ilcitl(ji,1) - nrecil 
     230      ! 
     231   END SUBROUTINE prt_ctl_info 
     232 
     233 
     234   SUBROUTINE prt_ctl_init( cdcomp, kntra ) 
     235      !!---------------------------------------------------------------------- 
     236      !!                     ***  ROUTINE prt_ctl_init  *** 
     237      !! 
     238      !! ** Purpose :   open ASCII files & compute indices 
     239      !!---------------------------------------------------------------------- 
     240      CHARACTER(len=3), OPTIONAL, INTENT(in   ) ::   cdcomp   ! only 'top' is accepted 
     241      INTEGER         , OPTIONAL, INTENT(in   ) ::   kntra    ! only for 'top': number of tracers 
     242      ! 
     243      INTEGER ::   ji, jj, jl 
     244      INTEGER ::   inum, idg, idg2 
     245      INTEGER ::   ijsplt, iimax, ijmax 
     246      INTEGER, DIMENSION(:,:), ALLOCATABLE ::    iimppt, ijmppt, ijpi, ijpj, iproc 
     247      INTEGER, DIMENSION(  :), ALLOCATABLE ::     iipos,  ijpos 
     248      LOGICAL, DIMENSION(:,:), ALLOCATABLE ::   llisoce 
     249      CHARACTER(len=64) :: clfile_out 
     250      CHARACTER(LEN=64) :: clfmt, clfmt2, clfmt3, clfmt4 
     251      CHARACTER(len=32) :: clname, cl_run 
     252      CHARACTER(len= 3) :: clcomp 
     253      !!---------------------------------------------------------------------- 
     254      ! 
     255      clname = 'output' 
     256      IF( PRESENT(cdcomp) ) THEN 
     257         clname = TRIM(clname)//'.'//TRIM(cdcomp) 
     258         clcomp = cdcomp 
     259      ELSE 
     260         clcomp = 'oce' 
     261      ENDIF 
     262      ! 
     263      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     264         cl_run = 'MULTI processor run' 
     265         idg = MAX( INT(LOG10(REAL(MAX(1,jpnij-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     266         WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg        ! '(a,ix.x)' 
     267         WRITE(clfile_out,clfmt) 'mpp.'//trim(clname)//'_', narea - 1 
     268         ijsplt = 1 
     269      ELSE                   ! MONO processor run 
     270         cl_run = 'MONO processor run ' 
     271         IF(lwp) THEN                  ! control print 
     272            WRITE(numout,*) 
     273            WRITE(numout,*) 'prt_ctl_init: sn_cfctl%l_prtctl parameters' 
     274            WRITE(numout,*) '~~~~~~~~~~~~~' 
     275         ENDIF 
     276         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area          
     277            nn_isplt = MAX(1, nn_isplt)            ! number of processors following i-direction 
     278            nn_jsplt = MAX(1, nn_jsplt)            ! number of processors following j-direction 
     279            ijsplt = nn_isplt * nn_jsplt           ! total number of processors ijsplt 
     280            IF( ijsplt == 1 )   CALL ctl_warn( 'nn_isplt & nn_jsplt are equal to 1 -> control sum done over the whole domain' ) 
     281            IF(lwp) WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
     282            IF(lwp) WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
     283            idg = MAX( INT(LOG10(REAL(MAX(1,ijsplt-1),wp))) + 1, 4 )    ! how many digits to we need to write? min=4, max=9 
     284            WRITE(clfmt, "('(a,i', i1, '.', i1, ')')") idg, idg         ! '(a,ix.x)' 
     285            IF( ijsplt == 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', 0 
     286         ELSE                                             ! print control done over a specific  area 
     287            ijsplt = 1 
     288            IF( nn_ictls < 1 .OR. nn_ictls > Ni0glo )   THEN 
     289               CALL ctl_warn( '          - nictls must be 1<=nictls>=Ni0glo, it is forced to 1' ) 
     290               nn_ictls = 1 
     291            ENDIF 
     292            IF( nn_ictle < 1 .OR. nn_ictle > Ni0glo )   THEN 
     293               CALL ctl_warn( '          - nictle must be 1<=nictle>=Ni0glo, it is forced to Ni0glo' ) 
     294               nn_ictle = Ni0glo 
     295            ENDIF 
     296            IF( nn_jctls < 1 .OR. nn_jctls > Nj0glo )   THEN 
     297               CALL ctl_warn( '          - njctls must be 1<=njctls>=Nj0glo, it is forced to 1' ) 
     298               nn_jctls = 1 
     299            ENDIF 
     300            IF( nn_jctle < 1 .OR. nn_jctle > Nj0glo )   THEN 
     301               CALL ctl_warn( '          - njctle must be 1<=njctle>=Nj0glo, it is forced to Nj0glo' ) 
     302               nn_jctle = Nj0glo 
     303            ENDIF 
     304            WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
     305            WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
     306            WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
     307            WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
     308            idg = MAXVAL( (/ nn_ictls,nn_ictle,nn_jctls,nn_jctle /) )   ! temporary use of idg to store the largest index 
     309            idg = MAX( INT(LOG10(REAL(idg,wp))) + 1, 4 )                ! how many digits to we need to write? min=4, max=9 
     310            WRITE(clfmt, "('(4(a,i', i1, '.', i1, '))')") idg, idg         ! '(4(a,ix.x))' 
     311            WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', nn_ictls, '_', nn_ictle, '_', nn_jctls, '_', nn_jctle 
     312         ENDIF 
     313      ENDIF 
     314 
     315      ! Allocate arrays 
     316      IF( .NOT. ALLOCATED(nall_ictls) ) ALLOCATE( nall_ictls(ijsplt), nall_ictle(ijsplt), nall_jctls(ijsplt), nall_jctle(ijsplt) ) 
     317 
     318      IF( jpnij > 1 ) THEN   ! MULTI processor run 
     319         ! 
     320         nall_ictls(1) = Nis0 
     321         nall_ictle(1) = Nie0 
     322         nall_jctls(1) = Njs0 
     323         nall_jctle(1) = Nje0 
     324         ! 
     325      ELSE                   ! MONO processor run 
     326         ! 
     327         IF( nn_ictls+nn_ictle+nn_jctls+nn_jctle == 0 )   THEN    ! print control done over the default area 
     328            ! 
     329            ALLOCATE(  iimppt(nn_isplt,nn_jsplt), ijmppt(nn_isplt,nn_jsplt),  ijpi(nn_isplt,nn_jsplt),  ijpj(nn_isplt,nn_jsplt),   & 
     330               &      llisoce(nn_isplt,nn_jsplt),  iproc(nn_isplt,nn_jsplt), iipos(nn_isplt*nn_jsplt), ijpos(nn_isplt*nn_jsplt) ) 
     331            CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, nn_isplt, nn_jsplt, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
     332            CALL mpp_is_ocean( llisoce ) 
     333            CALL mpp_getnum( llisoce, iproc, iipos, ijpos ) 
     334            ! 
     335            DO jj = 1,nn_jsplt 
     336               DO ji = 1, nn_isplt 
     337                  jl = iproc(ji,jj) + 1 
     338                  nall_ictls(jl) = iimppt(ji,jj) - 1 +      1      + nn_hls 
     339                  nall_ictle(jl) = iimppt(ji,jj) - 1 + ijpi(ji,jj) - nn_hls 
     340                  nall_jctls(jl) = ijmppt(ji,jj) - 1 +      1      + nn_hls 
     341                  nall_jctle(jl) = ijmppt(ji,jj) - 1 + ijpj(ji,jj) - nn_hls 
     342               END DO 
     343            END DO 
     344            ! 
     345            DEALLOCATE( iimppt, ijmppt, ijpi, ijpj, llisoce, iproc, iipos, ijpos ) 
     346            ! 
     347         ELSE                                             ! print control done over a specific  area 
     348            ! 
     349            nall_ictls(1) = nn_ictls + nn_hls 
     350            nall_ictle(1) = nn_ictle + nn_hls 
     351            nall_jctls(1) = nn_jctls + nn_hls 
     352            nall_jctle(1) = nn_jctle + nn_hls 
     353            ! 
     354         ENDIF 
     355      ENDIF 
     356 
     357      ! Initialization  
     358      IF( clcomp == 'oce' ) THEN 
     359         ALLOCATE( t_ctl(ijsplt), s_ctl(ijsplt), u_ctl(ijsplt), v_ctl(ijsplt), numprt_oce(ijsplt) ) 
     360         t_ctl(:) = 0.e0 
     361         s_ctl(:) = 0.e0 
     362         u_ctl(:) = 0.e0 
     363         v_ctl(:) = 0.e0 
     364      ENDIF 
     365      IF( clcomp == 'top' ) THEN 
     366         ALLOCATE( tra_ctl(kntra,ijsplt), numprt_top(ijsplt) ) 
     367         tra_ctl(:,:) = 0.e0 
     368      ENDIF 
     369 
     370      DO jl = 1,ijsplt 
     371 
     372         IF( ijsplt > 1 ) WRITE(clfile_out,clfmt) 'mono.'//trim(clname)//'_', jl-1 
     373 
     374         CALL ctl_opn( inum, clfile_out, 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, .FALSE. ) 
     375         IF( clcomp == 'oce' )   numprt_oce(jl) = inum 
     376         IF( clcomp == 'top' )   numprt_top(jl) = inum 
     377         WRITE(inum,*) 
     378         WRITE(inum,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC' 
     379         WRITE(inum,*) '                       NEMO team' 
     380         WRITE(inum,*) '            Ocean General Circulation Model' 
     381         IF( clcomp == 'oce' )   WRITE(inum,*) '                NEMO version 4.x  (2020) ' 
     382         IF( clcomp == 'top' )   WRITE(inum,*) '                 TOP vversion x (2020) ' 
     383         WRITE(inum,*) 
     384         IF( ijsplt > 1 )   & 
     385            &   WRITE(inum,*) '              MPI-subdomain number: ', jl-1 
     386         IF(  jpnij > 1 )   & 
     387            &   WRITE(inum,*) '              MPI-subdomain number: ', narea-1 
     388         WRITE(inum,*) 
     389         WRITE(inum,'(19x,a20)') cl_run 
     390         WRITE(inum,*)  
     391         WRITE(inum,*) 'prt_ctl :  Sum control indices' 
     392         WRITE(inum,*) '~~~~~~~' 
     393         WRITE(inum,*) 
     394         ! 
     395         ! clfmt2: '              ----- jctle = XXX (YYY) -----'             -> '(18x, 13a1, a9, iM, a2, iN, a2, 13a1)' 
     396         ! clfmt3: '              |                           |'             -> '(18x, a1, Nx, a1)' 
     397         ! clfmt4: '        ictls = XXX (YYY)           ictle = XXX (YYY)'   -> '(Nx, a9, iM, a2, iP, a2, Qx, a9, iM, a2, iP, a2)' 
     398         !         '              |                           |' 
     399         !         '              ----- jctle = XXX (YYY) -----' 
     400         ! clfmt5: '   njmpp = XXX'                                          -> '(Nx, a9, iM)' 
     401         ! clfmt6: '           nimpp = XXX'                                  -> '(Nx, a9, iM)' 
     402         ! 
     403         idg = MAXVAL( (/ nall_ictls(jl), nall_ictle(jl), nall_jctls(jl), nall_jctle(jl) /) )   ! temporary use of idg 
     404         idg = INT(LOG10(REAL(idg,wp))) + 1                                                     ! how many digits do we use? 
     405         idg2 = MAXVAL( (/ mig0(nall_ictls(jl)), mig0(nall_ictle(jl)), mjg0(nall_jctls(jl)), mjg0(nall_jctle(jl)) /) ) 
     406         idg2 = INT(LOG10(REAL(idg2,wp))) + 1                                                   ! how many digits do we use? 
     407         WRITE(clfmt2, "('(18x, 13a1, a9, i', i1, ', a2, i',i1,', a2, 13a1)')") idg, idg2 
     408         WRITE(clfmt3, "('(18x, a1, ', i2,'x, a1)')") 13+9+idg+2+idg2+2+13 - 2 
     409         WRITE(clfmt4, "('(', i2,'x, a9, i', i1,', a2, i', i1,', a2, ', i2,'x, a9, i', i1,', a2, i', i1,', a2)')") & 
     410            &          18-7, idg, idg2, 13+9+idg+2+idg2+2+13 - (2+idg+2+idg2+2+8), idg, idg2 
     411         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctle = ', nall_jctle(jl), ' (', mjg0(nall_jctle(jl)), ') ', ('-', ji=1,13) 
     412         WRITE(inum,clfmt3) '|', '|' 
     413         WRITE(inum,clfmt3) '|', '|' 
     414         WRITE(inum,clfmt3) '|', '|' 
     415         WRITE(inum,clfmt4)                 ' ictls = ', nall_ictls(jl), ' (', mig0(nall_ictls(jl)), ') ',   & 
     416            &                               ' ictle = ', nall_ictle(jl), ' (', mig0(nall_ictle(jl)), ') ' 
     417         WRITE(inum,clfmt3) '|', '|' 
     418         WRITE(inum,clfmt3) '|', '|' 
     419         WRITE(inum,clfmt3) '|', '|' 
     420         WRITE(inum,clfmt2) ('-', ji=1,13), ' jctls = ', nall_jctls(jl), ' (', mjg0(nall_jctls(jl)), ') ', ('-', ji=1,13) 
     421         WRITE(inum,*) 
     422         WRITE(inum,*) 
     423         ! 
    494424      END DO 
    495       IF(lwp) WRITE(numout,*) 
    496       IF(lwp) WRITE(numout,*)' sum ilcitl(i,1) = ', zidom, ' jpiglo = ', jpiglo 
    497        
    498       zjdom = nrecjl 
    499       DO jj = 1, jsplt 
    500          zjdom = zjdom + ilcjtl(1,jj) - nrecjl 
    501       END DO 
    502       IF(lwp) WRITE(numout,*)' sum ilcitl(1,j) = ', zjdom, ' jpjglo = ', jpjglo 
    503       IF(lwp) WRITE(numout,*) 
    504        
    505  
    506       !  2. Index arrays for subdomains 
    507       ! ------------------------------- 
    508  
    509       iimpptl(:,:) = 1 
    510       ijmpptl(:,:) = 1 
    511        
    512       IF( isplt > 1 ) THEN 
    513          DO jj = 1, jsplt 
    514             DO ji = 2, isplt 
    515                iimpptl(ji,jj) = iimpptl(ji-1,jj) + ilcitl(ji-1,jj) - nrecil 
    516             END DO 
    517          END DO 
    518       ENDIF 
    519  
    520       IF( jsplt > 1 ) THEN 
    521          DO jj = 2, jsplt 
    522             DO ji = 1, isplt 
    523                ijmpptl(ji,jj) = ijmpptl(ji,jj-1)+ilcjtl(ji,jj-1)-nrecjl 
    524             END DO 
    525          END DO 
    526       ENDIF 
    527        
    528       ! 3. Subdomain description 
    529       ! ------------------------ 
    530  
    531       DO jn = 1, ijsplt 
    532          ii = 1 + MOD( jn-1, isplt ) 
    533          ij = 1 + (jn-1) / isplt 
    534          nimpptl(jn) = iimpptl(ii,ij) 
    535          njmpptl(jn) = ijmpptl(ii,ij) 
    536          nlcitl (jn) = ilcitl (ii,ij)      
    537          nlcil       = nlcitl (jn)      
    538          nlcjtl (jn) = ilcjtl (ii,ij)      
    539          nlcjl       = nlcjtl (jn) 
    540          nbondjl = -1                                    ! general case 
    541          IF( jn   >  isplt          )   nbondjl = 0      ! first row of processor 
    542          IF( jn   >  (jsplt-1)*isplt )  nbondjl = 1     ! last  row of processor 
    543          IF( jsplt == 1             )   nbondjl = 2      ! one processor only in j-direction 
    544          ibonjtl(jn) = nbondjl 
    545           
    546          nbondil = 0                                     !  
    547          IF( MOD( jn, isplt ) == 1 )   nbondil = -1      ! 
    548          IF( MOD( jn, isplt ) == 0 )   nbondil =  1      ! 
    549          IF( isplt            == 1 )   nbondil =  2      ! one processor only in i-direction 
    550          ibonitl(jn) = nbondil 
    551           
    552          nldil =  1   + nn_hls 
    553          nleil = nlcil - nn_hls 
    554          IF( nbondil == -1 .OR. nbondil == 2 )   nldil = 1 
    555          IF( nbondil ==  1 .OR. nbondil == 2 )   nleil = nlcil 
    556          nldjl =  1   + nn_hls 
    557          nlejl = nlcjl - nn_hls 
    558          IF( nbondjl == -1 .OR. nbondjl == 2 )   nldjl = 1 
    559          IF( nbondjl ==  1 .OR. nbondjl == 2 )   nlejl = nlcjl 
    560          nlditl(jn) = nldil 
    561          nleitl(jn) = nleil 
    562          nldjtl(jn) = nldjl 
    563          nlejtl(jn) = nlejl 
    564       END DO 
    565       ! 
    566       ! Save processor layout in layout_prtctl.dat file  
    567       IF(lwp) THEN 
    568          CALL ctl_opn( inum, 'layout_prtctl.dat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE., narea ) 
    569          WRITE(inum,'(a)') 'nproc nlcil nlcjl nldil nldjl nleil nlejl nimpptl njmpptl ibonitl ibonjtl' 
    570          ! 
    571          DO jn = 1, ijsplt 
    572             WRITE(inum,'(i5,6i6,4i8)') jn-1,nlcitl(jn),  nlcjtl(jn), & 
    573                &                            nlditl(jn),  nldjtl(jn), & 
    574                &                            nleitl(jn),  nlejtl(jn), & 
    575                &                           nimpptl(jn), njmpptl(jn), & 
    576                &                           ibonitl(jn), ibonjtl(jn) 
    577          END DO 
    578          CLOSE(inum)    
    579       END IF 
    580       ! 
    581       ! 
    582    END SUBROUTINE sub_dom 
     425      ! 
     426   END SUBROUTINE prt_ctl_init 
     427 
    583428 
    584429   !!====================================================================== 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/IOM/restart.F90

    r11405 r13463  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE iom             ! I/O module 
    29    USE diurnal_bulk 
     29   USE diu_bulk 
    3030   USE lib_mpp         ! distribued memory computing library 
    3131 
    … …  
    3838   PUBLIC   rst_read_open   ! routine called in rst_read and (possibly) in dom_vvl_init 
    3939 
    40    !! * Substitutions 
    41 #  include "vectopt_loop_substitute.h90" 
    4240   !!---------------------------------------------------------------------- 
    4341   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    7068         IF( ln_rst_list ) THEN 
    7169            nrst_lst = 1 
    72             nitrst = nstocklist( nrst_lst ) 
     70            nitrst = nn_stocklist( nrst_lst ) 
    7371         ELSE 
    7472            nitrst = nitend 
    7573         ENDIF 
    7674      ENDIF 
     75       
     76      IF( .NOT. ln_rst_list .AND. nn_stock == -1 )   RETURN   ! we will never do any restart 
    7777 
    7878      ! frequency-based restart dumping (nn_stock) 
    79       IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nstock ) == 0 ) THEN    
     79      IF( .NOT. ln_rst_list .AND. MOD( kt - 1, nn_stock ) == 0 ) THEN    
    8080         ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
    81          nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
     81         nitrst = kt + nn_stock - 1                  ! define the next value of nitrst for restart writing 
    8282         IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    8383      ENDIF 
    … …  
    8585      ! we open and define the ocean restart file one time step before writing the data (-> at nitrst - 1) 
    8686      ! except if we write ocean restart files every time step or if an ocean restart file was writen at nitend - 1 
    87       IF( kt == nitrst - 1 .OR. nstock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
     87      IF( kt == nitrst - 1 .OR. nn_stock == 1 .OR. ( kt == nitend .AND. .NOT. lrst_oce ) ) THEN 
    8888         IF( nitrst <= nitend .AND. nitrst > 0 ) THEN  
    8989            ! beware of the format used to write kt (default is i8.8, that should be large enough...) 
    … …  
    131131 
    132132 
    133    SUBROUTINE rst_write( kt ) 
     133   SUBROUTINE rst_write( kt, Kbb, Kmm ) 
    134134      !!--------------------------------------------------------------------- 
    135135      !!                   ***  ROUTINE rstwrite  *** 
    … …  
    140140      !!              file, save fields which are necessary for restart 
    141141      !!---------------------------------------------------------------------- 
    142       INTEGER, INTENT(in) ::   kt   ! ocean time-step 
     142      INTEGER, INTENT(in) ::   kt         ! ocean time-step 
     143      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    143144      !!---------------------------------------------------------------------- 
    144145                     IF(lwxios) CALL iom_swap(      cwxios_context          ) 
    145                      CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rdt       , ldxios = lwxios)   ! dynamics time step 
     146                     CALL iom_rstput( kt, nitrst, numrow, 'rdt'    , rn_Dt       , ldxios = lwxios)   ! dynamics time step 
    146147                     CALL iom_delay_rst( 'WRITE', 'OCE', numrow )   ! save only ocean delayed global communication variables 
    147148 
    148149      IF ( .NOT. ln_diurnal_only ) THEN 
    149                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , ub, ldxios = lwxios        )     ! before fields 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vb, ldxios = lwxios        ) 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lwxios ) 
    152                      CALL iom_rstput( kt, nitrst, numrow, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lwxios ) 
    153                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      ) 
     150                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lwxios        )     ! before fields 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lwxios        ) 
     152                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 
     153                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 
     154                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lwxios      ) 
    154155                     ! 
    155                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , un, ldxios = lwxios        )     ! now fields 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vn, ldxios = lwxios        ) 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lwxios ) 
    158                      CALL iom_rstput( kt, nitrst, numrow, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lwxios ) 
    159                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:       ,Kmm), ldxios = lwxios        )     ! now fields 
     157                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lwxios        ) 
     158                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 
     159                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 
     160                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lwxios      ) 
    160161                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      ) 
    161                   ! extra variable needed for the ice sheet coupling 
    162                   IF ( ln_iscpl ) THEN  
    163                      CALL iom_rstput( kt, nitrst, numrow, 'tmask'  , tmask, ldxios = lwxios ) ! need to extrapolate T/S 
    164                      CALL iom_rstput( kt, nitrst, numrow, 'umask'  , umask, ldxios = lwxios ) ! need to correct barotropic velocity 
    165                      CALL iom_rstput( kt, nitrst, numrow, 'vmask'  , vmask, ldxios = lwxios ) ! need to correct barotropic velocity 
    166                      CALL iom_rstput( kt, nitrst, numrow, 'smask'  , ssmask, ldxios = lwxios) ! need to correct barotropic velocity 
    167                      CALL iom_rstput( kt, nitrst, numrow, 'e3t_n', e3t_n(:,:,:), ldxios = lwxios )   ! need to compute temperature correction 
    168                      CALL iom_rstput( kt, nitrst, numrow, 'e3u_n', e3u_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    169                      CALL iom_rstput( kt, nitrst, numrow, 'e3v_n', e3v_n(:,:,:), ldxios = lwxios )   ! need to compute bt conservation 
    170                      CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw_n(:,:,:), ldxios = lwxios ) ! need to compute extrapolation if vvl 
    171                   END IF 
    172162      ENDIF 
    173163       
    … …  
    184174         lrst_oce = .FALSE. 
    185175            IF( ln_rst_list ) THEN 
    186                nrst_lst = MIN(nrst_lst + 1, SIZE(nstocklist,1)) 
    187                nitrst = nstocklist( nrst_lst ) 
     176               nrst_lst = MIN(nrst_lst + 1, SIZE(nn_stocklist,1)) 
     177               nitrst = nn_stocklist( nrst_lst ) 
    188178            ENDIF 
    189179      ENDIF 
    … …  
    224214             IF( .NOT.lxios_set ) THEN 
    225215                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 
    226                  CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     216                 CALL iom_init( crxios_context ) 
    227217                 lxios_set = .TRUE. 
    228218             ENDIF 
    229219         ENDIF 
    230220         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 
    231              CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     221             CALL iom_init( crxios_context ) 
    232222             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 
    233223             lxios_set = .TRUE. 
    … …  
    238228 
    239229 
    240    SUBROUTINE rst_read 
     230   SUBROUTINE rst_read( Kbb, Kmm ) 
    241231      !!----------------------------------------------------------------------  
    242232      !!                   ***  ROUTINE rst_read  *** 
    … …  
    246236      !! ** Method  :   Read in restart.nc file fields which are necessary for restart 
    247237      !!---------------------------------------------------------------------- 
     238      INTEGER, INTENT(in) ::   Kbb, Kmm   ! ocean time level indices 
    248239      REAL(wp) ::   zrdt 
    249240      INTEGER  ::   jk 
    … …  
    259250         IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 
    260251         IF( zrdt /= rdt )   neuler = 0 
     252         IF( zrdt /= rn_Dt ) THEN 
     253            IF(lwp) WRITE( numout,*) 
     254            IF(lwp) WRITE( numout,*) 'rst_read:  rdt not equal to the read one' 
     255            IF(lwp) WRITE( numout,*) 
     256            IF(lwp) WRITE( numout,*) '      ==>>>   forced euler first time-step' 
     257            l_1st_euler =  .TRUE. 
     258         ENDIF 
    261259      ENDIF 
    262260 
    … …  
    265263      ! Diurnal DSST  
    266264      IF(lrxios) CALL iom_swap( TRIM(crxios_context) ) 
    267       IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios )  
     265      IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios )  
    268266      IF ( ln_diurnal_only ) THEN  
    269267         IF(lwp) WRITE( numout, * ) & 
    270          &   "rst_read:- ln_diurnal_only set, setting rhop=rau0"  
    271          rhop = rau0 
    272          CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios )  
    273          tsn(:,:,1,jp_tem) = w3d(:,:,1) 
     268         &   "rst_read:- ln_diurnal_only set, setting rhop=rho0"  
     269         rhop = rho0 
     270         CALL iom_get( numror, jpdom_auto, 'tn'     , w3d, ldxios = lrxios )  
     271         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 
    274272         RETURN  
    275273      ENDIF   
    276274       
    277275      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    278          CALL iom_get( numror, jpdom_autoglo, 'ub'     , ub, ldxios = lrxios                )   ! before fields 
    279          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vb, ldxios = lrxios                ) 
    280          CALL iom_get( numror, jpdom_autoglo, 'tb'     , tsb(:,:,:,jp_tem), ldxios = lrxios ) 
    281          CALL iom_get( numror, jpdom_autoglo, 'sb'     , tsb(:,:,:,jp_sal), ldxios = lrxios ) 
    282          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios              ) 
     276         ! before fields 
     277         CALL iom_get( numror, jpdom_auto, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     278         CALL iom_get( numror, jpdom_auto, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     279         CALL iom_get( numror, jpdom_auto, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
     280         CALL iom_get( numror, jpdom_auto, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
     281         CALL iom_get( numror, jpdom_auto, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
    283282      ELSE 
    284          neuler = 0 
    285       ENDIF 
    286       ! 
    287       CALL iom_get( numror, jpdom_autoglo, 'un'     , un, ldxios = lrxios )   ! now    fields 
    288       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vn, ldxios = lrxios ) 
    289       CALL iom_get( numror, jpdom_autoglo, 'tn'     , tsn(:,:,:,jp_tem), ldxios = lrxios ) 
    290       CALL iom_get( numror, jpdom_autoglo, 'sn'     , tsn(:,:,:,jp_sal), ldxios = lrxios ) 
    291       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios ) 
     283         l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
     284      ENDIF 
     285      ! 
     286      ! now fields 
     287      CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     288      CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     289      CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
     290      CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
     291      CALL iom_get( numror, jpdom_auto, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
    292292      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    293          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
     293         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    294294      ELSE 
    295          CALL eos( tsn, rhd, rhop, gdept_n(:,:,:) )    
     295         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )    
    296296      ENDIF 
    297297      IF(lrxios) CALL iom_swap( TRIM(cxios_context) ) 
    298298      ! 
    299       IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    300          tsb  (:,:,:,:) = tsn  (:,:,:,:)                             ! all before fields set to now values 
    301          ub   (:,:,:)   = un   (:,:,:) 
    302          vb   (:,:,:)   = vn   (:,:,:) 
    303          sshb (:,:)     = sshn (:,:) 
    304          ! 
    305          IF( .NOT.ln_linssh ) THEN 
    306             DO jk = 1, jpk 
    307                e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    308             END DO 
    309          ENDIF 
    310          ! 
     299      IF( l_1st_euler ) THEN                                  ! Euler restart  
     300         ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
     301         uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
     302         vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
     303         ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    311304      ENDIF 
    312305      ! 
Note: See TracChangeset for help on using the changeset viewer.