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 13286 for NEMO – NEMO

Changeset 13286 for NEMO


Ignore:
Timestamp:
2020-07-09T17:48:29+02:00 (4 years ago)
Author:
smasson
Message:

trunk: merge extra halos branch in trunk, see #2366

Location:
NEMO/trunk
Files:
2 deleted
199 edited
2 copied

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/r12931_sette_ticket2366@HEAD  sette 

  • NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/AGRIF_FixedGrids.in

    r9770 r13286  
    112 
    2 42 82 49 91 1 1 1 
    3 122 153 110 143 4 4 4 
     241 81 49 91 1 1 1 
     3121 152 110 143 4 4 4 
    440 
    551 

  • NEMO/trunk/cfgs/AGRIF_DEMO/EXPREF/namelist_cfg

    r13208 r13286  
    3333/ 
    3434!----------------------------------------------------------------------- 
    35 &namcfg        !   parameters of the configuration                      (default: user defined GYRE) 
     35&namcfg        !   parameters of the configuration                      (default: use namusr_def in namelist_cfg) 
    3636!----------------------------------------------------------------------- 
    3737   ln_read_cfg = .true.    !  (=T) read the domain configuration file 
    … …  
    4242/ 
    4343!----------------------------------------------------------------------- 
    44 &namtsd        !    Temperature & Salinity Data                         (default: OFF) 
     44&namtsd        !    Temperature & Salinity Data  (init/dmp)             (default: OFF) 
    4545!----------------------------------------------------------------------- 
    4646   !                       ! =T  read T-S fields for: 
    … …  
    6363!!   namsbc_cpl      CouPLed            formulation                     ("key_oasis3" ) 
    6464!!   namsbc_sas      Stand-Alone Surface module                         (SAS_SRC  only) 
     65!!   namsbc_iif      Ice-IF: use observed ice cover                     (nn_ice = 1   ) 
    6566!!   namtra_qsr      penetrative solar radiation                        (ln_traqsr  =T) 
     67!!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T) 
    6668!!   namsbc_rnf      river runoffs                                      (ln_rnf     =T) 
     69!!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T) 
    6770!!   namsbc_isf      ice shelf melting/freezing                         (ln_isfcav  =T : read (ln_read_cfg=T) or set or usr_def_zgr ) 
    6871!!   namsbc_iscpl    coupling option between land ice model and ocean   (ln_isfcav  =T) 
    69 !!   namsbc_apr      Atmospheric Pressure                               (ln_apr_dyn =T) 
    70 !!   namsbc_ssr      sea surface restoring term (for T and/or S)        (ln_ssr     =T) 
    7172!!   namsbc_wave     external fields from wave model                    (ln_wave    =T) 
    7273!!   namberg         iceberg floats                                     (ln_icebergs=T) 
    … …  
    7475! 
    7576!----------------------------------------------------------------------- 
    76 &namsbc        !   Surface Boundary Condition (surface module) 
     77&namsbc        !   Surface Boundary Condition manager                   (default: NO selection) 
    7778!----------------------------------------------------------------------- 
    7879   nn_fsbc     = 1         !  frequency of SBC module call 
    … …  
    8687                     ! Misc. options of sbc :  
    8788   ln_traqsr   = .true.    !  Light penetration in the ocean            (T => fill namtra_qsr) 
     89   ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    8890   ln_rnf      = .true.    !  runoffs                                   (T => fill namsbc_rnf) 
    89    ln_ssr      = .true.    !  Sea Surface Restoring on T and/or S       (T => fill namsbc_ssr) 
    9091   nn_fwb      = 0         !  FreshWater Budget: =0 unchecked 
    9192/ 
    9293!----------------------------------------------------------------------- 
    93 &namsbc_blk   !   namsbc_blk  generic Bulk formula                      (ln_blk =T) 
     94&namsbc_blk    !   namsbc_blk  generic Bulk formula                     (ln_blk =T) 
    9495!----------------------------------------------------------------------- 
    9596   !                    !  bulk algorithm : 
    96    ln_NCAR      = .true.    ! "NCAR"      algorithm   (Large and Yeager 2008) 
    97    ! 
     97   ln_NCAR    = .true.     ! "NCAR"      algorithm   (Large and Yeager 2008) 
    9898   cn_dir = './'  !  root directory for the bulk data location 
    9999   !___________!_________________________!___________________!___________!_____________!________!___________!______________________________________!__________!_______________! 
    100100   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !          weights filename            ! rotation ! land/sea mask ! 
    101101   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                                      ! pairing  !    filename   ! 
    102    sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Uwnd'   , '' 
    103    sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Vwnd'   , '' 
    104    sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    105    sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    106    sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    107    sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    108    sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    109    sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    110    sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     102   sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Uwnd'   , '' 
     103   sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Vwnd'   , '' 
     104   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     105   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     106   sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     107   sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     108   sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     109   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     110   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
    111111/ 
    112112!----------------------------------------------------------------------- 
    … …  
    125125/ 
    126126!----------------------------------------------------------------------- 
     127&namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr =T) 
     128!----------------------------------------------------------------------- 
     129   nn_sssr     =     2     !  add a damping term to the surface freshwater flux 
     130      rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day] 
     131      ln_sssr_bnd =  .true.   !  flag to bound erp term (associated with nn_sssr=2) 
     132      rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
     133/ 
     134!----------------------------------------------------------------------- 
    127135&namsbc_rnf    !   runoffs                                              (ln_rnf =T) 
    128136!----------------------------------------------------------------------- 
    … …  
    130138      rn_hrnf     =  15.e0    !  depth over which enhanced vertical mixing is used    (ln_rnf_mouth=T) 
    131139      rn_avt_rnf  =   1.e-3   !  value of the additional vertical mixing coef. [m2/s] (ln_rnf_mouth=T) 
     140   rn_rfact    =   1.e0    !  multiplicative factor for runoff 
    132141 
    133142   cn_dir = './'  !  root directory for the location of the runoff files 
    … …  
    142151/ 
    143152!----------------------------------------------------------------------- 
    144 &namsbc_ssr    !   surface boundary condition : sea surface restoring   (ln_ssr =T) 
    145 !----------------------------------------------------------------------- 
    146    nn_sssr     =     2     !  add a damping term to the surface freshwater flux 
    147       rn_deds     =  -166.67  !  magnitude of the damping on salinity   [mm/day] 
    148       ln_sssr_bnd =  .true.   !  flag to bound erp term (associated with nn_sssr=2) 
    149       rn_sssr_bnd =   4.e0    !  ABS(Max/Min) value of the damping erp term [mm/day] 
    150 / 
    151 !----------------------------------------------------------------------- 
    152 &namberg       !   iceberg parameters                                   (default: No iceberg) 
     153&namsbc_wave   ! External fields from wave model                        (ln_wave=T) 
     154!----------------------------------------------------------------------- 
     155/ 
     156!----------------------------------------------------------------------- 
     157&namberg       !   iceberg parameters                                   (default: OFF) 
    153158!----------------------------------------------------------------------- 
    154159   !  iceberg floats are not currently available with AGRIF 
    … …  
    159164!!                                                                    !! 
    160165!!   namlbc        lateral momentum boundary condition                  (default: NO selection) 
    161 !!   namagrif      agrif nested grid ( read by child model only )       ("key_agrif") 
     166!!   namagrif      agrif nested grid   (read by child model only)       ("key_agrif") 
    162167!!   nam_tide      Tidal forcing                                        (default: OFF) 
    163168!!   nambdy        Unstructured open boundaries                         (default: OFF) 
    … …  
    212217/ 
    213218!!====================================================================== 
    214 !!                        Tracer (T & S) namelists                    !! 
     219!!                        Tracer (T-S) namelists                      !! 
    215220!!                                                                    !! 
    216221!!   nameos        equation of state                                    (default: NO selection) 
    … …  
    233238      nn_fct_h   =  2               !  =2/4, horizontal 2nd / 4th order  
    234239      nn_fct_v   =  2               !  =2/4, vertical   2nd / COMPACT 4th order  
    235 / 
    236 !----------------------------------------------------------------------- 
    237 &namtra_mle    !   mixed layer eddy parametrisation (Fox-Kemper)        (default: OFF) 
    238 !----------------------------------------------------------------------- 
    239    ln_mle      = .true.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation 
    240240/ 
    241241!----------------------------------------------------------------------- 
    … …  
    255255/ 
    256256!----------------------------------------------------------------------- 
    257 &namtra_eiv !   eddy induced velocity param.                            (default: OFF) 
    258 !----------------------------------------------------------------------- 
    259    ln_ldfeiv     =.true.   ! use eddy induced velocity parameterization 
     257&namtra_mle    !   mixed layer eddy parametrisation (Fox-Kemper)        (default: OFF) 
     258!----------------------------------------------------------------------- 
     259   ln_mle      = .true.   ! (T) use the Mixed Layer Eddy (MLE) parameterisation 
     260/ 
     261!----------------------------------------------------------------------- 
     262&namtra_eiv    !   eddy induced velocity param.                         (default: OFF) 
     263!----------------------------------------------------------------------- 
     264   ln_ldfeiv   = .true.    ! use eddy induced velocity parameterization 
    260265      !                        !  Coefficients: 
    261266      nn_aei_ijk_t  = 21          ! space/time variation of the eiv coeficient 
    … …  
    286291! 
    287292!----------------------------------------------------------------------- 
    288 &nam_vvl       !   vertical coordinate options                          (default: z-star) 
    289 !----------------------------------------------------------------------- 
    290 / 
    291 !----------------------------------------------------------------------- 
    292293&namdyn_adv    !   formulation of the momentum advection                (default: NO selection) 
    293294!----------------------------------------------------------------------- 
    … …  
    334335! 
    335336!----------------------------------------------------------------------- 
    336 &namzdf        !   vertical physics                                     (default: NO selection) 
     337&namzdf        !   vertical physics manager                             (default: NO selection) 
    337338!----------------------------------------------------------------------- 
    338339   !                       ! type of vertical closure 
    … …  
    384385!!====================================================================== 
    385386! 
    386 ! 
    387387!----------------------------------------------------------------------- 
    388388&nammpp        !   Massively Parallel Processing                        ("key_mpp_mpi") 

  • NEMO/trunk/cfgs/ORCA2_ICE_PISCES/EXPREF/namelist_cfg

    r13214 r13286  
    110110   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !          weights filename            ! rotation ! land/sea mask ! 
    111111   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                                      ! pairing  !    filename   ! 
    112    sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Uwnd'   , '' 
    113    sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Vwnd'   , '' 
    114    sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    115    sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    116    sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    117    sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    118    sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    119    sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    120    sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
     112   sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Uwnd'   , '' 
     113   sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Vwnd'   , '' 
     114   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     115   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     116   sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     117   sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     118   sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     119   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     120   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
    121121/ 
    122122!----------------------------------------------------------------------- 
    … …  
    391391   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    392392   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    393    sn_mpb      = 'mixing_power_bot'      , -12               , 'field'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
    394    sn_mpp      = 'mixing_power_pyc'      , -12               , 'field'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
    395    sn_mpc      = 'mixing_power_cri'      , -12               , 'field'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
    396    sn_dsb      = 'decay_scale_bot'       , -12               , 'field'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
    397    sn_dsc      = 'decay_scale_cri'       , -12               , 'field'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
     393   sn_mpb      = 'int_wave_mix'      , -12.       , 'mixing_power_bot'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
     394   sn_mpp      = 'int_wave_mix'      , -12.       , 'mixing_power_pyc'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
     395   sn_mpc      = 'int_wave_mix'      , -12.       , 'mixing_power_cri'   , .false.  , .true. , 'yearly' , '' , ''  , '' 
     396   sn_dsb      = 'int_wave_mix'      , -12.       , 'decay_scale_bot'    , .false.  , .true. , 'yearly' , '' , ''  , '' 
     397   sn_dsc      = 'int_wave_mix'      , -12.       , 'decay_scale_cri'    , .false.  , .true. , 'yearly' , '' , ''  , '' 
    398398/ 
    399399!!====================================================================== 

  • NEMO/trunk/cfgs/ORCA2_SAS_ICE/EXPREF/namelist_cfg

    r13208 r13286  
    7373   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ !       weights filename               ! rotation ! land/sea mask ! 
    7474   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                                      ! pairing  !    filename   ! 
    75    sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Uwnd'   , '' 
    76    sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bicubic_noc.nc'  , 'Vwnd'   , '' 
    77    sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    78    sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    79    sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    80    sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    81    sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    82    sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    83    sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core_orca2_bilinear_noc.nc' , ''       , '' 
    84 / 
    85 !----------------------------------------------------------------------- 
    86 &namsbc_cpl    !   coupled ocean/atmosphere model                       ("key_oasis3") 
    87 !----------------------------------------------------------------------- 
     75   sn_wndi     = 'u_10.15JUNE2009_fill'       ,    6.        , 'U_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Uwnd'   , '' 
     76   sn_wndj     = 'v_10.15JUNE2009_fill'       ,    6.        , 'V_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bicub'  , 'Vwnd'   , '' 
     77   sn_qsr      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'SWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     78   sn_qlw      = 'ncar_rad.15JUNE2009_fill'   ,   24.        , 'LWDN_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     79   sn_tair     = 't_10.15JUNE2009_fill'       ,    6.        , 'T_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     80   sn_humi     = 'q_10.15JUNE2009_fill'       ,    6.        , 'Q_10_MOD',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     81   sn_prec     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'PRC_MOD1',   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     82   sn_snow     = 'ncar_precip.15JUNE2009_fill',   -1.        , 'SNOW'    ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
     83   sn_slp      = 'slp.15JUNE2009_fill'        ,    6.        , 'SLP'     ,   .false.   , .true. , 'yearly'  , 'weights_core2_orca2_bilin' , ''       , '' 
    8884/ 
    8985!----------------------------------------------------------------------- 

  • NEMO/trunk/cfgs/SHARED/namelist_ref

    r13216 r13286  
    12091209   !           !  file name              ! frequency (hours) ! variable  ! time interp.!  clim  ! 'yearly'/ ! weights filename ! rotation ! land/sea mask ! 
    12101210   !           !                         !  (if <0  months)  !   name    !   (logical) !  (T/F) ! 'monthly' !                  ! pairing  !    filename   ! 
    1211    sn_mpb      = 'NOT USED'              , -12               , 'mixing_power_bot' , .false.  , .true. , 'yearly' , '' , ''  , '' 
    1212    sn_mpp      = 'NOT USED'              , -12               , 'mixing_power_pyc' , .false.  , .true. , 'yearly' , '' , ''  , '' 
    1213    sn_mpc      = 'NOT USED'              , -12               , 'mixing_power_cri' , .false.  , .true. , 'yearly' , '' , ''  , '' 
    1214    sn_dsb      = 'NOT USED'              , -12               , 'decay_scale_bot'  , .false.  , .true. , 'yearly' , '' , ''  , '' 
    1215    sn_dsc      = 'NOT USED'              , -12               , 'decay_scale_cri'  , .false.  , .true. , 'yearly' , '' , ''  , '' 
     1211   sn_mpb      = 'NOT USED'              , -12.              , 'mixing_power_bot' , .false.  , .true. , 'yearly' , '' , ''  , '' 
     1212   sn_mpp      = 'NOT USED'              , -12.              , 'mixing_power_pyc' , .false.  , .true. , 'yearly' , '' , ''  , '' 
     1213   sn_mpc      = 'NOT USED'              , -12.              , 'mixing_power_cri' , .false.  , .true. , 'yearly' , '' , ''  , '' 
     1214   sn_dsb      = 'NOT USED'              , -12.              , 'decay_scale_bot'  , .false.  , .true. , 'yearly' , '' , ''  , '' 
     1215   sn_dsc      = 'NOT USED'              , -12.              , 'decay_scale_cri'  , .false.  , .true. , 'yearly' , '' , ''  , '' 
    12161216/ 
    12171217!!====================================================================== 
    … …  
    14021402   jpni        =   0       !  number of processors following i (set automatically if < 1), see also ln_listonly = T 
    14031403   jpnj        =   0       !  number of processors following j (set automatically if < 1), see also ln_listonly = T 
     1404   nn_hls      =   1       !  halo width (applies to both rows and columns) 
    14041405/ 
    14051406!----------------------------------------------------------------------- 
    … …  
    14171418   sn_cfctl%procincr  = 1         ! Increment for optional subsetting of areas [default:1] 
    14181419   sn_cfctl%ptimincr  = 1         ! Timestep increment for writing time step progress info 
    1419    nn_print    =    0             !  level of print (0 no extra print) 
    14201420   nn_ictls    =    0             !  start i indice of control sum (use to compare mono versus 
    14211421   nn_ictle    =    0             !  end   i indice of control sum        multi processor runs 

  • NEMO/trunk/cfgs/ref_cfgs.txt

    r13227 r13286  
    1111SPITZ12 OCE ICE 
    1212WED025 OCE ICE 
    13  

  • NEMO/trunk/src/ABL/ablrst.F90

    r13214 r13286  
    165165 
    166166      ! --- mandatory fields --- !  
    167       CALL iom_get( numrar, jpdom_autoglo,   'u_abl',   u_abl(:,:,:,nt_n      ) ) 
    168       CALL iom_get( numrar, jpdom_autoglo,   'v_abl',   v_abl(:,:,:,nt_n      ) ) 
    169       CALL iom_get( numrar, jpdom_autoglo,   't_abl',  tq_abl(:,:,:,nt_n,jp_ta) ) 
    170       CALL iom_get( numrar, jpdom_autoglo,   'q_abl',  tq_abl(:,:,:,nt_n,jp_qa) ) 
    171       CALL iom_get( numrar, jpdom_autoglo, 'tke_abl', tke_abl(:,:,:,nt_n      ) ) 
    172       CALL iom_get( numrar, jpdom_autoglo, 'avm_abl', avm_abl(:,:,:           ) ) 
    173       CALL iom_get( numrar, jpdom_autoglo, 'avt_abl', avt_abl(:,:,:           ) ) 
    174       CALL iom_get( numrar, jpdom_autoglo,'mxld_abl',mxld_abl(:,:,:           ) ) 
    175       CALL iom_get( numrar, jpdom_autoglo,    'pblh',    pblh(:,:             ) ) 
     167      CALL iom_get( numrar, jpdom_auto,   'u_abl',   u_abl(:,:,:,nt_n      ), cd_type = 'U', psgn = -1._wp ) 
     168      CALL iom_get( numrar, jpdom_auto,   'v_abl',   v_abl(:,:,:,nt_n      ), cd_type = 'V', psgn = -1._wp ) 
     169      CALL iom_get( numrar, jpdom_auto,   't_abl',  tq_abl(:,:,:,nt_n,jp_ta) ) 
     170      CALL iom_get( numrar, jpdom_auto,   'q_abl',  tq_abl(:,:,:,nt_n,jp_qa) ) 
     171      CALL iom_get( numrar, jpdom_auto, 'tke_abl', tke_abl(:,:,:,nt_n      ) ) 
     172      CALL iom_get( numrar, jpdom_auto, 'avm_abl', avm_abl(:,:,:           ) ) 
     173      CALL iom_get( numrar, jpdom_auto, 'avt_abl', avt_abl(:,:,:           ) ) 
     174      CALL iom_get( numrar, jpdom_auto,'mxld_abl',mxld_abl(:,:,:           ) ) 
     175      CALL iom_get( numrar, jpdom_auto,    'pblh',    pblh(:,:             ) ) 
    176176      CALL iom_delay_rst( 'READ', 'ABL', numrar )   ! read only abl delayed global communication variables 
    177177 

  • NEMO/trunk/src/ICE/icectl.F90

    r12649 r13286  
    702702      DO jl = 1, jpl 
    703703         CALL prt_ctl_info(' ') 
    704          CALL prt_ctl_info(' - Category : ', ivar1=jl) 
     704         CALL prt_ctl_info(' - Category : ', ivar=jl) 
    705705         CALL prt_ctl_info('   ~~~~~~~~~~') 
    706706         CALL prt_ctl(tab2d_1=h_i        (:,:,jl)        , clinfo1= ' h_i         : ') 
    … …  
    719719          
    720720         DO jk = 1, nlay_i 
    721             CALL prt_ctl_info(' - Layer : ', ivar1=jk) 
     721            CALL prt_ctl_info(' - Layer : ', ivar=jk) 
    722722            CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' t_i       : ') 
    723723         END DO 

  • NEMO/trunk/src/ICE/icedia.F90

    r12489 r13286  
    230230            CALL iom_get( numrir, 'frc_tembot' , frc_tembot  ) 
    231231            CALL iom_get( numrir, 'frc_sal'    , frc_sal     ) 
    232             CALL iom_get( numrir, jpdom_autoglo, 'vol_loc_ini', vol_loc_ini ) 
    233             CALL iom_get( numrir, jpdom_autoglo, 'tem_loc_ini', tem_loc_ini ) 
    234             CALL iom_get( numrir, jpdom_autoglo, 'sal_loc_ini', sal_loc_ini ) 
     232            CALL iom_get( numrir, jpdom_auto, 'vol_loc_ini', vol_loc_ini ) 
     233            CALL iom_get( numrir, jpdom_auto, 'tem_loc_ini', tem_loc_ini ) 
     234            CALL iom_get( numrir, jpdom_auto, 'sal_loc_ini', sal_loc_ini ) 
    235235         ELSE 
    236236            IF(lwp) WRITE(numout,*) 

  • NEMO/trunk/src/ICE/icedyn_adv_pra.F90

    r13226 r13286  
    772772            ! 
    773773            !                                                        ! ice thickness 
    774             CALL iom_get( numrir, jpdom_autoglo, 'sxice' , sxice  ) 
    775             CALL iom_get( numrir, jpdom_autoglo, 'syice' , syice  ) 
    776             CALL iom_get( numrir, jpdom_autoglo, 'sxxice', sxxice ) 
    777             CALL iom_get( numrir, jpdom_autoglo, 'syyice', syyice ) 
    778             CALL iom_get( numrir, jpdom_autoglo, 'sxyice', sxyice ) 
     774            CALL iom_get( numrir, jpdom_auto, 'sxice' , sxice  ) 
     775            CALL iom_get( numrir, jpdom_auto, 'syice' , syice  ) 
     776            CALL iom_get( numrir, jpdom_auto, 'sxxice', sxxice ) 
     777            CALL iom_get( numrir, jpdom_auto, 'syyice', syyice ) 
     778            CALL iom_get( numrir, jpdom_auto, 'sxyice', sxyice ) 
    779779            !                                                        ! snow thickness 
    780             CALL iom_get( numrir, jpdom_autoglo, 'sxsn'  , sxsn   ) 
    781             CALL iom_get( numrir, jpdom_autoglo, 'sysn'  , sysn   ) 
    782             CALL iom_get( numrir, jpdom_autoglo, 'sxxsn' , sxxsn  ) 
    783             CALL iom_get( numrir, jpdom_autoglo, 'syysn' , syysn  ) 
    784             CALL iom_get( numrir, jpdom_autoglo, 'sxysn' , sxysn  ) 
     780            CALL iom_get( numrir, jpdom_auto, 'sxsn'  , sxsn   ) 
     781            CALL iom_get( numrir, jpdom_auto, 'sysn'  , sysn   ) 
     782            CALL iom_get( numrir, jpdom_auto, 'sxxsn' , sxxsn  ) 
     783            CALL iom_get( numrir, jpdom_auto, 'syysn' , syysn  ) 
     784            CALL iom_get( numrir, jpdom_auto, 'sxysn' , sxysn  ) 
    785785            !                                                        ! ice concentration 
    786             CALL iom_get( numrir, jpdom_autoglo, 'sxa'   , sxa    ) 
    787             CALL iom_get( numrir, jpdom_autoglo, 'sya'   , sya    ) 
    788             CALL iom_get( numrir, jpdom_autoglo, 'sxxa'  , sxxa   ) 
    789             CALL iom_get( numrir, jpdom_autoglo, 'syya'  , syya   ) 
    790             CALL iom_get( numrir, jpdom_autoglo, 'sxya'  , sxya   ) 
     786            CALL iom_get( numrir, jpdom_auto, 'sxa'   , sxa    ) 
     787            CALL iom_get( numrir, jpdom_auto, 'sya'   , sya    ) 
     788            CALL iom_get( numrir, jpdom_auto, 'sxxa'  , sxxa   ) 
     789            CALL iom_get( numrir, jpdom_auto, 'syya'  , syya   ) 
     790            CALL iom_get( numrir, jpdom_auto, 'sxya'  , sxya   ) 
    791791            !                                                        ! ice salinity 
    792             CALL iom_get( numrir, jpdom_autoglo, 'sxsal' , sxsal  ) 
    793             CALL iom_get( numrir, jpdom_autoglo, 'sysal' , sysal  ) 
    794             CALL iom_get( numrir, jpdom_autoglo, 'sxxsal', sxxsal ) 
    795             CALL iom_get( numrir, jpdom_autoglo, 'syysal', syysal ) 
    796             CALL iom_get( numrir, jpdom_autoglo, 'sxysal', sxysal ) 
     792            CALL iom_get( numrir, jpdom_auto, 'sxsal' , sxsal  ) 
     793            CALL iom_get( numrir, jpdom_auto, 'sysal' , sysal  ) 
     794            CALL iom_get( numrir, jpdom_auto, 'sxxsal', sxxsal ) 
     795            CALL iom_get( numrir, jpdom_auto, 'syysal', syysal ) 
     796            CALL iom_get( numrir, jpdom_auto, 'sxysal', sxysal ) 
    797797            !                                                        ! ice age 
    798             CALL iom_get( numrir, jpdom_autoglo, 'sxage' , sxage  ) 
    799             CALL iom_get( numrir, jpdom_autoglo, 'syage' , syage  ) 
    800             CALL iom_get( numrir, jpdom_autoglo, 'sxxage', sxxage ) 
    801             CALL iom_get( numrir, jpdom_autoglo, 'syyage', syyage ) 
    802             CALL iom_get( numrir, jpdom_autoglo, 'sxyage', sxyage ) 
     798            CALL iom_get( numrir, jpdom_auto, 'sxage' , sxage  ) 
     799            CALL iom_get( numrir, jpdom_auto, 'syage' , syage  ) 
     800            CALL iom_get( numrir, jpdom_auto, 'sxxage', sxxage ) 
     801            CALL iom_get( numrir, jpdom_auto, 'syyage', syyage ) 
     802            CALL iom_get( numrir, jpdom_auto, 'sxyage', sxyage ) 
    803803            !                                                        ! snow layers heat content 
    804804            DO jk = 1, nlay_s 
    805805               WRITE(zchar1,'(I2.2)') jk 
    806                znam = 'sxc0'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxc0 (:,:,jk,:) = z3d(:,:,:) 
    807                znam = 'syc0'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   syc0 (:,:,jk,:) = z3d(:,:,:) 
    808                znam = 'sxxc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxxc0(:,:,jk,:) = z3d(:,:,:) 
    809                znam = 'syyc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   syyc0(:,:,jk,:) = z3d(:,:,:) 
    810                znam = 'sxyc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxyc0(:,:,jk,:) = z3d(:,:,:) 
     806               znam = 'sxc0'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxc0 (:,:,jk,:) = z3d(:,:,:) 
     807               znam = 'syc0'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   syc0 (:,:,jk,:) = z3d(:,:,:) 
     808               znam = 'sxxc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxxc0(:,:,jk,:) = z3d(:,:,:) 
     809               znam = 'syyc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   syyc0(:,:,jk,:) = z3d(:,:,:) 
     810               znam = 'sxyc0'//'_l'//zchar1 ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxyc0(:,:,jk,:) = z3d(:,:,:) 
    811811            END DO 
    812812            !                                                        ! ice layers heat content 
    813813            DO jk = 1, nlay_i 
    814814               WRITE(zchar1,'(I2.2)') jk 
    815                znam = 'sxe'//'_l'//zchar1   ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxe (:,:,jk,:) = z3d(:,:,:) 
    816                znam = 'sye'//'_l'//zchar1   ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sye (:,:,jk,:) = z3d(:,:,:) 
    817                znam = 'sxxe'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxxe(:,:,jk,:) = z3d(:,:,:) 
    818                znam = 'syye'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   syye(:,:,jk,:) = z3d(:,:,:) 
    819                znam = 'sxye'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_autoglo, znam , z3d )   ;   sxye(:,:,jk,:) = z3d(:,:,:) 
     815               znam = 'sxe'//'_l'//zchar1   ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxe (:,:,jk,:) = z3d(:,:,:) 
     816               znam = 'sye'//'_l'//zchar1   ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sye (:,:,jk,:) = z3d(:,:,:) 
     817               znam = 'sxxe'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxxe(:,:,jk,:) = z3d(:,:,:) 
     818               znam = 'syye'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   syye(:,:,jk,:) = z3d(:,:,:) 
     819               znam = 'sxye'//'_l'//zchar1  ;   CALL iom_get( numrir, jpdom_auto, znam , z3d )   ;   sxye(:,:,jk,:) = z3d(:,:,:) 
    820820            END DO 
    821821            ! 
    822822            IF( ln_pnd_H12 ) THEN                                    ! melt pond fraction 
    823                CALL iom_get( numrir, jpdom_autoglo, 'sxap' , sxap  ) 
    824                CALL iom_get( numrir, jpdom_autoglo, 'syap' , syap  ) 
    825                CALL iom_get( numrir, jpdom_autoglo, 'sxxap', sxxap ) 
    826                CALL iom_get( numrir, jpdom_autoglo, 'syyap', syyap ) 
    827                CALL iom_get( numrir, jpdom_autoglo, 'sxyap', sxyap ) 
     823               CALL iom_get( numrir, jpdom_auto, 'sxap' , sxap  ) 
     824               CALL iom_get( numrir, jpdom_auto, 'syap' , syap  ) 
     825               CALL iom_get( numrir, jpdom_auto, 'sxxap', sxxap ) 
     826               CALL iom_get( numrir, jpdom_auto, 'syyap', syyap ) 
     827               CALL iom_get( numrir, jpdom_auto, 'sxyap', sxyap ) 
    828828               !                                                     ! melt pond volume 
    829                CALL iom_get( numrir, jpdom_autoglo, 'sxvp' , sxvp  ) 
    830                CALL iom_get( numrir, jpdom_autoglo, 'syvp' , syvp  ) 
    831                CALL iom_get( numrir, jpdom_autoglo, 'sxxvp', sxxvp ) 
    832                CALL iom_get( numrir, jpdom_autoglo, 'syyvp', syyvp ) 
    833                CALL iom_get( numrir, jpdom_autoglo, 'sxyvp', sxyvp ) 
     829               CALL iom_get( numrir, jpdom_auto, 'sxvp' , sxvp  ) 
     830               CALL iom_get( numrir, jpdom_auto, 'syvp' , syvp  ) 
     831               CALL iom_get( numrir, jpdom_auto, 'sxxvp', sxxvp ) 
     832               CALL iom_get( numrir, jpdom_auto, 'syyvp', syyvp ) 
     833               CALL iom_get( numrir, jpdom_auto, 'sxyvp', sxyvp ) 
    834834            ENDIF 
    835835            ! 

  • NEMO/trunk/src/ICE/icedyn_rhg_evp.F90

    r13237 r13286  
    845845            ! 
    846846            IF( MIN( id1, id2, id3 ) > 0 ) THEN      ! fields exist 
    847                CALL iom_get( numrir, jpdom_autoglo, 'stress1_i' , stress1_i ) 
    848                CALL iom_get( numrir, jpdom_autoglo, 'stress2_i' , stress2_i ) 
    849                CALL iom_get( numrir, jpdom_autoglo, 'stress12_i', stress12_i ) 
     847               CALL iom_get( numrir, jpdom_auto, 'stress1_i' , stress1_i , cd_type = 'T' ) 
     848               CALL iom_get( numrir, jpdom_auto, 'stress2_i' , stress2_i , cd_type = 'T' ) 
     849               CALL iom_get( numrir, jpdom_auto, 'stress12_i', stress12_i, cd_type = 'F' ) 
    850850            ELSE                                     ! start rheology from rest 
    851851               IF(lwp) WRITE(numout,*) 

  • NEMO/trunk/src/ICE/icerst.F90

    r12649 r13286  
    211211 
    212212         ! --- mandatory fields --- !  
    213          CALL iom_get( numrir, jpdom_autoglo, 'v_i'  , v_i   ) 
    214          CALL iom_get( numrir, jpdom_autoglo, 'v_s'  , v_s   ) 
    215          CALL iom_get( numrir, jpdom_autoglo, 'sv_i' , sv_i  ) 
    216          CALL iom_get( numrir, jpdom_autoglo, 'a_i'  , a_i   ) 
    217          CALL iom_get( numrir, jpdom_autoglo, 't_su' , t_su  ) 
    218          CALL iom_get( numrir, jpdom_autoglo, 'u_ice', u_ice ) 
    219          CALL iom_get( numrir, jpdom_autoglo, 'v_ice', v_ice ) 
     213         CALL iom_get( numrir, jpdom_auto, 'v_i'  , v_i   ) 
     214         CALL iom_get( numrir, jpdom_auto, 'v_s'  , v_s   ) 
     215         CALL iom_get( numrir, jpdom_auto, 'sv_i' , sv_i  ) 
     216         CALL iom_get( numrir, jpdom_auto, 'a_i'  , a_i   ) 
     217         CALL iom_get( numrir, jpdom_auto, 't_su' , t_su  ) 
     218         CALL iom_get( numrir, jpdom_auto, 'u_ice', u_ice, cd_type = 'U', psgn = -1._wp ) 
     219         CALL iom_get( numrir, jpdom_auto, 'v_ice', v_ice, cd_type = 'V', psgn = -1._wp ) 
    220220         ! Snow enthalpy 
    221221         DO jk = 1, nlay_s 
    222222            WRITE(zchar1,'(I2.2)') jk 
    223223            znam = 'e_s'//'_l'//zchar1 
    224             CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     224            CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
    225225            e_s(:,:,jk,:) = z3d(:,:,:) 
    226226         END DO 
    … …  
    229229            WRITE(zchar1,'(I2.2)') jk 
    230230            znam = 'e_i'//'_l'//zchar1 
    231             CALL iom_get( numrir, jpdom_autoglo, znam , z3d ) 
     231            CALL iom_get( numrir, jpdom_auto, znam , z3d ) 
    232232            e_i(:,:,jk,:) = z3d(:,:,:) 
    233233         END DO 
    … …  
    236236         id1 = iom_varid( numrir, 'oa_i' , ldstop = .FALSE. ) 
    237237         IF( id1 > 0 ) THEN                       ! fields exist 
    238             CALL iom_get( numrir, jpdom_autoglo, 'oa_i', oa_i ) 
     238            CALL iom_get( numrir, jpdom_auto, 'oa_i', oa_i ) 
    239239         ELSE                                     ! start from rest 
    240240            IF(lwp) WRITE(numout,*) '   ==>>   previous run without ice age output then set it to zero' 
    … …  
    244244         id2 = iom_varid( numrir, 'a_ip' , ldstop = .FALSE. ) 
    245245         IF( id2 > 0 ) THEN                       ! fields exist 
    246             CALL iom_get( numrir, jpdom_autoglo, 'a_ip' , a_ip ) 
    247             CALL iom_get( numrir, jpdom_autoglo, 'v_ip' , v_ip ) 
     246            CALL iom_get( numrir, jpdom_auto, 'a_ip' , a_ip ) 
     247            CALL iom_get( numrir, jpdom_auto, 'v_ip' , v_ip ) 
    248248         ELSE                                     ! start from rest 
    249249            IF(lwp) WRITE(numout,*) '   ==>>   previous run without melt ponds output then set it to zero' 
    … …  
    256256            id4 = iom_varid( numrir, 't1_ice'  , ldstop = .FALSE. ) 
    257257            IF( id3 > 0 .AND. id4 > 0 ) THEN         ! fields exist 
    258                CALL iom_get( numrir, jpdom_autoglo, 'cnd_ice', cnd_ice ) 
    259                CALL iom_get( numrir, jpdom_autoglo, 't1_ice' , t1_ice  ) 
     258               CALL iom_get( numrir, jpdom_auto, 'cnd_ice', cnd_ice ) 
     259               CALL iom_get( numrir, jpdom_auto, 't1_ice' , t1_ice  ) 
    260260            ELSE                                     ! start from rest 
    261261               IF(lwp) WRITE(numout,*) '   ==>>   previous run without conductivity output then set it to zero' 

  • NEMO/trunk/src/ICE/iceupdate.F90

    r13226 r13286  
    417417            ! 
    418418            IF( id1 > 0 ) THEN                       ! fields exist 
    419                CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass'  , snwice_mass   ) 
    420                CALL iom_get( numrir, jpdom_autoglo, 'snwice_mass_b', snwice_mass_b ) 
     419               CALL iom_get( numrir, jpdom_auto, 'snwice_mass'  , snwice_mass   ) 
     420               CALL iom_get( numrir, jpdom_auto, 'snwice_mass_b', snwice_mass_b ) 
    421421            ELSE                                     ! start from rest 
    422422               IF(lwp) WRITE(numout,*) '   ==>>   previous run without snow-ice mass output then set it' 

  • NEMO/trunk/src/NST/agrif_ice_interp.F90

    r13216 r13286  
    269269!            imin = i1  ;  imax = i2  ;  jmin = j1  ;  jmax = j2 
    270270!            IF( (nbondj == -1) .OR. (nbondj == 2) )   jmin = 3 
    271 !            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = nlcj-2 
     271!            IF( (nbondj == +1) .OR. (nbondj == 2) )   jmax = jpj-2 
    272272!            IF( (nbondi == -1) .OR. (nbondi == 2) )   imin = 3 
    273 !            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = nlci-2 
     273!            IF( (nbondi == +1) .OR. (nbondi == 2) )   imax = jpi-2 
    274274! 
    275275!            ! smoothed fields 
    276276!            IF( eastern_side ) THEN 
    277 !               ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 
     277!               ztab(jpi,j1:j2,:) = z1 * ptab(jpi,j1:j2,:) + z2 * ptab(jpi-1,j1:j2,:) 
    278278!               DO jj = jmin, jmax 
    279279!                  rswitch = 0. 
    280 !                  IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 
    281 !                  ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:)  & 
    282 !                     &                +      umask(nlci-2,jj,1)   *  & 
    283 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:)   + z3 * ztab(nlci-2,jj,:) )  & 
    284 !                     &                  +      rswitch   * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 
    285 !                  ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 
     280!                  IF( u_ice(jpi-2,jj) > 0._wp ) rswitch = 1. 
     281!                  ztab(jpi-1,jj,:) = ( 1. - umask(jpi-2,jj,1) ) * ztab(jpi,jj,:)  & 
     282!                     &               +      umask(jpi-2,jj,1)   *  & 
     283!                     &               ( (1. - rswitch) * ( z4 * ztab(jpi  ,jj,:) + z3 * ztab(jpi-2,jj,:) )  & 
     284!                     &                 +     rswitch  * ( z6 * ztab(jpi-2,jj,:) + z5 * ztab(jpi  ,jj,:) + z7 * ztab(jpi-3,jj,:) ) ) 
     285!                  ztab(jpi-1,jj,:) = ztab(jpi-1,jj,:) * tmask(jpi-1,jj,1) 
    286286!               END DO 
    287287!            ENDIF 
    288288!            !  
    289289!            IF( northern_side ) THEN 
    290 !               ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 
     290!               ztab(i1:i2,jpj,:) = z1 * ptab(i1:i2,jpj,:) + z2 * ptab(i1:i2,jpj-1,:) 
    291291!               DO ji = imin, imax 
    292292!                  rswitch = 0. 
    293 !                  IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 
    294 !                  ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:)  & 
    295 !                     &                +      vmask(ji,nlcj-2,1)   *  & 
    296 !                     &                ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:)   + z3 * ztab(ji,nlcj-2,:) ) & 
    297 !                     &                  +      rswitch   * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 
    298 !                  ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 
     293!                  IF( v_ice(ji,jpj-2) > 0._wp ) rswitch = 1. 
     294!                  ztab(ji,jpj-1,:) = ( 1. - vmask(ji,jpj-2,1) ) * ztab(ji,jpj,:)  & 
     295!                     &               +      vmask(ji,jpj-2,1)   *  & 
     296!                     &               ( (1. - rswitch) * ( z4 * ztab(ji,jpj  ,:) + z3 * ztab(ji,jpj-2,:) ) & 
     297!                     &                 +     rswitch  * ( z6 * ztab(ji,jpj-2,:) + z5 * ztab(ji,jpj  ,:) + z7 * ztab(ji,jpj-3,:) ) ) 
     298!                  ztab(ji,jpj-1,:) = ztab(ji,jpj-1,:) * tmask(ji,jpj-1,1) 
    299299!               END DO 
    300300!            END IF 
    … …  
    327327!            ! 
    328328!            ! Treatment of corners 
    329 !            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(nlci-1,2,:)      = ptab(nlci-1,2,:)      ! East south 
    330 !            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 
    331 !            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(2,2,:)           = ptab(2,2,:)           ! West south 
    332 !            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(2,nlcj-1,:)      = ptab(2,nlcj-1,:)      ! West north 
     329!            IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(jpi-1,2    ,:) = ptab(jpi-1,    2,:)   ! East south 
     330!            IF( (eastern_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(jpi-1,jpj-1,:) = ptab(jpi-1,jpj-1,:)  ! East north 
     331!            IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) )  ztab(    2,    2,:) = ptab(    2,    2,:)   ! West south 
     332!            IF( (western_side) .AND. ((nbondj ==  1).OR.(nbondj == 2)) )  ztab(    2,jpj-1,:) = ptab(    2,jpj-1,:)   ! West north 
    333333!             
    334334!            ! retrieve ice tracers 

  • NEMO/trunk/src/NST/agrif_oce.F90

    r13216 r13286  
    6868   INTEGER, PUBLIC :: avt_id, avm_id, en_id                ! TKE related identificators 
    6969   INTEGER, PUBLIC :: mbkt_id, ht0_id 
     70   INTEGER, PUBLIC :: glamt_id, gphit_id 
    7071   INTEGER, PUBLIC :: kindic_agr 
    7172 

  • NEMO/trunk/src/NST/agrif_oce_interp.F90

    r13216 r13286  
    4444   PUBLIC   interptsn, interpsshn, interpavm 
    4545   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    46    PUBLIC   interpe3t 
     46   PUBLIC   interpe3t, interpglamt, interpgphit 
    4747   PUBLIC   interpht0, interpmbkt 
    4848   PUBLIC   agrif_initts, agrif_initssh 
    … …  
    8787      IF( Agrif_Root() )   RETURN 
    8888      ! 
    89       Agrif_SpecialValue    = 0._wp 
     89      Agrif_SpecialValue    = 0.0_wp 
    9090      Agrif_UseSpecialValue = ln_spc_dyn 
    9191      ! 
    9292      use_sign_north = .TRUE. 
    93       sign_north = -1. 
     93      sign_north = -1.0_wp 
    9494      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
    9595      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
    … …  
    100100      ! --- West --- ! 
    101101      IF( lk_west ) THEN 
    102          ibdy1 = 2 
    103          ibdy2 = 1+nbghostcells  
     102         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     103         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    104104         ! 
    105105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    106106            DO ji = mi0(ibdy1), mi1(ibdy2) 
    107107               uu_b(ji,:,Krhs_a) = 0._wp 
    108  
    109108               DO jk = 1, jpkm1 
    110109                  DO jj = 1, jpj 
    … …  
    112111                  END DO 
    113112               END DO 
    114  
    115113               DO jj = 1, jpj 
    116114                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    … …  
    123121            DO jk = 1, jpkm1 
    124122               DO jj = 1, jpj 
    125                   zub(ji,jj) = zub(ji,jj) &  
    126                      & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
     123                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    127124               END DO 
    128125            END DO 
    129126            DO jj=1,jpj 
    130127               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    131             END DO 
    132                 
     128            END DO  
    133129            DO jk = 1, jpkm1 
    134130               DO jj = 1, jpj 
    135                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a)-zub(ji,jj)) * umask(ji,jj,jk) 
    136                END DO 
    137             END DO 
    138          END DO 
    139                 
     131                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     132               END DO 
     133            END DO 
     134         END DO 
     135         !    
    140136         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    141137            DO ji = mi0(ibdy1), mi1(ibdy2) 
    … …  
    151147               DO jk = 1, jpkm1 
    152148                  DO jj = 1, jpj 
    153                      vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a)-zvb(ji,jj))*vmask(ji,jj,jk) 
     149                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk) 
    154150                  END DO 
    155151               END DO 
    156152            END DO 
    157153         ENDIF 
     154         ! 
    158155      ENDIF 
    159156 
    160157      ! --- East --- ! 
    161158      IF( lk_east) THEN 
    162          ibdy1 = jpiglo-1-nbghostcells 
    163          ibdy2 = jpiglo-2  
     159         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     160         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    164161         ! 
    165162         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    168165               DO jk = 1, jpkm1 
    169166                  DO jj = 1, jpj 
    170                      uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
    171                          & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     167                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    172168                  END DO 
    173169               END DO 
    … …  
    182178            DO jk = 1, jpkm1 
    183179               DO jj = 1, jpj 
    184                   zub(ji,jj) = zub(ji,jj) &  
    185                      & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     180                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    186181               END DO 
    187182            END DO 
    … …  
    189184               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    190185            END DO 
    191                 
    192186            DO jk = 1, jpkm1 
    193187               DO jj = 1, jpj 
    194                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    195                     & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 
    196                END DO 
    197             END DO 
    198          END DO 
    199                 
     188                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     189               END DO 
     190            END DO 
     191         END DO 
     192         ! 
    200193         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    201             ibdy1 = jpiglo-nbghostcells 
    202             ibdy2 = jpiglo-1  
     194            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     195            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    203196            DO ji = mi0(ibdy1), mi1(ibdy2) 
    204197               zvb(ji,:) = 0._wp 
    205198               DO jk = 1, jpkm1 
    206199                  DO jj = 1, jpj 
    207                      zvb(ji,jj) = zvb(ji,jj) & 
    208                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     200                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    209201                  END DO 
    210202               END DO 
    … …  
    214206               DO jk = 1, jpkm1 
    215207                  DO jj = 1, jpj 
    216                      vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    217                          & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
     208                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    218209                  END DO 
    219210               END DO 
    220211            END DO 
    221212         ENDIF 
     213         ! 
    222214      ENDIF 
    223215 
    224216      ! --- South --- ! 
    225217      IF( lk_south ) THEN 
    226          jbdy1 = 2 
    227          jbdy2 = 1+nbghostcells  
     218         jbdy1 = nn_hls + 2                  ! halo + land + 1 
     219         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    228220         ! 
    229221         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    232224               DO jk = 1, jpkm1 
    233225                  DO ji = 1, jpi 
    234                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    235                          & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     226                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    236227                  END DO 
    237228               END DO 
    … …  
    246237            DO jk=1,jpkm1 
    247238               DO ji=1,jpi 
    248                   zvb(ji,jj) = zvb(ji,jj) &  
    249                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     239                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    250240               END DO 
    251241            END DO 
    … …  
    253243               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    254244            END DO 
    255  
    256245            DO jk = 1, jpkm1 
    257246               DO ji = 1, jpi 
    258                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    259                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    260                END DO 
    261             END DO 
    262          END DO 
    263                 
     247                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     248               END DO 
     249            END DO 
     250         END DO 
     251         ! 
    264252         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    265253            DO jj = mj0(jbdy1), mj1(jbdy2) 
    … …  
    267255               DO jk = 1, jpkm1 
    268256                  DO ji = 1, jpi 
    269                      zub(ji,jj) = zub(ji,jj) &  
    270                         & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     257                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    271258                  END DO 
    272259               END DO 
    … …  
    274261                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    275262               END DO 
    276                    
    277263               DO jk = 1, jpkm1 
    278264                  DO ji = 1, jpi 
    279                      uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    280                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     265                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    281266                  END DO 
    282267               END DO 
    283268            END DO 
    284269         ENDIF 
     270         ! 
    285271      ENDIF 
    286272 
    287273      ! --- North --- ! 
    288274      IF( lk_north ) THEN 
    289          jbdy1 = jpjglo-1-nbghostcells 
    290          jbdy2 = jpjglo-2  
     275         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     276         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    291277         ! 
    292278         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    … …  
    295281               DO jk = 1, jpkm1 
    296282                  DO ji = 1, jpi 
    297                      vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    298                          & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     283                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    299284                  END DO 
    300285               END DO 
    … …  
    309294            DO jk=1,jpkm1 
    310295               DO ji=1,jpi 
    311                   zvb(ji,jj) = zvb(ji,jj) &  
    312                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     296                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    313297               END DO 
    314298            END DO 
    … …  
    316300               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    317301            END DO 
    318  
    319302            DO jk = 1, jpkm1 
    320303               DO ji = 1, jpi 
    321                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    322                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    323                END DO 
    324             END DO 
    325          END DO 
    326                 
     304                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     305               END DO 
     306            END DO 
     307         END DO 
     308         ! 
    327309         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    328             jbdy1 = jpjglo-nbghostcells 
    329             jbdy2 = jpjglo-1 
     310            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     311            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
    330312            DO jj = mj0(jbdy1), mj1(jbdy2) 
    331313               zub(:,jj) = 0._wp 
    332314               DO jk = 1, jpkm1 
    333315                  DO ji = 1, jpi 
    334                      zub(ji,jj) = zub(ji,jj) &  
    335                         & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     316                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    336317                  END DO 
    337318               END DO 
    … …  
    339320                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    340321               END DO 
    341                    
    342322               DO jk = 1, jpkm1 
    343323                  DO ji = 1, jpi 
    344                      uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    345                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     324                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    346325                  END DO 
    347326               END DO 
    348327            END DO 
    349328         ENDIF 
     329         ! 
    350330      ENDIF 
    351331      ! 
    … …  
    367347      !--- West ---! 
    368348      IF( lk_west ) THEN 
    369          istart = 2 
    370          iend   = nbghostcells+1 
     349         istart = nn_hls + 2                              ! halo + land + 1 
     350         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    371351         DO ji = mi0(istart), mi1(iend) 
    372352            DO jj=1,jpj 
    … …  
    379359      !--- East ---! 
    380360      IF( lk_east ) THEN 
    381          istart = jpiglo-nbghostcells 
    382          iend   = jpiglo-1 
     361         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     362         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    383363         DO ji = mi0(istart), mi1(iend) 
    384364 
    … …  
    387367            END DO 
    388368         END DO 
    389          istart = jpiglo-nbghostcells-1 
    390          iend   = jpiglo-2 
     369         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     370         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    391371         DO ji = mi0(istart), mi1(iend) 
    392372            DO jj=1,jpj 
    … …  
    398378      !--- South ---! 
    399379      IF( lk_south ) THEN 
    400          jstart = 2 
    401          jend   = nbghostcells+1 
     380         jstart = nn_hls + 2                              ! halo + land + 1 
     381         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    402382         DO jj = mj0(jstart), mj1(jend) 
    403383 
    … …  
    411391      !--- North ---! 
    412392      IF( lk_north ) THEN 
    413          jstart = jpjglo-nbghostcells 
    414          jend   = jpjglo-1 
     393         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     394         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    415395         DO jj = mj0(jstart), mj1(jend) 
    416396            DO ji=1,jpi 
    … …  
    418398            END DO 
    419399         END DO 
    420          jstart = jpjglo-nbghostcells-1 
    421          jend   = jpjglo-2 
     400         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     401         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    422402         DO jj = mj0(jstart), mj1(jend) 
    423403            DO ji=1,jpi 
    … …  
    429409   END SUBROUTINE Agrif_dyn_ts 
    430410 
     411    
    431412   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 
    432413      !!---------------------------------------------------------------------- 
    … …  
    444425      !--- West ---! 
    445426      IF( lk_west ) THEN 
    446          istart = 2 
    447          iend   = nbghostcells+1 
     427         istart = nn_hls + 2                              ! halo + land + 1 
     428         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    448429         DO ji = mi0(istart), mi1(iend) 
    449430            DO jj=1,jpj 
    … …  
    456437      !--- East ---! 
    457438      IF( lk_east ) THEN 
    458          istart = jpiglo-nbghostcells 
    459          iend   = jpiglo-1 
     439         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     440         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    460441         DO ji = mi0(istart), mi1(iend) 
    461442            DO jj=1,jpj 
    … …  
    463444            END DO 
    464445         END DO 
    465          istart = jpiglo-nbghostcells-1 
    466          iend   = jpiglo-2 
     446         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     447         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    467448         DO ji = mi0(istart), mi1(iend) 
    468449            DO jj=1,jpj 
    … …  
    474455      !--- South ---! 
    475456      IF( lk_south ) THEN 
    476          jstart = 2 
    477          jend   = nbghostcells+1 
     457         jstart = nn_hls + 2                              ! halo + land + 1 
     458         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    478459         DO jj = mj0(jstart), mj1(jend) 
    479460            DO ji=1,jpi 
    … …  
    486467      !--- North ---! 
    487468      IF( lk_north ) THEN 
    488          jstart = jpjglo-nbghostcells 
    489          jend   = jpjglo-1 
     469         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     470         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    490471         DO jj = mj0(jstart), mj1(jend) 
    491472            DO ji=1,jpi 
    … …  
    493474            END DO 
    494475         END DO 
    495          jstart = jpjglo-nbghostcells-1 
    496          jend   = jpjglo-2 
     476         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     477         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    497478         DO jj = mj0(jstart), mj1(jend) 
    498479            DO ji=1,jpi 
    … …  
    504485   END SUBROUTINE Agrif_dyn_ts_flux 
    505486 
     487    
    506488   SUBROUTINE Agrif_dta_ts( kt ) 
    507489      !!---------------------------------------------------------------------- 
    … …  
    578560      ! --- West --- ! 
    579561      IF(lk_west) THEN 
    580          istart = 2 
    581          iend   = 1 + nbghostcells 
     562         istart = nn_hls + 2                              ! halo + land + 1 
     563         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    582564         DO ji = mi0(istart), mi1(iend) 
    583565            DO jj = 1, jpj 
    584566               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    585             ENDDO 
    586          ENDDO 
     567            END DO 
     568         END DO 
    587569      ENDIF 
    588570      ! 
    589571      ! --- East --- ! 
    590572      IF(lk_east) THEN 
    591          istart = jpiglo - nbghostcells 
    592          iend   = jpiglo - 1 
     573         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     574         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    593575         DO ji = mi0(istart), mi1(iend) 
    594576            DO jj = 1, jpj 
    595577               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    596             ENDDO 
    597          ENDDO 
     578            END DO 
     579         END DO 
    598580      ENDIF 
    599581      ! 
    600582      ! --- South --- ! 
    601583      IF(lk_south) THEN 
    602          jstart = 2 
    603          jend   = 1 + nbghostcells 
     584         jstart = nn_hls + 2                              ! halo + land + 1 
     585         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    604586         DO jj = mj0(jstart), mj1(jend) 
    605587            DO ji = 1, jpi 
    606588               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    607             ENDDO 
    608          ENDDO 
     589            END DO 
     590         END DO 
    609591      ENDIF 
    610592      ! 
    611593      ! --- North --- ! 
    612594      IF(lk_north) THEN 
    613          jstart = jpjglo - nbghostcells 
    614          jend   = jpjglo - 1 
     595         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     596         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    615597         DO jj = mj0(jstart), mj1(jend) 
    616598            DO ji = 1, jpi 
    617599               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    618             ENDDO 
    619          ENDDO 
     600            END DO 
     601         END DO 
    620602      ENDIF 
    621603      ! 
    … …  
    637619      ! --- West --- ! 
    638620      IF(lk_west) THEN 
    639          istart = 2 
    640          iend   = 1+nbghostcells 
     621         istart = nn_hls + 2                              ! halo + land + 1 
     622         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    641623         DO ji = mi0(istart), mi1(iend) 
    642624            DO jj = 1, jpj 
    643625               ssha_e(ji,jj) = hbdy(ji,jj) 
    644             ENDDO 
    645          ENDDO 
     626            END DO 
     627         END DO 
    646628      ENDIF 
    647629      ! 
    648630      ! --- East --- ! 
    649631      IF(lk_east) THEN 
    650          istart = jpiglo - nbghostcells 
    651          iend   = jpiglo - 1 
     632         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     633         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    652634         DO ji = mi0(istart), mi1(iend) 
    653635            DO jj = 1, jpj 
    654636               ssha_e(ji,jj) = hbdy(ji,jj) 
    655             ENDDO 
    656          ENDDO 
     637            END DO 
     638         END DO 
    657639      ENDIF 
    658640      ! 
    659641      ! --- South --- ! 
    660642      IF(lk_south) THEN 
    661          jstart = 2 
    662          jend   = 1+nbghostcells 
     643         jstart = nn_hls + 2                              ! halo + land + 1 
     644         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    663645         DO jj = mj0(jstart), mj1(jend) 
    664646            DO ji = 1, jpi 
    665647               ssha_e(ji,jj) = hbdy(ji,jj) 
    666             ENDDO 
    667          ENDDO 
     648            END DO 
     649         END DO 
    668650      ENDIF 
    669651      ! 
    670652      ! --- North --- ! 
    671653      IF(lk_north) THEN 
    672          jstart = jpjglo - nbghostcells 
    673          jend   = jpjglo - 1 
     654         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     655         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    674656         DO jj = mj0(jstart), mj1(jend) 
    675657            DO ji = 1, jpi 
    676658               ssha_e(ji,jj) = hbdy(ji,jj) 
    677             ENDDO 
    678          ENDDO 
     659            END DO 
     660         END DO 
    679661      ENDIF 
    680662      ! 
    681663   END SUBROUTINE Agrif_ssh_ts 
    682664 
     665    
    683666   SUBROUTINE Agrif_avm 
    684667      !!---------------------------------------------------------------------- 
    … …  
    701684      ! 
    702685   END SUBROUTINE Agrif_avm 
    703     
     686 
    704687 
    705688   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    … …  
    793776                  DO jk=2,N_in 
    794777                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    795                   ENDDO 
     778                  END DO 
    796779 
    797780                  N_out = 0 
    … …  
    800783                     N_out = N_out + 1 
    801784                     h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
    802                   ENDDO 
     785                  END DO 
    803786 
    804787                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 
    805788                  DO jk=2,N_out 
    806789                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
    807                   ENDDO 
     790                  END DO 
    808791 
    809792                  IF (N_in*N_out > 0) THEN 
    … …  
    816799                     ENDIF 
    817800                  ENDIF 
    818                ENDDO 
    819             ENDDO 
     801               END DO 
     802            END DO 
    820803            Krhs_a = item 
    821804  
    … …  
    831814   END SUBROUTINE interptsn 
    832815 
     816    
    833817   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 
    834818      !!---------------------------------------------------------------------- 
    … …  
    849833   END SUBROUTINE interpsshn 
    850834 
     835    
    851836   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    852837      !!---------------------------------------------------------------------- 
    … …  
    934919                     tabin(jk) = 0. 
    935920                     ENDIF 
    936                  ENDDO 
     921                 END DO 
    937922                 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj)  
    938923                 DO jk=2,N_in 
    939924                    z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    940                  ENDDO 
     925                 END DO 
    941926                      
    942927                 N_out = 0 
    … …  
    945930                    N_out = N_out + 1 
    946931                    h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 
    947                  ENDDO 
     932                 END DO 
    948933 
    949934                 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 
    950935                 DO jk=2,N_out 
    951936                    z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk)  
    952                  ENDDO   
     937                 END DO   
    953938 
    954939                 IF (N_in*N_out > 0) THEN 
    … …  
    959944                     ENDIF    
    960945                 ENDIF 
    961                ENDDO 
    962             ENDDO 
     946               END DO 
     947            END DO 
    963948         ELSE 
    964949            DO jk = 1, jpkm1 
    … …  
    973958   END SUBROUTINE interpun 
    974959 
     960    
    975961   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    976962      !!---------------------------------------------------------------------- 
    … …  
    10551041                       tabin(jk)  = 0. 
    10561042                     ENDIF  
    1057                   ENDDO 
     1043                  END DO 
    10581044 
    10591045                  z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 
    10601046                  DO jk=2,N_in 
    10611047                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
    1062                   ENDDO 
     1048                  END DO 
    10631049 
    10641050                  N_out = 0 
    … …  
    10671053                     N_out = N_out + 1 
    10681054                     h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 
    1069                   ENDDO 
     1055                  END DO 
    10701056 
    10711057                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 
    10721058                  DO jk=2,N_out 
    10731059                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
    1074                   ENDDO 
     1060                  END DO 
    10751061  
    10761062                  IF (N_in*N_out > 0) THEN 
    … …  
    12861272                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
    12871273                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
    1288                      &                 ji+nimpp-1, jj+njmpp-1, jk 
    1289                      kindic_agr = kindic_agr + 1 
     1274                     &                 mig0(ji), mig0(jj), jk 
     1275                !     kindic_agr = kindic_agr + 1 
    12901276                  ENDIF 
    12911277               END DO 
    … …  
    12961282      !  
    12971283   END SUBROUTINE interpe3t 
     1284 
     1285   SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before ) 
     1286      !!---------------------------------------------------------------------- 
     1287      !!                  ***  ROUTINE interpglamt  *** 
     1288      !!----------------------------------------------------------------------   
     1289      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1290      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1291      LOGICAL                        , INTENT(in   ) :: before 
     1292      ! 
     1293      INTEGER :: ji, jj, jk 
     1294      REAL(wp):: ztst 
     1295      !!----------------------------------------------------------------------   
     1296      !     
     1297      IF( before ) THEN 
     1298         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 
     1299      ELSE 
     1300         ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4 
     1301         DO jj = j1, j2 
     1302            DO ji = i1, i2 
     1303               IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 
     1304                  WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 
     1305!                  kindic_agr = kindic_agr + 1 
     1306               ENDIF 
     1307            END DO 
     1308         END DO 
     1309      ENDIF 
     1310      !  
     1311   END SUBROUTINE interpglamt 
     1312 
     1313 
     1314   SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before ) 
     1315      !!---------------------------------------------------------------------- 
     1316      !!                  ***  ROUTINE interpgphit  *** 
     1317      !!----------------------------------------------------------------------   
     1318      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1319      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1320      LOGICAL                        , INTENT(in   ) :: before 
     1321      ! 
     1322      INTEGER :: ji, jj, jk 
     1323      REAL(wp):: ztst 
     1324      !!----------------------------------------------------------------------   
     1325      !     
     1326      IF( before ) THEN 
     1327         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 
     1328      ELSE 
     1329         ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4 
     1330         DO jj = j1, j2 
     1331            DO ji = i1, i2 
     1332               IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 
     1333                  WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 
     1334!                  kindic_agr = kindic_agr + 1 
     1335               ENDIF 
     1336            END DO 
     1337         END DO 
     1338      ENDIF 
     1339      !  
     1340   END SUBROUTINE interpgphit 
     1341 
    12981342 
    12991343   SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    … …  
    13681412                  DO jk = 1, N_out        ! Child vertical grid 
    13691413                     z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 
    1370                   ENDDO 
     1414                  END DO 
    13711415                  IF (N_in*N_out > 0) THEN 
    13721416                     CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1) 
    13731417                  ENDIF 
    1374                ENDDO 
    1375             ENDDO 
     1418               END DO 
     1419            END DO 
    13761420         ELSE 
    13771421            avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
    … …  
    13811425   END SUBROUTINE interpavm 
    13821426 
     1427    
    13831428   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
    13841429      !!---------------------------------------------------------------------- 
    … …  
    13991444   END SUBROUTINE interpmbkt 
    14001445 
     1446    
    14011447   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
    14021448      !!---------------------------------------------------------------------- 
    … …  
    14171463   END SUBROUTINE interpht0 
    14181464 
     1465    
    14191466   SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before) 
    14201467       INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2 
    … …  
    14351482   END SUBROUTINE agrif_initts  
    14361483 
     1484    
    14371485   SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before ) 
    14381486      !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/NST/agrif_oce_sponge.F90

    r13226 r13286  
    7878      zcoef = REAL(Agrif_rhot()-1,wp)/REAL(Agrif_rhot()) 
    7979 
    80       Agrif_SpecialValue=0. 
     80      Agrif_SpecialValue    = 0._wp 
    8181      Agrif_UseSpecialValue = ln_spc_dyn 
    82       use_sign_north = .TRUE. 
    83       sign_north = -1. 
     82      use_sign_north        = .TRUE. 
     83      sign_north            = -1._wp 
    8484      ! 
    8585      tabspongedone_u = .FALSE. 
    … …  
    9292      ! 
    9393      Agrif_UseSpecialValue = .FALSE. 
    94       use_sign_north = .FALSE. 
     94      use_sign_north        = .FALSE. 
    9595#endif 
    9696      ! 
    … …  
    109109      REAL(wp) ::   z1_ispongearea, z1_jspongearea 
    110110      REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 
     111#if defined key_vertical 
     112      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampu 
     113      REAL(wp), DIMENSION(jpi,jpj) :: ztabrampv 
     114#endif 
    111115      REAL(wp), DIMENSION(jpjmax)  :: zmskwest,  zmskeast 
    112116      REAL(wp), DIMENSION(jpimax)  :: zmsknorth, zmsksouth 
    … …  
    129133         ! Retrieve masks at open boundaries: 
    130134 
    131          ! --- West --- ! 
    132          IF( lk_west) THEN 
     135         IF( lk_west ) THEN                             ! --- West --- ! 
    133136            ztabramp(:,:) = 0._wp 
    134             ind1 = 1+nbghostcells 
     137            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    135138            DO ji = mi0(ind1), mi1(ind1)                 
    136139               ztabramp(ji,:) = ssumask(ji,:) 
    137140            END DO 
    138             ! 
    139             zmskwest(:) = 0._wp 
    140             zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     141            zmskwest(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
     142            zmskwest(jpj+1:jpjmax) = 0._wp 
    141143         ENDIF 
    142  
    143          ! --- East --- ! 
    144          IF( lk_east ) THEN 
     144         IF( lk_east ) THEN                             ! --- East --- ! 
    145145            ztabramp(:,:) = 0._wp 
    146             ind1 = jpiglo - nbghostcells - 1 
     146            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    147147            DO ji = mi0(ind1), mi1(ind1)                  
    148148               ztabramp(ji,:) = ssumask(ji,:) 
    149149            END DO 
    150             ! 
    151             zmskeast(:) = 0._wp 
    152             zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     150            zmskeast(    1:jpj   ) = MAXVAL(ztabramp(:,:), dim=1) 
     151            zmskeast(jpj+1:jpjmax) = 0._wp 
    153152         ENDIF 
    154  
    155          ! --- South --- ! 
    156          IF( lk_south ) THEN 
     153         IF( lk_south ) THEN                            ! --- South --- ! 
    157154            ztabramp(:,:) = 0._wp 
    158             ind1 = 1+nbghostcells 
     155            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    159156            DO jj = mj0(ind1), mj1(ind1)                  
    160157               ztabramp(:,jj) = ssvmask(:,jj) 
    161158            END DO 
    162             ! 
    163             zmsksouth(:) = 0._wp 
    164             zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     159            zmsksouth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
     160            zmsksouth(jpi+1:jpimax) = 0._wp 
    165161         ENDIF 
    166  
    167          ! --- North --- ! 
    168          IF( lk_north) THEN 
     162         IF( lk_north ) THEN                            ! --- North --- ! 
    169163            ztabramp(:,:) = 0._wp 
    170             ind1 = jpjglo - nbghostcells - 1 
     164            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    171165            DO jj = mj0(ind1), mj1(ind1)                  
    172166               ztabramp(:,jj) = ssvmask(:,jj) 
    173167            END DO 
    174             ! 
    175             zmsknorth(:) = 0._wp 
    176             zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     168            zmsknorth(    1:jpi   ) = MAXVAL(ztabramp(:,:), dim=2) 
     169            zmsknorth(jpi+1:jpimax) = 0._wp 
    177170         ENDIF 
    178171 
    … …  
    180173         zmskwest(:)  = 1._wp 
    181174         zmskeast(:)  = 1._wp 
     175         zmsksouth(:) = 1._wp 
    182176         zmsknorth(:) = 1._wp 
    183          zmsksouth(:) = 1._wp 
    184177#if defined key_mpp_mpi 
    185178!         CALL mpp_max( 'AGRIF_sponge', zmskwest(:) , jpjmax ) 
    … …  
    192185         ! Store it in ztabramp 
    193186 
    194          ispongearea  = nn_sponge_len * Agrif_irhox() 
    195          z1_ispongearea = 1._wp / REAL( ispongearea ) 
    196          jspongearea  = nn_sponge_len * Agrif_irhoy() 
    197          z1_jspongearea = 1._wp / REAL( jspongearea ) 
     187         ispongearea    = nn_sponge_len * Agrif_irhox() 
     188         z1_ispongearea = 1._wp / REAL( ispongearea, wp ) 
     189         jspongearea    = nn_sponge_len * Agrif_irhoy() 
     190         z1_jspongearea = 1._wp / REAL( jspongearea, wp ) 
    198191          
    199192         ztabramp(:,:) = 0._wp 
    … …  
    203196         IF ( nbcellsy <= 3 ) jspongearea = -1 
    204197 
    205          ! --- West --- ! 
    206          IF(lk_west) THEN 
    207             ind1 = 1+nbghostcells 
    208             ind2 = 1+nbghostcells + ispongearea  
     198         IF( lk_west ) THEN                             ! --- West --- ! 
     199            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     200            ind2 = nn_hls + 1 + nbghostcells + ispongearea  
    209201            DO ji = mi0(ind1), mi1(ind2)    
    210202               DO jj = 1, jpj                
    211                   ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
    212                END DO 
    213             END DO          
    214  
     203                  ztabramp(ji,jj) =                       REAL(ind2 - mig(ji), wp) * z1_ispongearea   * zmskwest(jj) 
     204               END DO 
     205            END DO 
    215206            ! ghost cells: 
    216207            ind1 = 1 
    217             ind2 = nbghostcells + 1 
     208            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    218209            DO ji = mi0(ind1), mi1(ind2)    
    219210               DO jj = 1, jpj                
    … …  
    222213            END DO 
    223214         ENDIF 
    224  
    225          ! --- East --- ! 
    226          IF(lk_east) THEN 
    227             ind1 = jpiglo - nbghostcells - ispongearea 
    228             ind2 = jpiglo - nbghostcells 
     215         IF( lk_east ) THEN                             ! --- East --- ! 
     216            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
     217            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    229218            DO ji = mi0(ind1), mi1(ind2) 
    230  
    231219               DO jj = 1, jpj 
    232                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    233                ENDDO 
    234             END DO 
    235  
     220                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mig(ji) - ind1, wp) * z1_ispongearea ) * zmskeast(jj) 
     221               END DO 
     222            END DO 
    236223            ! ghost cells: 
    237             ind1 = jpiglo - nbghostcells 
     224            ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    238225            ind2 = jpiglo 
    239226            DO ji = mi0(ind1), mi1(ind2) 
    240  
    241227               DO jj = 1, jpj 
    242228                  ztabramp(ji,jj) = zmskeast(jj) 
    243                ENDDO 
    244             END DO 
    245          ENDIF 
    246  
    247          ! --- South --- ! 
    248          IF( lk_south ) THEN  
    249             ind1 = 1+nbghostcells 
    250             ind2 = 1+nbghostcells + jspongearea 
     229               END DO 
     230            END DO 
     231         ENDIF       
     232         IF( lk_south ) THEN                            ! --- South --- ! 
     233            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     234            ind2 = nn_hls + 1 + nbghostcells + jspongearea  
    251235            DO jj = mj0(ind1), mj1(ind2)  
    252236               DO ji = 1, jpi 
    253                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
    254                END DO 
    255             END DO 
    256  
     237                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(ind2 - mjg(jj), wp) * z1_jspongearea ) * zmsksouth(ji) 
     238               END DO 
     239            END DO 
    257240            ! ghost cells: 
    258241            ind1 = 1 
    259             ind2 = nbghostcells + 1 
     242            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    260243            DO jj = mj0(ind1), mj1(ind2)  
    261244               DO ji = 1, jpi 
    … …  
    264247            END DO 
    265248         ENDIF 
    266  
    267          ! --- North --- ! 
    268          IF( lk_north ) THEN   
    269             ind1 = jpjglo - nbghostcells - jspongearea 
    270             ind2 = jpjglo - nbghostcells 
     249         IF( lk_north ) THEN                            ! --- North --- ! 
     250            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
     251            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    271252            DO jj = mj0(ind1), mj1(ind2) 
    272253               DO ji = 1, jpi 
    273                   ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
    274                END DO 
    275             END DO 
    276  
     254                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL(mjg(jj) - ind1, wp) * z1_jspongearea ) * zmsknorth(ji) 
     255               END DO 
     256            END DO 
    277257            ! ghost cells: 
    278             ind1 = jpjglo - nbghostcells 
     258            ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    279259            ind2 = jpjglo 
    280260            DO jj = mj0(ind1), mj1(ind2) 
    … …  
    284264            END DO 
    285265         ENDIF 
    286        
     266         ! 
    287267      ENDIF 
    288268 
    … …  
    295275            fspv(ji,jj) = 0.5_wp * ( ztabramp(ji,jj) + ztabramp(ji  ,jj+1) ) * ssvmask(ji,jj) 
    296276         END_2D 
    297          CALL lbc_lnk( 'agrif_Sponge', fspu, 'U', 1.0_wp )   ! Lateral boundary conditions 
    298          CALL lbc_lnk( 'agrif_Sponge', fspv, 'V', 1.0_wp ) 
    299  
    300          spongedoneT = .TRUE. 
    301277      ENDIF 
    302278 
    … …  
    311287                                  &  * ssvmask(ji,jj) * ssvmask(ji,jj+1) 
    312288         END_2D 
    313          CALL lbc_lnk( 'agrif_Sponge', fspt, 'T', 1.0_wp )   ! Lateral boundary conditions 
    314          CALL lbc_lnk( 'agrif_Sponge', fspf, 'F', 1.0_wp ) 
    315           
     289      ENDIF 
     290       
     291      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 
     292         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp, fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
     293         spongedoneT = .TRUE. 
     294         spongedoneU = .TRUE. 
     295      ENDIF 
     296      IF( .NOT. spongedoneT ) THEN 
     297         CALL lbc_lnk_multi( 'agrif_Sponge', fspu, 'U', 1._wp, fspv, 'V', 1._wp ) 
     298         spongedoneT = .TRUE. 
     299      ENDIF 
     300      IF( .NOT. spongedoneT .AND. .NOT. spongedoneU ) THEN 
     301         CALL lbc_lnk_multi( 'agrif_Sponge', fspt, 'T', 1._wp, fspf, 'F', 1._wp ) 
    316302         spongedoneU = .TRUE. 
    317303      ENDIF 
    … …  
    334320      END_2D 
    335321      ! 
    336       ztabramp(:,:) = REAL( mbkt_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'T', 1.0_wp ) 
    337       mbkt_parent(:,:) = NINT( ztabramp(:,:) ) 
    338       ztabramp(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'U', 1.0_wp ) 
    339       mbku_parent(:,:) = NINT( ztabramp(:,:) ) 
    340       ztabramp(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_Sponge', ztabramp, 'V', 1.0_wp ) 
    341       mbkv_parent(:,:) = NINT( ztabramp(:,:) ) 
     322      ztabramp (:,:) = REAL( mbkt_parent (:,:), wp ) 
     323      ztabrampu(:,:) = REAL( mbku_parentu(:,:), wp ) 
     324      ztabrampv(:,:) = REAL( mbkv_parentv(:,:), wp ) 
     325      CALL lbc_lnk_multi( 'Agrif_Sponge', ztabramp, 'T', 1._wp, ztabrampu, 'U', 1._wp, ztabrampv, 'V', 1._wp ) 
     326      mbkt_parent(:,:) = NINT( ztabramp (:,:) ) 
     327      mbku_parent(:,:) = NINT( ztabrampu(:,:) ) 
     328      mbkv_parent(:,:) = NINT( ztabrampv(:,:) ) 
    342329#endif 
    343330      ! 
    … …  
    346333   END SUBROUTINE Agrif_Sponge 
    347334 
     335    
    348336   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    349337      !!---------------------------------------------------------------------- 
    … …  
    433421                  N_out = N_out + 1 
    434422                  h_out(jk) = e3t(ji,jj,jk,Kbb_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    435                ENDDO 
     423               END DO 
    436424 
    437425               ! Account for small differences in free-surface 
    … …  
    444432                  CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),tabres_child(ji,jj,1:N_out,1:jpts),h_out(1:N_out),N_in,N_out,jpts) 
    445433               ENDIF 
    446             ENDDO 
    447          ENDDO 
     434            END DO 
     435         END DO 
    448436# endif 
    449437 
    … …  
    456444                  tsbdiff(ji,jj,jk,1:jpts) = (ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts))*tmask(ji,jj,jk) 
    457445# endif 
    458                ENDDO 
    459             ENDDO 
    460          ENDDO 
     446               END DO 
     447            END DO 
     448         END DO 
    461449 
    462450         DO jn = 1, jpts             
    … …  
    513501   END SUBROUTINE interptsn_sponge 
    514502 
     503    
    515504   SUBROUTINE interpun_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 
    516505      !!--------------------------------------------- 
    … …  
    521510      LOGICAL, INTENT(in) :: before 
    522511 
    523       INTEGER :: ji,jj,jk,jmax 
    524  
     512      INTEGER  :: ji,jj,jk,jmax 
     513      INTEGER  :: ind1 
    525514      ! sponge parameters  
    526515      REAL(wp) :: ze2u, ze1v, zua, zva, zbtr, zhtot 
    … …  
    586575                  zhtot = zhtot + h_in(jk) 
    587576                  tabin(jk) = tabres(ji,jj,jk,m1) 
    588                ENDDO 
     577               END DO 
    589578               !          
    590579               N_out = 0 
    … …  
    593582                  N_out = N_out + 1 
    594583                  h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 
    595                ENDDO 
     584               END DO 
    596585 
    597586               ! Account for small differences in free-surface 
    … …  
    605594                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    606595               ENDIF  
    607             ENDDO 
    608          ENDDO 
     596            END DO 
     597         END DO 
    609598 
    610599         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
    … …  
    659648 
    660649         jmax = j2-1 
    661         ! IF (lk_north) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
    662          IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2)   ! North 
     650         ind1 = jpjglo - ( nn_hls + nbghostcells + 2 )   ! North 
     651         DO jj = mj0(ind1), mj1(ind1)                  
     652            jmax = MIN(jmax,jj) 
     653         END DO 
    663654 
    664655         DO jj = j1+1, jmax 
    … …  
    688679   END SUBROUTINE interpun_sponge 
    689680 
    690    SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before,nb,ndir) 
     681    
     682   SUBROUTINE interpvn_sponge(tabres,i1,i2,j1,j2,k1,k2,m1,m2, before) 
    691683      !!--------------------------------------------- 
    692684      !!   *** ROUTINE interpvn_sponge *** 
    … …  
    695687      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: tabres 
    696688      LOGICAL, INTENT(in) :: before 
    697       INTEGER, INTENT(in) :: nb , ndir 
    698689      ! 
    699690      INTEGER  ::   ji, jj, jk, imax 
     691      INTEGER  :: ind1 
    700692      REAL(wp) ::   ze2u, ze1v, zua, zva, zbtr, zhtot 
    701693      REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: vbdiff 
    … …  
    759751                  zhtot = zhtot + h_in(jk) 
    760752                  tabin(jk) = tabres(ji,jj,jk,m1) 
    761                ENDDO 
     753               END DO 
    762754               !           
    763755               N_out = 0 
    … …  
    766758                  N_out = N_out + 1 
    767759                  h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 
    768                ENDDO 
     760               END DO 
    769761 
    770762               ! Account for small differences in free-surface 
    … …  
    778770                  CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 
    779771               ENDIF 
    780             ENDDO 
    781          ENDDO 
     772            END DO 
     773         END DO 
    782774 
    783775         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
    … …  
    812804 
    813805         imax = i2 - 1 
    814       !   IF(lk_east) imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    815          IF ((nbondi == 1).OR.(nbondi == 2))   imax = MIN(imax,nlci-nbghostcells-2)   ! East 
    816  
     806         ind1 = jpiglo - ( nn_hls + nbghostcells + 2 )   ! East 
     807         DO ji = mi0(ind1), mi1(ind1)                 
     808            imax = MIN(imax,ji) 
     809         END DO 
     810          
    817811         DO jj = j1+1, j2 
    818812            DO ji = i1+1, imax   ! vector opt. 

  • NEMO/trunk/src/NST/agrif_oce_update.F90

    r13216 r13286  
    8585 
    8686      Agrif_UseSpecialValueInUpdate = .FALSE. 
    87       Agrif_SpecialValueFineGrid = 0. 
     87      Agrif_SpecialValueFineGrid    = 0._wp 
    8888 
    8989      use_sign_north = .TRUE. 
    90       sign_north = -1. 
     90      sign_north     = -1._wp 
    9191 
    9292      !      
    … …  
    144144      ! 
    145145      Agrif_UseSpecialValueInUpdate = .TRUE. 
    146       Agrif_SpecialValueFineGrid = 0. 
     146      Agrif_SpecialValueFineGrid = 0._wp 
    147147# if ! defined DECAL_FEEDBACK_2D 
    148148      CALL Agrif_Update_Variable(sshn_id,procname = updateSSH) 
    … …  
    156156      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
    157157         use_sign_north = .TRUE. 
    158          sign_north = -1. 
     158         sign_north = -1._wp 
    159159         ! Refluxing on ssh: 
    160160#  if defined DECAL_FEEDBACK_2D 

  • NEMO/trunk/src/NST/agrif_user.F90

    r13226 r13286  
    1111   END SUBROUTINE agrif_user 
    1212 
     13    
    1314   SUBROUTINE agrif_before_regridding 
    1415   END SUBROUTINE agrif_before_regridding 
    1516 
     17    
    1618   SUBROUTINE Agrif_InitWorkspace 
    1719   END SUBROUTINE Agrif_InitWorkspace 
    1820 
     21    
    1922   SUBROUTINE Agrif_InitValues 
    2023      !!---------------------------------------------------------------------- 
    … …  
    3841   END SUBROUTINE Agrif_initvalues 
    3942 
    40    SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 
    41  
    42        USE domvvl 
    43        USE domain 
    44        USE par_oce 
    45        USE agrif_oce 
    46        USE agrif_oce_interp 
    47        USE oce 
    48        USE lib_mpp 
    49        USe lbclnk 
    50  
     43    
     44   SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 
     45      !!---------------------------------------------------------------------- 
     46      !!                 *** ROUTINE agrif_istate *** 
     47      !!---------------------------------------------------------------------- 
     48      USE domvvl 
     49      USE domain 
     50      USE par_oce 
     51      USE agrif_oce 
     52      USE agrif_oce_interp 
     53      USE oce 
     54      USE lib_mpp 
     55      USE lbclnk 
     56      ! 
     57      IMPLICIT NONE 
     58      ! 
    5159      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
    5260      INTEGER :: jn 
    53  
     61      !!---------------------------------------------------------------------- 
    5462      IF(lwp) WRITE(numout,*) ' ' 
    5563      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
    5664      IF(lwp) WRITE(numout,*) ' ' 
    5765 
    58       l_ini_child = .TRUE. 
    59       Agrif_SpecialValue    = 0._wp 
     66      l_ini_child           = .TRUE. 
     67      Agrif_SpecialValue    = 0.0_wp 
    6068      Agrif_UseSpecialValue = .TRUE. 
    61       uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     69      uu(:,:,:,:) = 0.0_wp   ;   vv(:,:,:,:) = 0.0_wp   ;   ts(:,:,:,:,:) = 0.0_wp 
    6270        
    63       Krhs_a = Kbb ; Kmm_a = Kbb 
     71      Krhs_a = Kbb   ;  Kmm_a = Kbb 
    6472 
    6573      ! Brutal fix to pas 1x1 refinment.  
    … …  
    7987      use_sign_north = .FALSE. 
    8088 
    81       Agrif_UseSpecialValue = .FALSE.            ! 
    82       l_ini_child = .FALSE. 
    83  
    84       Krhs_a = Kaa ; Kmm_a = Kmm 
     89      Agrif_UseSpecialValue = .FALSE. 
     90      l_ini_child           = .FALSE. 
     91 
     92      Krhs_a = Kaa   ;  Kmm_a = Kmm 
    8593 
    8694      DO jn = 1, jpts 
    8795         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
    8896      END DO 
    89       uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
    90       vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
    91  
    92  
    93       CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
    94       CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
    95  
    96    END SUBROUTINE agrif_istate    
    97  
     97      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)      
     98      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
     99 
     100 
     101      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
     102      CALL lbc_lnk(       'agrif_istate', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
     103 
     104   END SUBROUTINE Agrif_Istate 
     105 
     106    
    98107   SUBROUTINE agrif_declare_var_ini 
    99108      !!---------------------------------------------------------------------- 
    100       !!                 *** ROUTINE agrif_declare_var *** 
     109      !!                 *** ROUTINE agrif_declare_var_ini *** 
    101110      !!---------------------------------------------------------------------- 
    102111      USE agrif_util 
    … …  
    110119      ! 
    111120      INTEGER :: ind1, ind2, ind3 
     121      INTEGER :: its 
    112122      External :: nemo_mapping 
    113123      !!---------------------------------------------------------------------- 
    … …  
    126136      ! 1. Declaration of the type of variable which have to be interpolated 
    127137      !--------------------------------------------------------------------- 
    128       ind1 =     nbghostcells 
    129       ind2 = 2 + nbghostcells_x 
    130       ind3 = 2 + nbghostcells_y_s 
    131  
    132       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    133       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
    134       CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
    135  
    136       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    137       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    138  
     138      ind1 =              nbghostcells 
     139      ind2 = nn_hls + 2 + nbghostcells_x 
     140      ind3 = nn_hls + 2 + nbghostcells_y_s 
     141 
     142      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),   e3t_id) 
     143      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),  mbkt_id) 
     144      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   ht0_id) 
     145 
     146      CALL agrif_declare_variable((/1,2    /),(/ind2-1,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e1u_id) 
     147      CALL agrif_declare_variable((/2,1    /),(/ind2  ,ind3-1    /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e2v_id) 
    139148    
    140149      ! Initial or restart velues 
    141        
    142       CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsini_id) 
    143       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,uini_id )  
    144       CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,vini_id ) 
    145       CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id) 
     150      its = jpts+1 
     151      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 
     152      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  uini_id)  
     153      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  vini_id) 
     154      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),sshini_id) 
    146155      !  
    147156      
    148157      ! 2. Type of interpolation 
    149158      !------------------------- 
    150       CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
    151  
    152       CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
    153       CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
    154       CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
    155       CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
    156  
    157       CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    158       CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
     159      CALL Agrif_Set_bcinterp(   e3t_id,interp =AGRIF_constant) 
     160 
     161      CALL Agrif_Set_bcinterp(  mbkt_id,interp =AGRIF_constant) 
     162      CALL Agrif_Set_interp  (  mbkt_id,interp =AGRIF_constant) 
     163      CALL Agrif_Set_bcinterp(   ht0_id,interp =AGRIF_constant) 
     164      CALL Agrif_Set_interp  (   ht0_id,interp =AGRIF_constant) 
     165 
     166      CALL Agrif_Set_bcinterp(   e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     167      CALL Agrif_Set_bcinterp(   e2v_id,interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    159168 
    160169      ! Initial fields 
    161       CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
    162       CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
    163       CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
    164       CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
    165       CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
    166       CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
    167       CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
    168       CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     170      CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear  ) 
     171      CALL Agrif_Set_interp  ( tsini_id,interp =AGRIF_linear  ) 
     172      CALL Agrif_Set_bcinterp(  uini_id,interp =AGRIF_linear  ) 
     173      CALL Agrif_Set_interp  (  uini_id,interp =AGRIF_linear  ) 
     174      CALL Agrif_Set_bcinterp(  vini_id,interp =AGRIF_linear  ) 
     175      CALL Agrif_Set_interp  (  vini_id,interp =AGRIF_linear  ) 
     176      CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear  ) 
     177      CALL Agrif_Set_interp  (sshini_id,interp =AGRIF_linear  ) 
    169178 
    170179       ! 3. Location of interpolation 
    … …  
    172181!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
    173182! JC: check near the boundary only until matching in sponge has been sorted out: 
    174       CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     183      CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) )   
    175184 
    176185      ! extend the interpolation zone by 1 more point than necessary: 
    177186      ! RB check here 
    178       CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    179       CALL Agrif_Set_bc(  ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     187      CALL Agrif_Set_bc(   mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     188      CALL Agrif_Set_bc(    ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    180189       
    181       CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    182       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
    183  
    184       CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
    185       CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
    186       CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     190      CALL Agrif_Set_bc(    e1u_id, (/0,ind1-1/) ) 
     191      CALL Agrif_Set_bc(    e2v_id, (/0,ind1-1/) )   
     192 
     193      CALL Agrif_Set_bc(  tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     194      CALL Agrif_Set_bc(   uini_id, (/0,ind1-1/) )  
     195      CALL Agrif_Set_bc(   vini_id, (/0,ind1-1/) ) 
    187196      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    188197 
    … …  
    190199      !---------------  
    191200# if defined UPD_HIGH 
    192       CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
    193       CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     201      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting) 
     202      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average       ) 
    194203#else 
    195       CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    196       CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     204      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy          , update2=Agrif_Update_Average       ) 
     205      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Copy          ) 
    197206#endif 
    198207       
    … …  
    204213   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
    205214      !!---------------------------------------------------------------------- 
    206       !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
    207       !!---------------------------------------------------------------------- 
    208    
    209          !!---------------------------------------------------------------------- 
    210          !!                 *** ROUTINE Agrif_InitValues_cont *** 
    211          !! 
    212          !! ** Purpose ::   Declaration of variables to be interpolated 
    213          !!---------------------------------------------------------------------- 
     215      !!                 *** ROUTINE Agrif_Init_Domain *** 
     216      !!---------------------------------------------------------------------- 
    214217      USE agrif_oce_update 
    215218      USE agrif_oce_interp 
    … …  
    243246      ! on the child grid  
    244247      Agrif_UseSpecialValue = .FALSE. 
    245       ht0_parent(:,:) = 0._wp 
     248      ht0_parent( :,:) = 0._wp 
    246249      mbkt_parent(:,:) = 0 
    247250      ! 
    … …  
    255258      !       and no refinement 
    256259      DO_2D_10_10 
    257          mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj) ) 
    258          mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj) ) 
     260         mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj  ), mbkt_parent(ji,jj) ) 
     261         mbkv_parent(ji,jj) = MIN( mbkt_parent(ji  ,jj+1), mbkt_parent(ji,jj) ) 
    259262      END_2D 
    260263      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN  
    … …  
    265268      ELSE 
    266269         DO_2D_10_10 
    267             hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj)) 
    268             hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1)) 
     270            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 
     271            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 
    269272         END_2D 
    270  
    271       ENDIF 
    272       ! 
    273       CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp ) 
    274       CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1.0_wp ) 
    275       zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk('Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
    276       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    277       zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
     273      ENDIF 
     274      ! 
     275      CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 
     276      DO_2D_00_00 
     277         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 
     278      END_2D 
     279      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
     280      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     281      DO_2D_00_00 
     282         zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 
     283      END_2D 
     284      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
    278285      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    279286 
    … …  
    333340 
    334341   SUBROUTINE Agrif_InitValues_cont 
    335          !!---------------------------------------------------------------------- 
    336          !!                 *** ROUTINE Agrif_InitValues_cont *** 
    337          !! 
    338          !! ** Purpose ::   Declaration of variables to be interpolated 
    339          !!---------------------------------------------------------------------- 
     342      !!---------------------------------------------------------------------- 
     343      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     344      !! 
     345      !! ** Purpose ::   Declaration of variables to be interpolated 
     346      !!---------------------------------------------------------------------- 
    340347      USE agrif_oce_update 
    341348      USE agrif_oce_interp 
    … …  
    367374      Agrif_SpecialValue    = 0._wp 
    368375      Agrif_UseSpecialValue = .TRUE. 
    369       CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     376      CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn) 
    370377      CALL Agrif_Sponge 
    371378      tabspongedone_tsn = .FALSE. 
    … …  
    398405         use_sign_north = .TRUE. 
    399406         sign_north = -1. 
    400          CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    401          CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     407         CALL Agrif_Bc_variable(        unb_id,calledweight=1.,procname=interpunb ) 
     408         CALL Agrif_Bc_variable(        vnb_id,calledweight=1.,procname=interpvnb ) 
    402409         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    403410         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    … …  
    460467      ! 1. Declaration of the type of variable which have to be interpolated 
    461468      !--------------------------------------------------------------------- 
    462  
    463       ind1 =     nbghostcells 
    464       ind2 = 2 + nbghostcells_x 
    465       ind3 = 2 + nbghostcells_y_s 
    466  
     469      ind1 =              nbghostcells 
     470      ind2 = nn_hls + 2 + nbghostcells_x 
     471      ind3 = nn_hls + 2 + nbghostcells_y_s 
    467472# if defined key_vertical 
    468       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
    469       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
    470       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    471       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    472       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
    473       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    474       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
    475       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     473      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     474      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     475      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     476      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     477      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     478      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    476481# else 
    477       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    478       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    479       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
    480       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
    481       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
    482       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
    483       CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
    484       CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
     482      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     483      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     484      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     485      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     486      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     487      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     488      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     489      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    485490# endif 
    486       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    487       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    488       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    489       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    490       CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    491       CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    492  
    493       CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     491      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     492      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     493      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     494      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     495      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     496      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     497 
     498!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
     499!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
     500      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    494501 
    495502 
    496503      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    497 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    498 !         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     504!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     505!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    499506# if defined key_vertical 
    500          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
     507         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    501508# else 
    502          CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     509         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    503510# endif 
    504511      ENDIF 
    … …  
    506513      ! 2. Type of interpolation 
    507514      !------------------------- 
    508       CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    509       CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    510       CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    511  
    512       CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    513       CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    514       CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    515  
    516       CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    517       CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    518       CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    519       CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    520       CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     515      CALL Agrif_Set_bcinterp(       tsn_id,interp =AGRIF_linear) 
     516      CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     517      CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     518 
     519      CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 
     520      CALL Agrif_Set_bcinterp(  un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     521      CALL Agrif_Set_bcinterp(  vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     522 
     523      CALL Agrif_Set_bcinterp(       sshn_id,interp =AGRIF_linear) 
     524      CALL Agrif_Set_bcinterp(        unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     525      CALL Agrif_Set_bcinterp(        vnb_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     526      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     527      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
    521528! 
    522529! > Divergence conserving alternative: 
    … …  
    531538     
    532539 
    533        ! 3. Location of interpolation 
     540!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
     541!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
     542 
     543      ! 3. Location of interpolation 
    534544      !----------------------------- 
    535545      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
    … …  
    548558 
    549559      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
     560!!$      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )   
     561!!$      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )   
    550562 
    551563      ! 4. Update type 
    … …  
    553565 
    554566# if defined UPD_HIGH 
    555       CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    556       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    557       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    558  
    559       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    560       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    561       CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 
    562       CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     567      CALL Agrif_Set_Updatetype(      tsn_id,update = Agrif_Update_Full_Weighting) 
     568      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     569      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     570 
     571      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     572      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     573      CALL Agrif_Set_Updatetype(       sshn_id,update = Agrif_Update_Full_Weighting) 
     574      CALL Agrif_Set_Updatetype(        e3t_id,update = Agrif_Update_Full_Weighting) 
    563575 
    564576  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    569581 
    570582#else 
    571       CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    572       CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    573       CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    574  
    575       CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    576       CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    577       CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 
    578       CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
     583      CALL Agrif_Set_Updatetype(     tsn_id, update = AGRIF_Update_Average) 
     584      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     585      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     586 
     587      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     588      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     589      CALL Agrif_Set_Updatetype(       sshn_id,update = AGRIF_Update_Average) 
     590      CALL Agrif_Set_Updatetype(        e3t_id,update = AGRIF_Update_Average) 
    579591 
    580592 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    … …  
    589601 
    590602#if defined key_si3 
    591 SUBROUTINE Agrif_InitValues_cont_ice 
     603   SUBROUTINE Agrif_InitValues_cont_ice 
     604      !!---------------------------------------------------------------------- 
     605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     606      !!---------------------------------------------------------------------- 
    592607      USE Agrif_Util 
    593608      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    … …  
    597612      USE agrif_ice_interp 
    598613      USE lib_mpp 
    599       !!---------------------------------------------------------------------- 
    600       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    601       !!---------------------------------------------------------------------- 
    602  
     614      ! 
     615      IMPLICIT NONE 
     616      ! 
     617      !!---------------------------------------------------------------------- 
    603618      ! Controls 
    604619 
    … …  
    623638   END SUBROUTINE Agrif_InitValues_cont_ice 
    624639 
     640    
    625641   SUBROUTINE agrif_declare_var_ice 
    626642      !!---------------------------------------------------------------------- 
    627643      !!                 *** ROUTINE agrif_declare_var_ice *** 
    628644      !!---------------------------------------------------------------------- 
    629  
    630645      USE Agrif_Util 
    631646      USE ice 
    … …  
    635650      ! 
    636651      INTEGER :: ind1, ind2, ind3 
    637          !!---------------------------------------------------------------------- 
     652      INTEGER :: ipl 
     653      !!---------------------------------------------------------------------- 
    638654      ! 
    639655      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    … …  
    644660      !                            2,2 = two ghost lines 
    645661      !------------------------------------------------------------------------------------- 
    646  
    647       ind1 =     nbghostcells 
    648       ind2 = 2 + nbghostcells_x 
    649       ind3 = 2 + nbghostcells_y_s 
    650       CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    651       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
    652       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
    653  
    654       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 
    655       CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_iceini_id  ) 
    656       CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_iceini_id  ) 
     662      ind1 =              nbghostcells 
     663      ind2 = nn_hls + 2 + nbghostcells_x 
     664      ind3 = nn_hls + 2 + nbghostcells_y_s 
     665      ipl = jpl*(8+nlay_s+nlay_i) 
     666      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 
     667      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_ice_id) 
     668      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_ice_id) 
     669 
     670      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 
     671      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_iceini_id) 
     672      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_iceini_id) 
    657673 
    658674      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    … …  
    712728      USE agrif_top_interp 
    713729      USE agrif_top_sponge 
    714       !! 
    715    
    716    !! 
    717    IMPLICIT NONE 
    718    ! 
    719    CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    720    LOGICAL :: check_namelist 
    721       !!---------------------------------------------------------------------- 
    722  
    723  
    724    ! 1. Declaration of the type of variable which have to be interpolated 
    725    !--------------------------------------------------------------------- 
    726    CALL agrif_declare_var_top 
    727  
    728    ! 2. First interpolations of potentially non zero fields 
    729    !------------------------------------------------------- 
    730    Agrif_SpecialValue=0. 
    731    Agrif_UseSpecialValue = .TRUE. 
    732    CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    733    Agrif_UseSpecialValue = .FALSE. 
    734    CALL Agrif_Sponge 
    735    tabspongedone_trn = .FALSE. 
    736    CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    737    ! reset tsa to zero 
    738    tra(:,:,:,:) = 0. 
    739  
    740    ! 3. Some controls 
    741    !----------------- 
    742    check_namelist = .TRUE. 
    743  
    744    IF( check_namelist ) THEN 
    745       ! Check time steps 
    746       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    747          WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    748          WRITE(cl_check2,*)  rdt 
    749          WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    750          CALL ctl_stop( 'incompatible time step between grids',   & 
     730      ! 
     731      IMPLICIT NONE 
     732      ! 
     733      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     734      LOGICAL :: check_namelist 
     735      !!---------------------------------------------------------------------- 
     736 
     737      ! 1. Declaration of the type of variable which have to be interpolated 
     738      !--------------------------------------------------------------------- 
     739      CALL agrif_declare_var_top 
     740 
     741      ! 2. First interpolations of potentially non zero fields 
     742      !------------------------------------------------------- 
     743      Agrif_SpecialValue=0._wp 
     744      Agrif_UseSpecialValue = .TRUE. 
     745      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     746      Agrif_UseSpecialValue = .FALSE. 
     747      CALL Agrif_Sponge 
     748      tabspongedone_trn = .FALSE. 
     749      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     750      ! reset tsa to zero 
     751      tra(:,:,:,:) = 0._wp 
     752 
     753      ! 3. Some controls 
     754      !----------------- 
     755      check_namelist = .TRUE. 
     756 
     757      IF( check_namelist ) THEN 
     758         ! Check time steps 
     759         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     760            WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     761            WRITE(cl_check2,*)  rdt 
     762            WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     763            CALL ctl_stop( 'incompatible time step between grids',   & 
    751764               &               'parent grid value : '//cl_check1    ,   &  
    752765               &               'child  grid value : '//cl_check2    ,   &  
    753766               &               'value on child grid should be changed to  & 
    754767               &               :'//cl_check3  ) 
    755       ENDIF 
    756  
    757       ! Check run length 
    758       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     768         ENDIF 
     769 
     770         ! Check run length 
     771         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    759772            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    760          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    761          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    762          CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     773            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     774            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     775            CALL ctl_warn( 'incompatible run length between grids'               ,   & 
    763776               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    764777               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
    765          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    766          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    767       ENDIF 
    768    ENDIF 
    769    ! 
     778            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     779            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
     780         ENDIF 
     781      ENDIF 
     782      ! 
    770783   END SUBROUTINE Agrif_InitValues_cont_top 
    771784 
    … …  
    784797      INTEGER :: ind1, ind2, ind3 
    785798      !!---------------------------------------------------------------------- 
    786  
    787  
    788  
    789799!RB_CMEMS : declare here init for top       
    790800      ! 1. Declaration of the type of variable which have to be interpolated 
    791801      !--------------------------------------------------------------------- 
    792       ind1 =     nbghostcells 
    793       ind2 = 2 + nbghostcells_x 
    794       ind3 = 2 + nbghostcells_y_s 
     802      ind1 =              nbghostcells 
     803      ind2 = nn_hls + 2 + nbghostcells_x 
     804      ind3 = nn_hls + 2 + nbghostcells_y_s 
    795805# if defined key_vertical 
    796       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
    797       CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     806      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     807      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    798808# else 
    799809! LAURENT: STRANGE why (3,3) here ? 
    800       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    801       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     810      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     811      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    802812# endif 
    803813 
    … …  
    822832   END SUBROUTINE agrif_declare_var_top 
    823833# endif 
     834    
    824835 
    825836   SUBROUTINE Agrif_detect( kg, ksizex ) 
    … …  
    835846   END SUBROUTINE Agrif_detect 
    836847 
     848    
    837849   SUBROUTINE agrif_nemo_init 
    838850      !!---------------------------------------------------------------------- 
    839851      !!                     *** ROUTINE agrif_init *** 
    840852      !!---------------------------------------------------------------------- 
    841    USE agrif_oce  
    842    USE agrif_ice 
    843    USE dom_oce 
    844    USE in_out_manager 
    845    USE lib_mpp 
    846       !! 
     853      USE agrif_oce  
     854      USE agrif_ice 
     855      USE dom_oce 
     856      USE in_out_manager 
     857      USE lib_mpp 
     858      ! 
    847859      IMPLICIT NONE 
    848860      ! 
    … …  
    880892      ! 
    881893      ! Set the number of ghost cells according to periodicity 
    882       nbghostcells_x = nbghostcells 
     894      nbghostcells_x   = nbghostcells 
    883895      nbghostcells_y_s = nbghostcells 
    884896      nbghostcells_y_n = nbghostcells 
    885897      ! 
    886       IF ( jperio == 1 ) nbghostcells_x = 0 
    887       IF ( .NOT. lk_south ) nbghostcells_y_s = 0 
    888  
     898      IF(   jperio == 1  )   nbghostcells_x   = 0 
     899      IF( .NOT. lk_south )   nbghostcells_y_s = 0 
    889900      ! Some checks 
    890       IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
    891           CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
    892       IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
    893           CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     901      IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
     902         &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 
     903      IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    & 
     904         &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 
    894905      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    895906      ! 
    896907   END SUBROUTINE agrif_nemo_init 
    897908 
     909    
    898910# if defined key_mpp_mpi 
    899911   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    … …  
    909921      ! 
    910922      SELECT CASE( i ) 
    911       CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    912       CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
    913       CASE DEFAULT 
    914          indglob = indloc 
     923      CASE(1)        ;   indglob = mig(indloc) 
     924      CASE(2)        ;   indglob = mjg(indloc) 
     925      CASE DEFAULT   ;   indglob = indloc 
    915926      END SELECT 
    916927      ! 
    917928   END SUBROUTINE Agrif_InvLoc 
    918929 
     930    
    919931   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    920932      !!---------------------------------------------------------------------- 
    … …  
    929941      !!---------------------------------------------------------------------- 
    930942      ! 
    931       imin = nimppt(Agrif_Procrank+1)  ! ????? 
    932       jmin = njmppt(Agrif_Procrank+1)  ! ????? 
    933       imax = imin + jpi - 1 
    934       jmax = jmin + jpj - 1 
     943      imin = mig( 1 ) 
     944      jmin = mjg( 1 ) 
     945      imax = mig(jpi) 
     946      jmax = mjg(jpj) 
    935947      !  
    936948   END SUBROUTINE Agrif_get_proc_info 
    937949 
     950    
    938951   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    939952      !!---------------------------------------------------------------------- 
    … …  
    11301143   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
    11311144 
    1132    USE dom_oce 
    1133  
    1134    INTEGER :: ptx, pty, i1, isens 
    1135    INTEGER :: agrif_external_switch_index 
    1136  
    1137    IF( isens == 1 ) THEN 
    1138       IF( ptx == 2 ) THEN ! T, V points 
    1139          agrif_external_switch_index = jpiglo-i1+2 
    1140       ELSE ! U, F points 
    1141          agrif_external_switch_index = jpiglo-i1+1       
    1142       ENDIF 
    1143    ELSE IF( isens ==2 ) THEN 
    1144       IF ( pty == 2 ) THEN ! T, U points 
    1145          agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
    1146       ELSE ! V, F points 
    1147          agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
    1148       ENDIF 
    1149    ENDIF 
     1145      USE dom_oce 
     1146      ! 
     1147      IMPLICIT NONE 
     1148 
     1149      INTEGER :: ptx, pty, i1, isens 
     1150      INTEGER :: agrif_external_switch_index 
     1151      !!---------------------------------------------------------------------- 
     1152 
     1153      IF( isens == 1 ) THEN 
     1154         IF( ptx == 2 ) THEN ! T, V points 
     1155            agrif_external_switch_index = jpiglo-i1+2 
     1156         ELSE ! U, F points 
     1157            agrif_external_switch_index = jpiglo-i1+1       
     1158         ENDIF 
     1159      ELSE IF( isens ==2 ) THEN 
     1160         IF ( pty == 2 ) THEN ! T, U points 
     1161            agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1162         ELSE ! V, F points 
     1163            agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1164         ENDIF 
     1165      ENDIF 
    11501166 
    11511167   END FUNCTION agrif_external_switch_index 
    … …  
    11551171      !!                   *** ROUTINE Correct_field *** 
    11561172      !!---------------------------------------------------------------------- 
    1157     
    1158    USE dom_oce 
    1159    USE agrif_oce 
    1160  
    1161    INTEGER :: i1,i2,j1,j2 
    1162    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
    1163  
    1164    INTEGER :: i,j 
    1165    REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
    1166  
    1167    tab2dtemp = tab2d 
    1168  
    1169    IF( .NOT. use_sign_north ) THEN 
    1170       DO j=j1,j2 
    1171          DO i=i1,i2 
    1172             tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1173      USE dom_oce 
     1174      USE agrif_oce 
     1175      ! 
     1176      IMPLICIT NONE 
     1177      ! 
     1178      INTEGER :: i1,i2,j1,j2 
     1179      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1180      ! 
     1181      INTEGER :: i,j 
     1182      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1183      !!---------------------------------------------------------------------- 
     1184 
     1185      tab2dtemp = tab2d 
     1186 
     1187      IF( .NOT. use_sign_north ) THEN 
     1188         DO j=j1,j2 
     1189            DO i=i1,i2 
     1190               tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1191            END DO 
    11731192         END DO 
    1174       END DO 
    1175    ELSE 
    1176       DO j=j1,j2 
    1177          DO i=i1,i2 
    1178             tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1193      ELSE 
     1194         DO j=j1,j2 
     1195            DO i=i1,i2 
     1196               tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1197            END DO 
    11791198         END DO 
    1180       END DO 
    1181    ENDIF 
     1199      ENDIF 
    11821200 
    11831201   END SUBROUTINE Correct_field 

  • NEMO/trunk/src/OCE/ASM/asminc.F90

    r13237 r13286  
    360360 
    361361         IF ( ln_trainc ) THEN    
    362             CALL iom_get( inum, jpdom_autoglo, 'bckint', t_bkginc, 1 ) 
    363             CALL iom_get( inum, jpdom_autoglo, 'bckins', s_bkginc, 1 ) 
     362            CALL iom_get( inum, jpdom_auto, 'bckint', t_bkginc, 1 ) 
     363            CALL iom_get( inum, jpdom_auto, 'bckins', s_bkginc, 1 ) 
    364364            ! Apply the masks 
    365365            t_bkginc(:,:,:) = t_bkginc(:,:,:) * tmask(:,:,:) 
    … …  
    372372 
    373373         IF ( ln_dyninc ) THEN    
    374             CALL iom_get( inum, jpdom_autoglo, 'bckinu', u_bkginc, 1 )               
    375             CALL iom_get( inum, jpdom_autoglo, 'bckinv', v_bkginc, 1 )               
     374            CALL iom_get( inum, jpdom_auto, 'bckinu', u_bkginc, 1 )               
     375            CALL iom_get( inum, jpdom_auto, 'bckinv', v_bkginc, 1 )               
    376376            ! Apply the masks 
    377377            u_bkginc(:,:,:) = u_bkginc(:,:,:) * umask(:,:,:) 
    … …  
    384384         
    385385         IF ( ln_sshinc ) THEN 
    386             CALL iom_get( inum, jpdom_autoglo, 'bckineta', ssh_bkginc, 1 ) 
     386            CALL iom_get( inum, jpdom_auto, 'bckineta', ssh_bkginc, 1 ) 
    387387            ! Apply the masks 
    388388            ssh_bkginc(:,:) = ssh_bkginc(:,:) * tmask(:,:,1) 
    … …  
    393393 
    394394         IF ( ln_seaiceinc ) THEN 
    395             CALL iom_get( inum, jpdom_autoglo, 'bckinseaice', seaice_bkginc, 1 ) 
     395            CALL iom_get( inum, jpdom_auto, 'bckinseaice', seaice_bkginc, 1 ) 
    396396            ! Apply the masks 
    397397            seaice_bkginc(:,:) = seaice_bkginc(:,:) * tmask(:,:,1) 
    … …  
    467467         ! 
    468468         IF ( ln_trainc ) THEN    
    469             CALL iom_get( inum, jpdom_autoglo, 'tn', t_bkg ) 
    470             CALL iom_get( inum, jpdom_autoglo, 'sn', s_bkg ) 
     469            CALL iom_get( inum, jpdom_auto, 'tn', t_bkg ) 
     470            CALL iom_get( inum, jpdom_auto, 'sn', s_bkg ) 
    471471            t_bkg(:,:,:) = t_bkg(:,:,:) * tmask(:,:,:) 
    472472            s_bkg(:,:,:) = s_bkg(:,:,:) * tmask(:,:,:) 
    … …  
    474474         ! 
    475475         IF ( ln_dyninc ) THEN    
    476             CALL iom_get( inum, jpdom_autoglo, 'un', u_bkg ) 
    477             CALL iom_get( inum, jpdom_autoglo, 'vn', v_bkg ) 
     476            CALL iom_get( inum, jpdom_auto, 'un', u_bkg, cd_type = 'U', psgn = 1._wp ) 
     477            CALL iom_get( inum, jpdom_auto, 'vn', v_bkg, cd_type = 'V', psgn = 1._wp ) 
    478478            u_bkg(:,:,:) = u_bkg(:,:,:) * umask(:,:,:) 
    479479            v_bkg(:,:,:) = v_bkg(:,:,:) * vmask(:,:,:) 
    … …  
    481481         ! 
    482482         IF ( ln_sshinc ) THEN 
    483             CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh_bkg ) 
     483            CALL iom_get( inum, jpdom_auto, 'sshn', ssh_bkg ) 
    484484            ssh_bkg(:,:) = ssh_bkg(:,:) * tmask(:,:,1) 
    485485         ENDIF 

  • NEMO/trunk/src/OCE/BDY/bdyini.F90

    r13226 r13286  
    416416               CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    417417               DO ii = 1,nblendta(igrd,ib_bdy) 
    418                   nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 
     418                  nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 
    419419               END DO 
    420420               CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    421421               DO ii = 1,nblendta(igrd,ib_bdy) 
    422                   nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 
     422                  nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 
    423423               END DO 
    424424               CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 
    … …  
    13781378         DO ji = 1, jpi 
    13791379            DO jj = 1, jpj              
    1380               IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &  
    1381                &  ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1382               IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &  
    1383                &  ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1380              IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwdt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1381              IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    13841382            END DO 
    13851383         END DO 
    … …  
    14161414         DO ji = 1, jpi 
    14171415            DO jj = 1, jpj              
    1418               IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &  
    1419                &  ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1420               IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &  
    1421                &  ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1416              IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjedt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1417              IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjeft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14221418            END DO 
    14231419         END DO 
    … …  
    14541450         DO ji = 1, jpi 
    14551451            DO jj = 1, jpj              
    1456               IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &  
    1457                &  ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1458               IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &  
    1459                &  ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1452              IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisdt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1453              IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14601454            END DO 
    14611455         END DO 
    … …  
    14781472         DO ji = 1, jpi 
    14791473            DO jj = 1, jpj              
    1480               IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &  
    1481                &  ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1482               IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &  
    1483                &  ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1474               IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpindt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1475               IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpinft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14841476            END DO 
    14851477         END DO 

  • NEMO/trunk/src/OCE/BDY/bdytides.F90

    r12921 r13286  
    167167                  igrd = 1                       ! Everything is at T-points here 
    168168                  DO itide = 1, nb_harmo 
    169                      CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    170                      CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
     169                     CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     170                     CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) )  
    171171                     DO ib = 1, SIZE(dta%ssh) 
    172172                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    185185                  igrd = 2                       ! Everything is at U-points here 
    186186                  DO itide = 1, nb_harmo 
    187                      CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 
    188                      CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 
     187                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp) 
     188                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp) 
    189189                     DO ib = 1, SIZE(dta%u2d) 
    190190                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    … …  
    203203                  igrd = 3                       ! Everything is at V-points here 
    204204                  DO itide = 1, nb_harmo 
    205                      CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 
    206                      CALL iom_get  ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 
     205                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp) 
     206                     CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp) 
    207207                     DO ib = 1, SIZE(dta%v2d) 
    208208                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 

  • NEMO/trunk/src/OCE/C1D/dyndmp.F90

    r12377 r13286  
    121121         !Read in mask from file 
    122122         CALL iom_open ( cn_resto, imask) 
    123          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto) 
     123         CALL iom_get  ( imask, jpdom_auto, 'resto', resto) 
    124124         CALL iom_close( imask ) 
    125125      ENDIF 

  • NEMO/trunk/src/OCE/CRS/crs.F90

    r10068 r13286  
    3636      INTEGER  ::  jpiglo_full, jpjglo_full     !: jpiglo / jpjglo 
    3737      INTEGER  ::  npiglo, npjglo               !: jpjglo 
    38       INTEGER  ::  nlci_full, nlcj_full         !: i-, j-dimension of local or sub domain on parent grid 
    39       INTEGER  ::  nldi_full, nldj_full         !: starting indices of internal sub-domain on parent grid 
    40       INTEGER  ::  nlei_full, nlej_full         !: ending indices of internal sub-domain on parent grid 
    41       INTEGER  ::  nlci_crs, nlcj_crs           !: i-, j-dimension of local or sub domain on coarse grid 
    42       INTEGER  ::  nldi_crs, nldj_crs           !: starting indices of internal sub-domain on coarse grid 
    43       INTEGER  ::  nlei_crs, nlej_crs           !: ending indices of internal sub-domain on coarse grid 
     38      INTEGER  ::  Nis0_full, Njs0_full         !: starting indices of internal sub-domain on parent grid 
     39      INTEGER  ::  Nie0_full, Nje0_full         !: ending indices of internal sub-domain on parent grid 
     40      INTEGER  ::  Nis0_crs , Njs0_crs          !: starting indices of internal sub-domain on coarse grid 
     41      INTEGER  ::  Nie0_crs , Nje0_crs          !: ending indices of internal sub-domain on coarse grid 
    4442 
    4543      INTEGER  ::  narea_full, narea_crs        !: node 
    … …  
    4846      INTEGER  ::  nimpp_full, njmpp_full       !: global position of point (1,1) of subdomain on parent grid 
    4947      INTEGER  ::  nimpp_crs, njmpp_crs         !: set to 1,1 for now .  Valid only for monoproc 
    50       INTEGER  ::  nreci_full, nrecj_full 
    51       INTEGER  ::  nreci_crs, nrecj_crs 
    5248      !cc 
    5349      INTEGER ::   noea_full, nowe_full        !: index of the local neighboring processors in 
    … …  
    7672      INTEGER, DIMENSION(:), ALLOCATABLE :: mi0_crs, mi1_crs, mj0_crs, mj1_crs 
    7773      INTEGER  :: mxbinctr, mybinctr            ! central point in grid box 
    78       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcit_crs, nlcit_full  !: dimensions of every subdomain 
    79       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldit_crs, nldit_full     !: first, last indoor index for each i-domain 
    80       INTEGER, DIMENSION(:), ALLOCATABLE ::   nleit_crs, nleit_full    !: first, last indoor index for each j-domain 
    81       INTEGER, DIMENSION(:), ALLOCATABLE ::   nimppt_crs, nimppt_full    !: first, last indoor index for each j-domain 
    82       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlcjt_crs, nlcjt_full  !: dimensions of every subdomain 
    83       INTEGER, DIMENSION(:), ALLOCATABLE ::   nldjt_crs, nldjt_full     !: first, last indoor index for each i-domain 
    84       INTEGER, DIMENSION(:), ALLOCATABLE ::   nlejt_crs, nlejt_full    !: first, last indoor index for each j-domain 
    85       INTEGER, DIMENSION(:), ALLOCATABLE ::   njmppt_crs, njmppt_full    !: first, last indoor index for each j-domain 
     74      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpiall_crs,  jpiall_full   !: dimensions of every subdomain 
     75      INTEGER, DIMENSION(:), ALLOCATABLE ::   nis0all_crs, nis0all_full   !: first, last indoor index for each i-domain 
     76      INTEGER, DIMENSION(:), ALLOCATABLE ::   nie0all_crs, nie0all_full   !: first, last indoor index for each j-domain 
     77      INTEGER, DIMENSION(:), ALLOCATABLE ::    nimppt_crs,  nimppt_full   !: first, last indoor index for each j-domain 
     78      INTEGER, DIMENSION(:), ALLOCATABLE ::    jpjall_crs,  jpjall_full   !: dimensions of every subdomain 
     79      INTEGER, DIMENSION(:), ALLOCATABLE ::   njs0all_crs, njs0all_full   !: first, last indoor index for each i-domain 
     80      INTEGER, DIMENSION(:), ALLOCATABLE ::   nje0all_crs, nje0all_full   !: first, last indoor index for each j-domain 
     81      INTEGER, DIMENSION(:), ALLOCATABLE ::    njmppt_crs,  njmppt_full   !: first, last indoor index for each j-domain 
    8682 
    8783  
    8884      ! Masks 
    8985      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmask_crs, umask_crs, vmask_crs, fmask_crs 
    90       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: tmask_i_crs, rnfmsk_crs, tpol_crs, fpol_crs 
    91        
    92   !    REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: tmask_i_crs, tpol, fpol       
    93  
     86      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: rnfmsk_crs 
     87       
    9488      ! Scale factors 
    9589      REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: e1t_crs, e2t_crs, e1e2t_crs ! horizontal scale factors grid type T 
    … …  
    182176         &      umask_crs(jpi_crs,jpj_crs,jpk) , vmask_crs(jpi_crs,jpj_crs,jpk) , STAT=ierr(2)) 
    183177 
    184       ALLOCATE( tmask_i_crs(jpi_crs,jpj_crs)   , rnfmsk_crs(jpi_crs,jpj_crs), & 
    185       &         tpol_crs(jpiglo_crs,jpjglo_crs), fpol_crs(jpiglo_crs,jpjglo_crs), STAT=ierr(3) ) 
     178      ALLOCATE( rnfmsk_crs(jpi_crs,jpj_crs), STAT=ierr(3) ) 
    186179 
    187180      ALLOCATE( gphit_crs(jpi_crs,jpj_crs) , glamt_crs(jpi_crs,jpj_crs) , &  
    … …  
    238231         &      hmlp_crs(jpi_crs,jpj_crs) , hmlpt_crs(jpi_crs,jpj_crs) , STAT=ierr(14) ) 
    239232          
    240       ALLOCATE( nimppt_crs (jpnij) , nlcit_crs (jpnij) , nldit_crs (jpnij) , nleit_crs (jpnij),   & 
    241          &      nimppt_full(jpnij) , nlcit_full(jpnij) , nldit_full(jpnij) , nleit_full(jpnij),   & 
    242                 njmppt_crs (jpnij) , nlcjt_crs (jpnij) , nldjt_crs (jpnij) , nlejt_crs (jpnij),   & 
    243          &      njmppt_full(jpnij) , nlcjt_full(jpnij) , nldjt_full(jpnij) , nlejt_full(jpnij)  , STAT=ierr(15) ) 
     233      ALLOCATE( nimppt_crs (jpnij) , jpiall_crs (jpnij) , nis0all_crs (jpnij) , nie0all_crs (jpnij),   & 
     234         &      nimppt_full(jpnij) , jpiall_full(jpnij) , nis0all_full(jpnij) , nie0all_full(jpnij),   & 
     235                njmppt_crs (jpnij) , jpjall_crs (jpnij) , njs0all_crs (jpnij) , nje0all_crs (jpnij),   & 
     236         &      njmppt_full(jpnij) , jpjall_full(jpnij) , njs0all_full(jpnij) , nje0all_full(jpnij)  , STAT=ierr(15) ) 
    244237    
    245238      crs_dom_alloc = MAXVAL(ierr) 
    … …  
    258251      ierr(:) = 0 
    259252       
    260       ALLOCATE( mjs_crs(nlej_crs) , mje_crs(nlej_crs), mis_crs(nlei_crs) , mie_crs(nlei_crs), STAT=ierr(1) ) 
     253      ALLOCATE( mjs_crs(Nje0_crs) , mje_crs(Nje0_crs), mis_crs(Nie0_crs) , mie_crs(Nie0_crs), STAT=ierr(1) ) 
    261254      crs_dom_alloc2 = MAXVAL(ierr) 
    262255 
    … …  
    282275      jpjglo = jpjglo_full 
    283276 
    284       nlci   = nlci_full 
    285       nlcj   = nlcj_full 
    286       nldi   = nldi_full 
    287       nldj   = nldj_full 
    288       nlei   = nlei_full 
    289       nlej   = nlej_full 
    290       nimpp  = nimpp_full 
    291       njmpp  = njmpp_full 
    292        
    293       nlcit(:)  = nlcit_full(:) 
    294       nldit(:)  = nldit_full(:) 
    295       nleit(:)  = nleit_full(:) 
    296       nimppt(:) = nimppt_full(:) 
    297       nlcjt(:)  = nlcjt_full(:) 
    298       nldjt(:)  = nldjt_full(:) 
    299       nlejt(:)  = nlejt_full(:) 
    300       njmppt(:) = njmppt_full(:) 
     277      jpi   = jpi_full 
     278      jpj   = jpj_full 
     279      Nis0  = Nis0_full 
     280      Njs0  = Njs0_full 
     281      Nie0  = Nie0_full 
     282      Nje0  = Nje0_full 
     283      nimpp = nimpp_full 
     284      njmpp = njmpp_full 
     285       
     286      jpiall (:) = jpiall_full (:) 
     287      nis0all(:) = nis0all_full(:) 
     288      nie0all(:) = nie0all_full(:) 
     289      nimppt (:) = nimppt_full (:) 
     290      jpjall (:) = jpjall_full (:) 
     291      njs0all(:) = njs0all_full(:) 
     292      nje0all(:) = nje0all_full(:) 
     293      njmppt (:) = njmppt_full (:) 
    301294 
    302295   END SUBROUTINE dom_grid_glo 
    … …  
    322315 
    323316 
    324       nlci   = nlci_crs 
    325       nlcj   = nlcj_crs 
    326       nldi   = nldi_crs 
    327       nlei   = nlei_crs 
    328       nlej   = nlej_crs 
    329       nldj   = nldj_crs 
    330       nimpp  = nimpp_crs 
    331       njmpp  = njmpp_crs 
    332        
    333       nlcit(:)  = nlcit_crs(:) 
    334       nldit(:)  = nldit_crs(:) 
    335       nleit(:)  = nleit_crs(:) 
    336       nimppt(:) = nimppt_crs(:) 
    337       nlcjt(:)  = nlcjt_crs(:) 
    338       nldjt(:)  = nldjt_crs(:) 
    339       nlejt(:)  = nlejt_crs(:) 
    340       njmppt(:) = njmppt_crs(:) 
     317      jpi   = jpi_crs 
     318      jpj   = jpj_crs 
     319      Nis0  = Nis0_crs 
     320      Nie0  = Nie0_crs 
     321      Nje0  = Nje0_crs 
     322      Njs0  = Njs0_crs 
     323      nimpp = nimpp_crs 
     324      njmpp = njmpp_crs 
     325       
     326      jpiall (:) = jpiall_crs (:) 
     327      nis0all(:) = nis0all_crs(:) 
     328      nie0all(:) = nie0all_crs(:) 
     329      nimppt (:) = nimppt_crs (:) 
     330      jpjall (:) = jpjall_crs (:) 
     331      njs0all(:) = njs0all_crs(:) 
     332      nje0all(:) = nje0all_crs(:) 
     333      njmppt (:) = njmppt_crs (:) 
    341334      ! 
    342335   END SUBROUTINE dom_grid_crs 

  • NEMO/trunk/src/OCE/CRS/crsdom.F90

    r13226 r13286  
    7373   
    7474             
    75       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     75      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    7676         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    7777            je_2 = mje_crs(2)   ;  ij = je_2 
    … …  
    8181      ENDIF 
    8282      DO jk = 1, jpkm1 
    83          DO ji = 2, nlei_crs   
     83         DO ji = 2, Nie0_crs   
    8484            ijis = mis_crs(ji)  ;  ijie = mie_crs(ji)     
    8585            !           
    … …  
    101101      ! 
    102102      DO jk = 1, jpkm1 
    103          DO ji = 2, nlei_crs   
     103         DO ji = 2, Nie0_crs   
    104104            ijis = mis_crs(ji)     ;   ijie = mie_crs(ji)        
    105             DO jj = 3, nlej_crs 
     105            DO jj = 3, Nje0_crs 
    106106               ijjs = mjs_crs(jj)  ;   ijje = mje_crs(jj) 
    107107                           
    … …  
    168168      SELECT CASE ( cd_type ) 
    169169         CASE ( 'T' ) 
    170             DO jj =  nldj_crs, nlej_crs 
     170            DO jj =  Njs0_crs, Nje0_crs 
    171171               ijjs = mjs_crs(jj) + mybinctr 
    172                DO ji = 2, nlei_crs 
     172               DO ji = 2, Nie0_crs 
    173173                  ijis = mis_crs(ji) + mxbinctr  
    174174                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    177177            ENDDO 
    178178         CASE ( 'U' ) 
    179             DO jj =  nldj_crs, nlej_crs 
     179            DO jj =  Njs0_crs, Nje0_crs 
    180180               ijjs = mjs_crs(jj) + mybinctr                   
    181                DO ji = 2, nlei_crs 
     181               DO ji = 2, Nie0_crs 
    182182                  ijis = mis_crs(ji) 
    183183                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    186186            ENDDO 
    187187         CASE ( 'V' ) 
    188             DO jj =  nldj_crs, nlej_crs 
     188            DO jj =  Njs0_crs, Nje0_crs 
    189189               ijjs = mjs_crs(jj) 
    190                DO ji = 2, nlei_crs 
     190               DO ji = 2, Nie0_crs 
    191191                  ijis = mis_crs(ji) + mxbinctr  
    192192                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    195195            ENDDO 
    196196         CASE ( 'F' ) 
    197             DO jj =  nldj_crs, nlej_crs 
     197            DO jj =  Njs0_crs, Nje0_crs 
    198198               ijjs = mjs_crs(jj) 
    199                DO ji = 2, nlei_crs 
     199               DO ji = 2, Nie0_crs 
    200200                  ijis = mis_crs(ji) 
    201201                  p_gphi_crs(ji,jj) = p_gphi(ijis,ijjs) 
    … …  
    212212      SELECT CASE ( cd_type ) 
    213213         CASE ( 'T', 'V' ) 
    214             DO ji = 2, nlei_crs 
     214            DO ji = 2, Nie0_crs 
    215215               ijis = mis_crs(ji) + mxbinctr  
    216216               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    … …  
    218218            ENDDO 
    219219         CASE ( 'U', 'F' ) 
    220             DO ji = 2, nlei_crs 
     220            DO ji = 2, Nie0_crs 
    221221               ijis = mis_crs(ji)  
    222222               p_gphi_crs(ji,1) = p_gphi(ijis,1) 
    … …  
    261261 
    262262      DO jk = 1, jpk     
    263          DO ji = 2, nlei_crs 
     263         DO ji = 2, Nie0_crs 
    264264            ijie = mie_crs(ji) 
    265             DO jj = nldj_crs, nlej_crs 
     265            DO jj = Njs0_crs, Nje0_crs 
    266266               ijje = mje_crs(jj)   ;   ijrs =  mje_crs(jj) - mjs_crs(jj) 
    267267               ! Only for a factro 3 coarsening 
    … …  
    374374      ENDIF 
    375375 
    376       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     376      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    377377         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    378378            je_2 = mje_crs(2) 
    … …  
    512512                  ENDIF 
    513513          
    514                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     514                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    515515                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    516516                        je_2 = mje_crs(2) 
    … …  
    617617               CASE( 'T', 'W' ) 
    618618          
    619                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     619                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    620620                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    621621                        je_2 = mje_crs(2) 
    … …  
    674674               CASE( 'V' ) 
    675675 
    676                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     676                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    677677                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    678678                        ijje = mje_crs(2) 
    … …  
    711711               CASE( 'U' ) 
    712712 
    713                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     713                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    714714                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    715715                        je_2 = mje_crs(2) 
    … …  
    782782               CASE( 'T', 'W' ) 
    783783          
    784                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     784                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    785785                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    786786                        je_2 = mje_crs(2) 
    … …  
    842842               CASE( 'V' ) 
    843843 
    844                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     844                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    845845                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    846846                        ijje = mje_crs(2) 
    … …  
    883883               CASE( 'U' ) 
    884884 
    885                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     885                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    886886                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    887887                        je_2 = mje_crs(2) 
    … …  
    953953               CASE( 'T', 'W' ) 
    954954          
    955                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     955                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    956956                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    957957                        je_2 = mje_crs(2) 
    … …  
    10131013               CASE( 'V' ) 
    10141014 
    1015                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1015                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    10161016                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    10171017                        ijje = mje_crs(2) 
    … …  
    10531053               CASE( 'U' ) 
    10541054 
    1055                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1055                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    10561056                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    10571057                        je_2 = mje_crs(2) 
    … …  
    11581158            zsurfmsk(:,:) =  p_e12(:,:) * p_e3(:,:,1) * p_mask(:,:,1) 
    11591159 
    1160             IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1160            IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    11611161               IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    11621162                  je_2 = mje_crs(2) 
    … …  
    12341234               CASE( 'T', 'W' ) 
    12351235 
    1236                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1236                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    12371237                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    12381238                         je_2 = mje_crs(2) 
    … …  
    12851285               CASE( 'V' ) 
    12861286 
    1287                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1287                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    12881288                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    12891289                        ijje = mje_crs(2) 
    … …  
    13181318               CASE( 'U' ) 
    13191319 
    1320                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1320                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    13211321                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    13221322                        je_2 = mje_crs(2) 
    … …  
    13691369               CASE( 'T', 'W' ) 
    13701370   
    1371                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1371                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    13721372                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    13731373                         je_2 = mje_crs(2) 
    … …  
    14201420               CASE( 'V' ) 
    14211421 
    1422                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1422                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    14231423                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    14241424                        ijje = mje_crs(2) 
    … …  
    14531453               CASE( 'U' ) 
    14541454 
    1455                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1455                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    14561456                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    14571457                        je_2 = mje_crs(2) 
    … …  
    14971497              CASE( 'T', 'W' ) 
    14981498   
    1499                    IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1499                   IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15001500                      IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15011501                         je_2 = mje_crs(2) 
    … …  
    15481548               CASE( 'V' ) 
    15491549 
    1550                   IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1550                  IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15511551                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15521552                        ijje = mje_crs(2) 
    … …  
    15811581               CASE( 'U' ) 
    15821582 
    1583                  IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1583                 IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    15841584                     IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    15851585                        je_2 = mje_crs(2) 
    … …  
    16651665       ENDDO 
    16661666 
    1667        IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1667       IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    16681668          IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    16691669             je_2 = mje_crs(2) 
    … …  
    18081808      END SELECT 
    18091809 
    1810       IF( nldj_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
     1810      IF( Njs0_crs == 1 .AND. ( ( mje_crs(2) - mjs_crs(2) ) < 2 ) ) THEN     !!cc bande du sud style ORCA2 
    18111811         IF( mje_crs(2) - mjs_crs(2) == 1 ) THEN 
    18121812            je_2 = mje_crs(2) 
    … …  
    18991899      ! 2.a Define processor domain 
    19001900      IF( .NOT. lk_mpp ) THEN 
    1901          nimpp_crs  = 1 
    1902          njmpp_crs  = 1 
    1903          nlci_crs   = jpi_crs 
    1904          nlcj_crs   = jpj_crs 
    1905          nldi_crs   = 1 
    1906          nldj_crs   = 1 
    1907          nlei_crs   = jpi_crs 
    1908          nlej_crs   = jpj_crs 
     1901         nimpp_crs = 1 
     1902         njmpp_crs = 1 
     1903         Nis0_crs  = 1 
     1904         Njs0_crs  = 1 
     1905         Nie0_crs  = jpi_crs 
     1906         Nje0_crs  = jpj_crs 
    19091907      ELSE 
    19101908         ! Initialisation of most local variables - 
    1911          nimpp_crs  = 1 
    1912          njmpp_crs  = 1 
    1913          nlci_crs   = jpi_crs 
    1914          nlcj_crs   = jpj_crs 
    1915          nldi_crs   = 1 
    1916          nldj_crs   = 1 
    1917          nlei_crs   = jpi_crs 
    1918          nlej_crs   = jpj_crs 
     1909         nimpp_crs = 1 
     1910         njmpp_crs = 1 
     1911         Nis0_crs  = 1 
     1912         Njs0_crs  = 1 
     1913         Nie0_crs  = jpi_crs 
     1914         Nje0_crs  = jpj_crs 
    19191915          
    19201916        ! Calculs suivant une découpage en j 
    19211917        DO jn = 1, jpnij, jpni 
    19221918           IF( jn < ( jpnij - jpni + 1 ) ) THEN 
    1923               nlejt_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
     1919              nje0all_crs(jn) = AINT( REAL( ( jpjglo - (njmppt(jn     ) - 1) ) / nn_facty, wp ) ) & 
    19241920                       &    - AINT( REAL( ( jpjglo - (njmppt(jn+jpni) - 1) ) / nn_facty, wp ) ) 
    19251921           ELSE                                              
    1926               nlejt_crs(jn) = AINT( REAL(  nlejt(jn) / nn_facty, wp ) ) + 1             
     1922              nje0all_crs(jn) = AINT( REAL(  nje0all(jn) / nn_facty, wp ) ) + 1             
    19271923           ENDIF 
    1928            IF( noso < 0 ) nlejt_crs(jn) = nlejt_crs(jn) + 1              
     1924           IF( noso < 0 ) nje0all_crs(jn) = nje0all_crs(jn) + 1              
    19291925           SELECT CASE( ibonjt(jn) ) 
    19301926              CASE ( -1 ) 
    1931                 IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1932                 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1933                 nldjt_crs(jn) = nldjt(jn) 
     1927                IF( MOD( jpjglo - njmppt(jn), nn_facty) > 0 )  nje0all_crs(jn) = nje0all_crs(jn) + 1 
     1928                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 
     1929                njs0all_crs(jn) = njs0all(jn) 
    19341930               
    19351931              CASE ( 0 ) 
    19361932               
    1937                 nldjt_crs(jn) = nldjt(jn) 
    1938                 IF( nldjt(jn) == 1 )  nlejt_crs(jn) = nlejt_crs(jn) + 1 
    1939                 nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1940                 nlcjt_crs(jn) = nlejt_crs(jn) + nn_hls 
     1933                njs0all_crs(jn) = njs0all(jn) 
     1934                IF( njs0all(jn) == 1 )  nje0all_crs(jn) = nje0all_crs(jn) + 1 
     1935                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 
     1936                jpjall_crs (jn) = nje0all_crs(jn) + nn_hls 
    19411937                 
    19421938              CASE ( 1, 2 ) 
    19431939               
    1944                 nlejt_crs(jn) = nlejt_crs(jn) + nn_hls 
    1945                 nlcjt_crs(jn) = nlejt_crs(jn) 
    1946                 nldjt_crs(jn) = nldjt(jn) 
     1940                nje0all_crs(jn) = nje0all_crs(jn) + nn_hls 
     1941                jpjall_crs (jn) = nje0all_crs(jn) 
     1942                njs0all_crs(jn) = njs0all(jn) 
    19471943                 
    19481944              CASE DEFAULT 
    19491945                 CALL ctl_stop( 'STOP', 'error from crs_dom_def, you should not be there (1) ...' ) 
    19501946           END SELECT 
    1951            IF( nlcjt_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
    1952  
    1953            IF(nldjt_crs(jn) == 1 ) THEN 
     1947           IF( jpjall_crs(jn) > jpj_crs )     jpj_crs = jpj_crs + 1 
     1948 
     1949           IF(njs0all_crs(jn) == 1 ) THEN 
    19541950              njmppt_crs(jn) = 1 
    19551951           ELSE 
    … …  
    19581954            
    19591955           DO jj = jn + 1, jn + jpni - 1 
    1960               nlejt_crs(jj) = nlejt_crs(jn)  
    1961               nlcjt_crs(jj) = nlcjt_crs(jn) 
    1962               nldjt_crs(jj) = nldjt_crs(jn) 
    1963               njmppt_crs(jj)= njmppt_crs(jn) 
     1956              nje0all_crs(jj) = nje0all_crs(jn)  
     1957              jpjall_crs (jj) = jpjall_crs(jn) 
     1958              njs0all_crs(jj) = njs0all_crs(jn) 
     1959              njmppt_crs (jj) = njmppt_crs(jn) 
    19641960           ENDDO 
    19651961        ENDDO  
    1966         nlej_crs  = nlejt_crs(nproc + 1)  
    1967         nlcj_crs  = nlcjt_crs(nproc + 1) 
    1968         nldj_crs  = nldjt_crs(nproc + 1) 
    1969         njmpp_crs = njmppt_crs(nproc + 1) 
     1962        Nje0_crs  = nje0all_crs(nproc + 1)  
     1963        jpj_crs   = jpjall_crs (nproc + 1) 
     1964        Njs0_crs  = njs0all_crs(nproc + 1) 
     1965        njmpp_crs = njmppt_crs (nproc + 1) 
    19701966 
    19711967        ! Calcul suivant un decoupage en i 
    19721968        DO jn = 1, jpni 
    19731969           IF( jn == 1 ) THEN           
    1974               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) 
     1970              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) 
    19751971           ELSE 
    1976               nleit_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + nlcit(jn  ) )  / nn_factx, wp) ) & 
    1977                  &          - AINT( REAL( ( nimppt(jn-1) - 1 + nlcit(jn-1) )  / nn_factx, wp) ) 
     1972              nie0all_crs(jn) = AINT( REAL( ( nimppt(jn  ) - 1 + jpiall(jn  ) )  / nn_factx, wp) ) & 
     1973                 &            - AINT( REAL( ( nimppt(jn-1) - 1 + jpiall(jn-1) )  / nn_factx, wp) ) 
    19781974           ENDIF 
    19791975 
    19801976           SELECT CASE( ibonit(jn) ) 
    19811977              CASE ( -1 ) 
    1982                  nleit_crs(jn) = nleit_crs(jn) + nn_hls            
    1983                  nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    1984                  nldit_crs(jn) = nldit(jn)  
     1978                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls            
     1979                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 
     1980                 nis0all_crs(jn) = nis0all(jn)  
    19851981               
    19861982              CASE ( 0 ) 
    1987                  nleit_crs(jn) = nleit_crs(jn) + nn_hls 
    1988                  nlcit_crs(jn) = nleit_crs(jn) + nn_hls 
    1989                  nldit_crs(jn) = nldit(jn)  
     1983                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 
     1984                 jpiall_crs (jn) = nie0all_crs(jn) + nn_hls 
     1985                 nis0all_crs(jn) = nis0all(jn)  
    19901986                 
    19911987              CASE ( 1, 2 ) 
    1992                  IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nleit_crs(jn) = nleit_crs(jn) + 1 
    1993                  nleit_crs(jn) = nleit_crs(jn) + nn_hls 
    1994                  nlcit_crs(jn) = nleit_crs(jn) 
    1995                  nldit_crs(jn) = nldit(jn)  
     1988                 IF( MOD( jpiglo - nimppt(jn), nn_factx) > 0 )  nie0all_crs(jn) = nie0all_crs(jn) + 1 
     1989                 nie0all_crs(jn) = nie0all_crs(jn) + nn_hls 
     1990                 jpiall_crs (jn) = nie0all_crs(jn) 
     1991                 nis0all_crs(jn) = nis0all(jn)  
    19961992 
    19971993              CASE DEFAULT 
    … …  
    20011997           nimppt_crs(jn) = ANINT( REAL( (nimppt(jn) + 1 ) / nn_factx, wp ) ) + 1 
    20021998           DO jj = jn + jpni , jpnij, jpni 
    2003               nleit_crs(jj) = nleit_crs(jn)  
    2004               nlcit_crs(jj) = nlcit_crs(jn) 
    2005               nldit_crs(jj) = nldit_crs(jn) 
    2006               nimppt_crs(jj)= nimppt_crs(jn) 
     1999              nie0all_crs(jj) = nie0all_crs(jn)  
     2000              jpiall_crs (jj) = jpiall_crs (jn) 
     2001              nis0all_crs(jj) = nis0all_crs(jn) 
     2002              nimppt_crs (jj) = nimppt_crs (jn) 
    20072003           ENDDO 
    20082004         ENDDO  
    20092005         
    2010          nlei_crs  = nleit_crs(nproc + 1)  
    2011          nlci_crs  = nlcit_crs(nproc + 1) 
    2012          nldi_crs  = nldit_crs(nproc + 1) 
    2013          nimpp_crs = nimppt_crs(nproc + 1) 
     2006         Nie0_crs  = nie0all_crs(nproc + 1)  
     2007         jpi_crs   = jpiall_crs (nproc + 1) 
     2008         Nis0_crs  = nis0all_crs(nproc + 1) 
     2009         nimpp_crs = nimppt_crs (nproc + 1) 
    20142010 
    20152011         DO ji = 1, jpi_crs 
    … …  
    20432039      jpjglo_full = jpjglo 
    20442040 
    2045       nlcj_full   = nlcj 
    2046       nlci_full   = nlci 
    2047       nldi_full   = nldi 
    2048       nldj_full   = nldj 
    2049       nlei_full   = nlei 
    2050       nlej_full   = nlej 
    2051       nimpp_full  = nimpp      
    2052       njmpp_full  = njmpp 
     2041      jpj_full   = jpj 
     2042      jpi_full   = jpi 
     2043      Nis0_full  = Nis0 
     2044      Njs0_full  = Njs0 
     2045      Nie0_full  = Nie0 
     2046      Nje0_full  = Nje0 
     2047      nimpp_full = nimpp      
     2048      njmpp_full = njmpp 
    20532049       
    2054       nlcit_full(:)  = nlcit(:) 
    2055       nldit_full(:)  = nldit(:) 
    2056       nleit_full(:)  = nleit(:) 
    2057       nimppt_full(:) = nimppt(:) 
    2058       nlcjt_full(:)  = nlcjt(:) 
    2059       nldjt_full(:)  = nldjt(:) 
    2060       nlejt_full(:)  = nlejt(:) 
    2061       njmppt_full(:) = njmppt(:) 
     2050      jpiall_full (:) = jpiall (:) 
     2051      nis0all_full(:) = nis0all(:) 
     2052      nie0all_full(:) = nie0all(:) 
     2053      nimppt_full (:) = nimppt (:) 
     2054      jpjall_full (:) = jpjall (:) 
     2055      njs0all_full(:) = njs0all(:) 
     2056      nje0all_full(:) = nje0all(:) 
     2057      njmppt_full (:) = njmppt (:) 
    20622058       
    20632059      CALL dom_grid_crs  !swich de grille 
    … …  
    20732069         WRITE(numout,*) 
    20742070         WRITE(numout,*) ' nproc  = '     , nproc 
    2075          WRITE(numout,*) ' nlci   = '     , nlci 
    2076          WRITE(numout,*) ' nlcj   = '     , nlcj 
    2077          WRITE(numout,*) ' nldi   = '     , nldi 
    2078          WRITE(numout,*) ' nldj   = '     , nldj 
    2079          WRITE(numout,*) ' nlei   = '     , nlei 
    2080          WRITE(numout,*) ' nlej   = '     , nlej 
    2081          WRITE(numout,*) ' nlei_full='    , nlei_full 
    2082          WRITE(numout,*) ' nldi_full='    , nldi_full 
     2071         WRITE(numout,*) ' jpi    = '     , jpi 
     2072         WRITE(numout,*) ' jpj    = '     , jpj 
     2073         WRITE(numout,*) ' Nis0   = '     , Nis0 
     2074         WRITE(numout,*) ' Njs0   = '     , Njs0 
     2075         WRITE(numout,*) ' Nie0   = '     , Nie0 
     2076         WRITE(numout,*) ' Nje0   = '     , Nje0 
     2077         WRITE(numout,*) ' Nie0_full='    , Nie0_full 
     2078         WRITE(numout,*) ' Nis0_full='    , Nis0_full 
    20832079         WRITE(numout,*) ' nimpp  = '     , nimpp 
    20842080         WRITE(numout,*) ' njmpp  = '     , njmpp 
    … …  
    22032199        mje_crs(:) = mje2_crs(:)  
    22042200      ELSE 
    2205         DO jj = 1, nlej_crs 
     2201        DO jj = 1, Nje0_crs 
    22062202           mjs_crs(jj) = mjs2_crs(mjg_crs(jj)) - njmpp + 1 
    22072203           mje_crs(jj) = mje2_crs(mjg_crs(jj)) - njmpp + 1 
    22082204        ENDDO 
    2209         DO ji = 1, nlei_crs 
     2205        DO ji = 1, Nie0_crs 
    22102206           mis_crs(ji) = mis2_crs(mig_crs(ji)) - nimpp + 1 
    22112207           mie_crs(ji) = mie2_crs(mig_crs(ji)) - nimpp + 1 
    … …  
    22132209      ENDIF 
    22142210      ! 
    2215       nistr = mis_crs(2)  ;   niend = mis_crs(nlci_crs - 1) 
    2216       njstr = mjs_crs(3)  ;   njend = mjs_crs(nlcj_crs - 1) 
     2211      nistr = mis_crs(2)  ;   niend = mis_crs(jpi_crs - 1) 
     2212      njstr = mjs_crs(3)  ;   njend = mjs_crs(jpj_crs - 1) 
    22172213      ! 
    22182214   END SUBROUTINE crs_dom_def 

  • NEMO/trunk/src/OCE/CRS/crsdomwri.F90

    r13226 r13286  
    5050      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    5151      INTEGER           ::   inum         ! local units for 'mesh_mask.nc' file 
    52       INTEGER           ::   iif, iil, ijf, ijl 
    5352      CHARACTER(len=21) ::   clnam        ! filename (mesh and mask informations) 
    5453      !                                   !  workspace 
    … …  
    7675      CALL iom_rstput( 0, 0, inum, 'fmask', fmask_crs, ktype = jp_i1 ) 
    7776       
    78        
    79       tmask_i_crs(:,:) = tmask_crs(:,:,1) 
    80       iif = nn_hls 
    81       iil = nlci_crs - nn_hls + 1 
    82       ijf = nn_hls 
    83       ijl = nlcj_crs - nn_hls + 1 
    84       
    85       tmask_i_crs( 1:iif ,    :  ) = 0._wp 
    86       tmask_i_crs(iil:jpi_crs,    :  ) = 0._wp 
    87       tmask_i_crs(   :   , 1:ijf ) = 0._wp 
    88       tmask_i_crs(   :   ,ijl:jpj_crs) = 0._wp 
    89        
    90        
    91       tpol_crs(1:jpiglo_crs,:) = 1._wp 
    92       fpol_crs(1:jpiglo_crs,:) = 1._wp 
    93       IF( jperio == 3 .OR. jperio == 4 ) THEN 
    94          tpol_crs(jpiglo_crs/2+1:jpiglo_crs,:) = 0._wp 
    95          fpol_crs(       1      :jpiglo_crs,:) = 0._wp 
    96          IF( mjg_crs(nlej_crs) == jpiglo_crs ) THEN 
    97             DO ji = iif+1, iil-1 
    98                tmask_i_crs(ji,nlej_crs-1) = tmask_i_crs(ji,nlej_crs-1) & 
    99                & * tpol_crs(mig_crs(ji),1) 
    100             ENDDO 
    101          ENDIF 
    102       ENDIF 
    103       IF( jperio == 5 .OR. jperio == 6 ) THEN 
    104          tpol_crs(      1       :jpiglo_crs,:)=0._wp 
    105          fpol_crs(jpiglo_crs/2+1:jpiglo_crs,:)=0._wp 
    106       ENDIF 
    107        
    108       CALL iom_rstput( 0, 0, inum, 'tmaskutil', tmask_i_crs, ktype = jp_i1 ) 
    109                                    !    ! unique point mask 
     77      CALL dom_uniq_crs( zprw, 'T' ) 
     78      zprt = tmask_crs(:,:,1) * zprw 
     79      CALL iom_rstput( 0, 0, inum, 'tmaskutil', zprt, ktype = jp_i1 ) 
    11080      CALL dom_uniq_crs( zprw, 'U' ) 
    11181      zprt = umask_crs(:,:,1) * zprw 
    … …  
    211181      REAL(wp) ::  zshift   ! shift value link to the process number 
    212182      INTEGER  ::  ji       ! dummy loop indices 
    213       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    214       REAL(wp), DIMENSION(jpi_crs,jpj_crs) :: ztstref 
     183      LOGICAL , DIMENSION(jpi_crs,jpj_crs,1) ::   lluniq  ! store whether each point is unique or not 
     184      REAL(wp), DIMENSION(jpi_crs,jpj_crs  ) ::  ztstref 
    215185      !!---------------------------------------------------------------------- 
    216186      ! 
    … …  
    218188      ! in mpp: make sure that these values are different even between process 
    219189      ! -> apply a shift value according to the process number 
    220       zshift = jpi_crs * jpj_crs * ( narea - 1 ) 
     190      zshift = (jpi_crs+1.) * (jpj_crs+1.) * ( narea - 1 )   ! we should use jpimax_crs but not existing 
    221191      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi_crs*jpj_crs) /), (/ jpi_crs, jpj_crs /) ) 
    222192      ! 
    223193      puniq(:,:) = ztstref(:,:)                   ! default definition 
    224194      CALL crs_lbc_lnk( puniq,cdgrd, 1.0_wp )            ! apply boundary conditions 
    225       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    226       ! 
    227       puniq(:,:) = 1.                             ! default definition 
    228       ! fill only the inner part of the cpu with llbl converted into real  
    229       puniq(nldi_crs:nlei_crs,nldj_crs:nlej_crs) = REAL( COUNT( lldbl(nldi_crs:nlei_crs,nldj_crs:nlej_crs,:), dim = 3 ) , wp ) 
     195      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
     196      ! 
     197      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp ) 
    230198      ! 
    231199   END SUBROUTINE dom_uniq_crs 

  • NEMO/trunk/src/OCE/DIA/diaar5.F90

    r13237 r13286  
    396396            ALLOCATE( zsaldta(jpi,jpj,jpk,jpts) ) 
    397397            CALL iom_open ( 'sali_ref_clim_monthly', inum ) 
    398             CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
    399             CALL iom_get  ( inum, jpdom_data, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
     398            CALL iom_get  ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,1), 1  ) 
     399            CALL iom_get  ( inum, jpdom_global, 'vosaline' , zsaldta(:,:,:,2), 12 ) 
    400400            CALL iom_close( inum ) 
    401401 

  • NEMO/trunk/src/OCE/DIA/diadct.F90

    r13237 r13286  
    412412              ijloc=ijglo-njmpp+1   !  " 
    413413 
    414               !verify if the point is on the local domain:(1,nlei)*(1,nlej) 
    415               IF( iiloc >= 1 .AND. iiloc <= nlei .AND. & 
    416                   ijloc >= 1 .AND. ijloc <= nlej       )THEN 
     414              !verify if the point is on the local domain:(1,Nie0)*(1,Nje0) 
     415              IF( iiloc >= 1 .AND. iiloc <= Nie0 .AND. & 
     416                  ijloc >= 1 .AND. ijloc <= Nje0       )THEN 
    417417                 iptloc = iptloc + 1                                                 ! count local points 
    418418                 secs(jsec)%listPoint(iptloc) = POINT_SECTION(mi0(iiglo),mj0(ijglo)) ! store local coordinates 
    … …  
    519519  
    520520     !which coordinate shall we verify ? 
    521      IF      ( cdind=='I' )THEN   ; itest=nlei ; iind=1 
    522      ELSE IF ( cdind=='J' )THEN   ; itest=nlej ; iind=2 
     521     IF      ( cdind=='I' )THEN   ; itest=Nie0 ; iind=1 
     522     ELSE IF ( cdind=='J' )THEN   ; itest=Nje0 ; iind=2 
    523523     ELSE    ; CALL ctl_stop("removepoints :Wrong value for cdind")  
    524524     ENDIF 

  • NEMO/trunk/src/OCE/DIA/diahsb.F90

    r13237 r13286  
    274274               CALL iom_get( numror, 'frc_wn_s', frc_wn_s, ldxios = lrxios ) 
    275275            ENDIF 
    276             CALL iom_get( numror, jpdom_autoglo, 'surf_ini'  , surf_ini  , ldxios = lrxios ) ! ice sheet coupling 
    277             CALL iom_get( numror, jpdom_autoglo, 'ssh_ini'   , ssh_ini   , ldxios = lrxios ) 
    278             CALL iom_get( numror, jpdom_autoglo, 'e3t_ini'   , e3t_ini   , ldxios = lrxios ) 
    279             CALL iom_get( numror, jpdom_autoglo, 'tmask_ini' , tmask_ini , ldxios = lrxios ) 
    280             CALL iom_get( numror, jpdom_autoglo, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios ) 
    281             CALL iom_get( numror, jpdom_autoglo, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios ) 
     276            CALL iom_get( numror, jpdom_auto, 'surf_ini'  , surf_ini  , ldxios = lrxios ) ! ice sheet coupling 
     277            CALL iom_get( numror, jpdom_auto, 'ssh_ini'   , ssh_ini   , ldxios = lrxios ) 
     278            CALL iom_get( numror, jpdom_auto, 'e3t_ini'   , e3t_ini   , ldxios = lrxios ) 
     279            CALL iom_get( numror, jpdom_auto, 'tmask_ini' , tmask_ini , ldxios = lrxios ) 
     280            CALL iom_get( numror, jpdom_auto, 'hc_loc_ini', hc_loc_ini, ldxios = lrxios ) 
     281            CALL iom_get( numror, jpdom_auto, 'sc_loc_ini', sc_loc_ini, ldxios = lrxios ) 
    282282            IF( ln_linssh ) THEN 
    283                CALL iom_get( numror, jpdom_autoglo, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios ) 
    284                CALL iom_get( numror, jpdom_autoglo, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios ) 
     283               CALL iom_get( numror, jpdom_auto, 'ssh_hc_loc_ini', ssh_hc_loc_ini, ldxios = lrxios ) 
     284               CALL iom_get( numror, jpdom_auto, 'ssh_sc_loc_ini', ssh_sc_loc_ini, ldxios = lrxios ) 
    285285            ENDIF 
    286286         ELSE 

  • NEMO/trunk/src/OCE/DIA/diaptr.F90

    r13237 r13286  
    355355         btmsk(:,:,1) = tmask_i(:,:)                  
    356356         CALL iom_open( 'subbasins', inum,  ldstop = .FALSE.  ) 
    357          CALL iom_get( inum, jpdom_data, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
    358          CALL iom_get( inum, jpdom_data, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
    359          CALL iom_get( inum, jpdom_data, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
     357         CALL iom_get( inum, jpdom_global, 'atlmsk', btmsk(:,:,2) )   ! Atlantic basin 
     358         CALL iom_get( inum, jpdom_global, 'pacmsk', btmsk(:,:,3) )   ! Pacific  basin 
     359         CALL iom_get( inum, jpdom_global, 'indmsk', btmsk(:,:,4) )   ! Indian   basin 
    360360         CALL iom_close( inum ) 
    361361         btmsk(:,:,5) = MAX ( btmsk(:,:,3), btmsk(:,:,4) )          ! Indo-Pacific basin 

  • NEMO/trunk/src/OCE/DIA/diawri.F90

    r13237 r13286  
    471471 
    472472      ! Define indices of the horizontal output zoom and vertical limit storage 
    473       iimi = 1      ;      iima = jpi 
    474       ijmi = 1      ;      ijma = jpj 
     473      iimi = Nis0   ;   iima = Nie0 
     474      ijmi = Njs0   ;   ijma = Nje0 
    475475      ipk = jpk 
    476476      IF(ln_abl) ipka = jpkam1 

  • NEMO/trunk/src/OCE/DOM/closea.F90

    r12377 r13286  
    2222   ! 
    2323   USE diu_bulk    , ONLY: ln_diurnal_only            ! used for sanity check 
    24    USE iom         , ONLY: iom_open, iom_get, iom_close, jpdom_data ! I/O routines 
     24   USE iom         , ONLY: iom_open, iom_get, iom_close, jpdom_global ! I/O routines 
    2525   USE lib_fortran , ONLY: glob_sum                   ! fortran library 
    2626   USE lib_mpp     , ONLY: mpp_max, ctl_nam, ctl_stop ! MPP library 
    … …  
    236236      ! 
    237237      CALL iom_open ( cd_file, ics ) 
    238       CALL iom_get  ( ics, jpdom_data, TRIM(cd_var), zdta ) 
     238      CALL iom_get  ( ics, jpdom_global, TRIM(cd_var), zdta ) 
    239239      CALL iom_close( ics ) 
    240240      k_mskout(:,:) = NINT(zdta(:,:)) 

  • NEMO/trunk/src/OCE/DOM/daymod.F90

    r13226 r13286  
    279279      IF(sn_cfctl%l_prtctl) THEN 
    280280         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    281          CALL prt_ctl_info(charout) 
     281         CALL prt_ctl_info( charout ) 
    282282      ENDIF 
    283283 

  • NEMO/trunk/src/OCE/DOM/dom_oce.F90

    r13237 r13286  
    7676   !                             !: domain MPP decomposition parameters 
    7777   INTEGER             , PUBLIC ::   nimpp, njmpp     !: i- & j-indexes for mpp-subdomain left bottom 
    78    INTEGER             , PUBLIC ::   nreci, nrecj     !: overlap region in i and j 
    7978   INTEGER             , PUBLIC ::   nproc            !: number for local processor 
    8079   INTEGER             , PUBLIC ::   narea            !: number for local area 
    … …  
    8685 
    8786   INTEGER, PUBLIC ::   npolj             !: north fold mark (0, 3 or 4) 
    88    INTEGER, PUBLIC ::   nlci, nldi, nlei  !: i-dimensions of the local subdomain and its first and last indoor indices 
    89    INTEGER, PUBLIC ::   nlcj, nldj, nlej  !: i-dimensions of the local subdomain and its first and last indoor indices 
    9087   INTEGER, PUBLIC ::   noea, nowe        !: index of the local neighboring processors in 
    9188   INTEGER, PUBLIC ::   noso, nono        !: east, west, south and north directions 
    9289   INTEGER, PUBLIC ::   nidom             !: ??? 
    9390 
    94    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local  ==> global domain i-index 
    95    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local  ==> global domain j-index 
    96    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global ==> local  domain i-index (mi0=1 and mi1=0 if the global index 
    97    !                                                                !                                             is not in the local domain) 
    98    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global ==> local  domain j-index (mj0=1 and mj1=0 if the global index 
    99    !                                                                !                                             is not in the local domain) 
    100    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt, njmppt   !: i-, j-indexes for each processor 
    101    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit, ibonjt   !: i-, j- processor neighbour existence 
    102    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nlcit , nlcjt    !: dimensions of every subdomain 
    103    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    104    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
    105    INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 
     91   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig        !: local ==> global domain, including halos (jpiglo), i-index 
     92   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg        !: local ==> global domain, including halos (jpjglo), j-index 
     93   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig0       !: local ==> global domain, excluding halos (Ni0glo), i-index 
     94   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg0       !: local ==> global domain, excluding halos (Nj0glo), j-index 
     95   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mig0_oldcmp !: local ==> global domain, excluding halos (Ni0glo), i-index 
     96   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mjg0_oldcmp !: local ==> global domain, excluding halos (Nj0glo), j-index 
     97   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mi0, mi1   !: global, including halos (jpiglo) ==> local domain i-index 
     98   !                                                                !:    (mi0=1 and mi1=0 if global index not in local domain) 
     99   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   mj0, mj1   !: global, including halos (jpjglo) ==> local domain j-index 
     100   !                                                                !:    (mj0=1 and mj1=0 if global index not in local domain) 
     101   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nimppt,  njmppt   !: i-, j-indexes for each processor 
     102   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   ibonit,  ibonjt   !: i-, j- processor neighbour existence 
     103   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   jpiall,  jpjall   !: dimensions of all subdomain 
     104   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nis0all, njs0all  !: first, last indoor index for all i-subdomain 
     105   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nie0all, nje0all  !: first, last indoor index for all j-subdomain 
     106   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nfimpp, nfproc, nfjpi 
    106107 
    107108   !!---------------------------------------------------------------------- 
    … …  
    116117   ! 
    117118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    118    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
    119    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , e2_e1u, r1_e1e2u        !: associated metrics at u-point 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , e1_e2v, r1_e1e2v        !: associated metrics at v-point 
    120121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    121122   ! 
    … …  
    187188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    188189 
    189    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level           (ISF) 
     190   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf   !: top first wet T-, U-, V-, F-level           (ISF) 
    190191 
    191192   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)           ::   ssmask, ssumask, ssvmask, ssfmask   !: surface mask at T-,U-, V- and F-pts 
    192    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    193    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    194  
    195    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
     193   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, wmask, fmask   !: land/ocean mask at T-, U-, V-, W- and F-pts 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    196195 
    197196   !!---------------------------------------------------------------------- 
    … …  
    262261      ! 
    263262      ii = ii+1 
    264       ALLOCATE( mig(jpi), mjg(jpj), STAT=ierr(ii) ) 
    265          ! 
    266       ii = ii+1 
    267       ALLOCATE( mi0(jpiglo)   , mi1 (jpiglo),  mj0(jpjglo)   , mj1 (jpjglo) ,     & 
    268          &      tpol(jpiglo) , fpol(jpiglo)                              , STAT=ierr(ii) ) 
     263      ALLOCATE( mig(jpi), mjg(jpj), mig0(jpi), mjg0(jpj), mig0_oldcmp(jpi), mjg0_oldcmp(jpj), STAT=ierr(ii) ) 
     264         ! 
     265      ii = ii+1 
     266      ALLOCATE( mi0(jpiglo), mi1(jpiglo), mj0(jpjglo), mj1(jpjglo), STAT=ierr(ii) ) 
    269267         ! 
    270268      ii = ii+1 

  • NEMO/trunk/src/OCE/DOM/domain.F90

    r13237 r13286  
    240240      !! ** Method  :    
    241241      !! 
    242       !! ** Action  : - mig , mjg : local  domain indices ==> global domain indices 
     242      !! ** Action  : - mig , mjg : local  domain indices ==> global domain, including halos, indices 
     243      !!              - mig0, mjg0: local  domain indices ==> global domain, excluding halos, indices 
    243244      !!              - mi0 , mi1 : global domain indices ==> local  domain indices 
    244       !!              - mj0,, mj1   (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
     245      !!              - mj0 , mj1   (if global point not in the local domain ==> mi0>mi1 and/or mj0>mj1) 
    245246      !!---------------------------------------------------------------------- 
    246247      INTEGER ::   ji, jj   ! dummy loop argument 
    247248      !!---------------------------------------------------------------------- 
    248249      ! 
    249       DO ji = 1, jpi                 ! local domain indices ==> global domain indices 
     250      DO ji = 1, jpi                 ! local domain indices ==> global domain, including halos, indices 
    250251        mig(ji) = ji + nimpp - 1 
    251252      END DO 
    … …  
    253254        mjg(jj) = jj + njmpp - 1 
    254255      END DO 
    255       !                              ! global domain indices ==> local domain indices 
     256      !                              ! local domain indices ==> global domain, excluding halos, indices 
     257      ! 
     258      mig0(:) = mig(:) - nn_hls 
     259      mjg0(:) = mjg(:) - nn_hls   
     260      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     261      ! we must define mig0 and mjg0 as bellow. 
     262      ! Once we decide to forget trunk compatibility, we must simply define mig0 and mjg0 as: 
     263      mig0_oldcmp(:) = mig0(:) + COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     264      mjg0_oldcmp(:) = mjg0(:) + COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) 
     265      ! 
     266      !                              ! global domain, including halos, indices ==> local domain indices 
    256267      !                                   ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the  
    257268      !                                   ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.  
    … …  
    271282         WRITE(numout,*) '   local  domain:   jpi    = ', jpi   , ' jpj    = ', jpj   , ' jpk    = ', jpk 
    272283         WRITE(numout,*) 
    273          WRITE(numout,*) '   conversion from local to global domain indices (and vise versa) done' 
    274          IF( nn_print >= 1 ) THEN 
    275             WRITE(numout,*) 
    276             WRITE(numout,*) '          conversion local  ==> global i-index domain (mig)' 
    277             WRITE(numout,25)              (mig(ji),ji = 1,jpi) 
    278             WRITE(numout,*) 
    279             WRITE(numout,*) '          conversion global ==> local  i-index domain' 
    280             WRITE(numout,*) '             starting index (mi0)' 
    281             WRITE(numout,25)              (mi0(ji),ji = 1,jpiglo) 
    282             WRITE(numout,*) '             ending index (mi1)' 
    283             WRITE(numout,25)              (mi1(ji),ji = 1,jpiglo) 
    284             WRITE(numout,*) 
    285             WRITE(numout,*) '          conversion local  ==> global j-index domain (mjg)' 
    286             WRITE(numout,25)              (mjg(jj),jj = 1,jpj) 
    287             WRITE(numout,*) 
    288             WRITE(numout,*) '          conversion global ==> local  j-index domain' 
    289             WRITE(numout,*) '             starting index (mj0)' 
    290             WRITE(numout,25)              (mj0(jj),jj = 1,jpjglo) 
    291             WRITE(numout,*) '             ending index (mj1)' 
    292             WRITE(numout,25)              (mj1(jj),jj = 1,jpjglo) 
    293          ENDIF 
    294       ENDIF 
    295  25   FORMAT( 100(10x,19i4,/) ) 
     284      ENDIF 
    296285      ! 
    297286   END SUBROUTINE dom_glo 
    … …  
    413402#endif 
    414403 
    415 #if defined key_agrif 
    416404      IF( Agrif_Root() ) THEN 
    417 #endif 
    418       IF(lwp) WRITE(numout,*) 
    419       SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    420       CASE (  1 )  
    421          CALL ioconf_calendar('gregorian') 
    422          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
    423       CASE (  0 ) 
    424          CALL ioconf_calendar('noleap') 
    425          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
    426       CASE ( 30 ) 
    427          CALL ioconf_calendar('360d') 
    428          IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
    429       END SELECT 
    430 #if defined key_agrif 
    431       ENDIF 
    432 #endif 
     405         IF(lwp) WRITE(numout,*) 
     406         SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
     407         CASE (  1 )  
     408            CALL ioconf_calendar('gregorian') 
     409            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "gregorian", i.e. leap year' 
     410         CASE (  0 ) 
     411            CALL ioconf_calendar('noleap') 
     412            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "noleap", i.e. no leap year' 
     413         CASE ( 30 ) 
     414            CALL ioconf_calendar('360d') 
     415            IF(lwp) WRITE(numout,*) '   ==>>>   The IOIPSL calendar is "360d", i.e. 360 days in a year' 
     416         END SELECT 
     417      ENDIF 
    433418 
    434419      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 903) 
    … …  
    503488      !! ** Method  :   compute and print extrema of masked scale factors 
    504489      !!---------------------------------------------------------------------- 
    505       INTEGER, DIMENSION(2) ::   imi1, imi2, ima1, ima2 
    506       INTEGER, DIMENSION(2) ::   iloc   !  
    507       REAL(wp) ::  ze1min, ze1max, ze2min, ze2max 
     490      LOGICAL, DIMENSION(jpi,jpj) ::   llmsk 
     491      INTEGER, DIMENSION(2)       ::   imil, imip, imi1, imi2, imal, imap, ima1, ima2 
     492      REAL(wp)                    ::   zglmin, zglmax, zgpmin, zgpmax, ze1min, ze1max, ze2min, ze2max 
    508493      !!---------------------------------------------------------------------- 
    509494      ! 
    510495      IF(lk_mpp) THEN 
    511          CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
    512          CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
    513          CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
    514          CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
     496         CALL mpp_minloc( 'domain', glamt(:,:), tmask_i(:,:), zglmin, imil ) 
     497         CALL mpp_minloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmin, imip ) 
     498         CALL mpp_minloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1min, imi1 ) 
     499         CALL mpp_minloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2min, imi2 ) 
     500         CALL mpp_maxloc( 'domain', glamt(:,:), tmask_i(:,:), zglmax, imal ) 
     501         CALL mpp_maxloc( 'domain', gphit(:,:), tmask_i(:,:), zgpmax, imap ) 
     502         CALL mpp_maxloc( 'domain',   e1t(:,:), tmask_i(:,:), ze1max, ima1 ) 
     503         CALL mpp_maxloc( 'domain',   e2t(:,:), tmask_i(:,:), ze2max, ima2 ) 
    515504      ELSE 
    516          ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    517          ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    518          ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )     
    519          ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )     
    520          ! 
    521          iloc  = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    522          imi1(1) = iloc(1) + nimpp - 1 
    523          imi1(2) = iloc(2) + njmpp - 1 
    524          iloc  = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    525          imi2(1) = iloc(1) + nimpp - 1 
    526          imi2(2) = iloc(2) + njmpp - 1 
    527          iloc  = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    528          ima1(1) = iloc(1) + nimpp - 1 
    529          ima1(2) = iloc(2) + njmpp - 1 
    530          iloc  = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp ) 
    531          ima2(1) = iloc(1) + nimpp - 1 
    532          ima2(2) = iloc(2) + njmpp - 1 
    533       ENDIF 
     505         llmsk = tmask_i(:,:) == 1._wp 
     506         zglmin = MINVAL( glamt(:,:), mask = llmsk )     
     507         zgpmin = MINVAL( gphit(:,:), mask = llmsk )     
     508         ze1min = MINVAL(   e1t(:,:), mask = llmsk )     
     509         ze2min = MINVAL(   e2t(:,:), mask = llmsk )     
     510         zglmin = MAXVAL( glamt(:,:), mask = llmsk )     
     511         zgpmin = MAXVAL( gphit(:,:), mask = llmsk )     
     512         ze1max = MAXVAL(   e1t(:,:), mask = llmsk )     
     513         ze2max = MAXVAL(   e2t(:,:), mask = llmsk )     
     514         ! 
     515         imil   = MINLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     516         imip   = MINLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     517         imi1   = MINLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     518         imi2   = MINLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     519         imal   = MAXLOC( glamt(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     520         imap   = MAXLOC( gphit(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     521         ima1   = MAXLOC(   e1t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     522         ima2   = MAXLOC(   e2t(:,:), mask = llmsk ) + (/ nimpp - 1, njmpp - 1 /) 
     523      ENDIF 
     524      ! 
    534525      IF(lwp) THEN 
    535526         WRITE(numout,*) 
    536527         WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors' 
    537528         WRITE(numout,*) '~~~~~~~' 
    538          WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
    539          WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
    540          WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    541          WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     529         WRITE(numout,"(14x,'glamt mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmin, imil(1), imil(2) 
     530         WRITE(numout,"(14x,'glamt maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zglmax, imal(1), imal(2) 
     531         WRITE(numout,"(14x,'gphit mini: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmin, imip(1), imip(2) 
     532         WRITE(numout,"(14x,'gphit maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") zgpmax, imap(1), imap(2) 
     533         WRITE(numout,"(14x,'  e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2) 
     534         WRITE(numout,"(14x,'  e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2) 
     535         WRITE(numout,"(14x,'  e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2) 
     536         WRITE(numout,"(14x,'  e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2) 
    542537      ENDIF 
    543538      ! 
    … …  
    606601      IF(lwp) THEN 
    607602         WRITE(numout,*) '      cn_cfg = ', TRIM(cd_cfg), '   nn_cfg = ', kk_cfg 
    608          WRITE(numout,*) '      jpiglo = ', kpi 
    609          WRITE(numout,*) '      jpjglo = ', kpj 
     603         WRITE(numout,*) '      Ni0glo = ', kpi 
     604         WRITE(numout,*) '      Nj0glo = ', kpj 
    610605         WRITE(numout,*) '      jpkglo = ', kpk 
    611606         WRITE(numout,*) '      type of global domain lateral boundary   jperio = ', kperio 
    … …  
    631626      !!---------------------------------------------------------------------- 
    632627      INTEGER           ::   ji, jj, jk   ! dummy loop indices 
    633       INTEGER           ::   izco, izps, isco, icav 
    634628      INTEGER           ::   inum     ! local units 
    635629      CHARACTER(len=21) ::   clnam    ! filename (mesh and mask informations) 
    … …  
    646640      !          
    647641      clnam = cn_domcfg_out  ! filename (configuration information) 
    648       CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    649        
     642      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )      
    650643      ! 
    651644      !                             !==  ORCA family specificities  ==! 
    … …  
    655648      ENDIF 
    656649      ! 
    657       !                             !==  global domain size  ==! 
    658       ! 
    659       CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    660       CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    661       CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk   , wp), ktype = jp_i4 ) 
    662       ! 
    663650      !                             !==  domain characteristics  ==! 
    664651      ! 
    … …  
    667654      ! 
    668655      !                                   ! type of vertical coordinate 
    669       IF( ln_zco    ) THEN   ;   izco = 1   ;   ELSE   ;   izco = 0   ;   ENDIF 
    670       IF( ln_zps    ) THEN   ;   izps = 1   ;   ELSE   ;   izps = 0   ;   ENDIF 
    671       IF( ln_sco    ) THEN   ;   isco = 1   ;   ELSE   ;   isco = 0   ;   ENDIF 
    672       CALL iom_rstput( 0, 0, inum, 'ln_zco'   , REAL( izco, wp), ktype = jp_i4 ) 
    673       CALL iom_rstput( 0, 0, inum, 'ln_zps'   , REAL( izps, wp), ktype = jp_i4 ) 
    674       CALL iom_rstput( 0, 0, inum, 'ln_sco'   , REAL( isco, wp), ktype = jp_i4 ) 
     656      CALL iom_rstput( 0, 0, inum, 'ln_zco', REAL(COUNT((/ln_zco/)), wp), ktype = jp_i4 ) 
     657      CALL iom_rstput( 0, 0, inum, 'ln_zps', REAL(COUNT((/ln_zps/)), wp), ktype = jp_i4 ) 
     658      CALL iom_rstput( 0, 0, inum, 'ln_sco', REAL(COUNT((/ln_sco/)), wp), ktype = jp_i4 ) 
    675659      ! 
    676660      !                                   ! ocean cavities under iceshelves 
    677       IF( ln_isfcav ) THEN   ;   icav = 1   ;   ELSE   ;   icav = 0   ;   ENDIF 
    678       CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 ) 
     661      CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL(COUNT((/ln_isfcav/)), wp), ktype = jp_i4 ) 
    679662      ! 
    680663      !                             !==  horizontal mesh  ! 

  • NEMO/trunk/src/OCE/DOM/domhgr.F90

    r10068 r13286  
    3131   USE iom            ! I/O library 
    3232   USE lib_mpp        ! MPP library 
     33   USE lbclnk         ! lateal boundary condition / mpp exchanges 
    3334   USE timing         ! Timing 
    3435 
    … …  
    8889      ENDIF 
    8990      ! 
    90       ! 
    9191      IF( ln_read_cfg ) THEN        !==  read in mesh_mask.nc file  ==! 
     92         ! 
    9293         IF(lwp) WRITE(numout,*) 
    9394         IF(lwp) WRITE(numout,*) '   ==>>>   read horizontal mesh in ', TRIM( cn_domcfg ), ' file' 
    … …  
    112113         ! 
    113114      ENDIF 
    114       ! 
    115115      !                             !==  Coriolis parameter  ==!   (if necessary) 
    116116      ! 
    … …  
    126126         ENDIF 
    127127      ENDIF 
    128  
    129128      ! 
    130129      !                             !==  associated horizontal metrics  ==! 
    … …  
    150149      e2_e1u(:,:) = e2u(:,:) / e1u(:,:) 
    151150      e1_e2v(:,:) = e1v(:,:) / e2v(:,:) 
    152       ! 
    153151      ! 
    154152      IF( ln_timing )   CALL timing_stop('dom_hgr') 
    … …  
    189187      CALL iom_open( cn_domcfg, inum ) 
    190188      ! 
    191       CALL iom_get( inum, jpdom_data, 'glamt', plamt, lrowattr=ln_use_jattr ) 
    192       CALL iom_get( inum, jpdom_data, 'glamu', plamu, lrowattr=ln_use_jattr ) 
    193       CALL iom_get( inum, jpdom_data, 'glamv', plamv, lrowattr=ln_use_jattr ) 
    194       CALL iom_get( inum, jpdom_data, 'glamf', plamf, lrowattr=ln_use_jattr ) 
    195       ! 
    196       CALL iom_get( inum, jpdom_data, 'gphit', pphit, lrowattr=ln_use_jattr ) 
    197       CALL iom_get( inum, jpdom_data, 'gphiu', pphiu, lrowattr=ln_use_jattr ) 
    198       CALL iom_get( inum, jpdom_data, 'gphiv', pphiv, lrowattr=ln_use_jattr ) 
    199       CALL iom_get( inum, jpdom_data, 'gphif', pphif, lrowattr=ln_use_jattr ) 
    200       ! 
    201       CALL iom_get( inum, jpdom_data, 'e1t'  , pe1t  , lrowattr=ln_use_jattr ) 
    202       CALL iom_get( inum, jpdom_data, 'e1u'  , pe1u  , lrowattr=ln_use_jattr ) 
    203       CALL iom_get( inum, jpdom_data, 'e1v'  , pe1v  , lrowattr=ln_use_jattr ) 
    204       CALL iom_get( inum, jpdom_data, 'e1f'  , pe1f  , lrowattr=ln_use_jattr ) 
    205       ! 
    206       CALL iom_get( inum, jpdom_data, 'e2t'  , pe2t  , lrowattr=ln_use_jattr ) 
    207       CALL iom_get( inum, jpdom_data, 'e2u'  , pe2u  , lrowattr=ln_use_jattr ) 
    208       CALL iom_get( inum, jpdom_data, 'e2v'  , pe2v  , lrowattr=ln_use_jattr ) 
    209       CALL iom_get( inum, jpdom_data, 'e2f'  , pe2f  , lrowattr=ln_use_jattr ) 
     189      CALL iom_get( inum, jpdom_global, 'glamt', plamt, cd_type = 'T', psgn = 1._wp ) 
     190      CALL iom_get( inum, jpdom_global, 'glamu', plamu, cd_type = 'U', psgn = 1._wp ) 
     191      CALL iom_get( inum, jpdom_global, 'glamv', plamv, cd_type = 'V', psgn = 1._wp ) 
     192      CALL iom_get( inum, jpdom_global, 'glamf', plamf, cd_type = 'F', psgn = 1._wp ) 
     193      ! 
     194      CALL iom_get( inum, jpdom_global, 'gphit', pphit, cd_type = 'T', psgn = 1._wp ) 
     195      CALL iom_get( inum, jpdom_global, 'gphiu', pphiu, cd_type = 'U', psgn = 1._wp ) 
     196      CALL iom_get( inum, jpdom_global, 'gphiv', pphiv, cd_type = 'V', psgn = 1._wp ) 
     197      CALL iom_get( inum, jpdom_global, 'gphif', pphif, cd_type = 'F', psgn = 1._wp ) 
     198      ! 
     199      CALL iom_get( inum, jpdom_global, 'e1t'  , pe1t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 
     200      CALL iom_get( inum, jpdom_global, 'e1u'  , pe1u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     201      CALL iom_get( inum, jpdom_global, 'e1v'  , pe1v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     202      CALL iom_get( inum, jpdom_global, 'e1f'  , pe1f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
     203      ! 
     204      CALL iom_get( inum, jpdom_global, 'e2t'  , pe2t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy ) 
     205      CALL iom_get( inum, jpdom_global, 'e2u'  , pe2u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     206      CALL iom_get( inum, jpdom_global, 'e2v'  , pe2v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     207      CALL iom_get( inum, jpdom_global, 'e2f'  , pe2f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
    210208      ! 
    211209      IF(  iom_varid( inum, 'ff_f', ldstop = .FALSE. ) > 0  .AND.  & 
    212210         & iom_varid( inum, 'ff_t', ldstop = .FALSE. ) > 0    ) THEN 
    213211         IF(lwp) WRITE(numout,*) '           Coriolis factor at f- and t-points read in ', TRIM( cn_domcfg ), ' file' 
    214          CALL iom_get( inum, jpdom_data, 'ff_f'  , pff_f  , lrowattr=ln_use_jattr ) 
    215          CALL iom_get( inum, jpdom_data, 'ff_t'  , pff_t  , lrowattr=ln_use_jattr ) 
     212         CALL iom_get( inum, jpdom_global, 'ff_f', pff_f, cd_type = 'F', psgn = 1._wp ) 
     213         CALL iom_get( inum, jpdom_global, 'ff_t', pff_t, cd_type = 'T', psgn = 1._wp ) 
    216214         kff = 1 
    217215      ELSE 
    … …  
    221219      IF( iom_varid( inum, 'e1e2u', ldstop = .FALSE. ) > 0 ) THEN 
    222220         IF(lwp) WRITE(numout,*) '           e1e2u & e1e2v read in ', TRIM( cn_domcfg ), ' file' 
    223          CALL iom_get( inum, jpdom_data, 'e1e2u'  , pe1e2u  , lrowattr=ln_use_jattr ) 
    224          CALL iom_get( inum, jpdom_data, 'e1e2v'  , pe1e2v  , lrowattr=ln_use_jattr ) 
     221         CALL iom_get( inum, jpdom_global, 'e1e2u', pe1e2u, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     222         CALL iom_get( inum, jpdom_global, 'e1e2v', pe1e2v, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
    225223         ke1e2u_v = 1 
    226224      ELSE 

  • NEMO/trunk/src/OCE/DOM/dommsk.F90

    r13237 r13286  
    2626   USE oce            ! ocean dynamics and tracers 
    2727   USE dom_oce        ! ocean space and time domain 
     28   USE domutl         !  
    2829   USE usrdef_fmask   ! user defined fmask 
    2930   USE bdy_oce        ! open boundary 
    … …  
    8990      ! 
    9091      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    91       INTEGER  ::   iif, iil       ! local integers 
    92       INTEGER  ::   ijf, ijl       !   -       - 
    9392      INTEGER  ::   iktop, ikbot   !   -       - 
    9493      INTEGER  ::   ios, inum 
    … …  
    136135         ikbot = k_bot(ji,jj) 
    137136         IF( iktop /= 0 ) THEN       ! water in the column 
    138             tmask(ji,jj,iktop:ikbot  ) = 1._wp 
     137            tmask(ji,jj,iktop:ikbot) = 1._wp 
    139138         ENDIF 
    140139      END_2D 
    141140      ! 
    142       ! the following call is mandatory 
    143       ! it masks boundaries (bathy=0) where needed depending on the configuration (closed, periodic...)   
    144       CALL lbc_lnk( 'dommsk', tmask  , 'T', 1._wp )      ! Lateral boundary conditions 
    145  
    146      ! Mask corrections for bdy (read in mppini2) 
     141      ! Mask corrections for bdy (read in mppini2) 
    147142      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    148143903   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nambdy in reference namelist' ) 
    … …  
    152147      IF ( ln_bdy .AND. ln_mask_file ) THEN 
    153148         CALL iom_open( cn_mask_file, inum ) 
    154          CALL iom_get ( inum, jpdom_data, 'bdy_msk', bdytmask(:,:) ) 
     149         CALL iom_get ( inum, jpdom_global, 'bdy_msk', bdytmask(:,:) ) 
    155150         CALL iom_close( inum ) 
    156151         DO_3D_11_11( 1, jpkm1 ) 
    … …  
    162157      ! ---------------------------------------- 
    163158      ! NB: at this point, fmask is designed for free slip lateral boundary condition 
    164       DO jk = 1, jpk 
    165          DO jj = 1, jpjm1 
    166             DO ji = 1, jpim1   ! vector loop 
    167                umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
    168                vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
    169             END DO 
    170             DO ji = 1, jpim1      ! NO vector opt. 
    171                fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
    172                   &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
    173             END DO 
    174          END DO 
    175       END DO 
     159      DO_3D_00_00( 1, jpk ) 
     160         umask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk) 
     161         vmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji  ,jj+1,jk) 
     162         fmask(ji,jj,jk) = tmask(ji,jj  ,jk) * tmask(ji+1,jj  ,jk)   & 
     163            &            * tmask(ji,jj+1,jk) * tmask(ji+1,jj+1,jk) 
     164      END_3D 
    176165      CALL lbc_lnk_multi( 'dommsk', umask, 'U', 1.0_wp, vmask, 'V', 1.0_wp, fmask, 'F', 1.0_wp )      ! Lateral boundary conditions 
    177166  
    … …  
    187176      END DO 
    188177 
    189  
    190178      ! Ocean/land column mask at t-, u-, and v-points   (i.e. at least 1 wet cell in the vertical) 
    191179      ! ---------------------------------------------- 
    … …  
    195183      ssfmask(:,:) = MAXVAL( fmask(:,:,:), DIM=3 ) 
    196184 
    197  
    198185      ! Interior domain mask  (used for global sum) 
    199186      ! -------------------- 
    200187      ! 
    201       iif = nn_hls   ;   iil = nlci - nn_hls + 1 
    202       ijf = nn_hls   ;   ijl = nlcj - nn_hls + 1 
    203       ! 
    204       !                          ! halo mask : 0 on the halo and 1 elsewhere 
    205       tmask_h(:,:) = 1._wp                   
    206       tmask_h( 1 :iif,   :   ) = 0._wp      ! first columns 
    207       tmask_h(iil:jpi,   :   ) = 0._wp      ! last  columns (including mpp extra columns) 
    208       tmask_h(   :   , 1 :ijf) = 0._wp      ! first rows 
    209       tmask_h(   :   ,ijl:jpj) = 0._wp      ! last  rows (including mpp extra rows) 
    210       ! 
    211       !                          ! north fold mask 
    212       tpol(1:jpiglo) = 1._wp  
    213       fpol(1:jpiglo) = 1._wp 
    214       IF( jperio == 3 .OR. jperio == 4 ) THEN      ! T-point pivot 
    215          tpol(jpiglo/2+1:jpiglo) = 0._wp 
    216          fpol(     1    :jpiglo) = 0._wp 
    217          IF( mjg(nlej) == jpjglo ) THEN                  ! only half of the nlcj-1 row for tmask_h 
    218             DO ji = iif+1, iil-1 
    219                tmask_h(ji,nlej-1) = tmask_h(ji,nlej-1) * tpol(mig(ji)) 
    220             END DO 
    221          ENDIF 
    222       ENDIF 
    223       ! 
    224       IF( jperio == 5 .OR. jperio == 6 ) THEN      ! F-point pivot 
    225          tpol(     1    :jpiglo) = 0._wp 
    226          fpol(jpiglo/2+1:jpiglo) = 0._wp 
    227       ENDIF 
     188      CALL dom_uniq( tmask_h, 'T' ) 
    228189      ! 
    229190      !                          ! interior mask : 2D ocean mask x halo mask  
    230191      tmask_i(:,:) = ssmask(:,:) * tmask_h(:,:) 
    231  
    232192 
    233193      ! Lateral boundary conditions on velocity (modify fmask) 

  • NEMO/trunk/src/OCE/DOM/domqco.F90

    r13237 r13286  
    217217            ! 
    218218            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    219                CALL iom_get( numror, jpdom_autoglo, 'sshb'   , ssh(:,:,Kbb), ldxios = lrxios    ) 
    220                CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     219               CALL iom_get( numror, jpdom_auto, 'sshb'   , ssh(:,:,Kbb), ldxios = lrxios    ) 
     220               CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    221221               ! needed to restart if land processor not computed 
    222222               IF(lwp) write(numout,*) 'qe_rst_read : ssh(:,:,Kbb) and ssh(:,:,Kmm) found in restart files' 
    … …  
    232232               IF(lwp) write(numout,*) 'sshn set equal to sshb.' 
    233233               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    234                CALL iom_get( numror, jpdom_autoglo, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 
     234               CALL iom_get( numror, jpdom_auto, 'sshb', ssh(:,:,Kbb), ldxios = lrxios ) 
    235235               ssh(:,:,Kmm) = ssh(:,:,Kbb) 
    236236               l_1st_euler = .TRUE. 
    … …  
    239239               IF(lwp) write(numout,*) 'sshb set equal to sshn.' 
    240240               IF(lwp) write(numout,*) 'neuler is forced to 0' 
    241                CALL iom_get( numror, jpdom_autoglo, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 
     241               CALL iom_get( numror, jpdom_auto, 'sshn', ssh(:,:,Kmm), ldxios = lrxios ) 
    242242               ssh(:,:,Kbb) = ssh(:,:,Kmm) 
    243243               l_1st_euler = .TRUE. 

  • NEMO/trunk/src/OCE/DOM/domvvl.F90

    r13237 r13286  
    273273            IF( cn_cfg == "orca" .OR. cn_cfg == "ORCA" ) THEN 
    274274               IF( nn_cfg == 3 ) THEN   ! ORCA2: Suppress ztilde in the Foxe Basin for ORCA2 
    275                   ii0 = 103   ;   ii1 = 111        
    276                   ij0 = 128   ;   ij1 = 135   ;    
     275                  ii0 = 103 + nn_hls - 1   ;   ii1 = 111 + nn_hls - 1       
     276                  ij0 = 128 + nn_hls       ;   ij1 = 135 + nn_hls 
    277277                  frq_rst_e3t( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  0.0_wp 
    278278                  frq_rst_hdv( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  1.e0_wp / rn_Dt 
    … …  
    805805         IF( ln_rstart ) THEN                   !* Read the restart file 
    806806            CALL rst_read_open                  !  open the restart file if necessary 
    807             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     807            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    808808            ! 
    809809            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    818818            ! 
    819819            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    820                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    821                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     820               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     821               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    822822               ! needed to restart if land processor not computed  
    823823               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    833833               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    834834               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    835                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     835               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    836836               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    837837               l_1st_euler = .true. 
    … …  
    840840               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    841841               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    842                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     842               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    843843               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    844844               l_1st_euler = .true. 
    … …  
    865865               !                          ! ----------------------- ! 
    866866               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    867                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    868                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     867                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     868                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    869869               ELSE                            ! one at least array is missing 
    870870                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    875875                  !                       ! ------------ ! 
    876876                  IF( id5 > 0 ) THEN  ! required array exists 
    877                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     877                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    878878                  ELSE                ! array is missing 
    879879                     hdiv_lf(:,:,:) = 0.0_wp 

  • NEMO/trunk/src/OCE/DOM/domwri.F90

    r13226 r13286  
    1313   !!---------------------------------------------------------------------- 
    1414   !!   dom_wri        : create and write mesh and mask file(s) 
    15    !!   dom_uniq       : identify unique point of a grid (TUVF) 
    1615   !!   dom_stiff      : diagnose maximum grid stiffness/hydrostatic consistency (s-coordinate) 
    1716   !!---------------------------------------------------------------------- 
    1817   ! 
    1918   USE dom_oce         ! ocean space and time domain 
     19   USE domutl          !  
    2020   USE phycst ,   ONLY :   rsmall 
    2121   USE wet_dry,   ONLY :   ll_wd  ! Wetting and drying 
    … …  
    7474      !                                  ! ============================ 
    7575      CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. ) 
    76       ! 
    77       !                                                         ! global domain size 
    78       CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 ) 
    79       CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 ) 
    80       CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpkglo, wp), ktype = jp_i4 ) 
    81  
    8276      !                                                         ! domain characteristics 
    8377      CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 ) 
    … …  
    182176      !                                     ! ============================ 
    183177   END SUBROUTINE dom_wri 
    184  
    185  
    186    SUBROUTINE dom_uniq( puniq, cdgrd ) 
    187       !!---------------------------------------------------------------------- 
    188       !!                  ***  ROUTINE dom_uniq  *** 
    189       !!                    
    190       !! ** Purpose :   identify unique point of a grid (TUVF) 
    191       !! 
    192       !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element 
    193       !!                2) check which elements have been changed 
    194       !!---------------------------------------------------------------------- 
    195       CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !  
    196       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !  
    197       ! 
    198       REAL(wp) ::  zshift   ! shift value link to the process number 
    199       INTEGER  ::  ji       ! dummy loop indices 
    200       LOGICAL, DIMENSION(SIZE(puniq,1),SIZE(puniq,2),1) ::  lldbl  ! store whether each point is unique or not 
    201       REAL(wp), DIMENSION(jpi,jpj) ::   ztstref 
    202       !!---------------------------------------------------------------------- 
    203       ! 
    204       ! build an array with different values for each element  
    205       ! in mpp: make sure that these values are different even between process 
    206       ! -> apply a shift value according to the process number 
    207       zshift = jpi * jpj * ( narea - 1 ) 
    208       ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) ) 
    209       ! 
    210       puniq(:,:) = ztstref(:,:)                   ! default definition 
    211       CALL lbc_lnk( 'domwri', puniq, cdgrd, 1.0_wp )            ! apply boundary conditions 
    212       lldbl(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have been changed  
    213       ! 
    214       puniq(:,:) = 1.                             ! default definition 
    215       ! fill only the inner part of the cpu with llbl converted into real  
    216       puniq(nldi:nlei,nldj:nlej) = REAL( COUNT( lldbl(nldi:nlei,nldj:nlej,:), dim = 3 ) , wp ) 
    217       ! 
    218    END SUBROUTINE dom_uniq 
    219178 
    220179 

  • NEMO/trunk/src/OCE/DOM/domzgr.F90

    r13226 r13286  
    7575      INTEGER  ::   ioptio, ibat, ios   ! local integer 
    7676      REAL(wp) ::   zrefdep             ! depth of the reference level (~10m) 
     77      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk 
    7778      !!---------------------------------------------------------------------- 
    7879      ! 
    … …  
    109110         ! 
    110111      ENDIF 
     112      ! 
     113      ! the following is mandatory 
     114      ! make sure that closed boundaries are correctly defined in k_top that will be used to compute all mask arrays 
     115      ! 
     116      zmsk(:,:) = 1._wp                                       ! default: no closed boundaries 
     117      IF( jperio == 0 .OR. jperio == 2 .OR. jperio == 3 .OR. jperio == 5 ) THEN   ! E-W closed 
     118         zmsk(  mi0(     1+nn_hls):mi1(     1+nn_hls),:) = 0._wp   ! first column of inner global domain at 0 
     119         zmsk(  mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls),:) = 0._wp   ! last  column of inner global domain at 0  
     120      ENDIF 
     121      IF( .NOT. ( jperio == 2 .OR. jperio == 7 ) ) THEN                           ! S closed 
     122         zmsk(:,mj0(     1+nn_hls):mj1(     1+nn_hls)  ) = 0._wp   ! first   line of inner global domain at 0 
     123      ENDIF 
     124      IF( jperio == 0 .OR. jperio == 1 ) THEN                                     ! N closed 
     125         zmsk(:,mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls)  ) = 0._wp   ! last    line of inner global domain at 0 
     126      ENDIF 
     127      CALL lbc_lnk( 'usrdef_zgr', zmsk, 'T', 1. )             ! set halos 
     128      k_top(:,:) = k_top(:,:) * NINT( zmsk(:,:) ) 
    111129      ! 
    112130!!gm to be remove when removing the OLD definition of e3 scale factors so that gde3w disappears 
    … …  
    164182!!gm end bug 
    165183      ! 
    166       IF( nprint == 1 .AND. lwp )   THEN 
     184      IF( lwp )   THEN 
    167185         WRITE(numout,*) ' MIN val k_top   ', MINVAL(   k_top(:,:) ), ' MAX ', MAXVAL( k_top(:,:) ) 
    168186         WRITE(numout,*) ' MIN val k_bot   ', MINVAL(   k_bot(:,:) ), ' MAX ', MAXVAL( k_bot(:,:) ) 
    … …  
    236254      CALL iom_get( inum, jpdom_unknown, 'e3w_1d'  , pe3w_1d  ) 
    237255      ! 
    238       CALL iom_get( inum, jpdom_data, 'e3t_0'  , pe3t  , lrowattr=ln_use_jattr )    ! 3D coordinate 
    239       CALL iom_get( inum, jpdom_data, 'e3u_0'  , pe3u  , lrowattr=ln_use_jattr ) 
    240       CALL iom_get( inum, jpdom_data, 'e3v_0'  , pe3v  , lrowattr=ln_use_jattr ) 
    241       CALL iom_get( inum, jpdom_data, 'e3f_0'  , pe3f  , lrowattr=ln_use_jattr ) 
    242       CALL iom_get( inum, jpdom_data, 'e3w_0'  , pe3w  , lrowattr=ln_use_jattr ) 
    243       CALL iom_get( inum, jpdom_data, 'e3uw_0' , pe3uw , lrowattr=ln_use_jattr ) 
    244       CALL iom_get( inum, jpdom_data, 'e3vw_0' , pe3vw , lrowattr=ln_use_jattr ) 
     256      CALL iom_get( inum, jpdom_global, 'e3t_0'  , pe3t , cd_type = 'T', psgn = 1._wp, kfill = jpfillcopy )    ! 3D coordinate 
     257      CALL iom_get( inum, jpdom_global, 'e3u_0'  , pe3u , cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     258      CALL iom_get( inum, jpdom_global, 'e3v_0'  , pe3v , cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
     259      CALL iom_get( inum, jpdom_global, 'e3f_0'  , pe3f , cd_type = 'F', psgn = 1._wp, kfill = jpfillcopy ) 
     260      CALL iom_get( inum, jpdom_global, 'e3w_0'  , pe3w , cd_type = 'W', psgn = 1._wp, kfill = jpfillcopy ) 
     261      CALL iom_get( inum, jpdom_global, 'e3uw_0' , pe3uw, cd_type = 'U', psgn = 1._wp, kfill = jpfillcopy ) 
     262      CALL iom_get( inum, jpdom_global, 'e3vw_0' , pe3vw, cd_type = 'V', psgn = 1._wp, kfill = jpfillcopy ) 
    245263      ! 
    246264      !                          !* depths 
    … …  
    254272         CALL iom_get( inum, jpdom_unknown, 'gdept_1d', pdept_1d )    
    255273         CALL iom_get( inum, jpdom_unknown, 'gdepw_1d', pdepw_1d ) 
    256          CALL iom_get( inum, jpdom_data   , 'gdept_0' , pdept , lrowattr=ln_use_jattr ) 
    257          CALL iom_get( inum, jpdom_data   , 'gdepw_0' , pdepw , lrowattr=ln_use_jattr ) 
     274         CALL iom_get( inum, jpdom_global , 'gdept_0' , pdept, kfill = jpfillcopy ) 
     275         CALL iom_get( inum, jpdom_global , 'gdepw_0' , pdepw, kfill = jpfillcopy ) 
    258276         ! 
    259277      ELSE                                !- depths computed from e3. scale factors 
    … …  
    269287      ! 
    270288      !                          !* ocean top and bottom level 
    271       CALL iom_get( inum, jpdom_data, 'top_level'    , z2d  , lrowattr=ln_use_jattr )   ! 1st wet T-points (ISF) 
     289      CALL iom_get( inum, jpdom_global, 'top_level'    , z2d  )   ! 1st wet T-points (ISF) 
    272290      k_top(:,:) = NINT( z2d(:,:) ) 
    273       CALL iom_get( inum, jpdom_data, 'bottom_level' , z2d  , lrowattr=ln_use_jattr )   ! last wet T-points 
     291      CALL iom_get( inum, jpdom_global, 'bottom_level' , z2d  )   ! last wet T-points 
    274292      k_bot(:,:) = NINT( z2d(:,:) ) 
    275293      ! 

  • NEMO/trunk/src/OCE/DOM/dtatsd.F90

    r12377 r13286  
    153153         IF( nn_cfg == 2 .AND. ln_tsd_dmp ) THEN    ! some hand made alterations 
    154154            ! 
    155             ij0 = 101   ;   ij1 = 109                       ! Reduced T & S in the Alboran Sea 
    156             ii0 = 141   ;   ii1 = 155 
     155            ij0 = 101 + nn_hls       ;   ij1 = 109 + nn_hls                       ! Reduced T & S in the Alboran Sea 
     156            ii0 = 141 + nn_hls - 1   ;   ii1 = 155 + nn_hls - 1 
    157157            DO jj = mj0(ij0), mj1(ij1) 
    158158               DO ji = mi0(ii0), mi1(ii1) 
    … …  
    167167               END DO 
    168168            END DO 
    169             ij0 =  87   ;   ij1 =  96                          ! Reduced temperature in Red Sea 
    170             ii0 = 148   ;   ii1 = 160 
     169            ij0 =  87 + nn_hls       ;   ij1 =  96 + nn_hls                       ! Reduced temperature in Red Sea 
     170            ii0 = 148 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
    171171            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 ) = 7.0_wp 
    172172            sf_tsd(jp_tem)%fnow( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 ) = 6.5_wp 

  • NEMO/trunk/src/OCE/DYN/dynspg_ts.F90

    r13237 r13286  
    901901         !                                   ! --------------- 
    902902         IF( ln_rstart .AND. ln_bt_fw .AND. (.NOT.l_1st_euler) ) THEN    !* Read the restart file 
    903             CALL iom_get( numror, jpdom_autoglo, 'ub2_b'  , ub2_b  (:,:), ldxios = lrxios )    
    904             CALL iom_get( numror, jpdom_autoglo, 'vb2_b'  , vb2_b  (:,:), ldxios = lrxios )  
    905             CALL iom_get( numror, jpdom_autoglo, 'un_bf'  , un_bf  (:,:), ldxios = lrxios )    
    906             CALL iom_get( numror, jpdom_autoglo, 'vn_bf'  , vn_bf  (:,:), ldxios = lrxios )  
     903            CALL iom_get( numror, jpdom_auto, 'ub2_b'  , ub2_b  (:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
     904            CALL iom_get( numror, jpdom_auto, 'vb2_b'  , vb2_b  (:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios )  
     905            CALL iom_get( numror, jpdom_auto, 'un_bf'  , un_bf  (:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
     906            CALL iom_get( numror, jpdom_auto, 'vn_bf'  , vn_bf  (:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios )  
    907907            IF( .NOT.ln_bt_av ) THEN 
    908                CALL iom_get( numror, jpdom_autoglo, 'sshbb_e'  , sshbb_e(:,:), ldxios = lrxios )    
    909                CALL iom_get( numror, jpdom_autoglo, 'ubb_e'    ,   ubb_e(:,:), ldxios = lrxios )    
    910                CALL iom_get( numror, jpdom_autoglo, 'vbb_e'    ,   vbb_e(:,:), ldxios = lrxios ) 
    911                CALL iom_get( numror, jpdom_autoglo, 'sshb_e'   ,  sshb_e(:,:), ldxios = lrxios )  
    912                CALL iom_get( numror, jpdom_autoglo, 'ub_e'     ,    ub_e(:,:), ldxios = lrxios )    
    913                CALL iom_get( numror, jpdom_autoglo, 'vb_e'     ,    vb_e(:,:), ldxios = lrxios ) 
     908               CALL iom_get( numror, jpdom_auto, 'sshbb_e'  , sshbb_e(:,:), cd_type = 'T', psgn =  1._wp, ldxios = lrxios )    
     909               CALL iom_get( numror, jpdom_auto, 'ubb_e'    ,   ubb_e(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
     910               CALL iom_get( numror, jpdom_auto, 'vbb_e'    ,   vbb_e(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
     911               CALL iom_get( numror, jpdom_auto, 'sshb_e'   ,  sshb_e(:,:), cd_type = 'T', psgn =  1._wp, ldxios = lrxios )  
     912               CALL iom_get( numror, jpdom_auto, 'ub_e'     ,    ub_e(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
     913               CALL iom_get( numror, jpdom_auto, 'vb_e'     ,    vb_e(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
    914914            ENDIF 
    915915#if defined key_agrif 
    916916            ! Read time integrated fluxes 
    917917            IF ( .NOT.Agrif_Root() ) THEN 
    918                CALL iom_get( numror, jpdom_autoglo, 'ub2_i_b'  , ub2_i_b(:,:), ldxios = lrxios )    
    919                CALL iom_get( numror, jpdom_autoglo, 'vb2_i_b'  , vb2_i_b(:,:), ldxios = lrxios ) 
     918               CALL iom_get( numror, jpdom_auto, 'ub2_i_b'  , ub2_i_b(:,:), cd_type = 'U', psgn = -1._wp, ldxios = lrxios )    
     919               CALL iom_get( numror, jpdom_auto, 'vb2_i_b'  , vb2_i_b(:,:), cd_type = 'V', psgn = -1._wp, ldxios = lrxios ) 
    920920            ENDIF 
    921921#endif 
    … …  
    976976      ! Max courant number for ext. grav. waves 
    977977      ! 
    978       DO_2D_11_11 
     978      DO_2D_00_00 
    979979         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    980980         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
    … …  
    982982      END_2D 
    983983      ! 
    984       zcmax = MAXVAL( zcu(:,:) ) 
     984      zcmax = MAXVAL( zcu(Nis0:Nie0,Njs0:Nje0) ) 
    985985      CALL mpp_max( 'dynspg_ts', zcmax ) 
    986986 

  • NEMO/trunk/src/OCE/DYN/dynvor.F90

    r13237 r13286  
    8080   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2u_2        ! = di(e2u)/2          used in T-point metric term calculation 
    8181   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1v_2        ! = dj(e1v)/2           -        -      -       -  
    82    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2u)/(2*e1e2f)  used in F-point metric term calculation 
    83    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1v)/(2*e1e2f)   -        -      -       -  
     82   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   di_e2v_2e1e2f   ! = di(e2v)/(2*e1e2f)  used in F-point metric term calculation 
     83   REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   dj_e1u_2e1e2f   ! = dj(e1u)/(2*e1e2f)   -        -      -       -  
    8484    
    8585   REAL(wp) ::   r1_4  = 0.250_wp         ! =1/4 

  • NEMO/trunk/src/OCE/DYN/dynzdf.F90

    r13237 r13286  
    107107      !                    ! time stepping except vertical diffusion 
    108108      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
    109          DO jk = 1, jpkm1 
    110             puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kbb) + rDt * puu(:,:,jk,Krhs) ) * umask(:,:,jk) 
    111             pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kbb) + rDt * pvv(:,:,jk,Krhs) ) * vmask(:,:,jk) 
    112          END DO 
     109         DO_3D_00_00( 1, jpkm1 ) 
     110            puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kbb) + rDt * puu(ji,jj,jk,Krhs) ) * umask(ji,jj,jk) 
     111            pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kbb) + rDt * pvv(ji,jj,jk,Krhs) ) * vmask(ji,jj,jk) 
     112         END_3D 
    113113      ELSE                                      ! applied on thickness weighted velocity 
    114          DO jk = 1, jpkm1 
    115             puu(:,:,jk,Kaa) = (         e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb)  & 
    116                &            + rDt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs)  )  & 
    117                &                  / e3u(:,:,jk,Kaa) * umask(:,:,jk) 
    118             pvv(:,:,jk,Kaa) = (         e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb)  & 
    119                &            + rDt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs)  )  & 
    120                &                  / e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
    121          END DO 
     114         DO_3D_00_00( 1, jpkm1 ) 
     115            puu(ji,jj,jk,Kaa) = (         e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb )  & 
     116               &                  + rDt * e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Krhs)  ) & 
     117               &                        / e3u(ji,jj,jk,Kaa) * umask(ji,jj,jk) 
     118            pvv(ji,jj,jk,Kaa) = (         e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb )  & 
     119               &                  + rDt * e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Krhs)  ) & 
     120               &                        / e3v(ji,jj,jk,Kaa) * vmask(ji,jj,jk) 
     121         END_3D 
    122122      ENDIF 
    123123      !                    ! add top/bottom friction  
    … …  
    127127      !     G. Madec : in linear free surface, e3u(:,:,:,Kaa) = e3u(:,:,:,Kmm) = e3u_0, so systematic use of e3u(:,:,:,Kaa) 
    128128      IF( ln_drgimp .AND. ln_dynspg_ts ) THEN 
    129          DO jk = 1, jpkm1        ! remove barotropic velocities 
    130             puu(:,:,jk,Kaa) = ( puu(:,:,jk,Kaa) - uu_b(:,:,Kaa) ) * umask(:,:,jk) 
    131             pvv(:,:,jk,Kaa) = ( pvv(:,:,jk,Kaa) - vv_b(:,:,Kaa) ) * vmask(:,:,jk) 
    132          END DO 
     129         DO_3D_00_00( 1, jpkm1 )      ! remove barotropic velocities 
     130            puu(ji,jj,jk,Kaa) = ( puu(ji,jj,jk,Kaa) - uu_b(ji,jj,Kaa) ) * umask(ji,jj,jk) 
     131            pvv(ji,jj,jk,Kaa) = ( pvv(ji,jj,jk,Kaa) - vv_b(ji,jj,Kaa) ) * vmask(ji,jj,jk) 
     132         END_3D 
    133133         DO_2D_00_00 
    134134            iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points  

  • NEMO/trunk/src/OCE/DYN/sshwzv.F90

    r13237 r13286  
    2828   USE bdydyn2d       ! bdy_ssh routine 
    2929#if defined key_agrif 
     30   USE agrif_oce 
    3031   USE agrif_oce_interp 
    3132#endif 
    … …  
    215216      ENDIF 
    216217      ! 
    217 #if defined key_agrif  
    218       IF( .NOT. AGRIF_Root() ) THEN  
     218#if defined key_agrif 
     219      IF( .NOT. AGRIF_Root() ) THEN 
     220         ! 
    219221         ! Mask vertical velocity at first/last columns/row  
    220222         ! inside computational domain (cosmetic)  
    221          ! --- West --- !          
    222          IF( lk_west) THEN 
    223             DO ji = mi0(2), mi1(2) 
    224                DO jj = 1, jpj 
    225                   pww(ji,jj,:) = 0._wp  
    226                ENDDO 
    227             ENDDO 
    228          ENDIF 
    229          ! 
    230          ! --- East --- ! 
    231          IF( lk_east) THEN 
    232             DO ji = mi0(jpiglo-1), mi1(jpiglo-1) 
    233                DO jj = 1, jpj 
    234                   pww(ji,jj,:) = 0._wp 
    235                ENDDO 
    236             ENDDO 
    237          ENDIF 
    238          ! 
    239          ! --- South --- ! 
    240          IF( lk_south) THEN 
    241             DO jj = mj0(2), mj1(2) 
    242                DO ji = 1, jpi 
    243                   pww(ji,jj,:) = 0._wp 
    244                ENDDO 
    245             ENDDO 
    246          ENDIF 
    247          ! 
    248          ! --- North --- ! 
    249          IF( lk_north) THEN 
    250             DO jj = mj0(jpjglo-1), mj1(jpjglo-1) 
    251                DO ji = 1, jpi 
    252                   pww(ji,jj,:) = 0._wp 
    253                ENDDO 
    254             ENDDO 
    255          ENDIF 
     223         DO jk = 1, jpkm1 
     224            IF( lk_west ) THEN                             ! --- West --- ! 
     225               DO ji = mi0(2+nn_hls), mi1(2+nn_hls) 
     226                  DO jj = 1, jpj 
     227                     pww(ji,jj,jk) = 0._wp  
     228                  END DO 
     229               END DO 
     230            ENDIF 
     231            IF( lk_east ) THEN                             ! --- East --- ! 
     232               DO ji = mi0(jpiglo-1-nn_hls), mi1(jpiglo-1-nn_hls) 
     233                  DO jj = 1, jpj 
     234                     pww(ji,jj,jk) = 0._wp 
     235                  END DO 
     236               END DO 
     237            ENDIF 
     238            IF( lk_south ) THEN                            ! --- South --- ! 
     239               DO jj = mj0(2+nn_hls), mj1(2+nn_hls) 
     240                  DO ji = 1, jpi 
     241                     pww(ji,jj,jk) = 0._wp 
     242                  END DO 
     243               END DO 
     244            ENDIF 
     245            IF( lk_north ) THEN                            ! --- North --- ! 
     246               DO jj = mj0(jpjglo-1-nn_hls), mj1(jpjglo-1-nn_hls) 
     247                  DO ji = 1, jpi 
     248                     pww(ji,jj,jk) = 0._wp 
     249                  END DO 
     250               END DO 
     251            ENDIF 
     252            ! 
     253         END DO 
    256254         ! 
    257255      ENDIF  
    258 #endif  
     256#endif 
    259257      ! 
    260258      IF( ln_timing )   CALL timing_stop('wzv') 

  • NEMO/trunk/src/OCE/FLO/floblk.F90

    r13237 r13286  
    106106222   DO jfl = 1, jpnfl 
    107107# if   defined key_mpp_mpi 
    108          IF( iil(jfl) >= mig(nldi) .AND. iil(jfl) <= mig(nlei) .AND.   & 
    109              ijl(jfl) >= mjg(nldj) .AND. ijl(jfl) <= mjg(nlej)   ) THEN 
     108         IF( iil(jfl) >= mig(Nis0) .AND. iil(jfl) <= mig(Nie0) .AND.   & 
     109             ijl(jfl) >= mjg(Njs0) .AND. ijl(jfl) <= mjg(Nje0)   ) THEN 
    110110            iiloc(jfl) = iil(jfl) - mig(1) + 1 
    111111            ijloc(jfl) = ijl(jfl) - mjg(1) + 1 

  • NEMO/trunk/src/OCE/FLO/flodom.F90

    r12377 r13286  
    155155         ikmfl(jfl) = 0 
    156156# if   defined key_mpp_mpi 
    157          DO ji = MAX(nldi,2), nlei 
    158             DO jj = MAX(nldj,2), nlej   ! NO vector opt. 
     157         DO ji = MAX(Nis0,2), Nie0 
     158            DO jj = MAX(Njs0,2), Nje0   ! NO vector opt. 
    159159# else          
    160160         DO ji = 2, jpi 

  • NEMO/trunk/src/OCE/FLO/florst.F90

    r11536 r13286  
    9898         IF( lk_mpp ) THEN 
    9999            DO jfl = 1, jpnfl 
    100                IF( (INT(tpifl(jfl)) >= mig(nldi)) .AND.   & 
    101                   &(INT(tpifl(jfl)) <= mig(nlei)) .AND.   & 
    102                   &(INT(tpjfl(jfl)) >= mjg(nldj)) .AND.   & 
    103                   &(INT(tpjfl(jfl)) <= mjg(nlej)) ) THEN 
     100               IF( (INT(tpifl(jfl)) >= mig(Nis0)) .AND.   & 
     101                  &(INT(tpifl(jfl)) <= mig(Nie0)) .AND.   & 
     102                  &(INT(tpjfl(jfl)) >= mjg(Njs0)) .AND.   & 
     103                  &(INT(tpjfl(jfl)) <= mjg(Nje0)) ) THEN 
    104104                  iperproc(narea) = iperproc(narea)+1 
    105105               ENDIF 

  • NEMO/trunk/src/OCE/FLO/flowri.F90

    r12489 r13286  
    105105            ibfloc = mj1( ibfl ) 
    106106  
    107             IF( nldi <= iafloc .AND. iafloc <= nlei .AND. & 
    108               & nldj <= ibfloc .AND. ibfloc <= nlej       ) THEN  
     107            IF( Nis0 <= iafloc .AND. iafloc <= Nie0 .AND. & 
     108              & Njs0 <= ibfloc .AND. ibfloc <= Nje0       ) THEN  
    109109 
    110110               !the float is inside of current proc's area 

  • NEMO/trunk/src/OCE/ICB/icb_oce.F90

    r13281 r13286  
    147147   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldexpect                    !: nfold expected number of bergs 
    148148   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   nicbfldreq                       !: nfold message handle (immediate send) 
    149  
    150    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: griddata                           !: work array for icbrst 
    151  
    152149   !!---------------------------------------------------------------------- 
    153150   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    197194      icb_alloc = icb_alloc + ill 
    198195 
    199       ALLOCATE( griddata(jpi,jpj,1), STAT=ill ) 
    200       icb_alloc = icb_alloc + ill 
    201  
    202196      CALL mpp_sum ( 'icb_oce', icb_alloc ) 
    203197      IF( icb_alloc > 0 )   CALL ctl_warn('icb_alloc: allocation of arrays failed') 

  • NEMO/trunk/src/OCE/ICB/icbini.F90

    r13281 r13286  
    133133      ! first entry with narea for this processor is left hand interior index 
    134134      ! last  entry                               is right hand interior index 
    135       jj = nlcj/2 
     135      jj = jpj/2 
    136136      nicbdi = -1 
    137137      nicbei = -1 
    … …  
    149149      ! 
    150150      ! repeat for j direction 
    151       ji = nlci/2 
     151      ji = jpi/2 
    152152      nicbdj = -1 
    153153      nicbej = -1 
    … …  
    166166      ! special for east-west boundary exchange we save the destination index 
    167167      i1 = MAX( nicbdi-1, 1) 
    168       i3 = INT( src_calving(i1,nlcj/2) ) 
     168      i3 = INT( src_calving(i1,jpj/2) ) 
    169169      jj = INT( i3/nicbpack ) 
    170170      ricb_left = REAL( i3 - nicbpack*jj, wp ) 
    171171      i1 = MIN( nicbei+1, jpi ) 
    172       i3 = INT( src_calving(i1,nlcj/2) ) 
     172      i3 = INT( src_calving(i1,jpj/2) ) 
    173173      jj = INT( i3/nicbpack ) 
    174174      ricb_right = REAL( i3 - nicbpack*jj, wp ) 
    … …  
    203203         WRITE(numicb,*) 'processor ', narea 
    204204         WRITE(numicb,*) 'jpi, jpj   ', jpi, jpj 
    205          WRITE(numicb,*) 'nldi, nlei ', nldi, nlei 
    206          WRITE(numicb,*) 'nldj, nlej ', nldj, nlej 
     205         WRITE(numicb,*) 'Nis0, Nie0 ', Nis0, Nie0 
     206         WRITE(numicb,*) 'Njs0, Nje0 ', Njs0, Nje0 
    207207         WRITE(numicb,*) 'berg i interior ', nicbdi, nicbei 
    208208         WRITE(numicb,*) 'berg j interior ', nicbdj, nicbej 
    209209         WRITE(numicb,*) 'berg left       ', ricb_left 
    210210         WRITE(numicb,*) 'berg right      ', ricb_right 
    211          jj = nlcj/2 
     211         jj = jpj/2 
    212212         WRITE(numicb,*) "central j line:" 
    213213         WRITE(numicb,*) "i processor" 
    … …  
    215215         WRITE(numicb,*) "i point" 
    216216         WRITE(numicb,*) (INT(src_calving(ji,jj)), ji=1,jpi) 
    217          ji = nlci/2 
     217         ji = jpi/2 
    218218         WRITE(numicb,*) "central i line:" 
    219219         WRITE(numicb,*) "j processor" 
    … …  
    256256         ivar = iom_varid( inum, 'maxclass', ldstop=.FALSE. ) 
    257257         IF( ivar > 0 ) THEN 
    258             CALL iom_get  ( inum, jpdom_data, 'maxclass', src_calving )   ! read the max distribution array 
     258            CALL iom_get  ( inum, jpdom_global, 'maxclass', src_calving )   ! read the max distribution array 
    259259            berg_grid%maxclass(:,:) = INT( src_calving ) 
    260260            src_calving(:,:) = 0._wp 

  • NEMO/trunk/src/OCE/ICB/icbrst.F90

    r13062 r13286  
    9191            ij = INT( localpt%yj + 0.5 ) 
    9292            ! Only proceed if this iceberg is on the local processor (excluding halos). 
    93             IF ( ii .GE. nldi+nimpp-1 .AND. ii .LE. nlei+nimpp-1 .AND. & 
    94            &     ij .GE. nldj+njmpp-1 .AND. ij .LE. nlej+njmpp-1 ) THEN            
    95  
    96                CALL iom_get( ncid, jpdom_unknown, 'number'       , zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
     93            IF ( ii >= mig(Nis0) .AND. ii <= mig(Nie0) .AND.  & 
     94           &     ij >= mjg(Njs0) .AND. ij <= mjg(Nje0) ) THEN            
     95 
     96               CALL iom_get( ncid, jpdom_unknown, 'number', zdata(:) , ktime=jn, kstart=(/1/), kcount=(/nkounts/) ) 
    9797               localberg%number(:) = INT(zdata(:)) 
    9898               imax_icb = MAX( imax_icb, INT(zdata(1)) ) 
    … …  
    123123 
    124124      ! Gridded variables 
    125       CALL iom_get( ncid, jpdom_autoglo,    'calving'     , src_calving  ) 
    126       CALL iom_get( ncid, jpdom_autoglo,    'calving_hflx', src_calving_hflx  ) 
    127       CALL iom_get( ncid, jpdom_autoglo,    'stored_heat' , berg_grid%stored_heat  ) 
    128       CALL iom_get( ncid, jpdom_autoglo_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/1,1,1/), kcount=(/1,1,nclasses/) ) 
     125      CALL iom_get( ncid, jpdom_auto,    'calving'     , src_calving  ) 
     126      CALL iom_get( ncid, jpdom_auto,    'calving_hflx', src_calving_hflx  ) 
     127      CALL iom_get( ncid, jpdom_auto,    'stored_heat' , berg_grid%stored_heat  ) 
     128      ! with jpdom_auto_xy, ue use only the third element of kstart and kcount. 
     129      CALL iom_get( ncid, jpdom_auto_xy, 'stored_ice'  , berg_grid%stored_ice, kstart=(/-99,-99,1/), kcount=(/-99,-99,nclasses/) ) 
    129130       
    130131      CALL iom_get( ncid, jpdom_unknown, 'kount' , zdata(:) ) 
    … …  
    229230    
    230231         ! Dimensions 
    231          nret = NF90_DEF_DIM(ncid, 'x', jpi, ix_dim) 
     232         nret = NF90_DEF_DIM(ncid, 'x', Ni_0, ix_dim) 
    232233         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim x failed') 
    233234    
    234          nret = NF90_DEF_DIM(ncid, 'y', jpj, iy_dim) 
     235         nret = NF90_DEF_DIM(ncid, 'y', Nj_0, iy_dim) 
    235236         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_def_dim y failed') 
    236237    
    … …  
    244245         IF( lk_mpp ) THEN 
    245246            ! Set domain parameters (assume jpdom_local_full) 
    246             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ) 
    247             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ) 
    248             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ) 
    249             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ) 
    250             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/jpi   , jpj   /) ) 
    251             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/nimpp , njmpp /) ) 
    252             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/nimpp + jpi - 1 , njmpp + jpj - 1 /) ) 
    253             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/nldi - 1        , nldj - 1         /) ) 
    254             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/jpi - nlei      , jpj - nlej       /) ) 
    255             nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'              ) 
     247            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij                        ) 
     248            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_number'         , narea-1                      ) 
     249            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/ 1         , 2          /) ) 
     250            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_global'    , (/ Ni0glo    , Nj0glo     /) ) 
     251            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_size_local'     , (/ Ni_0      , Nj_0       /) ) 
     252            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_first' , (/ mig0(Nis0), mjg0(Njs0) /) ) 
     253            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_position_last'  , (/ mig0(Nie0), mjg0(Nje0) /) ) 
     254            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_start', (/ 0         , 0          /) ) 
     255            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , (/ 0         , 0          /) ) 
     256            nret = NF90_PUT_ATT( ncid, NF90_GLOBAL, 'DOMAIN_type'           , 'BOX'                        ) 
    256257         ENDIF 
    257258          
    … …  
    344345         nstrt3(1) = 1 
    345346         nstrt3(2) = 1 
    346          nlngth3(1) = jpi 
    347          nlngth3(2) = jpj 
     347         nlngth3(1) = Ni_0 
     348         nlngth3(2) = Nj_0 
    348349         nlngth3(3) = 1 
    349350    
    350351         DO jn=1,nclasses 
    351             griddata(:,:,1) = berg_grid%stored_ice(:,:,jn) 
    352352            nstrt3(3) = jn 
    353             nret = NF90_PUT_VAR( ncid, nsiceid, griddata, nstrt3, nlngth3 ) 
     353            nret = NF90_PUT_VAR( ncid, nsiceid, berg_grid%stored_ice(Nis0:Nie0,Njs0:Nje0,jn), nstrt3, nlngth3 ) 
    354354            IF (nret .ne. NF90_NOERR) THEN 
    355355               IF( lwp ) WRITE(numout,*) TRIM(NF90_STRERROR( nret )) 
    … …  
    362362         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var kount failed') 
    363363    
    364          nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(:,:) ) 
     364         nret = NF90_PUT_VAR( ncid, nsheatid, berg_grid%stored_heat(Nis0:Nie0,Njs0:Nje0) ) 
    365365         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var stored_heat failed') 
    366366         IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: stored_heat written' 
    367367    
    368          nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(:,:) ) 
     368         nret = NF90_PUT_VAR( ncid, ncalvid , src_calving(Nis0:Nie0,Njs0:Nje0) ) 
    369369         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving failed') 
    370          nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(:,:) ) 
     370         nret = NF90_PUT_VAR( ncid, ncalvhid, src_calving_hflx(Nis0:Nie0,Njs0:Nje0) ) 
    371371         IF (nret .ne. NF90_NOERR) CALL ctl_stop('icebergs, write_restart: nf_put_var calving_hflx failed') 
    372372         IF( lwp ) WRITE(numout,*) 'file: ',TRIM(cl_path)//TRIM(cl_filename),' var: calving written' 

  • NEMO/trunk/src/OCE/IOM/in_out_manager.F90

    r12933 r13286  
    118118   LOGICAL ::   ln_timing        !: run control for timing 
    119119   LOGICAL ::   ln_diacfl        !: flag whether to create CFL diagnostics 
    120    INTEGER ::   nn_print         !: level of print (0 no print) 
    121120   INTEGER ::   nn_ictls         !: Start i indice for the SUM control 
    122121   INTEGER ::   nn_ictle         !: End   i indice for the SUM control 
    … …  
    125124   INTEGER ::   nn_isplt         !: number of processors following i 
    126125   INTEGER ::   nn_jsplt         !: number of processors following j 
    127    !                                           
    128    INTEGER ::   nprint, nictls, nictle, njctls, njctle, isplt, jsplt    !: OLD namelist names 
    129  
    130    INTEGER ::   ijsplt     =    1      !: nb of local domain = nb of processors 
    131126 
    132127   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/IOM/iom.F90

    r13226 r13286  
    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 
    … …  
    3435   USE ice      , ONLY :   jpl 
    3536#endif 
    36    USE domngb          ! ocean space and time domain 
    3737   USE phycst          ! physical constants 
    3838   USE dianam          ! build name of file 
    … …  
    101101CONTAINS 
    102102 
    103    SUBROUTINE iom_init( cdname, fname, ld_tmppatch, ld_closedef )  
     103   SUBROUTINE iom_init( cdname, fname, ld_closedef )  
    104104      !!---------------------------------------------------------------------- 
    105105      !!                     ***  ROUTINE   *** 
    … …  
    110110      CHARACTER(len=*),           INTENT(in)  :: cdname 
    111111      CHARACTER(len=*), OPTIONAL, INTENT(in)  :: fname 
    112       LOGICAL         , OPTIONAL, INTENT(in)  :: ld_tmppatch 
    113112      LOGICAL         , OPTIONAL, INTENT(in)  :: ld_closedef 
    114113#if defined key_iomput 
    … …  
    123122      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zt_bnds, zw_bnds 
    124123      REAL(wp), DIMENSION(2,jpkam1)         :: za_bnds   ! ABL vertical boundaries 
    125       LOGICAL ::   ll_tmppatch = .TRUE.    !: seb: patch before we remove periodicity 
    126       INTEGER ::   nldi_save, nlei_save    !:      and close boundaries in output files 
    127       INTEGER ::   nldj_save, nlej_save    !: 
    128124      LOGICAL ::   ll_closedef = .TRUE. 
    129125      !!---------------------------------------------------------------------- 
    130126      ! 
    131       ! seb: patch before we remove periodicity and close boundaries in output files 
    132       IF( PRESENT(ld_tmppatch) ) THEN   ;   ll_tmppatch = ld_tmppatch 
    133       ELSE                              ;   ll_tmppatch = .TRUE. 
    134       ENDIF 
    135       IF ( ll_tmppatch ) THEN 
    136          nldi_save = nldi   ;   nlei_save = nlei 
    137          nldj_save = nldj   ;   nlej_save = nlej 
    138          IF( nimpp           ==      1 ) nldi = 1 
    139          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    140          IF( njmpp           ==      1 ) nldj = 1 
    141          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    142       ENDIF 
    143127      IF ( PRESENT(ld_closedef) ) ll_closedef = ld_closedef 
    144128      ! 
    … …  
    157141 
    158142      SELECT CASE ( nleapy )        ! Choose calendar for IOIPSL 
    159       CASE ( 1)   ; CALL xios_define_calendar( TYPE = "Gregorian", time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    160           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    161       CASE ( 0)   ; CALL xios_define_calendar( TYPE = "NoLeap"   , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    162           &                                    start_date = xios_date(nyear,nmonth,nday,0,0,0) ) 
    163       CASE (30)   ; CALL xios_define_calendar( TYPE = "D360"     , time_origin = xios_date(irefyear,irefmonth,irefday,00,00,00), & 
    164           &                                    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) ) 
    165149      END SELECT 
    166150 
    … …  
    176160         ! 
    177161         IF( ln_cfmeta ) THEN   ! Add additional grid metadata 
    178             CALL iom_set_domain_attr("grid_T", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
    179             CALL iom_set_domain_attr("grid_U", area = real( e1e2u(nldi:nlei, nldj:nlej), dp)) 
    180             CALL iom_set_domain_attr("grid_V", area = real( e1e2v(nldi:nlei, nldj:nlej), dp)) 
    181             CALL iom_set_domain_attr("grid_W", area = real( e1e2t(nldi:nlei, nldj:nlej), dp)) 
     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)) 
    182166            CALL set_grid_bounds( "T", glamf, gphif, glamt, gphit ) 
    183167            CALL set_grid_bounds( "U", glamv, gphiv, glamu, gphiu ) 
    … …  
    199183         ! 
    200184         IF( ln_cfmeta .AND. .NOT. llrst_context) THEN   ! Add additional grid metadata 
    201             CALL iom_set_domain_attr("grid_T", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp)) 
    202             CALL iom_set_domain_attr("grid_U", area = real(e1u_crs(nldi:nlei, nldj:nlej) * e2u_crs(nldi:nlei, nldj:nlej), dp) ) 
    203             CALL iom_set_domain_attr("grid_V", area = real(e1v_crs(nldi:nlei, nldj:nlej) * e2v_crs(nldi:nlei, nldj:nlej), dp) ) 
    204             CALL iom_set_domain_attr("grid_W", area = real(e1e2t_crs(nldi:nlei, nldj:nlej), dp ) ) 
     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)) 
    205189            CALL set_grid_bounds( "T", glamf_crs, gphif_crs, glamt_crs, gphit_crs ) 
    206190            CALL set_grid_bounds( "U", glamv_crs, gphiv_crs, glamu_crs, gphiu_crs ) 
    … …  
    288272      DEALLOCATE( zt_bnds, zw_bnds ) 
    289273      ! 
    290       IF ( ll_tmppatch ) THEN 
    291          nldi = nldi_save   ;   nlei = nlei_save 
    292          nldj = nldj_save   ;   nlej = nlej_save 
    293       ENDIF 
    294274#endif 
    295275      ! 
    … …  
    671651 
    672652 
    673    SUBROUTINE iom_open( cdname, kiomid, ldwrt, kdom, ldstop, ldiof, kdlev, cdcomp ) 
     653   SUBROUTINE iom_open( cdname, kiomid, ldwrt, ldstop, ldiof, kdlev, cdcomp ) 
    674654      !!--------------------------------------------------------------------- 
    675655      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    680660      INTEGER         , INTENT(  out)           ::   kiomid   ! iom identifier of the opened file 
    681661      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldwrt    ! open in write modeb          (default = .FALSE.) 
    682       INTEGER         , INTENT(in   ), OPTIONAL ::   kdom     ! Type of domain to be written (default = jpdom_local_noovlap) 
    683662      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldstop   ! stop if open to read a non-existing file (default = .TRUE.) 
    684663      LOGICAL         , INTENT(in   ), OPTIONAL ::   ldiof    ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 
    … …  
    693672      LOGICAL               ::   llok      ! check the existence  
    694673      LOGICAL               ::   llwrt     ! local definition of ldwrt 
    695       LOGICAL               ::   llnoov    ! local definition to read overlap 
    696674      LOGICAL               ::   llstop    ! local definition of ldstop 
    697675      LOGICAL               ::   lliof     ! local definition of ldiof 
    698676      INTEGER               ::   icnt      ! counter for digits in clcpu (max = jpmax_digits) 
    699677      INTEGER               ::   iln, ils  ! lengths of character 
    700       INTEGER               ::   idom      ! type of domain 
    701678      INTEGER               ::   istop     !  
    702       INTEGER, DIMENSION(2,5) ::   idompar ! domain parameters:  
    703679      ! local number of points for x,y dimensions 
    704680      ! position of first local point for x,y dimensions 
    … …  
    732708      ELSE                        ;   lliof = .FALSE. 
    733709      ENDIF 
    734       ! do we read the overlap  
    735       ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    736       llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif 
    737710      ! create the file name by added, if needed, TRIM(Agrif_CFixed()) and TRIM(clsuffix) 
    738711      ! ============= 
    … …  
    774747         lxios_sini = .TRUE. 
    775748      ENDIF 
    776       IF( llwrt ) THEN 
    777          ! check the domain definition 
    778 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    779 !         idom = jpdom_local_noovlap   ! default definition 
    780          IF( llnoov ) THEN   ;   idom = jpdom_local_noovlap   ! default definition 
    781          ELSE                ;   idom = jpdom_local_full      ! default definition 
    782          ENDIF 
    783          IF( PRESENT(kdom) )   idom = kdom 
    784          ! create the domain informations 
    785          ! ============= 
    786          SELECT CASE (idom) 
    787          CASE (jpdom_local_full) 
    788             idompar(:,1) = (/ jpi             , jpj              /) 
    789             idompar(:,2) = (/ nimpp           , njmpp            /) 
    790             idompar(:,3) = (/ nimpp + jpi - 1 , njmpp + jpj - 1  /) 
    791             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    792             idompar(:,5) = (/ jpi - nlei      , jpj - nlej       /) 
    793          CASE (jpdom_local_noextra) 
    794             idompar(:,1) = (/ nlci            , nlcj             /) 
    795             idompar(:,2) = (/ nimpp           , njmpp            /) 
    796             idompar(:,3) = (/ nimpp + nlci - 1, njmpp + nlcj - 1 /) 
    797             idompar(:,4) = (/ nldi - 1        , nldj - 1         /) 
    798             idompar(:,5) = (/ nlci - nlei     , nlcj - nlej      /) 
    799          CASE (jpdom_local_noovlap) 
    800             idompar(:,1) = (/ nlei  - nldi + 1, nlej  - nldj + 1 /) 
    801             idompar(:,2) = (/ nimpp + nldi - 1, njmpp + nldj - 1 /) 
    802             idompar(:,3) = (/ nimpp + nlei - 1, njmpp + nlej - 1 /) 
    803             idompar(:,4) = (/ 0               , 0                /) 
    804             idompar(:,5) = (/ 0               , 0                /) 
    805          CASE DEFAULT 
    806             CALL ctl_stop( TRIM(clinfo), 'wrong value of kdom, only jpdom_local* cases are accepted' ) 
    807          END SELECT 
    808       ENDIF 
    809749      ! Open the NetCDF file 
    810750      ! ============= 
    … …  
    830770      ENDIF 
    831771      IF( istop == nstop ) THEN   ! no error within this routine 
    832          CALL iom_nf90_open( clname, kiomid, llwrt, llok, idompar, kdlev = kdlev, cdcomp = cdcomp ) 
     772         CALL iom_nf90_open( clname, kiomid, llwrt, llok, kdlev = kdlev, cdcomp = cdcomp ) 
    833773      ENDIF 
    834774      ! 
    … …  
    10911031   END SUBROUTINE iom_g1d_dp 
    10921032 
    1093    SUBROUTINE iom_g2d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    1094       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    1095       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    1096       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1097       REAL(sp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    1098       REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:)           ::   ztmp_pvar ! tmp var to read field 
    1099       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    1100       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    1101       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    1102       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1103                                                                                ! look for and use a file attribute 
    1104                                                                                ! called open_ocean_jstart to set the start 
    1105                                                                                ! value for the 2nd dimension (netcdf only) 
    1106       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
     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 
    11071046      ! 
    11081047      IF( kiomid > 0 ) THEN 
    11091048         IF( iom_file(kiomid)%nfid > 0 ) THEN 
    11101049            ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2))) 
    1111             CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=ztmp_pvar,   & 
    1112               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1113               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
     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 
     1071      ! 
     1072      IF( kiomid > 0 ) THEN 
     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  ) 
    11141099            pvar = ztmp_pvar 
    11151100            DEALLOCATE(ztmp_pvar) 
    11161101         END IF 
    11171102      ENDIF 
    1118    END SUBROUTINE iom_g2d_sp 
    1119  
    1120  
    1121    SUBROUTINE iom_g2d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios) 
    1122       INTEGER         , INTENT(in   )                           ::   kiomid    ! Identifier of the file 
    1123       INTEGER         , INTENT(in   )                           ::   kdom      ! Type of domain to be read 
    1124       CHARACTER(len=*), INTENT(in   )                           ::   cdvar     ! Name of the variable 
    1125       REAL(dp)        , INTENT(  out), DIMENSION(:,:)           ::   pvar      ! read field 
    1126       INTEGER         , INTENT(in   )                , OPTIONAL ::   ktime     ! record number 
    1127       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kstart    ! start axis position of the reading  
    1128       INTEGER         , INTENT(in   ), DIMENSION(2)  , OPTIONAL ::   kcount    ! number of points in each axis 
    1129       LOGICAL         , INTENT(in   )                , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1130                                                                                ! look for and use a file attribute 
    1131                                                                                ! called open_ocean_jstart to set the start 
    1132                                                                                ! value for the 2nd dimension (netcdf only) 
    1133       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios      ! read data using XIOS 
    1134       ! 
    1135       IF( kiomid > 0 ) THEN 
    1136          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r2d=pvar,   & 
    1137               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1138               &                                                     lrowattr=lrowattr,  ldxios=ldxios) 
    1139       ENDIF 
    1140    END SUBROUTINE iom_g2d_dp 
    1141  
    1142    SUBROUTINE iom_g3d_sp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    1143       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    1144       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    1145       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1146       REAL(sp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    1147       REAL(dp)        , ALLOCATABLE  , DIMENSION(:,:,:)           ::   ztmp_pvar ! tmp var to read field 
    1148       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    1149       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    1150       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1151       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1152                                                                                  ! look for and use a file attribute 
    1153                                                                                  ! called open_ocean_jstart to set the start 
    1154                                                                                  ! value for the 2nd dimension (netcdf only) 
    1155       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
     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 
    11561117      ! 
    11571118      IF( kiomid > 0 ) THEN 
    11581119         IF( iom_file(kiomid)%nfid > 0 ) THEN 
    1159             ALLOCATE(ztmp_pvar(size(pvar,1), size(pvar,2), size(pvar,3))) 
    1160             CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=ztmp_pvar,   & 
    1161               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1162               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    1163             pvar = ztmp_pvar 
    1164             DEALLOCATE(ztmp_pvar) 
     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  ) 
    11651123         END IF 
    11661124      ENDIF 
    1167    END SUBROUTINE iom_g3d_sp 
    1168  
    1169    SUBROUTINE iom_g3d_dp( kiomid, kdom, cdvar, pvar, ktime, kstart, kcount, lrowattr, ldxios ) 
    1170       INTEGER         , INTENT(in   )                             ::   kiomid    ! Identifier of the file 
    1171       INTEGER         , INTENT(in   )                             ::   kdom      ! Type of domain to be read 
    1172       CHARACTER(len=*), INTENT(in   )                             ::   cdvar     ! Name of the variable 
    1173       REAL(dp)        , INTENT(  out), DIMENSION(:,:,:)           ::   pvar      ! read field 
    1174       INTEGER         , INTENT(in   )                  , OPTIONAL ::   ktime     ! record number 
    1175       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kstart    ! start axis position of the reading  
    1176       INTEGER         , INTENT(in   ), DIMENSION(3)    , OPTIONAL ::   kcount    ! number of points in each axis 
    1177       LOGICAL         , INTENT(in   )                  , OPTIONAL ::   lrowattr  ! logical flag telling iom_get to 
    1178                                                                                  ! look for and use a file attribute 
    1179                                                                                  ! called open_ocean_jstart to set the start 
    1180                                                                                  ! value for the 2nd dimension (netcdf only) 
    1181       LOGICAL         , INTENT(in   ),               OPTIONAL ::   ldxios        ! read data using XIOS 
    1182       ! 
    1183       IF( kiomid > 0 ) THEN 
    1184          IF( iom_file(kiomid)%nfid > 0 ) CALL iom_get_123d( kiomid, kdom       , cdvar        , pv_r3d=pvar,   & 
    1185               &                                                     ktime=ktime, kstart=kstart, kcount=kcount, & 
    1186               &                                                     lrowattr=lrowattr, ldxios=ldxios ) 
    1187       ENDIF 
    11881125   END SUBROUTINE iom_g3d_dp 
    11891126 
    1190  
    1191  
    11921127   !!---------------------------------------------------------------------- 
    11931128 
    1194    SUBROUTINE iom_get_123d( kiomid, kdom  , cdvar ,   & 
    1195          &                  pv_r1d, pv_r2d, pv_r3d,   & 
    1196          &                  ktime , kstart, kcount,   & 
    1197          &                  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 ) 
    11981131      !!----------------------------------------------------------------------- 
    11991132      !!                  ***  ROUTINE  iom_get_123d  *** 
    … …  
    12031136      !! ** Method : read ONE record at each CALL 
    12041137      !!----------------------------------------------------------------------- 
    1205       INTEGER                    , INTENT(in   )           ::   kiomid     ! Identifier of the file 
    1206       INTEGER                    , INTENT(in   )           ::   kdom       ! Type of domain to be read 
    1207       CHARACTER(len=*)           , INTENT(in   )           ::   cdvar      ! Name of the variable 
    1208       REAL(dp), DIMENSION(:)     , INTENT(  out), OPTIONAL ::   pv_r1d     ! read field (1D case) 
    1209       REAL(dp), DIMENSION(:,:)   , INTENT(  out), OPTIONAL ::   pv_r2d     ! read field (2D case) 
    1210       REAL(dp), DIMENSION(:,:,:) , INTENT(  out), OPTIONAL ::   pv_r3d     ! read field (3D case) 
    1211       INTEGER                    , INTENT(in   ), OPTIONAL ::   ktime      ! record number 
    1212       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kstart     ! start position of the reading in each axis  
    1213       INTEGER , DIMENSION(:)     , INTENT(in   ), OPTIONAL ::   kcount     ! number of points to be read in each axis 
    1214       LOGICAL                    , INTENT(in   ), OPTIONAL ::   lrowattr   ! logical flag telling iom_get to 
    1215                                                                            ! look for and use a file attribute 
    1216                                                                            ! called open_ocean_jstart to set the start 
    1217                                                                            ! value for the 2nd dimension (netcdf only) 
    1218       LOGICAL                    , INTENT(in   ), OPTIONAL ::   ldxios     ! use XIOS to read restart 
    1219       ! 
    1220       LOGICAL                        ::   llxios       ! local definition for XIOS read 
    1221       LOGICAL                        ::   llnoov      ! local definition to read overlap 
    1222       LOGICAL                        ::   luse_jattr  ! local definition to read open_ocean_jstart file attribute 
    1223       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 
    12241154      INTEGER                        ::   jl          ! loop on number of dimension  
    12251155      INTEGER                        ::   idom        ! type of domain 
    … …  
    12381168      INTEGER, DIMENSION(jpmax_dims) ::   ishape      ! size of the dimensions of the variable 
    12391169      REAL(dp)                       ::   zscf, zofs  ! sacle_factor and add_offset 
     1170      REAL(wp)                       ::   zsgn        ! local value of psgn 
    12401171      INTEGER                        ::   itmp        ! temporary integer 
    12411172      CHARACTER(LEN=256)             ::   clinfo      ! info character 
    12421173      CHARACTER(LEN=256)             ::   clname      ! file name 
    12431174      CHARACTER(LEN=1)               ::   clrankpv, cldmspc      !  
    1244       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. 
    12451177      INTEGER                        ::   inlev       ! number of levels for 3D data 
    12461178      REAL(dp)                       ::   gma, gmi 
    … …  
    12511183      ! 
    12521184      llxios = .FALSE. 
    1253       if(PRESENT(ldxios)) llxios = ldxios 
    1254       idvar = iom_varid( kiomid, cdvar )  
     1185      IF( PRESENT(ldxios) )  llxios = ldxios 
     1186      ! 
    12551187      idom = kdom 
     1188      istop = nstop 
    12561189      ! 
    12571190      IF(.NOT.llxios) THEN 
    12581191         clname = iom_file(kiomid)%name   !   esier to read 
    12591192         clinfo = '          iom_get_123d, file: '//trim(clname)//', var: '//trim(cdvar) 
    1260          ! local definition of the domain ? 
    1261          ! do we read the overlap  
    1262          ! ugly patch SM+JMM+RB to overwrite global definition in some cases 
    1263          llnoov = (jpni * jpnj ) == jpnij .AND. .NOT. lk_agrif  
    12641193         ! check kcount and kstart optionals parameters... 
    1265          IF( PRESENT(kcount) .AND. (.NOT. PRESENT(kstart)) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
    1266          IF( PRESENT(kstart) .AND. (.NOT. PRESENT(kcount)) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
    1267          IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND.  idom /= jpdom_autoglo_xy  ) & 
    1268      &          CALL ctl_stop(trim(clinfo), 'kstart present needs kdom = jpdom_unknown or kdom = jpdom_autoglo_xy') 
    1269  
    1270          luse_jattr = .false. 
    1271          IF( PRESENT(lrowattr) ) THEN 
    1272             IF( lrowattr .AND. idom /= jpdom_data   ) CALL ctl_stop(trim(clinfo), 'lrowattr present and true needs kdom = jpdom_data') 
    1273             IF( lrowattr .AND. idom == jpdom_data   ) luse_jattr = .true. 
    1274          ENDIF 
    1275  
     1194         IF( PRESENT(kcount) .AND. .NOT. PRESENT(kstart) ) CALL ctl_stop(trim(clinfo), 'kcount present needs kstart present') 
     1195         IF( PRESENT(kstart) .AND. .NOT. PRESENT(kcount) ) CALL ctl_stop(trim(clinfo), 'kstart present needs kcount present') 
     1196         IF( PRESENT(kstart) .AND. idom /= jpdom_unknown .AND. idom /= jpdom_auto_xy ) & 
     1197            &          CALL ctl_stop(TRIM(clinfo), 'kstart present needs idom = jpdom_unknown or idom = jpdom_auto_xy') 
     1198         IF( idom == jpdom_auto_xy .AND. .NOT. PRESENT(kstart) ) & 
     1199            &          CALL ctl_stop(TRIM(clinfo), 'idom = jpdom_auto_xy requires kstart to be present') 
     1200         ! 
    12761201         ! Search for the variable in the data base (eventually actualize data) 
    1277          istop = nstop 
    12781202         ! 
     1203         idvar = iom_varid( kiomid, cdvar )  
    12791204         IF( idvar > 0 ) THEN 
    1280             ! to write iom_file(kiomid)%dimsz in a shorter way ! 
    1281             idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)  
     1205            ! 
     1206            idimsz(:) = iom_file(kiomid)%dimsz(:, idvar)      ! to write iom_file(kiomid)%dimsz in a shorter way 
    12821207            inbdim = iom_file(kiomid)%ndims(idvar)            ! number of dimensions in the file 
    12831208            idmspc = inbdim                                   ! number of spatial dimensions in the file 
    … …  
    12851210            IF( idmspc > 3 )   CALL ctl_stop(trim(clinfo), 'the file has more than 3 spatial dimensions this case is not coded...')  
    12861211            ! 
    1287             ! update idom definition... 
    1288             ! Identify the domain in case of jpdom_auto(glo/dta) definition 
    1289             IF( idom == jpdom_autoglo_xy ) THEN 
    1290                ll_depth_spec = .TRUE. 
    1291                idom = jpdom_autoglo 
    1292             ELSE 
    1293                ll_depth_spec = .FALSE. 
    1294             ENDIF 
    1295             IF( idom == jpdom_autoglo .OR. idom == jpdom_autodta ) THEN             
    1296                IF( idom == jpdom_autoglo ) THEN   ;   idom = jpdom_global  
    1297                ELSE                               ;   idom = jpdom_data 
    1298                ENDIF 
     1212            ! Identify the domain in case of jpdom_auto definition 
     1213            IF( idom == jpdom_auto .OR. idom == jpdom_auto_xy ) THEN             
     1214               idom = jpdom_global   ! default 
     1215               ! else: if the file name finishes with _xxxx.nc with xxxx any number 
    12991216               ind1 = INDEX( clname, '_', back = .TRUE. ) + 1 
    13001217               ind2 = INDEX( clname, '.', back = .TRUE. ) - 1 
    13011218               IF( ind2 > ind1 ) THEN   ;   IF( VERIFY( clname(ind1:ind2), '0123456789' ) == 0 )   idom = jpdom_local   ;   ENDIF 
    1302             ENDIF 
    1303             ! Identify the domain in case of jpdom_local definition 
    1304             IF( idom == jpdom_local ) THEN 
    1305                IF(     idimsz(1) == jpi               .AND. idimsz(2) == jpj               ) THEN   ;   idom = jpdom_local_full 
    1306                ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN   ;   idom = jpdom_local_noextra 
    1307                ELSEIF( idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN   ;   idom = jpdom_local_noovlap 
    1308                ELSE   ;   CALL ctl_stop( trim(clinfo), 'impossible to identify the local domain' ) 
    1309                ENDIF 
    13101219            ENDIF 
    13111220            ! 
    … …  
    13201229            WRITE(cldmspc , fmt='(i1)') idmspc 
    13211230            ! 
    1322             !!GS: we consider 2D data as 3D data with vertical dim size = 1 
    1323             !IF(     idmspc <  irankpv ) THEN  
    1324             !   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
    1325             !      &                         'it is impossible to read a '//clrankpv//'D array from this file...' ) 
    1326             !ELSEIF( idmspc == irankpv ) THEN 
    1327             IF( idmspc == irankpv ) THEN 
     1231            IF(     idmspc <  irankpv ) THEN                     ! it seems we want to read more than we can... 
     1232               IF(     irankpv == 3 .AND. idmspc == 2 ) THEN     !   3D input array from 2D spatial data in the file: 
     1233                  llok = inlev == 1                              !     -> 3rd dimension must be equal to 1 
     1234               ELSEIF( irankpv == 3 .AND. idmspc == 1 ) THEN     !   3D input array from 1D spatial data in the file: 
     1235                  llok = inlev == 1 .AND. SIZE(pv_r3d, 2) == 1   !     -> 2nd and 3rd dimensions must be equal to 1 
     1236               ELSEIF( irankpv == 2 .AND. idmspc == 2 ) THEN     !   2D input array from 1D spatial data in the file: 
     1237                  llok = SIZE(pv_r2d, 2) == 1                    !     -> 2nd dimension must be equal to 1 
     1238               ELSE 
     1239                  llok = .FALSE. 
     1240               ENDIF 
     1241               IF( .NOT. llok )   CALL ctl_stop( TRIM(clinfo), 'The file has only '//cldmspc//' spatial dimension',   & 
     1242                  &                                            '=> cannot read a true '//clrankpv//'D array from this file...' ) 
     1243            ELSEIF( idmspc == irankpv ) THEN 
    13281244               IF( PRESENT(pv_r1d) .AND. idom /= jpdom_unknown )   & 
    13291245                  &   CALL ctl_stop( TRIM(clinfo), 'case not coded...You must use jpdom_unknown' ) 
    1330             ELSEIF( idmspc >  irankpv ) THEN 
     1246            ELSEIF( idmspc >  irankpv ) THEN                     ! it seems we want to read less than we should... 
    13311247                  IF( PRESENT(pv_r2d) .AND. itime == 1 .AND. idimsz(3) == 1 .AND. idmspc == 3 ) THEN 
    1332                      CALL ctl_warn( trim(clinfo), '2D array but 3 spatial dimensions for the data...'              ,   & 
     1248                     CALL ctl_warn( trim(clinfo), '2D array input but 3 spatial dimensions in the file...'              ,   & 
    13331249                           &         'As the size of the z dimension is 1 and as we try to read the first record, ',   & 
    13341250                           &         'we accept this case, even if there is a possible mix-up between z and time dimension' )    
    … …  
    13441260            ! definition of istart and icnt 
    13451261            ! 
    1346             icnt  (:) = 1 
    1347             istart(:) = 1 
    1348             istart(idmspc+1) = itime 
    1349     
    1350             IF( PRESENT(kstart) .AND. .NOT. ll_depth_spec ) THEN  
    1351                istart(1:idmspc) = kstart(1:idmspc)  
    1352                icnt  (1:idmspc) = kcount(1:idmspc) 
    1353             ELSE 
    1354                IF(idom == jpdom_unknown ) THEN 
    1355                   icnt(1:idmspc) = idimsz(1:idmspc) 
    1356                ELSE  
    1357                   IF( .NOT. PRESENT(pv_r1d) ) THEN   !   not a 1D array 
    1358                      IF(     idom == jpdom_data    ) THEN 
    1359                         jstartrow = 1 
    1360                         IF( luse_jattr ) THEN 
    1361                            CALL iom_getatt(kiomid, 'open_ocean_jstart', jstartrow ) ! -999 is returned if the attribute is not found 
    1362                            jstartrow = MAX(1,jstartrow) 
    1363                         ENDIF 
    1364                         istart(1:2) = (/ mig(1), mjg(1) + jstartrow - 1 /)  ! icnt(1:2) done below 
    1365                      ELSEIF( idom == jpdom_global  ) THEN ; istart(1:2) = (/ nimpp , njmpp  /)  ! icnt(1:2) done below 
    1366                      ENDIF 
    1367                      ! we do not read the overlap                     -> we start to read at nldi, nldj 
    1368 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1369 !                  IF( idom /= jpdom_local_noovlap )   istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1370                      IF( llnoov .AND. idom /= jpdom_local_noovlap ) istart(1:2) = istart(1:2) + (/ nldi - 1, nldj - 1 /) 
    1371                   ! we do not read the overlap and the extra-halos -> from nldi to nlei and from nldj to nlej  
    1372 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1373 !                  icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1374                      IF( llnoov ) THEN   ;   icnt(1:2) = (/ nlei - nldi + 1, nlej - nldj + 1 /) 
    1375                      ELSE                ;   icnt(1:2) = (/ nlci           , nlcj            /) 
    1376                      ENDIF 
    1377                      IF( PRESENT(pv_r3d) ) THEN 
    1378                         IF( idom == jpdom_data ) THEN                        ;                               icnt(3) = inlev 
    1379                         ELSEIF( ll_depth_spec .AND. PRESENT(kstart) ) THEN   ;   istart(3) = kstart(3)   ;   icnt(3) = kcount(3) 
    1380                         ELSE                                                 ;                               icnt(3) = inlev 
    1381                         ENDIF 
    1382                      ENDIF 
     1262            icnt  (:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1263            istart(:) = 1              ! default definition (simple way to deal with special cases listed above)  
     1264            istart(idmspc+1) = itime   ! temporal dimenstion 
     1265            ! 
     1266            IF( idom == jpdom_unknown ) THEN 
     1267               IF( PRESENT(kstart) .AND. idom /= jpdom_auto_xy ) THEN  
     1268                  istart(1:idmspc) = kstart(1:idmspc)  
     1269                  icnt  (1:idmspc) = kcount(1:idmspc) 
     1270               ELSE 
     1271                  icnt  (1:idmspc) = idimsz(1:idmspc) 
     1272               ENDIF 
     1273            ELSE   !   not a 1D array as pv_r1d requires jpdom_unknown 
     1274               ! we do not read the overlap and the extra-halos -> from Nis0 to Nie0 and from Njs0 to Nje0  
     1275               IF( idom == jpdom_global )   istart(1:2) = (/ mig0(Nis0), mjg0(Njs0) /) 
     1276               icnt(1:2) = (/ Ni_0, Nj_0 /) 
     1277               IF( PRESENT(pv_r3d) ) THEN 
     1278                  IF( idom == jpdom_auto_xy ) THEN 
     1279                     istart(3) = kstart(3) 
     1280                     icnt  (3) = kcount(3) 
     1281                  ELSE 
     1282                     icnt  (3) = inlev 
    13831283                  ENDIF 
    13841284               ENDIF 
    13851285            ENDIF 
    1386  
     1286            ! 
    13871287            ! check that istart and icnt can be used with this file 
    13881288            !- 
    … …  
    13951295               ENDIF 
    13961296            END DO 
    1397  
     1297            ! 
    13981298            ! check that icnt matches the input array 
    13991299            !-      
    … …  
    14051305            ELSE 
    14061306               IF( irankpv == 2 ) THEN 
    1407 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1408 !               ishape(1:2) = SHAPE(pv_r2d(nldi:nlei,nldj:nlej  ))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej)' 
    1409                   IF( llnoov ) THEN ; ishape(1:2)=SHAPE(pv_r2d(nldi:nlei,nldj:nlej  )) ; ctmp1='d(nldi:nlei,nldj:nlej)' 
    1410                   ELSE              ; ishape(1:2)=SHAPE(pv_r2d(1   :nlci,1   :nlcj  )) ; ctmp1='d(1:nlci,1:nlcj)' 
    1411                   ENDIF 
     1307                  ishape(1:2) = SHAPE(pv_r2d(Nis0:Nie0,Njs0:Nje0  ))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0)' 
    14121308               ENDIF 
    14131309               IF( irankpv == 3 ) THEN  
    1414 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1415 !               ishape(1:3) = SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:))   ;   ctmp1 = 'd(nldi:nlei,nldj:nlej,:)' 
    1416                   IF( llnoov ) THEN ; ishape(1:3)=SHAPE(pv_r3d(nldi:nlei,nldj:nlej,:)) ; ctmp1='d(nldi:nlei,nldj:nlej,:)' 
    1417                   ELSE              ; ishape(1:3)=SHAPE(pv_r3d(1   :nlci,1   :nlcj,:)) ; ctmp1='d(1:nlci,1:nlcj,:)' 
    1418                   ENDIF 
     1310                  ishape(1:3) = SHAPE(pv_r3d(Nis0:Nie0,Njs0:Nje0,:))   ;   ctmp1 = 'd(Nis0:Nie0,Njs0:Nje0,:)' 
    14191311               ENDIF 
    1420             ENDIF 
    1421           
     1312            ENDIF          
    14221313            DO jl = 1, irankpv 
    14231314               WRITE( ctmp2, FMT="(', ', i1,'): ', i5,' /= icnt(', i1,'):', i5)" ) jl, ishape(jl), jl, icnt(jl) 
    … …  
    14311322         IF( idvar > 0 .AND. istop == nstop ) THEN   ! no additional errors until this point... 
    14321323            ! 
    1433          ! find the right index of the array to be read 
    1434 ! JMM + SM: ugly patch before getting the new version of lib_mpp) 
    1435 !         IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1436 !         ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1437 !         ENDIF 
    1438             IF( llnoov ) THEN 
    1439                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = nldi   ;   ix2 = nlei      ;   iy1 = nldj   ;   iy2 = nlej 
    1440                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1441                ENDIF 
    1442             ELSE 
    1443                IF( idom /= jpdom_unknown ) THEN   ;   ix1 = 1      ;   ix2 = nlci      ;   iy1 = 1      ;   iy2 = nlcj 
    1444                ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    1445                ENDIF 
     1324            ! find the right index of the array to be read 
     1325            IF( idom /= jpdom_unknown ) THEN   ;   ix1 = Nis0   ;   ix2 = Nie0      ;   iy1 = Njs0   ;   iy2 = Nje0 
     1326            ELSE                               ;   ix1 = 1      ;   ix2 = icnt(1)   ;   iy1 = 1      ;   iy2 = icnt(2) 
    14461327            ENDIF 
    14471328       
    … …  
    14501331            IF( istop == nstop ) THEN   ! no additional errors until this point... 
    14511332               IF(lwp) WRITE(numout,"(10x,' read ',a,' (rec: ',i6,') in ',a,' ok')") TRIM(cdvar), itime, TRIM(iom_file(kiomid)%name) 
    1452               
     1333 
     1334               cl_type = 'T' 
     1335               IF( PRESENT(cd_type) )   cl_type = cd_type 
     1336               zsgn = 1._wp 
     1337               IF( PRESENT(psgn   ) )   zsgn    = psgn 
    14531338               !--- overlap areas and extra hallows (mpp) 
    1454                IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown ) THEN 
    1455                   CALL lbc_lnk( 'iom', pv_r2d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    1456                ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown ) THEN 
    1457                   ! this if could be simplified with the new lbc_lnk that works with any size of the 3rd dimension 
    1458                   IF( icnt(3) == inlev ) THEN 
    1459                      CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing ) 
    1460                   ELSE   ! put some arbitrary value (a call to lbc_lnk will be done later...) 
    1461                      DO jj = nlcj+1, jpj   ;   pv_r3d(1:nlci, jj, :) = pv_r3d(1:nlci, nlej, :)   ;   END DO 
    1462                      DO ji = nlci+1, jpi   ;   pv_r3d(ji    , : , :) = pv_r3d(nlei  , :   , :)   ;   END DO 
    1463                   ENDIF 
     1339               IF(     PRESENT(pv_r2d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1340                  CALL lbc_lnk( 'iom', pv_r2d, cl_type, zsgn, kfillmode = kfill ) 
     1341               ELSEIF( PRESENT(pv_r3d) .AND. idom /= jpdom_unknown .AND. cl_type /= 'Z' ) THEN 
     1342                  CALL lbc_lnk( 'iom', pv_r3d, cl_type, zsgn, kfillmode = kfill ) 
    14641343               ENDIF 
    14651344               ! 
    … …  
    14781357         CALL iom_swap( TRIM(crxios_context) )  
    14791358         IF( PRESENT(pv_r3d) ) THEN 
    1480             pv_r3d(:, :, :) = 0. 
    1481             if(lwp) write(numout,*) 'XIOS RST READ (3D): ',trim(cdvar) 
     1359            IF(lwp) WRITE(numout,*) 'XIOS RST READ (3D): ',TRIM(cdvar) 
    14821360            CALL xios_recv_field( trim(cdvar), pv_r3d) 
    1483             IF(idom /= jpdom_unknown ) then 
    1484                 CALL lbc_lnk( 'iom', pv_r3d,'Z', -999.0_wp, kfillmode = jpfillnothing) 
    1485             ENDIF 
     1361            IF(idom /= jpdom_unknown )   CALL lbc_lnk( 'iom', pv_r3d,'Z', -999., kfillmode = jpfillnothing) 
    14861362         ELSEIF( PRESENT(pv_r2d) ) THEN 
    1487             pv_r2d(:, :) = 0. 
    1488             if(lwp) write(numout,*) 'XIOS RST READ (2D): ', trim(cdvar) 
     1363            IF(lwp) WRITE(numout,*) 'XIOS RST READ (2D): ', TRIM(cdvar) 
    14891364            CALL xios_recv_field( trim(cdvar), pv_r2d) 
    1490             IF(idom /= jpdom_unknown ) THEN 
    1491                 CALL lbc_lnk('iom', pv_r2d,'Z',-999.0_wp, kfillmode = jpfillnothing) 
    1492             ENDIF 
     1365            IF(idom /= jpdom_unknown )   CALL lbc_lnk('iom', pv_r2d,'Z',-999., kfillmode = jpfillnothing) 
    14931366         ELSEIF( PRESENT(pv_r1d) ) THEN 
    1494             pv_r1d(:) = 0. 
    1495             if(lwp) write(numout,*) 'XIOS RST READ (1D): ', trim(cdvar) 
     1367            IF(lwp) WRITE(numout,*) 'XIOS RST READ (1D): ', TRIM(cdvar) 
    14961368            CALL xios_recv_field( trim(cdvar), pv_r1d) 
    14971369         ENDIF 
    … …  
    20361908      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    20371909      REAL(sp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    2038 #if defined key_iomput 
    2039       CALL xios_send_field(cdname, pfield2d) 
     1910      IF( iom_use(cdname) ) THEN 
     1911#if defined key_iomput 
     1912         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1913            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1914         ELSE 
     1915            CALL xios_send_field( cdname, pfield2d ) 
     1916         ENDIF 
    20401917#else 
    2041       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    2042 #endif 
     1918         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1919#endif 
     1920      ENDIF 
    20431921   END SUBROUTINE iom_p2d_sp 
    20441922 
    … …  
    20461924      CHARACTER(LEN=*)            , INTENT(in) ::   cdname 
    20471925      REAL(dp),     DIMENSION(:,:), INTENT(in) ::   pfield2d 
    2048 #if defined key_iomput 
    2049       CALL xios_send_field(cdname, pfield2d) 
     1926      IF( iom_use(cdname) ) THEN 
     1927#if defined key_iomput 
     1928         IF( SIZE(pfield2d, dim=1) == jpi .AND. SIZE(pfield2d, dim=2) == jpj ) THEN 
     1929            CALL xios_send_field( cdname, pfield2d(Nis0:Nie0, Njs0:Nje0) )       ! this extraction will create a copy of pfield2d 
     1930         ELSE 
     1931            CALL xios_send_field( cdname, pfield2d ) 
     1932         ENDIF 
    20501933#else 
    2051       IF( .FALSE. )   WRITE(numout,*) cdname, pfield2d   ! useless test to avoid compilation warnings 
    2052 #endif 
     1934         WRITE(numout,*) pfield2d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1935#endif 
     1936      ENDIF 
    20531937   END SUBROUTINE iom_p2d_dp 
    20541938 
    … …  
    20561940      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20571941      REAL(sp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    2058 #if defined key_iomput 
    2059       CALL xios_send_field( cdname, pfield3d ) 
     1942      IF( iom_use(cdname) ) THEN 
     1943#if defined key_iomput 
     1944         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1945            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1946         ELSE 
     1947            CALL xios_send_field( cdname, pfield3d ) 
     1948         ENDIF 
    20601949#else 
    2061       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    2062 #endif 
     1950         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1951#endif 
     1952      ENDIF 
    20631953   END SUBROUTINE iom_p3d_sp 
    20641954 
    … …  
    20661956      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20671957      REAL(dp),       DIMENSION(:,:,:), INTENT(in) ::   pfield3d 
    2068 #if defined key_iomput 
    2069       CALL xios_send_field( cdname, pfield3d ) 
     1958      IF( iom_use(cdname) ) THEN 
     1959#if defined key_iomput 
     1960         IF( SIZE(pfield3d, dim=1) == jpi .AND. SIZE(pfield3d, dim=2) == jpj ) THEN 
     1961            CALL xios_send_field( cdname, pfield3d(Nis0:Nie0, Njs0:Nje0,:) )     ! this extraction will create a copy of pfield3d 
     1962         ELSE 
     1963            CALL xios_send_field( cdname, pfield3d ) 
     1964         ENDIF 
    20701965#else 
    2071       IF( .FALSE. )   WRITE(numout,*) cdname, pfield3d   ! useless test to avoid compilation warnings 
    2072 #endif 
     1966         WRITE(numout,*) pfield3d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1967#endif 
     1968      ENDIF 
    20731969   END SUBROUTINE iom_p3d_dp 
    20741970 
    … …  
    20761972      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20771973      REAL(sp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    2078 #if defined key_iomput 
    2079       CALL xios_send_field(cdname, pfield4d) 
     1974      IF( iom_use(cdname) ) THEN 
     1975#if defined key_iomput 
     1976         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1977            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1978         ELSE 
     1979            CALL xios_send_field (cdname, pfield4d ) 
     1980         ENDIF 
    20801981#else 
    2081       IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    2082 #endif 
     1982         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1983#endif 
     1984      ENDIF 
    20831985   END SUBROUTINE iom_p4d_sp 
    20841986 
    … …  
    20861988      CHARACTER(LEN=*)                , INTENT(in) ::   cdname 
    20871989      REAL(dp),       DIMENSION(:,:,:,:), INTENT(in) ::   pfield4d 
    2088 #if defined key_iomput 
    2089       CALL xios_send_field(cdname, pfield4d) 
     1990      IF( iom_use(cdname) ) THEN 
     1991#if defined key_iomput 
     1992         IF( SIZE(pfield4d, dim=1) == jpi .AND. SIZE(pfield4d, dim=2) == jpj ) THEN 
     1993            CALL xios_send_field( cdname, pfield4d(Nis0:Nie0, Njs0:Nje0,:,:) )   ! this extraction will create a copy of pfield4d 
     1994         ELSE 
     1995            CALL xios_send_field (cdname, pfield4d ) 
     1996         ENDIF 
    20901997#else 
    2091       IF( .FALSE. )   WRITE(numout,*) cdname, pfield4d   ! useless test to avoid compilation warnings 
    2092 #endif 
     1998         WRITE(numout,*) pfield4d   ! iom_use(cdname) = .F. -> useless test to avoid compilation warnings 
     1999#endif 
     2000      ENDIF 
    20932001   END SUBROUTINE iom_p4d_dp 
    20942002 
    … …  
    22872195      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    22882196      ! 
    2289       INTEGER  :: ni, nj 
    22902197      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zmask 
    22912198      LOGICAL, INTENT(IN) :: ldxios, ldrxios 
    22922199      !!---------------------------------------------------------------------- 
    22932200      ! 
    2294       ni = nlei-nldi+1 
    2295       nj = nlej-nldj+1 
    2296       ! 
    2297       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) 
    2298       CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2201      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) 
     2202      CALL iom_set_domain_attr("grid_"//cdgrd, data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    22992203!don't define lon and lat for restart reading context.  
    23002204      IF ( .NOT.ldrxios ) & 
    2301          CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(nldi:nlei, nldj:nlej),(/ ni*nj /)), dp),   & 
    2302          &                                     latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp ) )   
     2205         CALL iom_set_domain_attr("grid_"//cdgrd, lonvalue = real(RESHAPE(plon(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp),   & 
     2206         &                                        latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp ))   
    23032207      ! 
    23042208      IF ( ln_mskland .AND. (.NOT.ldxios) ) THEN 
    … …  
    23062210         SELECT CASE ( cdgrd ) 
    23072211         CASE('T')   ;   zmask(:,:,:)       = tmask(:,:,:) 
    2308          CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:)   ;   CALL lbc_lnk( 'iom', zmask, 'U', 1.0_wp ) 
    2309          CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:)   ;   CALL lbc_lnk( 'iom', zmask, 'V', 1.0_wp ) 
     2212         CASE('U')   ;   zmask(2:jpim1,:,:) = tmask(2:jpim1,:,:) + tmask(3:jpi,:,:) 
     2213         CASE('V')   ;   zmask(:,2:jpjm1,:) = tmask(:,2:jpjm1,:) + tmask(:,3:jpj,:) 
    23102214         CASE('W')   ;   zmask(:,:,2:jpk  ) = tmask(:,:,1:jpkm1) + tmask(:,:,2:jpk)   ;   zmask(:,:,1) = tmask(:,:,1) 
    23112215         END SELECT 
    23122216         ! 
    2313          CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni*nj    /)) /= 0. ) 
    2314          CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 
     2217         CALL iom_set_domain_attr( "grid_"//cdgrd       , mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,1),(/Ni_0*Nj_0    /)) /= 0. ) 
     2218         CALL iom_set_grid_attr  ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(Nis0:Nie0,Njs0:Nje0,:),(/Ni_0,Nj_0,jpk/)) /= 0. ) 
    23152219      ENDIF 
    23162220      ! 
    23172221   END SUBROUTINE set_grid 
    2318  
    23192222 
    23202223   SUBROUTINE set_grid_bounds( cdgrd, plon_cnr, plat_cnr, plon_pnt, plat_pnt ) 
    … …  
    23292232      REAL(wp), DIMENSION(jpi,jpj), OPTIONAL, INTENT(in) :: plon_pnt, plat_pnt  ! Lat/lon coord. of the point of cell (i,j) 
    23302233      ! 
    2331       INTEGER :: ji, jj, jn, ni, nj 
     2234      INTEGER :: ji, jj, jn 
    23322235      INTEGER :: icnr, jcnr                             ! Offset such that the vertex coordinate (i+icnr,j+jcnr) 
    2333       !                                                 ! represents the bottom-left corner of cell (i,j) 
     2236      !                                                 ! represents the 
     2237      !                                                 bottom-left corner of 
     2238      !                                                 cell (i,j) 
    23342239      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: z_bnds      ! Lat/lon coordinates of the vertices of cell (i,j) 
    23352240      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     :: z_fld       ! Working array to determine where to rotate cells 
    … …  
    23462251      END SELECT 
    23472252      ! 
    2348       ni = nlei-nldi+1   ! Dimensions of subdomain interior 
    2349       nj = nlej-nldj+1 
    2350       ! 
    23512253      z_fld(:,:) = 1._wp 
    23522254      CALL lbc_lnk( 'iom', z_fld, cdgrd, -1.0_wp )    ! Working array for location of northfold 
    23532255      ! 
    23542256      ! Cell vertices that can be defined 
    2355       DO jj = 2, jpjm1 
    2356          DO ji = 2, jpim1 
    2357             z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    2358             z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    2359             z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    2360             z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    2361             z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
    2362             z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
    2363             z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
    2364             z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
    2365          END DO 
    2366       END DO 
    2367       ! 
    2368       ! Cell vertices on boundries 
    2369       DO jn = 1, 4 
    2370          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,1), cdgrd, 1.0_wp, pfillval=999._wp ) 
    2371          CALL lbc_lnk( 'iom', z_bnds(jn,:,:,2), cdgrd, 1.0_wp, pfillval=999._wp ) 
    2372       END DO 
    2373       ! 
    2374       ! Zero-size cells at closed boundaries if cell points provided, 
    2375       ! otherwise they are closed cells with unrealistic bounds 
    2376       IF( PRESENT(plon_pnt) .AND. PRESENT(plat_pnt) ) THEN 
    2377          IF( (nbondi == -1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    2378             DO jn = 1, 4        ! (West or jpni = 1), closed E-W 
    2379                z_bnds(jn,1,:,1) = plat_pnt(1,:)  ;  z_bnds(jn,1,:,2) = plon_pnt(1,:) 
    2380             END DO 
    2381          ENDIF 
    2382          IF( (nbondi == 1 .OR. nbondi == 2) .AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) THEN 
    2383             DO jn = 1, 4        ! (East or jpni = 1), closed E-W 
    2384                z_bnds(jn,nlci,:,1) = plat_pnt(nlci,:)  ;  z_bnds(jn,nlci,:,2) = plon_pnt(nlci,:) 
    2385             END DO 
    2386          ENDIF 
    2387          IF( nbondj == -1 .OR. (nbondj == 2 .AND. jperio /= 2) ) THEN 
    2388             DO jn = 1, 4        ! South or (jpnj = 1, not symmetric) 
    2389                z_bnds(jn,:,1,1) = plat_pnt(:,1)  ;  z_bnds(jn,:,1,2) = plon_pnt(:,1) 
    2390             END DO 
    2391          ENDIF 
    2392          IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio  < 3 ) THEN 
    2393             DO jn = 1, 4        ! (North or jpnj = 1), no north fold 
    2394                z_bnds(jn,:,nlcj,1) = plat_pnt(:,nlcj)  ;  z_bnds(jn,:,nlcj,2) = plon_pnt(:,nlcj) 
    2395             END DO 
    2396          ENDIF 
    2397       ENDIF 
    2398       ! 
    2399       IF( (nbondj == 1 .OR. nbondj == 2) .AND. jperio >= 3 ) THEN    ! Rotate cells at the north fold 
    2400          DO jj = 1, jpj 
    2401             DO ji = 1, jpi 
    2402                IF( z_fld(ji,jj) == -1. ) THEN 
    2403                   z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
    2404                   z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
    2405                   z_bnds(:,ji,jj,:) = z_rot(:,:) 
    2406                ENDIF 
    2407             END DO 
    2408          END DO 
    2409       ELSE IF( nbondj == 2 .AND. jperio == 2 ) THEN                  ! Invert cells at the symmetric equator 
    2410          DO ji = 1, jpi 
    2411             z_rot(1:2,:) = z_bnds(3:4,ji,1,:) 
    2412             z_rot(3:4,:) = z_bnds(1:2,ji,1,:) 
    2413             z_bnds(:,ji,1,:) = z_rot(:,:) 
    2414          END DO 
    2415       ENDIF 
    2416       ! 
    2417       CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,1),(/ 4,ni*nj /)), dp),           & 
    2418           &                                    bounds_lon =real( RESHAPE(z_bnds(:,nldi:nlei,nldj:nlej,2),(/ 4,ni*nj /)), dp), nvertex=4 ) 
    2419       ! 
    2420       DEALLOCATE( z_bnds, z_fld, z_rot )  
     2257      DO_2D_00_00 
     2258         z_bnds(1,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2259         z_bnds(2,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2260         z_bnds(3,ji,jj,1) = plat_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2261         z_bnds(4,ji,jj,1) = plat_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2262         z_bnds(1,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr  ) ! Bottom-left 
     2263         z_bnds(2,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr  ) ! Bottom-right 
     2264         z_bnds(3,ji,jj,2) = plon_cnr(ji+icnr+1,jj+jcnr+1) ! Top-right 
     2265         z_bnds(4,ji,jj,2) = plon_cnr(ji+icnr,  jj+jcnr+1) ! Top-left 
     2266      END_2D 
     2267      ! 
     2268      DO_2D_00_00 
     2269         IF( z_fld(ji,jj) == -1. ) THEN 
     2270            z_rot(1,:) = z_bnds(3,ji,jj,:) ; z_rot(2,:) = z_bnds(4,ji,jj,:) 
     2271            z_rot(3,:) = z_bnds(1,ji,jj,:) ; z_rot(4,:) = z_bnds(2,ji,jj,:) 
     2272            z_bnds(:,ji,jj,:) = z_rot(:,:) 
     2273         ENDIF 
     2274      END_2D 
     2275      ! 
     2276      CALL iom_set_domain_attr("grid_"//cdgrd, bounds_lat = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,1),(/ 4,Ni_0*Nj_0 /)), dp),           & 
     2277          &                                    bounds_lon = real(RESHAPE(z_bnds(:,Nis0:Nie0,Njs0:Nje0,2),(/ 4,Ni_0*Nj_0 /)), dp), nvertex=4 ) 
     2278      ! 
     2279      DEALLOCATE( z_bnds, z_fld, z_rot ) 
    24212280      ! 
    24222281   END SUBROUTINE set_grid_bounds 
    24232282 
    2424  
    24252283   SUBROUTINE set_grid_znl( plat ) 
    24262284      !!---------------------------------------------------------------------- 
    … …  
    24322290      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   plat 
    24332291      ! 
    2434       INTEGER  :: ni, nj, ix, iy 
     2292      INTEGER  :: ix, iy 
    24352293      REAL(wp), DIMENSION(:), ALLOCATABLE  ::   zlon 
    24362294      !!---------------------------------------------------------------------- 
    24372295      ! 
    2438       ni=nlei-nldi+1       ! define zonal mean domain (jpj*jpk) 
    2439       nj=nlej-nldj+1 
    2440       ALLOCATE( zlon(ni*nj) )       ;       zlon(:) = 0._wp 
     2296      ALLOCATE( zlon(Ni_0*Nj_0) )       ;       zlon(:) = 0._wp 
    24412297      ! 
    24422298!      CALL dom_ngb( -168.53_wp, 65.03_wp, ix, iy, 'T' ) !  i-line that passes through Bering Strait: Reference latitude (used in plots) 
    24432299      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) 
    2444       CALL iom_set_domain_attr("gznl", ni_glo=jpiglo, nj_glo=jpjglo, ibegin=nimpp+nldi-2, jbegin=njmpp+nldj-2, ni=ni, nj=nj) 
    2445       CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 1-nldi, data_ni = jpi, data_jbegin = 1-nldj, data_nj = jpj) 
     2300      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) 
     2301      CALL iom_set_domain_attr("gznl", data_dim=2, data_ibegin = 0, data_ni = Ni_0, data_jbegin = 0, data_nj = Nj_0) 
    24462302      CALL iom_set_domain_attr("gznl", lonvalue = real(zlon, dp),   & 
    2447          &                             latvalue = real(RESHAPE(plat(nldi:nlei, nldj:nlej),(/ ni*nj /)),dp))   
    2448       CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=jpjglo) 
     2303         &                             latvalue = real(RESHAPE(plat(Nis0:Nie0, Njs0:Nje0),(/ Ni_0*Nj_0 /)),dp))   
     2304      CALL iom_set_zoom_domain_attr("ptr", ibegin=ix-1, jbegin=0, ni=1, nj=Nj_0) 
    24492305      ! 
    24502306      CALL iom_update_file_name('ptr') 
    … …  
    25232379         ! Equatorial section (attributs: jbegin, ni, name_suffix) 
    25242380         CALL dom_ngb( 0.0_wp, 0.0_wp, ix, iy, cl1 ) 
    2525          CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=jpiglo, nj=1 ) 
     2381         CALL iom_set_zoom_domain_attr('Eq'//cl1, ibegin=0, jbegin=iy-1, ni=Ni0glo, nj=1 ) 
    25262382         CALL iom_get_file_attr   ('Eq'//cl1, name_suffix = clsuff             ) 
    25272383         CALL iom_set_file_attr   ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 

  • NEMO/trunk/src/OCE/IOM/iom_def.F90

    r13062 r13286  
    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) 
    … …  
    3530   INTEGER, PARAMETER, PUBLIC ::   jpmax_digits =  9   !: maximum number of digits for the cpu number in the file name 
    3631 
    37  
    3832!$AGRIF_DO_NOT_TREAT 
    3933   INTEGER, PUBLIC            ::   iom_open_init = 0   !: used to initialize iom_file(:)%nfid to 0 
    … …  
    4539   LOGICAL, PUBLIC            ::   lxios_sini = .FALSE. ! is restart in a single file 
    4640   LOGICAL, PUBLIC            ::   lxios_set  = .FALSE.  
    47  
    48  
    4941 
    5042   TYPE, PUBLIC ::   file_descriptor 

  • NEMO/trunk/src/OCE/IOM/iom_nf90.F90

    r13226 r13286  
    4747CONTAINS 
    4848 
    49    SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdompar, kdlev, cdcomp ) 
     49   SUBROUTINE iom_nf90_open( cdname, kiomid, ldwrt, ldok, kdlev, cdcomp ) 
    5050      !!--------------------------------------------------------------------- 
    5151      !!                   ***  SUBROUTINE  iom_open  *** 
    … …  
    5757      LOGICAL                , INTENT(in   )           ::   ldwrt       ! read or write the file? 
    5858      LOGICAL                , INTENT(in   )           ::   ldok        ! check the existence  
    59       INTEGER, DIMENSION(2,5), INTENT(in   ), OPTIONAL ::   kdompar     ! domain parameters:  
    6059      INTEGER                , INTENT(in   ), OPTIONAL ::   kdlev       ! size of the ice/abl third dimension 
    6160      CHARACTER(len=3)       , INTENT(in   ), OPTIONAL ::   cdcomp      ! name of component calling iom_nf90_open 
    … …  
    134133            CALL iom_nf90_check(NF90_SET_FILL( if90id, NF90_NOFILL,                   idmy ), clinfo) 
    135134            ! define dimensions 
    136                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'x',   kdompar(1,1), idmy ), clinfo) 
    137                                CALL iom_nf90_check(NF90_DEF_DIM( if90id,            'y',   kdompar(2,1), 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) 
    138137            SELECT CASE (clcomp) 
    139             CASE ('OCE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',            jpk, idmy ), clinfo) 
    140             CASE ('ICE')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numcat',          kdlev, idmy ), clinfo) 
    141             CASE ('ABL')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,      'nav_lev',          kdlev, idmy ), clinfo) 
    142             CASE ('SED')   ;   CALL iom_nf90_check(NF90_DEF_DIM( if90id,       'numsed',          kdlev, idmy ), clinfo) 
     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) 
    143142            CASE DEFAULT   ;   CALL ctl_stop( 'iom_nf90_open unknown component type' ) 
    144143            END SELECT 
    145144                               CALL iom_nf90_check(NF90_DEF_DIM( if90id, 'time_counter', NF90_UNLIMITED, idmy ), clinfo) 
    146145            ! global attributes 
    147             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number_total'   , jpnij              ), clinfo) 
    148             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_number'         , narea-1            ), clinfo) 
    149             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_dimensions_ids' , (/1     , 2     /) ), clinfo) 
    150             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_global'    , (/jpiglo, jpjglo/) ), clinfo) 
    151             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_size_local'     , kdompar(:,1)      ), clinfo) 
    152             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_first' , kdompar(:,2)      ), clinfo) 
    153             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_position_last'  , kdompar(:,3)      ), clinfo) 
    154             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_start', kdompar(:,4)      ), clinfo) 
    155             CALL iom_nf90_check(NF90_PUT_ATT( if90id, NF90_GLOBAL, 'DOMAIN_halo_size_end'  , kdompar(:,5)      ), clinfo) 
    156             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) 
    157156         ELSE                          !* the file should be open for read mode so it must exist... 
    158157            CALL ctl_stop( TRIM(clinfo), ' should be impossible case...' ) 
    … …  
    672671         IF( PRESENT(pv_r2d) .OR. PRESENT(pv_r3d) ) THEN 
    673672            idimsz(1:2) = iom_file(kiomid)%dimsz(1:2,idvar) 
    674             IF(     idimsz(1) == (nlei - nldi + 1) .AND. idimsz(2) == (nlej - nldj + 1) ) THEN 
    675                ix1 = nldi   ;   ix2 = nlei   ;   iy1 = nldj   ;   iy2 = nlej 
    676             ELSEIF( idimsz(1) == nlci              .AND. idimsz(2) == nlcj              ) THEN 
    677                ix1 = 1      ;   ix2 = nlci   ;   iy1 = 1      ;   iy2 = nlcj 
    678             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 
    679678               ix1 = 1      ;   ix2 = jpi    ;   iy1 = 1      ;   iy2 = jpj 
    680679            ELSE  

  • NEMO/trunk/src/OCE/IOM/prtctl.F90

    r12377 r13286  
    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  *** 
    … …  
    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/trunk/src/OCE/IOM/restart.F90

    r13237 r13286  
    214214             IF( .NOT.lxios_set ) THEN 
    215215                 IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS' 
    216                  CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     216                 CALL iom_init( crxios_context ) 
    217217                 lxios_set = .TRUE. 
    218218             ENDIF 
    219219         ENDIF 
    220220         IF( TRIM(Agrif_CFixed()) /= '0' .AND. lrxios) THEN 
    221              CALL iom_init( crxios_context, ld_tmppatch = .false. ) 
     221             CALL iom_init( crxios_context ) 
    222222             IF(lwp) WRITE(numout,*) 'Enable restart reading by XIOS for AGRIF' 
    223223             lxios_set = .TRUE. 
    … …  
    259259       
    260260      ! Diurnal DSST  
    261       IF( ln_diurnal ) CALL iom_get( numror, jpdom_autoglo, 'Dsst' , x_dsst, ldxios = lrxios )  
     261      IF( ln_diurnal ) CALL iom_get( numror, jpdom_auto, 'Dsst' , x_dsst, ldxios = lrxios )  
    262262      IF ( ln_diurnal_only ) THEN  
    263263         IF(lwp) WRITE( numout, * ) & 
    264264         &   "rst_read:- ln_diurnal_only set, setting rhop=rho0"  
    265265         rhop = rho0 
    266          CALL iom_get( numror, jpdom_autoglo, 'tn'     , w3d, ldxios = lrxios )  
     266         CALL iom_get( numror, jpdom_auto, 'tn'     , w3d, ldxios = lrxios )  
    267267         ts(:,:,1,jp_tem,Kmm) = w3d(:,:,1) 
    268268         RETURN  
    … …  
    270270       
    271271      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    272          CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios )   ! before fields 
    273          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios ) 
    274          CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
    275          CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
    276          CALL iom_get( numror, jpdom_autoglo, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
     272         ! before fields 
     273         CALL iom_get( numror, jpdom_auto, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     274         CALL iom_get( numror, jpdom_auto, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     275         CALL iom_get( numror, jpdom_auto, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
     276         CALL iom_get( numror, jpdom_auto, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
     277         CALL iom_get( numror, jpdom_auto, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
    277278      ELSE 
    278279         l_1st_euler =  .TRUE.      ! before field not found, forced euler 1st time-step 
    279280      ENDIF 
    280281      ! 
    281       CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios )       ! now    fields 
    282       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios ) 
    283       CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
    284       CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
    285       CALL iom_get( numror, jpdom_autoglo, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
     282      ! now fields 
     283      CALL iom_get( numror, jpdom_auto, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'U', psgn = -1._wp ) 
     284      CALL iom_get( numror, jpdom_auto, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios, cd_type = 'V', psgn = -1._wp ) 
     285      CALL iom_get( numror, jpdom_auto, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
     286      CALL iom_get( numror, jpdom_auto, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
     287      CALL iom_get( numror, jpdom_auto, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
    286288      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    287          CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
     289         CALL iom_get( numror, jpdom_auto, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    288290      ELSE 
    289291         CALL eos( ts(:,:,:,:,Kmm), rhd, rhop, gdept(:,:,:,Kmm) )    

  • NEMO/trunk/src/OCE/ISF/isfcpl.F90

    r13237 r13286  
    2020   USE domqco   , ONLY: dom_qco_zgr      ! vertical scale factor interpolation 
    2121#endif 
    22    USE domngb  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
     22   USE domutl  , ONLY: dom_ngb          ! find the closest grid point from a given lon/lat position 
    2323   ! 
    2424   USE oce            ! ocean dynamics and tracers 
    … …  
    183183      !!---------------------------------------------------------------------- 
    184184      ! 
    185       CALL iom_get( numror, jpdom_autoglo, 'ssmask'  , zssmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
     185      CALL iom_get( numror, jpdom_auto, 'ssmask'  , zssmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
    186186 
    187187      ! compute new ssh if we open a full water column  
    … …  
    264264      !!---------------------------------------------------------------------- 
    265265      !  
    266       CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
    267       !CALL iom_get( numror, jpdom_autoglo, 'wmask'  , zwmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
    268       !CALL iom_get( numror, jpdom_autoglo, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl) 
     266      CALL iom_get( numror, jpdom_auto, 'tmask'  , ztmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
     267      !CALL iom_get( numror, jpdom_auto, 'wmask'  , zwmask_b, ldxios = lrxios   ) ! need to extrapolate T/S 
     268      !CALL iom_get( numror, jpdom_auto, 'gdepw_n', zdepw_b(:,:,:), ldxios = lrxios ) ! need to interpol vertical profile (vvl) 
    269269      ! 
    270270      !  
    … …  
    410410      !!---------------------------------------------------------------------- 
    411411      ! 
    412       CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b, ldxios = lrxios ) 
    413       CALL iom_get( numror, jpdom_autoglo, 'e3u_n'  , ze3u_b  , ldxios = lrxios ) 
    414       CALL iom_get( numror, jpdom_autoglo, 'e3v_n'  , ze3v_b  , ldxios = lrxios ) 
     412      CALL iom_get( numror, jpdom_auto, 'tmask'  , ztmask_b, ldxios = lrxios ) 
     413      CALL iom_get( numror, jpdom_auto, 'e3u_n'  , ze3u_b  , ldxios = lrxios ) 
     414      CALL iom_get( numror, jpdom_auto, 'e3v_n'  , ze3v_b  , ldxios = lrxios ) 
    415415      ! 
    416416      ! 1.0: compute horizontal volume flux divergence difference before-after coupling 
    … …  
    520520 
    521521      ! get restart variable 
    522       CALL iom_get( numror, jpdom_autoglo, 'tmask'  , ztmask_b(:,:,:), ldxios = lrxios   ) ! need to extrapolate T/S 
    523       CALL iom_get( numror, jpdom_autoglo, 'e3t_n'  , ze3t_b(:,:,:)  , ldxios = lrxios ) 
    524       CALL iom_get( numror, jpdom_autoglo, 'tn'     , zt_b(:,:,:)    , ldxios = lrxios ) 
    525       CALL iom_get( numror, jpdom_autoglo, 'sn'     , zs_b(:,:,:)    , ldxios = lrxios ) 
     522      CALL iom_get( numror, jpdom_auto, 'tmask'  , ztmask_b(:,:,:), ldxios = lrxios   ) ! need to extrapolate T/S 
     523      CALL iom_get( numror, jpdom_auto, 'e3t_n'  , ze3t_b(:,:,:)  , ldxios = lrxios ) 
     524      CALL iom_get( numror, jpdom_auto, 'tn'     , zt_b(:,:,:)    , ldxios = lrxios ) 
     525      CALL iom_get( numror, jpdom_auto, 'sn'     , zs_b(:,:,:)    , ldxios = lrxios ) 
    526526 
    527527      ! compute run length 
    … …  
    544544 
    545545      DO jk = 1,jpk-1 
    546          DO jj = nldj,nlej 
    547             DO ji = nldi,nlei 
     546         DO jj = Njs0,Nje0 
     547            DO ji = Nis0,Nie0 
    548548 
    549549               ! volume diff 
    … …  
    578578      nisfl(:)=0 
    579579      DO jk = 1,jpk-1 
    580          DO jj = nldj,nlej 
    581             DO ji = nldi,nlei 
     580         DO jj = Njs0,Nje0 
     581            DO ji = Nis0,Nie0 
    582582               jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ; 
    583583               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN  
    … …  
    600600      jisf = 0 
    601601      DO jk = 1,jpk-1 
    602          DO jj = nldj,nlej 
    603             DO ji = nldi,nlei 
     602         DO jj = Njs0,Nje0 
     603            DO ji = Nis0,Nie0 
    604604               IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 
    605605 

  • NEMO/trunk/src/OCE/ISF/isfrst.F90

    r11931 r13286  
    5353      IF( iom_varid( numror, cfwf_b, ldstop = .FALSE. ) > 0 ) THEN 
    5454         IF(lwp) WRITE(numout,*) '          nit000-1 isf tracer content forcing fields read in the restart file' 
    55          CALL iom_get( numror, jpdom_autoglo, cfwf_b, pfwf_b(:,:)        , ldxios = lrxios )   ! before ice shelf melt 
    56          CALL iom_get( numror, jpdom_autoglo, chc_b , ptsc_b (:,:,jp_tem), ldxios = lrxios )   ! before ice shelf heat flux 
    57          CALL iom_get( numror, jpdom_autoglo, csc_b , ptsc_b (:,:,jp_sal), ldxios = lrxios )   ! before ice shelf heat flux 
     55         CALL iom_get( numror, jpdom_auto, cfwf_b, pfwf_b(:,:)        , ldxios = lrxios )   ! before ice shelf melt 
     56         CALL iom_get( numror, jpdom_auto, chc_b , ptsc_b (:,:,jp_tem), ldxios = lrxios )   ! before ice shelf heat flux 
     57         CALL iom_get( numror, jpdom_auto, csc_b , ptsc_b (:,:,jp_sal), ldxios = lrxios )   ! before ice shelf heat flux 
    5858      ELSE 
    5959         pfwf_b(:,:)   = pfwf(:,:) 

  • NEMO/trunk/src/OCE/ISF/isfutils.F90

    r12271 r13286  
    1212   !!---------------------------------------------------------------------- 
    1313 
    14    USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_data        ! read input file 
     14   USE iom           , ONLY: iom_open, iom_get, iom_close, jpdom_global      ! read input file 
    1515   USE lib_fortran   , ONLY: glob_sum, glob_min, glob_max                    ! compute global value 
    16    USE par_oce       , ONLY: jpi,jpj,jpk, jpnij                              ! domain size 
    17    USE dom_oce       , ONLY: nldi, nlei, nldj, nlej, narea, tmask_h, tmask_i ! local domain 
     16   USE par_oce       , ONLY: jpi,jpj,jpk, jpnij, Nis0, Nie0, Njs0, Nje0      ! domain size 
     17   USE dom_oce       , ONLY: narea, tmask_h, tmask_i                        ! local domain 
    1818   USE in_out_manager, ONLY: i8, wp, lwp, numout                             ! miscelenious 
    1919   USE lib_mpp 
    … …  
    4747 
    4848      CALL iom_open( TRIM(cdfile), inum ) 
    49       CALL iom_get( inum, jpdom_data, TRIM(cdvar), pvar) 
     49      CALL iom_get( inum, jpdom_global, TRIM(cdvar), pvar) 
    5050      CALL iom_close(inum) 
    5151 
    … …  
    8484      ! 
    8585      ! local MOD sum 
    86       DO jj=nldj,nlej 
    87          DO ji=nldi,nlei 
     86      DO jj=Njs0,Nje0 
     87         DO ji=Nis0,Nie0 
    8888            idums = ABS(MOD(TRANSFER(pvar(ji,jj), ip),imodd)) 
    8989            itmps(narea) = MOD(itmps(narea) + idums, imods) 
    … …  
    138138      ! local MOD sum 
    139139      DO jk=1,jpk 
    140          DO jj=nldj,nlej 
    141             DO ji=nldi,nlei 
     140         DO jj=Njs0,Nje0 
     141            DO ji=Nis0,Nie0 
    142142               idums = ABS(MOD(TRANSFER(pvar(ji,jj,jk), ip),imodd)) 
    143143               itmps(narea) = MOD(itmps(narea) + idums, imods) 

  • NEMO/trunk/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r13226 r13286  
    3939      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    4040      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
    41       &                    , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     41      &                    , kfillmode, pfillval, lsend, lrecv ) 
    4242      !!--------------------------------------------------------------------- 
    4343      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
    … …  
    5151      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    5252      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
    53       INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated 
    5453      !! 
    5554      INTEGER                          ::   kfld        ! number of elements that will be attributed 
    … …  
    7675      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    7776      ! 
    78       CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     77      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
    7978      ! 
    8079   END SUBROUTINE ROUTINE_MULTI 

  • NEMO/trunk/src/OCE/LBC/lbc_nfd_ext_generic.h90

    r13226 r13286  
    3434      ! 
    3535      SELECT CASE ( jpni ) 
    36       CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction 
     36      CASE ( 1 )     ;   ipj = jpj        ! 1 proc only  along the i-direction 
    3737      CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction 
    3838      END SELECT 

  • NEMO/trunk/src/OCE/LBC/lbc_nfd_generic.h90

    r13226 r13286  
    1010#      endif 
    1111#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt2d(i,j) 
     12#      define J_SIZE(ptab)             SIZE(ptab(1)%pt2d,2) 
    1213#      define K_SIZE(ptab)             1 
    1314#      define L_SIZE(ptab)             1 
    … …  
    2021#      endif 
    2122#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt3d(i,j,k) 
     23#      define J_SIZE(ptab)             SIZE(ptab(1)%pt3d,2) 
    2224#      define K_SIZE(ptab)             SIZE(ptab(1)%pt3d,3) 
    2325#      define L_SIZE(ptab)             1 
    … …  
    3032#      endif 
    3133#      define ARRAY_IN(i,j,k,l,f)      ptab(f)%pt4d(i,j,k,l) 
     34#      define J_SIZE(ptab)             SIZE(ptab(1)%pt4d,2) 
    3235#      define K_SIZE(ptab)             SIZE(ptab(1)%pt4d,3) 
    3336#      define L_SIZE(ptab)             SIZE(ptab(1)%pt4d,4) 
    … …  
    4043#   if defined DIM_2d 
    4144#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j) 
     45#      define J_SIZE(ptab)          SIZE(ptab,2) 
    4246#      define K_SIZE(ptab)          1 
    4347#      define L_SIZE(ptab)          1 
    … …  
    4549#   if defined DIM_3d 
    4650#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k) 
     51#      define J_SIZE(ptab)          SIZE(ptab,2) 
    4752#      define K_SIZE(ptab)          SIZE(ptab,3) 
    4853#      define L_SIZE(ptab)          1 
    … …  
    5055#   if defined DIM_4d 
    5156#      define ARRAY_IN(i,j,k,l,f)   ptab(i,j,k,l) 
     57#      define J_SIZE(ptab)          SIZE(ptab,2) 
    5258#      define K_SIZE(ptab)          SIZE(ptab,3) 
    5359#      define L_SIZE(ptab)          SIZE(ptab,4) 
    … …  
    7682      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    7783      ! 
    78       INTEGER  ::    ji,  jj,  jk,  jl, jh, jf   ! dummy loop indices 
    79       INTEGER  ::   ipi, ipj, ipk, ipl,    ipf   ! dimension of the input array 
    80       INTEGER  ::   ijt, iju, ipjm1 
     84      INTEGER  ::    ji,  jj,  jk,  jl, jf   ! dummy loop indices 
     85      INTEGER  ::        ipj, ipk, ipl, ipf   ! dimension of the input array 
     86      INTEGER  ::   ii1, ii2, ij1, ij2 
    8187      !!---------------------------------------------------------------------- 
    8288      ! 
    83       ipk = K_SIZE(ptab)   ! 3rd dimension 
     89      ipj = J_SIZE(ptab)   ! 2nd dimension 
     90      ipk = K_SIZE(ptab)   ! 3rd    - 
    8491      ipl = L_SIZE(ptab)   ! 4th    - 
    8592      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    86       ! 
    87       ! 
    88       SELECT CASE ( jpni ) 
    89       CASE ( 1 )     ;   ipj = nlcj       ! 1 proc only  along the i-direction 
    90       CASE DEFAULT   ;   ipj = 4          ! several proc along the i-direction 
    91       END SELECT 
    92       ipjm1 = ipj-1 
    93  
    9493      ! 
    9594      DO jf = 1, ipf                      ! Loop on the number of arrays to be treated 
    … …  
    101100            SELECT CASE ( NAT_IN(jf)  ) 
    102101            CASE ( 'T' , 'W' )                         ! T-, W-point 
    103                DO ji = 2, jpiglo 
    104                   ijt = jpiglo-ji+2 
    105                   ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf) 
    106                END DO 
    107                ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-2,:,:,jf) 
    108                DO ji = jpiglo/2+1, jpiglo 
    109                   ijt = jpiglo-ji+2 
    110                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    111                END DO 
     102               DO jl = 1, ipl; DO jk = 1, ipk 
     103                  ! 
     104                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     105                    DO jj = 1, nn_hls 
     106                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1 
     107                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 
     108                     ! 
     109                     DO ji = 1, nn_hls            ! first nn_hls points 
     110                        ii1 =                ji          ! ends at: nn_hls 
     111                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
     112                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     113                     END DO 
     114                     DO ji = 1, 1                 ! point nn_hls+1 
     115                        ii1 = nn_hls + ji 
     116                        ii2 = ii1 
     117                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     118                     END DO 
     119                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     120                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 
     121                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 
     122                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     123                     END DO 
     124                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1 
     125                        ii1 = jpiglo - nn_hls + ji 
     126                        ii2 =          nn_hls + ji 
     127                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     128                     END DO 
     129                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points 
     130                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 
     131                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 
     132                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     133                     END DO 
     134                  END DO 
     135                  ! 
     136                  ! line number ipj-nn_hls : right half 
     137                    DO jj = 1, 1 
     138                     ij1 = ipj - nn_hls 
     139                     ij2 = ij1   ! same line 
     140                     ! 
     141                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     142                        ii1 = jpiglo/2 + ji + 1          ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls - 1) + 1 = jpiglo - nn_hls 
     143                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1) + 1 = nn_hls + 2 
     144                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     145                     END DO 
     146                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
     147                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls   
     148                        ii1 =                ji          ! ends at: nn_hls 
     149                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
     150                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     151                     END DO 
     152                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
     153                  END DO 
     154                  ! 
     155               END DO; END DO 
    112156            CASE ( 'U' )                               ! U-point 
    113                DO ji = 1, jpiglo-1 
    114                   iju = jpiglo-ji+1 
    115                   ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf) 
    116                END DO 
    117                ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-2,:,:,jf) 
    118                ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-2,:,:,jf)  
    119                DO ji = jpiglo/2, jpiglo-1 
    120                   iju = jpiglo-ji+1 
    121                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf) 
    122                END DO 
     157               DO jl = 1, ipl; DO jk = 1, ipk 
     158                  ! 
     159                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     160                    DO jj = 1, nn_hls 
     161                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1 
     162                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 
     163                     ! 
     164                     DO ji = 1, nn_hls            ! first nn_hls points 
     165                        ii1 =                ji          ! ends at: nn_hls 
     166                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     167                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     168                     END DO 
     169                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     170                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
     171                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
     172                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     173                     END DO 
     174                     DO ji = 1, nn_hls            ! last nn_hls points 
     175                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     176                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
     177                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     178                     END DO 
     179                  END DO 
     180                  ! 
     181                  ! line number ipj-nn_hls : right half 
     182                    DO jj = 1, 1 
     183                     ij1 = ipj - nn_hls 
     184                     ij2 = ij1   ! same line 
     185                     ! 
     186                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     187                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
     188                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 
     189                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     190                     END DO 
     191                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
     192                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls   
     193                        ii1 =                ji          ! ends at: nn_hls 
     194                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     195                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     196                     END DO 
     197                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
     198                  END DO 
     199                  ! 
     200               END DO; END DO 
    123201            CASE ( 'V' )                               ! V-point 
    124                DO ji = 2, jpiglo 
    125                   ijt = jpiglo-ji+2 
    126                   ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf) 
    127                   ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-3,:,:,jf) 
    128                END DO 
    129                ARRAY_IN(1,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(3,ipj-3,:,:,jf)  
     202               DO jl = 1, ipl; DO jk = 1, ipk 
     203                  ! 
     204                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 
     205                    DO jj = 1, nn_hls+1 
     206                       ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 
     207                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 
     208                     ! 
     209                     DO ji = 1, nn_hls            ! first nn_hls points 
     210                        ii1 =                ji          ! ends at: nn_hls 
     211                        ii2 = 2*nn_hls + 2 - ji          ! ends at: 2*nn_hls + 2 - nn_hls = nn_hls + 2 
     212                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     213                     END DO 
     214                     DO ji = 1, 1                 ! point nn_hls+1 
     215                        ii1 = nn_hls + ji 
     216                        ii2 = ii1 
     217                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     218                     END DO 
     219                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+2 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     220                        ii1 = 2 + nn_hls      + ji - 1   ! ends at: 2 + nn_hls + jpiglo - 2*nn_hls - 1 - 1 = jpiglo - nn_hls 
     221                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) + 1 = nn_hls + 2 
     222                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     223                     END DO 
     224                     DO ji = 1, 1                 ! point jpiglo - nn_hls + 1 
     225                        ii1 = jpiglo - nn_hls + ji 
     226                        ii2 =          nn_hls + ji 
     227                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     228                     END DO 
     229                     DO ji = 1, nn_hls-1          ! last nn_hls-1 points 
     230                        ii1 = jpiglo - nn_hls + 1 + ji   ! ends at: jpiglo - nn_hls + 1 + nn_hls - 1 = jpiglo 
     231                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls + 1 = jpiglo - 2*nn_hls + 2 
     232                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     233                     END DO 
     234                  END DO 
     235                  ! 
     236               END DO; END DO 
    130237            CASE ( 'F' )                               ! F-point 
    131                DO ji = 1, jpiglo-1 
    132                   iju = jpiglo-ji+1 
    133                   ARRAY_IN(ji,ipj-1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf) 
    134                   ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-3,:,:,jf) 
    135                END DO 
    136                ARRAY_IN(   1  ,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(    2   ,ipj-3,:,:,jf) 
    137                ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(jpiglo-1,ipj-3,:,:,jf)  
    138             END SELECT 
     238               DO jl = 1, ipl; DO jk = 1, ipk 
     239                  ! 
     240                  ! last nn_hls+1 lines (from ipj to ipj-nn_hls) : full 
     241                    DO jj = 1, nn_hls+1 
     242                       ij1 = ipj            - jj + 1       ! ends at: ipj - ( nn_hls + 1 ) + 1 = ipj - nn_hls 
     243                     ij2 = ipj - 2*nn_hls + jj - 2       ! ends at: ipj - 2*nn_hls + nn_hls + 1 - 2 = ipj - nn_hls - 1 
     244                     ! 
     245                     DO ji = 1, nn_hls            ! first nn_hls points 
     246                        ii1 =                ji          ! ends at: nn_hls 
     247                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     248                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     249                     END DO 
     250                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     251                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
     252                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
     253                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     254                     END DO 
     255                     DO ji = 1, nn_hls            ! last nn_hls points 
     256                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     257                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
     258                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     259                     END DO 
     260                  END DO 
     261                  ! 
     262               END DO; END DO 
     263            END SELECT   ! NAT_IN(jf) 
    139264            ! 
    140265         CASE ( 5 , 6 )                        ! *  North fold  F-point pivot 
    … …  
    142267            SELECT CASE ( NAT_IN(jf)  ) 
    143268            CASE ( 'T' , 'W' )                         ! T-, W-point 
    144                DO ji = 1, jpiglo 
    145                   ijt = jpiglo-ji+1 
    146                   ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-1,:,:,jf) 
    147                END DO 
     269               DO jl = 1, ipl; DO jk = 1, ipk 
     270                  ! 
     271                  ! first: line number ipj-nn_hls : 3 points 
     272                    DO jj = 1, 1 
     273                     ij1 = ipj - nn_hls 
     274                     ij2 = ij1   ! same line 
     275                     ! 
     276                     DO ji = 1, 1            ! points from jpiglo/2+1 
     277                        ii1 = jpiglo/2 + ji 
     278                        ii2 = jpiglo/2 - ji + 1 
     279                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign... 
     280                     END DO 
     281                     DO ji = 1, 1            ! points jpiglo - nn_hls 
     282                        ii1 = jpiglo - nn_hls + ji - 1 
     283                        ii2 =          nn_hls + ji 
     284                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign... 
     285                     END DO 
     286                     DO ji = 1, 1            ! point nn_hls: redo it just in case (if e-w periodocity already done) 
     287                        !                    ! as we just changed point jpiglo - nn_hls 
     288                        ii1 = nn_hls + ji - 1 
     289                        ii2 = nn_hls + ji 
     290                        ARRAY_IN(ii1,ij1,jk,jl,jf) =              ARRAY_IN(ii2,ij2,jk,jl,jf)   ! Warning: pb with sign... 
     291                     END DO 
     292                  END DO 
     293                  ! 
     294                  ! Second: last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     295                    DO jj = 1, nn_hls 
     296                       ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls 
     297                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 
     298                     ! 
     299                     DO ji = 1, nn_hls            ! first nn_hls points 
     300                        ii1 =                ji          ! ends at: nn_hls 
     301                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     302                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     303                     END DO 
     304                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     305                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
     306                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
     307                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     308                     END DO 
     309                     DO ji = 1, nn_hls            ! last nn_hls points 
     310                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     311                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
     312                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     313                     END DO 
     314                  END DO 
     315                  ! 
     316               END DO; END DO 
    148317            CASE ( 'U' )                               ! U-point 
    149                DO ji = 1, jpiglo-1 
    150                   iju = jpiglo-ji 
    151                   ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-1,:,:,jf) 
    152                END DO 
    153                ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpiglo-2,ipj-1,:,:,jf) 
     318               DO jl = 1, ipl; DO jk = 1, ipk 
     319                  ! 
     320                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     321                    DO jj = 1, nn_hls 
     322                       ij1 = ipj + 1        - jj           ! ends at: ipj + 1 - nn_hls 
     323                     ij2 = ipj - 2*nn_hls + jj           ! ends at: ipj - 2*nn_hls + nn_hls = ipj - nn_hls 
     324                     ! 
     325                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points 
     326                        ii1 =            ji              ! ends at: nn_hls-1 
     327                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
     328                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     329                     END DO 
     330                     DO ji = 1, 1                 ! point nn_hls 
     331                        ii1 = nn_hls + ji - 1 
     332                        ii2 = jpiglo - ii1 
     333                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     334                     END DO 
     335                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls) 
     336                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 
     337                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 
     338                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     339                     END DO 
     340                     DO ji = 1, 1                 ! point jpiglo - nn_hls 
     341                        ii1 = jpiglo - nn_hls + ji - 1 
     342                        ii2 = ii1 
     343                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     344                     END DO 
     345                     DO ji = 1, nn_hls            ! last nn_hls points 
     346                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     347                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 
     348                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     349                     END DO 
     350                  END DO 
     351                  ! 
     352               END DO; END DO 
    154353            CASE ( 'V' )                               ! V-point 
    155                DO ji = 1, jpiglo 
    156                   ijt = jpiglo-ji+1 
    157                   ARRAY_IN(ji,ipj,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipj-2,:,:,jf) 
    158                END DO 
    159                DO ji = jpiglo/2+1, jpiglo 
    160                   ijt = jpiglo-ji+1 
    161                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(ijt,ipjm1,:,:,jf) 
    162                END DO 
     354               DO jl = 1, ipl; DO jk = 1, ipk 
     355                  ! 
     356                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     357                    DO jj = 1, nn_hls 
     358                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1 
     359                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 
     360                     ! 
     361                     DO ji = 1, nn_hls            ! first nn_hls points 
     362                        ii1 =                ji          ! ends at: nn_hls 
     363                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     364                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     365                     END DO 
     366                     DO ji = 1, Ni0glo            ! points from nn_hls to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     367                        ii1 = nn_hls          + ji       ! ends at: nn_hls + jpiglo - 2*nn_hls = jpiglo - nn_hls 
     368                        ii2 = jpiglo - nn_hls - ji + 1   ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls ) + 1 = nn_hls + 1 
     369                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     370                     END DO 
     371                     DO ji = 1, nn_hls            ! last nn_hls points 
     372                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     373                        ii2 = jpiglo - nn_hls + 1 - ji   ! ends at: jpiglo - nn_hls + 1 - nn_hls = jpiglo - 2*nn_hls + 1 
     374                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     375                     END DO 
     376                  END DO    
     377                  ! 
     378                  ! line number ipj-nn_hls : right half 
     379                    DO jj = 1, 1 
     380                     ij1 = ipj - nn_hls 
     381                     ij2 = ij1   ! same line 
     382                     ! 
     383                     DO ji = 1, Ni0glo/2          ! points from jpiglo/2+1 to jpiglo - nn_hls   (note: Ni0glo = jpiglo - 2*nn_hls) 
     384                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
     385                        ii2 = jpiglo/2 - ji + 1          ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls) + 1 = nn_hls + 1 
     386                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     387                     END DO 
     388                     DO ji = 1, nn_hls            ! first nn_hls points: redo them just in case (if e-w periodocity already done) 
     389                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hls   
     390                        ii1 =                ji          ! ends at: nn_hls 
     391                        ii2 = 2*nn_hls + 1 - ji          ! ends at: 2*nn_hls + 1 - nn_hls = nn_hls + 1 
     392                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     393                     END DO 
     394                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
     395                  END DO 
     396                  ! 
     397               END DO; END DO 
    163398            CASE ( 'F' )                               ! F-point 
    164                DO ji = 1, jpiglo-1 
    165                   iju = jpiglo-ji 
    166                   ARRAY_IN(ji,ipj  ,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipj-2,:,:,jf) 
    167                END DO 
    168                ARRAY_IN(jpiglo,ipj,:,:,jf) = SGN_IN(jf)   * ARRAY_IN(jpiglo-2,ipj-2,:,:,jf) 
    169                DO ji = jpiglo/2+1, jpiglo-1 
    170                   iju = jpiglo-ji 
    171                   ARRAY_IN(ji,ipjm1,:,:,jf) = SGN_IN(jf)  * ARRAY_IN(iju,ipjm1,:,:,jf) 
    172                END DO 
    173             END SELECT 
     399               DO jl = 1, ipl; DO jk = 1, ipk 
     400                  ! 
     401                  ! last nn_hls lines (from ipj to ipj-nn_hls+1) : full 
     402                    DO jj = 1, nn_hls 
     403                       ij1 = ipj            - jj + 1       ! ends at: ipj - nn_hls + 1 
     404                     ij2 = ipj - 2*nn_hls + jj - 1       ! ends at: ipj - 2*nn_hls + nn_hls - 1 = ipj - nn_hls - 1 
     405                     ! 
     406                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points 
     407                        ii1 =            ji              ! ends at: nn_hls-1 
     408                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
     409                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     410                     END DO 
     411                     DO ji = 1, 1                 ! point nn_hls 
     412                        ii1 = nn_hls + ji - 1 
     413                        ii2 = jpiglo - ii1 
     414                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     415                     END DO 
     416                     DO ji = 1, Ni0glo - 1        ! points from nn_hls+1 to jpiglo - nn_hls - 1  (note: Ni0glo = jpiglo - 2*nn_hls) 
     417                        ii1 =          nn_hls + ji       ! ends at: nn_hls + ( jpiglo - 2*nn_hls - 1 ) = jpiglo - nn_hls - 1 
     418                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - ( jpiglo - 2*nn_hls - 1 ) = nn_hls + 1 
     419                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     420                     END DO 
     421                     DO ji = 1, 1                 ! point jpiglo - nn_hls 
     422                        ii1 = jpiglo - nn_hls + ji - 1 
     423                        ii2 = ii1 
     424                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     425                     END DO 
     426                     DO ji = 1, nn_hls            ! last nn_hls points 
     427                        ii1 = jpiglo - nn_hls + ji       ! ends at: jpiglo - nn_hls + nn_hls = jpiglo 
     428                        ii2 = jpiglo - nn_hls - ji       ! ends at: jpiglo - nn_hls - nn_hls = jpiglo - 2*nn_hls 
     429                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     430                     END DO 
     431                  END DO    
     432                  ! 
     433                  ! line number ipj-nn_hls : right half 
     434                    DO jj = 1, 1 
     435                     ij1 = ipj - nn_hls 
     436                     ij2 = ij1   ! same line 
     437                     ! 
     438                     DO ji = 1, Ni0glo/2-1        ! points from jpiglo/2+1 to jpiglo - nn_hls-1  (note: Ni0glo = jpiglo - 2*nn_hls) 
     439                        ii1 = jpiglo/2 + ji              ! ends at: jpiglo/2 + (jpiglo/2 - nn_hls) = jpiglo - nn_hls 
     440                        ii2 = jpiglo/2 - ji              ! ends at: jpiglo/2 - (jpiglo/2 - nn_hls - 1 ) = nn_hls + 1 
     441                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     442                     END DO 
     443                     DO ji = 1, nn_hls-1          ! first nn_hls-1 points: redo them just in case (if e-w periodocity already done) 
     444                        !                         ! as we just changed points jpiglo-2nn_hls+1 to jpiglo-nn_hl-1   
     445                        ii1 =            ji              ! ends at: nn_hls 
     446                        ii2 = 2*nn_hls - ji              ! ends at: 2*nn_hls - ( nn_hls - 1 ) = nn_hls + 1 
     447                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
     448                     END DO 
     449                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
     450                  END DO 
     451                  ! 
     452               END DO; END DO 
     453            END SELECT   ! NAT_IN(jf) 
    174454            ! 
    175          CASE DEFAULT                           ! *  closed : the code probably never go through 
    176             ! 
    177             SELECT CASE ( NAT_IN(jf) ) 
    178             CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    179                ARRAY_IN(:, 1 ,:,:,jf) = 0._wp 
    180                ARRAY_IN(:,ipj,:,:,jf) = 0._wp 
    181             CASE ( 'F' )                               ! F-point 
    182                ARRAY_IN(:,ipj,:,:,jf) = 0._wp 
    183             END SELECT 
    184             ! 
    185          END SELECT     !  npolj 
     455         END SELECT   ! npolj 
    186456         ! 
    187       END DO 
     457      END DO   ! ipf 
    188458      ! 
    189459   END SUBROUTINE ROUTINE_NFD 
    … …  
    194464#undef NAT_IN 
    195465#undef SGN_IN 
     466#undef J_SIZE 
    196467#undef K_SIZE 
    197468#undef L_SIZE 

  • NEMO/trunk/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r13226 r13286  
    6060#      define L_SIZE(ptab)          SIZE(ptab,4) 
    6161#   endif 
    62 #   define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l) 
    6362#   define J_SIZE(ptab2)             SIZE(ptab2,2) 
     63#   define ARRAY2_IN(i,j,k,l,f)   ptab2(i,j,k,l) 
    6464#   if defined SINGLE_PRECISION 
    6565#      define ARRAY_TYPE(i,j,k,l,f)     REAL(sp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    … …  
    8282      !! 
    8383      !!---------------------------------------------------------------------- 
    84       ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied 
    85       ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied 
     84      ARRAY_TYPE(:,:,:,:,:) 
     85      ARRAY2_TYPE(:,:,:,:,:)  
    8686      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    8787      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    8888      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    8989      ! 
    90       INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices 
    91       INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array 
    92       INTEGER  ::   ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop 
     90      INTEGER  ::    ji,  jj,   jk, jn, ii,   jl,   jh,  jf   ! dummy loop indices 
     91      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf, iij, ijj   ! dimension of the input array 
     92      INTEGER  ::   ijt, iju, ijta, ijua, jia, startloop, endloop 
    9393      LOGICAL  ::   l_fast_exchanges 
    9494      !!---------------------------------------------------------------------- 
    … …  
    100100      ! Security check for further developments 
    101101      IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 
    102       ! 
    103       ijpj   = 1    ! index of first modified line  
    104       ijpjp1 = 2    ! index + 1 
    105        
    106102      ! 2nd dimension determines exchange speed 
    107103      IF (ipj == 1 ) THEN 
    … …  
    120116            ! 
    121117            CASE ( 'T' , 'W' )                         ! T-, W-point 
    122                IF ( nimpp /= 1 ) THEN   ;   startloop = 1 
    123                ELSE                     ;   startloop = 2 
    124                ENDIF 
    125                ! 
    126                DO jl = 1, ipl; DO jk = 1, ipk 
    127                   DO ji = startloop, nlci 
    128                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    129                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     118               IF ( nimpp /= 1 ) THEN  ;  startloop = 1  
     119               ELSE                    ;  startloop = 1 + nn_hls 
     120               ENDIF 
     121               ! 
     122               DO jl = 1, ipl; DO jk = 1, ipk 
     123                    DO jj = 1, nn_hls 
     124                       ijj = jpj -jj +1 
     125                     DO ji = startloop, jpi 
     126                     ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
     127                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     128                     END DO 
    130129                  END DO 
    131130               END DO; END DO 
    132131               IF( nimpp == 1 ) THEN 
    133132                  DO jl = 1, ipl; DO jk = 1, ipk 
    134                      ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf) 
    135                   END DO; END DO 
    136                ENDIF 
    137                ! 
    138                IF ( .NOT. l_fast_exchanges ) THEN 
    139                   IF( nimpp >= jpiglo/2+1 ) THEN 
     133                     DO jj = 1, nn_hls 
     134                     ijj = jpj -jj +1 
     135                     DO ii = 0, nn_hls-1 
     136                        ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
     137                     END DO 
     138                     END DO 
     139                  END DO; END DO 
     140               ENDIF               
     141               ! 
     142               IF ( .NOT. l_fast_exchanges ) THEN 
     143                  IF( nimpp >= Ni0glo/2+2 ) THEN 
    140144                     startloop = 1 
    141                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    142                      startloop = jpiglo/2+1 - nimpp + 1 
    143                   ELSE 
    144                      startloop = nlci + 1 
    145                   ENDIF 
    146                   IF( startloop <= nlci ) THEN 
     145                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 
     146                     startloop = Ni0glo/2+2 - nimpp + nn_hls 
     147                  ELSE 
     148                     startloop = jpi + 1 
     149                  ENDIF 
     150                  IF( startloop <= jpi ) THEN 
    147151                     DO jl = 1, ipl; DO jk = 1, ipk 
    148                         DO ji = startloop, nlci 
    149                            ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     152                        DO ji = startloop, jpi 
     153                           ijt  = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
    150154                           jia  = ji + nimpp - 1 
    151155                           ijta = jpiglo - jia + 2 
    152156                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    153                               ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf) 
     157                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,jpj-nn_hls,jk,jl,jf) 
    154158                           ELSE 
    155                               ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     159                              ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
    156160                           ENDIF 
    157161                        END DO 
    … …  
    159163                  ENDIF 
    160164               ENDIF 
    161  
    162165            CASE ( 'U' )                                     ! U-point 
    163                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    164                   endloop = nlci 
     166               IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     167                  endloop = jpi 
    165168               ELSE 
    166                   endloop = nlci - 1 
    167                ENDIF 
    168                DO jl = 1, ipl; DO jk = 1, ipk 
    169                   DO ji = 1, endloop 
    170                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    171                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     169                  endloop = jpi - nn_hls 
     170               ENDIF 
     171               DO jl = 1, ipl; DO jk = 1, ipk 
     172        DO jj = 1, nn_hls 
     173              ijj = jpj -jj +1 
     174                     DO ji = 1, endloop 
     175                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     176                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     177                     END DO 
    172178                  END DO 
    173179               END DO; END DO 
    174180               IF (nimpp .eq. 1) THEN 
    175                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    176                ENDIF 
    177                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    178                   ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
    179                ENDIF 
    180                ! 
    181                IF ( .NOT. l_fast_exchanges ) THEN 
    182                   IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    183                      endloop = nlci 
    184                   ELSE 
    185                      endloop = nlci - 1 
    186                   ENDIF 
    187                   IF( nimpp >= jpiglo/2 ) THEN 
    188                      startloop = 1 
    189                      ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
    190                      startloop = jpiglo/2 - nimpp + 1 
     181        DO jj = 1, nn_hls 
     182           ijj = jpj -jj +1 
     183           DO ii = 0, nn_hls-1 
     184         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     185           END DO 
     186                  END DO 
     187               ENDIF 
     188               IF((nimpp + jpi - 1) .eq. jpiglo) THEN 
     189                  DO jj = 1, nn_hls 
     190                       ijj = jpj -jj +1 
     191         DO ii = 1, nn_hls 
     192               ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     193         END DO 
     194        END DO 
     195               ENDIF 
     196               ! 
     197               IF ( .NOT. l_fast_exchanges ) THEN 
     198                  IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     199                     endloop = jpi 
     200                  ELSE 
     201                     endloop = jpi - nn_hls 
     202                  ENDIF 
     203                  IF( nimpp >= Ni0glo/2+1 ) THEN 
     204                     startloop = nn_hls 
     205                  ELSEIF( ( nimpp + jpi - 1 >= Ni0glo/2+1 ) .AND. ( nimpp < Ni0glo/2+1 ) ) THEN 
     206                     startloop = Ni0glo/2+1 - nimpp + nn_hls  
    191207                  ELSE 
    192208                     startloop = endloop + 1 
    … …  
    195211                  DO jl = 1, ipl; DO jk = 1, ipk 
    196212                     DO ji = startloop, endloop 
    197                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    198                         jia = ji + nimpp - 1 
    199                         ijua = jpiglo - jia + 1 
     213                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     214                        jia = ji + nimpp - 1  
     215                        ijua = jpiglo - jia + 1  
    200216                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    201                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf) 
     217                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,jpj-nn_hls,jk,jl,jf) 
    202218                        ELSE 
    203                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     219                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
    204220                        ENDIF 
    205221                     END DO 
    … …  
    210226            CASE ( 'V' )                                     ! V-point 
    211227               IF( nimpp /= 1 ) THEN 
    212                  startloop = 1 
     228                 startloop = 1  
    213229               ELSE 
    214                  startloop = 2 
    215                ENDIF 
    216                IF ( .NOT. l_fast_exchanges ) THEN 
    217                   DO jl = 1, ipl; DO jk = 1, ipk 
    218                      DO ji = startloop, nlci 
    219                         ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    220                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
    221                      END DO 
    222                   END DO; END DO 
    223                ENDIF 
    224                DO jl = 1, ipl; DO jk = 1, ipk 
    225                   DO ji = startloop, nlci 
    226                      ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    227                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     230                 startloop = 1 + nn_hls 
     231               ENDIF 
     232               IF ( .NOT. l_fast_exchanges ) THEN 
     233                  DO jl = 1, ipl; DO jk = 1, ipk 
     234                       DO jj = 2, nn_hls+1 
     235                     ijj = jpj -jj +1 
     236                        DO ji = startloop, jpi 
     237                           ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
     238                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     239                        END DO 
     240                    END DO 
     241                  END DO; END DO 
     242               ENDIF 
     243               DO jl = 1, ipl; DO jk = 1, ipk 
     244                  DO ji = startloop, jpi 
     245                     ijt=jpiglo - ji - nimpp - nfimpp(isendto(1)) + 4 
     246                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
    228247                  END DO 
    229248               END DO; END DO 
    230249               IF (nimpp .eq. 1) THEN 
    231                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 
     250        DO jj = 1, nn_hls 
     251                       ijj = jpj-jj+1 
     252                       DO ii = 0, nn_hls-1 
     253                        ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,jpj-2*nn_hls+jj-1,:,:,jf) 
     254           END DO 
     255        END DO 
    232256               ENDIF 
    233257            CASE ( 'F' )                                     ! F-point 
    234                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    235                   endloop = nlci 
     258               IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     259                  endloop = jpi 
    236260               ELSE 
    237                   endloop = nlci - 1 
    238                ENDIF 
    239                IF ( .NOT. l_fast_exchanges ) THEN 
    240                   DO jl = 1, ipl; DO jk = 1, ipk 
    241                      DO ji = 1, endloop 
    242                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    243                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
    244                      END DO 
     261                  endloop = jpi - nn_hls 
     262               ENDIF 
     263               IF ( .NOT. l_fast_exchanges ) THEN 
     264                  DO jl = 1, ipl; DO jk = 1, ipk 
     265                       DO jj = 2, nn_hls+1 
     266                     ijj = jpj -jj +1 
     267                        DO ji = 1, endloop 
     268                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     269                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     270                        END DO 
     271                    END DO 
    245272                  END DO; END DO 
    246273               ENDIF 
    247274               DO jl = 1, ipl; DO jk = 1, ipk 
    248275                  DO ji = 1, endloop 
    249                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    250                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    251                   END DO 
    252                END DO; END DO 
    253                IF (nimpp .eq. 1) THEN 
    254                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf) 
    255                   IF ( .NOT. l_fast_exchanges ) & 
    256                      ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    257                ENDIF 
    258                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    259                   ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf) 
    260                   IF ( .NOT. l_fast_exchanges ) & 
    261                      ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
    262                ENDIF 
    263                ! 
    264             END SELECT 
     276                     iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     277                     ARRAY_IN(ji,jpj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
     278                  END DO 
     279               END DO; END DO 
     280      IF (nimpp .eq. 1) THEN                
     281         DO ii = 1, nn_hls 
     282                 ARRAY_IN(ii,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls-1,:,:,jf) 
     283         END DO 
     284         IF ( .NOT. l_fast_exchanges ) THEN 
     285            DO jj = 1, nn_hls 
     286                      ijj = jpj -jj 
     287                      DO ii = 0, nn_hls-1 
     288                         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     289                   END DO 
     290                      END DO 
     291                     ENDIF 
     292      ENDIF 
     293      IF((nimpp + jpi - 1 ) .eq. jpiglo) THEN 
     294                   DO ii = 1, nn_hls 
     295                 ARRAY_IN(jpi-ii+1,jpj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls-1,:,:,jf) 
     296         END DO 
     297         IF ( .NOT. l_fast_exchanges ) THEN 
     298            DO jj = 1, nn_hls 
     299                           ijj = jpj -jj 
     300                      DO ii = 1, nn_hls 
     301                         ARRAY_IN(jpi-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii,jpj-2*nn_hls+jj-1,:,:,jf) 
     302                         END DO 
     303                      END DO 
     304                     ENDIF 
     305                  ENDIF 
     306                  ! 
     307       END SELECT 
    265308            ! 
    266309         CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
    … …  
    269312            CASE ( 'T' , 'W' )                               ! T-, W-point 
    270313               DO jl = 1, ipl; DO jk = 1, ipk 
    271                   DO ji = 1, nlci 
    272                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    273                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
    274                   END DO 
     314        DO jj = 1, nn_hls 
     315           ijj = jpj-jj+1 
     316           DO ji = 1, jpi 
     317                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     318                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     319                     END DO 
     320        END DO 
    275321               END DO; END DO 
    276322               ! 
    277323            CASE ( 'U' )                                     ! U-point 
    278                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    279                   endloop = nlci 
     324               IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     325                  endloop = jpi 
    280326               ELSE 
    281                   endloop = nlci - 1 
    282                ENDIF 
    283                DO jl = 1, ipl; DO jk = 1, ipk 
    284                   DO ji = 1, endloop 
    285                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    286                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    287                   END DO 
    288                END DO; END DO 
    289                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    290                   DO jl = 1, ipl; DO jk = 1, ipk 
    291                      ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 
     327                  endloop = jpi - nn_hls 
     328               ENDIF 
     329               DO jl = 1, ipl; DO jk = 1, ipk 
     330        DO jj = 1, nn_hls 
     331           ijj = jpj-jj+1 
     332                     DO ji = 1, endloop 
     333                        iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
     334                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     335                     END DO 
     336                  END DO 
     337               END DO; END DO 
     338               IF(nimpp + jpi - 1 .eq. jpiglo) THEN 
     339                  DO jl = 1, ipl; DO jk = 1, ipk 
     340                     DO jj = 1, nn_hls 
     341                          ijj = jpj-jj+1 
     342                        DO ii = 1, nn_hls 
     343            iij = jpi-ii+1 
     344                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj,jk,jl,jf) 
     345                        END DO 
     346                     END DO 
    292347                  END DO; END DO 
    293348               ENDIF 
    … …  
    295350            CASE ( 'V' )                                     ! V-point 
    296351               DO jl = 1, ipl; DO jk = 1, ipk 
    297                   DO ji = 1, nlci 
    298                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    299                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     352        DO jj = 1, nn_hls 
     353           ijj = jpj -jj +1 
     354                     DO ji = 1, jpi 
     355                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     356                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     357                     END DO 
    300358                  END DO 
    301359               END DO; END DO 
    302360 
    303361               IF ( .NOT. l_fast_exchanges ) THEN 
    304                   IF( nimpp >= jpiglo/2+1 ) THEN 
     362                  IF( nimpp >= Ni0glo/2+2 ) THEN 
    305363                     startloop = 1 
    306                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    307                      startloop = jpiglo/2+1 - nimpp + 1 
    308                   ELSE 
    309                      startloop = nlci + 1 
    310                   ENDIF 
    311                   IF( startloop <= nlci ) THEN 
    312                   DO jl = 1, ipl; DO jk = 1, ipk 
    313                      DO ji = startloop, nlci 
    314                         ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    315                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
    316                      END DO 
     364                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 
     365                     startloop = Ni0glo/2+2 - nimpp + nn_hls 
     366                  ELSE 
     367                     startloop = jpi + 1 
     368                  ENDIF 
     369                  IF( startloop <= jpi ) THEN 
     370                  DO jl = 1, ipl; DO jk = 1, ipk 
     371                        DO ji = startloop, jpi 
     372                        ijt = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 3 
     373                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     374                        END DO 
    317375                  END DO; END DO 
    318376                  ENDIF 
    … …  
    320378               ! 
    321379            CASE ( 'F' )                               ! F-point 
    322                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    323                   endloop = nlci 
     380               IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     381                  endloop = jpi 
    324382               ELSE 
    325                   endloop = nlci - 1 
    326                ENDIF 
    327                DO jl = 1, ipl; DO jk = 1, ipk 
    328                   DO ji = 1, endloop 
    329                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    330                      ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    331                   END DO 
    332                END DO; END DO 
    333                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    334                   DO jl = 1, ipl; DO jk = 1, ipk 
    335                      ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-2,jk,jl,jf) 
    336                   END DO; END DO 
    337                ENDIF 
    338                ! 
    339                IF ( .NOT. l_fast_exchanges ) THEN 
    340                   IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    341                      endloop = nlci 
    342                   ELSE 
    343                      endloop = nlci - 1 
    344                   ENDIF 
    345                   IF( nimpp >= jpiglo/2+1 ) THEN 
    346                      startloop = 1 
    347                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    348                      startloop = jpiglo/2+1 - nimpp + 1 
     383                  endloop = jpi - nn_hls 
     384               ENDIF 
     385               DO jl = 1, ipl; DO jk = 1, ipk 
     386        DO jj = 1, nn_hls 
     387          ijj = jpj -jj +1 
     388                    DO ji = 1, endloop 
     389                       iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
     390                       ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     391                     END DO 
     392                  END DO 
     393               END DO; END DO 
     394               IF((nimpp + jpi - 1) .eq. jpiglo) THEN 
     395                  DO jl = 1, ipl; DO jk = 1, ipk 
     396                     DO jj = 1, nn_hls 
     397                        ijj = jpj -jj +1 
     398                        DO ii = 1, nn_hls 
     399            iij = jpi -ii+1 
     400                           ARRAY_IN(iij,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(jpi-2*nn_hls+ii-1,jpj-2*nn_hls+jj-1,jk,jl,jf) 
     401                        END DO 
     402                     END DO 
     403                  END DO; END DO 
     404               ENDIF 
     405               ! 
     406               IF ( .NOT. l_fast_exchanges ) THEN 
     407                  IF( nimpp + jpi - 1 /= jpiglo ) THEN 
     408                     endloop = jpi 
     409                  ELSE 
     410                     endloop = jpi - nn_hls 
     411                  ENDIF 
     412                  IF( nimpp >= Ni0glo/2+2 ) THEN 
     413                     startloop = 1  
     414                  ELSEIF( nimpp+jpi-1 >= Ni0glo/2+2 .AND. nimpp < Ni0glo/2+2 ) THEN 
     415                     startloop = Ni0glo/2+2 - nimpp + nn_hls 
    349416                  ELSE 
    350417                     startloop = endloop + 1 
    … …  
    353420                     DO jl = 1, ipl; DO jk = 1, ipk 
    354421                        DO ji = startloop, endloop 
    355                            iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    356                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     422                           iju = jpiglo - ji - nimpp - nfimpp(isendto(1)) + 2 
     423                           ARRAY_IN(ji,jpj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
    357424                        END DO 
    358425                     END DO; END DO 

  • NEMO/trunk/src/OCE/LBC/lbcnfd.F90

    r13226 r13286  
    7070 
    7171   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !: 
    72    INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !: 
     72   INTEGER, PUBLIC                       ::   nsndto                     !: 
    7373   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate 
     74   INTEGER, PUBLIC                       ::   ijpj 
    7475 
    7576   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r13226 r13286  
    10981098      ! Look for how many procs on the northern boundary 
    10991099      ndim_rank_north = 0 
    1100       DO jjproc = 1, jpnij 
    1101          IF( njmppt(jjproc) == njmppmax )   ndim_rank_north = ndim_rank_north + 1 
     1100      DO jjproc = 1, jpni 
     1101         IF( nfproc(jjproc) /= -1 )   ndim_rank_north = ndim_rank_north + 1 
    11021102      END DO 
    11031103      ! 
    … …  
    11091109      ! Note : the rank start at 0 in MPI 
    11101110      ii = 0 
    1111       DO ji = 1, jpnij 
    1112          IF ( njmppt(ji) == njmppmax   ) THEN 
     1111      DO ji = 1, jpni 
     1112         IF ( nfproc(ji) /= -1   ) THEN 
    11131113            ii=ii+1 
    1114             nrank_north(ii)=ji-1 
     1114            nrank_north(ii)=nfproc(ji) 
    11151115         END IF 
    11161116      END DO 

  • NEMO/trunk/src/OCE/LBC/mpp_lbc_north_icb_generic.h90

    r13226 r13286  
    3636      ! 
    3737      INTEGER ::   ji, jj, jr 
    38       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    39       INTEGER ::   ipj, ij, iproc 
     38      INTEGER ::   ierr, itaille 
     39      INTEGER ::   ipj, ij, iproc, ijnr, ii1, ipi, impp 
    4040      ! 
    4141      REAL(PRECISION), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e 
    … …  
    4747      ALLOCATE(        ztab_e(jpiglo, 1-kextj:ipj+kextj)       ,       & 
    4848     &            znorthloc_e(jpimax, 1-kextj:ipj+kextj)       ,       & 
    49      &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,jpni)    ) 
     49     &          znorthgloio_e(jpimax, 1-kextj:ipj+kextj,ndim_rank_north)    ) 
    5050      ! 
    5151# if defined SINGLE_PRECISION 
    … …  
    7373      IF( ln_timing ) CALL tic_tac(.FALSE.) 
    7474      ! 
     75      ijnr = 0 
    7576      DO jr = 1, ndim_rank_north            ! recover the global north array 
    76          iproc = nrank_north(jr) + 1 
    77          ildi = nldit (iproc) 
    78          ilei = nleit (iproc) 
    79          iilb = nimppt(iproc) 
    80          DO jj = 1-kextj, ipj+kextj 
    81             DO ji = ildi, ilei 
    82                ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
     77         iproc = nfproc(jr) 
     78         IF( iproc /= -1 ) THEN 
     79            impp = nfimpp(jr) 
     80            ipi  = nfjpi(jr) 
     81            ijnr = ijnr + 1 
     82            DO jj = 1-kextj, ipj+kextj 
     83               DO ji = 1, ipi 
     84                  ii1 = impp + ji - 1       ! corresponds to mig(ji) but for subdomain iproc 
     85                  ztab_e(ii1,jj) = znorthgloio_e(ji,jj,ijnr) 
     86               END DO 
    8387            END DO 
    84          END DO 
     88         ENDIF 
    8589      END DO 
    8690 

  • NEMO/trunk/src/OCE/LBC/mpp_lnk_generic.h90

    r13226 r13286  
    7272 
    7373#if defined MULTI 
    74    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     74   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
    7575      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    7676#else 
    77    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     77   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv ) 
    7878#endif 
    7979      ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
    … …  
    8484      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    8585      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    86       INTEGER              ,OPTIONAL, INTENT(in   ) ::   ihlcom        ! number of ranks and rows to be communicated 
    8786      ! 
    8887      INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices 
    … …  
    9291      INTEGER  ::   ierr 
    9392      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no 
    94       INTEGER  ::   ihl                          ! number of ranks and rows to be communicated  
    95       REAL(PRECISION) ::   zland 
     93      REAL(wp) ::   zland 
    9694      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend 
    9795      REAL(PRECISION), DIMENSION(:,:,:,:,:), ALLOCATABLE ::   zsnd_we, zrcv_we, zsnd_ea, zrcv_ea   ! east -west  & west - east  halos 
    … …  
    109107      ipl = L_SIZE(ptab)   ! 4th    - 
    110108      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    111       ! 
    112       IF( PRESENT(ihlcom) ) THEN   ;   ihl = ihlcom 
    113       ELSE                         ;   ihl = 1 
    114       END IF 
    115109      ! 
    116110      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 
    … …  
    175169      ! 
    176170      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    177       isize = ihl * jpj * ipk * ipl * ipf       
     171      isize = nn_hls * jpj * ipk * ipl * ipf       
    178172      ! 
    179173      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    180       IF( llsend_we )   ALLOCATE( zsnd_we(ihl,jpj,ipk,ipl,ipf) ) 
    181       IF( llsend_ea )   ALLOCATE( zsnd_ea(ihl,jpj,ipk,ipl,ipf) ) 
    182       IF( llrecv_we )   ALLOCATE( zrcv_we(ihl,jpj,ipk,ipl,ipf) ) 
    183       IF( llrecv_ea )   ALLOCATE( zrcv_ea(ihl,jpj,ipk,ipl,ipf) ) 
     174      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     175      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
     176      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     177      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
    184178      ! 
    185179      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    186          ishift = ihl 
    187          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    188             zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! ihl + 1 -> 2*ihl 
     180         ishift = nn_hls 
     181         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     182            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls 
    189183         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    190184      ENDIF 
    191185      ! 
    192186      IF(llsend_ea  ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    193          ishift = jpi - 2 * ihl 
    194          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    195             zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*ihl + 1 -> jpi - ihl 
     187         ishift = jpi - 2 * nn_hls 
     188         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     189            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 
    196190         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    197191      ENDIF 
    … …  
    215209      ! 2.1 fill weastern halo 
    216210      ! ---------------------- 
    217       ! ishift = 0                         ! fill halo from ji = 1 to ihl 
     211      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls 
    218212      SELECT CASE ( ifill_we ) 
    219213      CASE ( jpfillnothing )               ! no filling  
    220214      CASE ( jpfillmpi   )                 ! use data received by MPI  
    221          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    222             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> ihl 
    223          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     215         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     216            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
     217         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    224218      CASE ( jpfillperio )                 ! use east-weast periodicity 
    225          ishift2 = jpi - 2 * ihl 
    226          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     219         ishift2 = jpi - 2 * nn_hls 
     220         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    227221            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    228          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     222         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    229223      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    230          DO jf = 1, ipf                               ! number of arrays to be treated 
    231             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    232                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    233                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
    234                END DO   ;   END DO   ;   END DO   ;   END DO 
    235             ENDIF 
    236          END DO 
     224         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     225            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 
     226         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    237227      CASE ( jpfillcst   )                 ! filling with constant value 
    238          DO jf = 1, ipf                               ! number of arrays to be treated 
    239             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    240                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    241                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    242                END DO;   END DO   ;   END DO   ;   END DO 
    243             ENDIF 
    244          END DO 
     228         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     229            ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     230         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    245231      END SELECT 
    246232      ! 
    247233      ! 2.2 fill eastern halo 
    248234      ! --------------------- 
    249       ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
     235      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi  
    250236      SELECT CASE ( ifill_ea ) 
    251237      CASE ( jpfillnothing )               ! no filling  
    252238      CASE ( jpfillmpi   )                 ! use data received by MPI  
    253          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    254             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - ihl + 1 -> jpi 
     239         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     240            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi 
    255241         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    256242      CASE ( jpfillperio )                 ! use east-weast periodicity 
    257          ishift2 = ihl 
    258          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     243         ishift2 = nn_hls 
     244         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    259245            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    260246         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    261247      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    262          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     248         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    263249            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
    264250         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    265251      CASE ( jpfillcst   )                 ! filling with constant value 
    266          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     252         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    267253            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    268          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     254         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    269255      END SELECT 
    270256      ! 
    … …  
    278264         ! 
    279265         SELECT CASE ( jpni ) 
    280          CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! only 1 northern proc, no mpp 
    281          CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:) OPT_K(:) )   ! for all northern procs. 
     266         CASE ( 1 )     ;   CALL lbc_nfd( ptab, NAT_IN(:), SGN_IN(:)                  OPT_K(:) )   ! only 1 northern proc, no mpp 
     267         CASE DEFAULT   ;   CALL mpp_nfd( ptab, NAT_IN(:), SGN_IN(:), ifill_no, zland OPT_K(:) )   ! for all northern procs. 
    282268         END SELECT 
    283269         ! 
    … …  
    290276      ! ---------------------------------------------------- ! 
    291277      ! 
    292       IF( llsend_so )   ALLOCATE( zsnd_so(jpi,ihl,ipk,ipl,ipf) ) 
    293       IF( llsend_no )   ALLOCATE( zsnd_no(jpi,ihl,ipk,ipl,ipf) ) 
    294       IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,ihl,ipk,ipl,ipf) ) 
    295       IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,ihl,ipk,ipl,ipf) ) 
    296       ! 
    297       isize = jpi * ihl * ipk * ipl * ipf       
     278      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     279      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     280      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     281      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     282      ! 
     283      isize = jpi * nn_hls * ipk * ipl * ipf       
    298284 
    299285      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    300286      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    301          ishift = ihl 
    302          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    303             zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! ihl+1 -> 2*ihl 
     287         ishift = nn_hls 
     288         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     289            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls 
    304290         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    305291      ENDIF 
    306292      ! 
    307293      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    308          ishift = jpj - 2 * ihl 
    309          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    310             zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*ihl+1 -> jpj-ihl 
     294         ishift = jpj - 2 * nn_hls 
     295         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     296            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls 
    311297         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    312298      ENDIF 
    … …  
    329315      ! 5.1 fill southern halo 
    330316      ! ---------------------- 
    331       ! ishift = 0                         ! fill halo from jj = 1 to ihl 
     317      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls 
    332318      SELECT CASE ( ifill_so ) 
    333319      CASE ( jpfillnothing )               ! no filling  
    334320      CASE ( jpfillmpi   )                 ! use data received by MPI  
    335          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    336             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> ihl 
    337          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     321         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     322            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
     323         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    338324      CASE ( jpfillperio )                 ! use north-south periodicity 
    339          ishift2 = jpj - 2 * ihl 
    340          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     325         ishift2 = jpj - 2 * nn_hls 
     326         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    341327            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    342          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     328         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    343329      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    344          DO jf = 1, ipf                               ! number of arrays to be treated 
    345             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    346                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    347                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ihl+1,jk,jl,jf) 
    348                END DO   ;   END DO   ;   END DO   ;   END DO 
    349             ENDIF 
    350          END DO 
     330         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     331            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
     332         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    351333      CASE ( jpfillcst   )                 ! filling with constant value 
    352          DO jf = 1, ipf                               ! number of arrays to be treated 
    353             IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    354                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi  
    355                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    356                END DO;   END DO   ;   END DO   ;   END DO 
    357             ENDIF 
    358          END DO 
     334         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi  
     335            ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     336         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    359337      END SELECT 
    360338      ! 
    361339      ! 5.2 fill northern halo 
    362340      ! ---------------------- 
    363       ishift = jpj - ihl                ! fill halo from jj = jpj-ihl+1 to jpj  
     341      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
    364342      SELECT CASE ( ifill_no ) 
    365343      CASE ( jpfillnothing )               ! no filling  
    366344      CASE ( jpfillmpi   )                 ! use data received by MPI  
    367          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    368             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-ihl+1 -> jpj 
     345         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     346            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj 
    369347         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    370348      CASE ( jpfillperio )                 ! use north-south periodicity 
    371          ishift2 = ihl 
    372          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     349         ishift2 = nn_hls 
     350         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    373351            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    374          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     352         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    375353      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    376          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     354         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    377355            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
    378          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     356         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    379357      CASE ( jpfillcst   )                 ! filling with constant value 
    380          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     358         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    381359            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    382          END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     360         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    383361      END SELECT 
    384362      ! 
    … …  
    410388      ! 
    411389   END SUBROUTINE ROUTINE_LNK 
    412  
     390#undef PRECISION 
     391#undef SENDROUTINE 
     392#undef RECVROUTINE 
    413393#undef ARRAY_TYPE 
    414394#undef NAT_IN 

  • NEMO/trunk/src/OCE/LBC/mpp_lnk_icb_generic.h90

    r13226 r13286  
    105105      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    106106      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    107          iihom = jpi-nreci-kexti 
     107         iihom = jpi - (2 * nn_hls) -kexti 
    108108         DO jl = 1, ipreci 
    109109            r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 
    … …  
    165165      ! 
    166166      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    167          ijhom = jpj-nrecj-kextj 
     167         ijhom = jpj - (2 * nn_hls) - kextj 
    168168         DO jl = 1, iprecj 
    169169            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 

  • NEMO/trunk/src/OCE/LBC/mpp_loc_generic.h90

    r13226 r13286  
    109109#undef PRECISION 
    110110#undef ARRAY_TYPE 
    111 #undef MAX_TYPE 
     111#undef MASK_TYPE 
    112112#undef ARRAY_IN 
    113113#undef MASK_IN 

  • NEMO/trunk/src/OCE/LBC/mpp_nfd_generic.h90

    r13226 r13286  
    7474# endif 
    7575 
    76    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 
     76   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfillmode, pfillval, kfld ) 
    7777      !!---------------------------------------------------------------------- 
    7878      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
    7979      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    8080      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     81      INTEGER          , INTENT(in   ) ::   kfillmode   ! filling method for halo over land  
     82      REAL(wp)         , INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    8183      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    8284      ! 
     85      LOGICAL  ::   ll_add_line 
    8386      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices 
    84       INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array 
     87      INTEGER  ::   ipi, ipj, ipj2, ipk, ipl, ipf   ! dimension of the input array 
    8588      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    86       INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb 
    87       INTEGER  ::   ij, iproc 
     89      INTEGER  ::   ierr, ibuffsize, iis0, iie0, impp 
     90      INTEGER  ::   ii1, ii2, ij1, ij2 
     91      INTEGER  ::   ipimax, i0max 
     92      INTEGER  ::   ij, iproc, ipni, ijnr 
    8893      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather 
    8994      INTEGER                             ::   ml_err      ! for mpi_isend when avoiding mpi_allgather 
    9095      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat     ! for mpi_isend when avoiding mpi_allgather 
    9196      !                                                    ! Workspace for message transfers avoiding mpi_allgather 
    92       INTEGER                             ::   ipf_j       ! sum of lines for all multi fields 
    93       INTEGER                             ::   js          ! counter 
    94       INTEGER, DIMENSION(:,:),          ALLOCATABLE ::   jj_s  ! position of sent lines 
    95       INTEGER, DIMENSION(:),            ALLOCATABLE ::   ipj_s ! number of sent lines 
    96       REAL(PRECISION), DIMENSION(:,:,:)      , ALLOCATABLE ::   ztabl 
    97       REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, ztabr 
    98       REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   znorthloc, zfoldwk       
    99       REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio 
     97      INTEGER                             ::   ipj_b       ! sum of lines for all multi fields 
     98      INTEGER                             ::   i012        ! 0, 1 or 2 
     99      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_s  ! position of sent lines 
     100      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_b  ! position of buffer lines 
     101      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines 
     102      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays 
     103      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztabglo, znorthloc 
     104      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo 
    100105      !!---------------------------------------------------------------------- 
    101106      ! 
    … …  
    106111      IF( l_north_nogather ) THEN      !==  no allgather exchanges  ==! 
    107112 
    108          ALLOCATE(ipj_s(ipf)) 
    109  
    110          ipj      = 2            ! Max 2nd dimension of message transfers (last two j-line only) 
    111          ipj_s(:) = 1            ! Real 2nd dimension of message transfers (depending on perf requirement) 
    112                                  ! by default, only one line is exchanged 
    113  
    114          ALLOCATE( jj_s(ipf,2) ) 
    115  
    116          ! re-define number of exchanged lines : 
    117          !  must be two during the first two time steps 
    118          !  to correct possible incoherent values on North fold lines from restart  
    119  
     113         !   ---   define number of exchanged lines   --- 
     114         ! 
     115         ! In theory we should exchange only nn_hls lines. 
     116         ! 
     117         ! However, some other points are duplicated in the north pole folding: 
     118         !  - jperio=[34], grid=T : half of the last line (jpiglo/2+2:jpiglo-nn_hls) 
     119         !  - jperio=[34], grid=U : half of the last line (jpiglo/2+1:jpiglo-nn_hls) 
     120         !  - jperio=[34], grid=V : all the last line nn_hls+1 and (nn_hls+2:jpiglo-nn_hls) 
     121         !  - jperio=[34], grid=F : all the last line (nn_hls+1:jpiglo-nn_hls) 
     122         !  - jperio=[56], grid=T : 2 points of the last line (jpiglo/2+1 and jpglo-nn_hls) 
     123         !  - jperio=[56], grid=U : no points are duplicated 
     124         !  - jperio=[56], grid=V : half of the last line (jpiglo/2+1:jpiglo-nn_hls) 
     125         !  - jperio=[56], grid=F : half of the last line (jpiglo/2+1:jpiglo-nn_hls-1) 
     126         ! The order of the calculations may differ for these duplicated points (as, for example jj+1 becomes jj-1) 
     127         ! This explain why these duplicated points may have different values even if they are at the exact same location. 
     128         ! In consequence, we may want to force the folding on these points by setting l_full_nf_update = .TRUE. 
     129         ! This is slightly slower but necessary to avoid different values on identical grid points!! 
     130         ! 
    120131         !!!!!!!!!           temporary switch off this optimisation ==> force TRUE           !!!!!!!! 
    121132         !!!!!!!!!  needed to get the same results without agrif and with agrif and no zoom  !!!!!!!! 
    122133         !!!!!!!!!                    I don't know why we must do that...                    !!!!!!!! 
    123134         l_full_nf_update = .TRUE. 
    124  
    125          ! Two lines update (slower but necessary to avoid different values ion identical grid points 
    126          IF ( l_full_nf_update .OR.                          &    ! if coupling fields 
    127               ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart 
    128             ipj_s(:) = 2 
     135         ! also force it if not restart during the first 2 steps (leap frog?) 
     136         ll_add_line = l_full_nf_update .OR. ( ncom_stp <= nit000+1 .AND. .NOT. ln_rstart ) 
     137          
     138         ALLOCATE(ipj_s(ipf))                ! how many lines do we exchange? 
     139         IF( ll_add_line ) THEN 
     140            DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
     141               ipj_s(jf) = nn_hls + COUNT( (/ npolj == 3 .OR. npolj == 4 .OR. NAT_IN(jf) == 'V' .OR. NAT_IN(jf) == 'F' /) )  
     142            END DO 
     143         ELSE 
     144            ipj_s(:) = nn_hls 
     145         ENDIF 
     146          
     147         ipj   = MAXVAL(ipj_s(:))            ! Max 2nd dimension of message transfers 
     148         ipj_b = SUM(   ipj_s(:))            ! Total number of lines to be exchanged 
     149         ALLOCATE( jj_s(ipj, ipf), jj_b(ipj, ipf) ) 
    129150 
    130151         ! Index of modifying lines in input 
     152         ij1 = 0 
    131153         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
    132154            ! 
    133155            SELECT CASE ( npolj ) 
    134             ! 
    135156            CASE ( 3, 4 )                       ! *  North fold  T-point pivot 
    136                ! 
    137157               SELECT CASE ( NAT_IN(jf) ) 
    138                ! 
    139                CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    140                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
    141                CASE ( 'V' , 'F' )                                 ! V-, F-point 
    142                   jj_s(jf,1) = nlcj - 3 ;  jj_s(jf,2) = nlcj - 2 
     158               CASE ( 'T', 'W', 'U' )   ;   i012 = 1   ! T-, U-, W-point 
     159               CASE ( 'V', 'F'      )   ;   i012 = 2   ! V-, F-point 
    143160               END SELECT 
    144             ! 
    145             CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
     161            CASE ( 5, 6 )                       ! *  North fold  F-point pivot 
    146162               SELECT CASE ( NAT_IN(jf) ) 
    147                ! 
    148                CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    149                   jj_s(jf,1) = nlcj - 1       
    150                   ipj_s(jf) = 1                  ! need only one line anyway 
    151                CASE ( 'V' , 'F' )                                 ! V-, F-point 
    152                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
     163               CASE ( 'T', 'W', 'U' )   ;   i012 = 0   ! T-, U-, W-point 
     164               CASE ( 'V', 'F'      )   ;   i012 = 1   ! V-, F-point 
    153165               END SELECT 
    154             ! 
    155166            END SELECT 
    156             ! 
    157          ENDDO 
    158          !  
    159          ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged 
    160          ! 
    161          ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) ) 
    162          ! 
    163          js = 0 
    164          DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
     167               ! 
    165168            DO jj = 1, ipj_s(jf) 
    166                js = js + 1 
    167                DO jl = 1, ipl 
    168                   DO jk = 1, ipk 
    169                      znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf) 
    170                   END DO 
    171                END DO 
     169               ij1 = ij1 + 1 
     170               jj_b(jj,jf) = ij1 
     171               jj_s(jj,jf) = jpj - 2*nn_hls + jj - i012 
    172172            END DO 
     173            ! 
    173174         END DO 
    174175         ! 
    175          ibuffsize = jpimax * ipf_j * ipk * ipl 
    176          ! 
    177          ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) ) 
    178          ALLOCATE( ztabr(jpimax*jpmaxngh,ipj,ipk,ipl,ipf) )  
    179          ! when some processors of the north fold are suppressed,  
    180          ! values of ztab* arrays corresponding to these suppressed domain won't be defined  
    181          ! and we need a default definition to 0. 
    182          ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding 
    183          IF ( jpni*jpnj /= jpnij ) ztabr(:,:,:,:,:) = 0._wp 
     176         ALLOCATE( ztabb(jpimax,ipj_b,ipk,ipl) )   ! store all the data to be sent in a buffer array 
     177         ibuffsize = jpimax * ipj_b * ipk * ipl 
     178         ! 
     179         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     180            DO jj = 1, ipj_s(jf) 
     181               ij1 = jj_b(jj,jf) 
     182               ij2 = jj_s(jj,jf) 
     183               DO ji = 1, jpi 
     184                  ztabb(ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf) 
     185               END DO 
     186               DO ji = jpi+1, jpimax 
     187                  ztabb(ji,ij1,jk,jl) = HUGE(0._wp)   ! avoid sending uninitialized values (make sure we don't use it) 
     188               END DO 
     189            END DO 
     190         END DO   ;   END DO   ;   END DO 
    184191         ! 
    185192         ! start waiting time measurement 
    186193         IF( ln_timing ) CALL tic_tac(.TRUE.) 
    187194         ! 
     195         ! send the data as soon as possible 
    188196         DO jr = 1, nsndto 
    189             IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
    190                CALL SENDROUTINE( 5, znorthloc, ibuffsize, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     197            iproc = nfproc(isendto(jr)) 
     198            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 
     199               CALL SENDROUTINE( 5, ztabb, ibuffsize, iproc, ml_req_nf(jr) ) 
    191200            ENDIF 
    192201         END DO 
    193202         ! 
     203         ipimax = jpimax * jpmaxngh 
     204         ALLOCATE( ztabw(jpimax,ipj_b,ipk,ipl), ztabr(ipimax,ipj_b,ipk,ipl) )  
     205         ! 
     206         DO jr = 1, nsndto 
     207            ! 
     208            ipni  = isendto(jr) 
     209            iproc = nfproc(ipni) 
     210            ipi   = nfjpi (ipni) 
     211            ! 
     212            IF( ipni ==   1  ) THEN   ;   iis0 =   1            ! domain  left side: as e-w comm already done -> from 1st column 
     213            ELSE                      ;   iis0 =   1 + nn_hls   ! default: -> from inner domain  
     214            ENDIF 
     215            IF( ipni == jpni ) THEN   ;   iie0 = ipi            ! domain right side: as e-w comm already done -> until last column 
     216            ELSE                      ;   iie0 = ipi - nn_hls   ! default: -> until inner domain  
     217            ENDIF 
     218            impp = nfimpp(ipni) - nfimpp(isendto(1)) 
     219            ! 
     220            IF(           iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed) 
     221               ! 
     222               SELECT CASE ( kfillmode ) 
     223               CASE ( jpfillnothing )               ! no filling  
     224               CASE ( jpfillcopy    )               ! filling with inner domain values 
     225                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     226                     DO jj = 1, ipj_s(jf) 
     227                        ij1 = jj_b(jj,jf) 
     228                        ij2 = jj_s(jj,jf) 
     229                        DO ji = iis0, iie0 
     230                           ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
     231                        END DO 
     232                     END DO 
     233                  END DO   ;   END DO   ;   END DO 
     234               CASE ( jpfillcst     )               ! filling with constant value 
     235                  DO jl = 1, ipl   ;   DO jk = 1, ipk 
     236                     DO jj = 1, ipj_b 
     237                        DO ji = iis0, iie0 
     238                           ztabr(impp+ji,jj,jk,jl) = pfillval 
     239                        END DO 
     240                     END DO 
     241                  END DO   ;   END DO 
     242               END SELECT 
     243               ! 
     244            ELSE IF( iproc == narea-1 ) THEN   ! get data from myself! 
     245               ! 
     246               DO jf = 1, ipf   ;   DO jl = 1, ipl  ;   DO jk = 1, ipk 
     247                  DO jj = 1, ipj_s(jf) 
     248                     ij1 = jj_b(jj,jf) 
     249                     ij2 = jj_s(jj,jf) 
     250                     DO ji = iis0, iie0 
     251                        ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf) 
     252                     END DO 
     253                  END DO 
     254               END DO   ;   END DO   ;   END DO 
     255               ! 
     256            ELSE                               ! get data from a neighbour trough communication 
     257               !   
     258               CALL RECVROUTINE(5, ztabw, ibuffsize, iproc) 
     259               DO jl = 1, ipl   ;   DO jk = 1, ipk 
     260                  DO jj = 1, ipj_b 
     261                     DO ji = iis0, iie0 
     262                        ztabr(impp+ji,jj,jk,jl) = ztabw(ji,jj,jk,jl) 
     263                     END DO 
     264                  END DO 
     265               END DO   ;   END DO 
     266                
     267            ENDIF 
     268            ! 
     269         END DO   ! nsndto 
     270         ! 
     271         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     272         ! 
     273         ! North fold boundary condition 
     274         ! 
     275         DO jf = 1, ipf 
     276            ij1 = jj_b(       1 ,jf) 
     277            ij2 = jj_b(ipj_s(jf),jf) 
     278            CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat LBC_ARG, psgn LBC_ARG ) 
     279         END DO 
     280         ! 
     281         DEALLOCATE( ztabr, ztabw, jj_s, jj_b, ipj_s ) 
     282         ! 
    194283         DO jr = 1,nsndto 
    195             iproc = nfipproc(isendto(jr),jpnj) 
    196             IF(iproc /= -1) THEN 
    197                iilb = nimppt(iproc+1) 
    198                ilci = nlcit (iproc+1) 
    199                ildi = nldit (iproc+1) 
    200                ilei = nleit (iproc+1) 
    201                IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
    202                IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
    203                iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    204             ENDIF 
     284            iproc = nfproc(isendto(jr)) 
    205285            IF( iproc /= narea-1 .AND. iproc /= -1 ) THEN 
    206                CALL RECVROUTINE(5, zfoldwk, ibuffsize, iproc) 
    207                js = 0 
    208                DO jf = 1, ipf ; DO jj = 1, ipj_s(jf) 
    209                   js = js + 1 
    210                   DO jl = 1, ipl 
    211                      DO jk = 1, ipk 
    212                         DO ji = ildi, ilei 
    213                            ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 
    214                         END DO 
    215                      END DO 
    216                   END DO 
    217                END DO; END DO 
    218             ELSE IF( iproc == narea-1 ) THEN 
    219                DO jf = 1, ipf ; DO jj = 1, ipj_s(jf) 
    220                   DO jl = 1, ipl 
    221                      DO jk = 1, ipk 
    222                         DO ji = ildi, ilei 
    223                            ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 
    224                         END DO 
    225                      END DO 
    226                   END DO 
    227                END DO; END DO 
     286               CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err )   ! put the wait at the very end just before the deallocate 
    228287            ENDIF 
    229288         END DO 
    230          DO jr = 1,nsndto 
    231             IF( nfipproc(isendto(jr),jpnj) /= narea-1 .AND. nfipproc(isendto(jr),jpnj) /= -1 ) THEN 
    232                CALL mpi_wait( ml_req_nf(jr), ml_stat, ml_err ) 
    233             ENDIF 
    234          END DO 
    235          ! 
    236          IF( ln_timing ) CALL tic_tac(.FALSE.) 
    237          ! 
    238          ! North fold boundary condition 
    239          ! 
    240          DO jf = 1, ipf 
    241             CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,1:ipj_s(jf),:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG ) 
    242          END DO 
    243          ! 
    244          DEALLOCATE( zfoldwk, ztabr, jj_s, ipj_s ) 
     289         DEALLOCATE( ztabb ) 
    245290         ! 
    246291      ELSE                             !==  allgather exchanges  ==! 
    247292         ! 
    248          ipj   = 4            ! 2nd dimension of message transfers (last j-lines) 
    249          ! 
    250          ALLOCATE( znorthloc(jpimax,ipj,ipk,ipl,ipf) ) 
    251          ! 
    252          DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab 
    253             DO jl = 1, ipl 
    254                DO jk = 1, ipk 
    255                   DO jj = nlcj - ipj +1, nlcj 
    256                      ij = jj - nlcj + ipj 
    257                      znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 
    258                   END DO 
     293         ! how many lines do we exchange at max? -> ipj    (no further optimizations in this case...) 
     294         ipj =      nn_hls + 2 
     295         ! how many lines do we     need at max? -> ipj2   (no further optimizations in this case...) 
     296         ipj2 = 2 * nn_hls + 2 
     297         ! 
     298         i0max = jpimax - 2 * nn_hls 
     299         ibuffsize = i0max * ipj * ipk * ipl * ipf 
     300         ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,ndim_rank_north) ) 
     301         ! 
     302         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! put in znorthloc ipj j-lines of ptab 
     303            DO jj = 1, ipj 
     304               ij2 = jpj - ipj2 + jj                        ! the first ipj lines of the last ipj2 lines 
     305               DO ji = 1, Ni_0 
     306                  ii2 = Nis0 - 1 + ji                       ! inner domain: Nis0 to Nie0 
     307                  znorthloc(ji,jj,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) 
     308               END DO 
     309               DO ji = Ni_0+1, i0max 
     310                  znorthloc(ji,jj,jk,jl,jf) = HUGE(0._wp)   ! avoid sending uninitialized values (make sure we don't use it) 
    259311               END DO 
    260312            END DO 
    261          END DO 
    262          ! 
    263          ibuffsize = jpimax * ipj * ipk * ipl * ipf 
    264          ! 
    265          ALLOCATE( ztab       (jpiglo,ipj,ipk,ipl,ipf     ) ) 
    266          ALLOCATE( znorthgloio(jpimax,ipj,ipk,ipl,ipf,jpni) ) 
    267          ! 
    268          ! when some processors of the north fold are suppressed, 
    269          ! values of ztab* arrays corresponding to these suppressed domain won't be defined 
    270          ! and we need a default definition to 0. 
    271          ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding 
    272          IF ( jpni*jpnj /= jpnij ) ztab(:,:,:,:,:) = 0._wp 
     313         END DO   ;   END DO   ;   END DO 
    273314         ! 
    274315         ! start waiting time measurement 
    275316         IF( ln_timing ) CALL tic_tac(.TRUE.) 
    276          CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_TYPE,                & 
    277             &                znorthgloio, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 
    278          ! 
     317         CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 
    279318         ! stop waiting time measurement 
    280319         IF( ln_timing ) CALL tic_tac(.FALSE.) 
    281          ! 
    282          DO jr = 1, ndim_rank_north         ! recover the global north array 
    283             iproc = nrank_north(jr) + 1 
    284             iilb  = nimppt(iproc) 
    285             ilci  = nlcit (iproc) 
    286             ildi  = nldit (iproc) 
    287             ilei  = nleit (iproc) 
    288             IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
    289             IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
    290             DO jf = 1, ipf 
    291                DO jl = 1, ipl 
    292                   DO jk = 1, ipk 
     320         DEALLOCATE( znorthloc ) 
     321         ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) ) 
     322         ! 
     323         ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines 
     324         ijnr = 0 
     325         DO jr = 1, jpni                                                        ! recover the global north array 
     326            iproc = nfproc(jr) 
     327            impp  = nfimpp(jr) 
     328            ipi   = nfjpi( jr) - 2 * nn_hls                       ! corresponds to Ni_0 but for subdomain iproc 
     329            IF( iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed) 
     330              ! 
     331               SELECT CASE ( kfillmode ) 
     332               CASE ( jpfillnothing )               ! no filling  
     333               CASE ( jpfillcopy    )               ! filling with inner domain values 
     334                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
    293335                     DO jj = 1, ipj 
    294                         DO ji = ildi, ilei 
    295                            ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 
     336                        ij2 = jpj - ipj2 + jj                    ! the first ipj lines of the last ipj2 lines 
     337                        DO ji = 1, ipi 
     338                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     339                           ztabglo(ii1,jj,jk,jl,jf) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
    296340                        END DO 
    297341                     END DO 
     342                  END DO   ;   END DO   ;   END DO 
     343               CASE ( jpfillcst     )               ! filling with constant value 
     344                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     345                     DO jj = 1, ipj 
     346                        DO ji = 1, ipi 
     347                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     348                           ztabglo(ii1,jj,jk,jl,jf) = pfillval 
     349                        END DO 
     350                     END DO 
     351                 END DO   ;   END DO   ;   END DO 
     352               END SELECT 
     353               ! 
     354            ELSE 
     355               ijnr = ijnr + 1 
     356               DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     357                  DO jj = 1, ipj 
     358                     DO ji = 1, ipi 
     359                        ii1 = impp + nn_hls + ji - 1             ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     360                        ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,ijnr) 
     361                     END DO 
    298362                  END DO 
     363               END DO   ;   END DO   ;   END DO 
     364            ENDIF 
     365            ! 
     366         END DO   ! jpni 
     367         DEALLOCATE( znorthglo ) 
     368         ! 
     369         DO jf = 1, ipf 
     370            CALL lbc_nfd( ztabglo(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
     371            DO jl = 1, ipl   ;   DO jk = 1, ipk                  ! e-w periodicity 
     372               DO jj = 1, nn_hls + 1 
     373                  ij1 = ipj2 - (nn_hls + 1) + jj                 ! need only the last nn_hls + 1 lines until ipj2 
     374                  ztabglo(              1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf) 
     375                  ztabglo(jpiglo-nn_hls+1:jpiglo,ij1,jk,jl,jf) = ztabglo(         nn_hls+1:     2*nn_hls,ij1,jk,jl,jf) 
     376               END DO 
     377            END DO   ;   END DO 
     378         END DO      
     379         ! 
     380         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! Scatter back to ARRAY_IN 
     381            DO jj = 1, nn_hls + 1 
     382               ij1 = jpj  - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until jpj 
     383               ij2 = ipj2 - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until ipj2 
     384               DO ji= 1, jpi 
     385                  ii2 = mig(ji) 
     386                  ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(ii2,ij2,jk,jl,jf) 
    299387               END DO 
    300388            END DO 
    301          END DO 
    302          DO jf = 1, ipf 
    303             CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
    304          END DO 
    305          ! 
    306          DO jf = 1, ipf 
    307             DO jl = 1, ipl 
    308                DO jk = 1, ipk 
    309                   DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN 
    310                      ij = jj - nlcj + ipj 
    311                      DO ji= 1, nlci 
    312                         ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 
    313                      END DO 
    314                   END DO 
    315                END DO 
    316             END DO 
    317          END DO 
    318          ! 
    319       ! 
    320          DEALLOCATE( ztab ) 
    321          DEALLOCATE( znorthgloio ) 
    322       ENDIF 
    323       ! 
    324       DEALLOCATE( znorthloc ) 
     389         END DO   ;   END DO   ;   END DO 
     390         ! 
     391         DEALLOCATE( ztabglo ) 
     392         ! 
     393      ENDIF   ! l_north_nogather 
    325394      ! 
    326395   END SUBROUTINE ROUTINE_NFD 

  • NEMO/trunk/src/OCE/LBC/mppini.F90

    r13216 r13286  
    88   !!            8.0  !  1998-05  (M. Imbard, J. Escobar, L. Colombet )  SHMEM and MPI versions 
    99   !!  NEMO      1.0  !  2004-01  (G. Madec, J.M Molines)  F90 : free form , north fold jpni > 1 
    10    !!            3.4  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) add mpp_init_nfdcom 
    11    !!            3.   ! 2013-06  (I. Epicoco, S. Mocavero, CMCC) mpp_init_nfdcom: setup avoiding MPI communication  
     10   !!            3.4  !  2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)  add init_nfdcom 
     11   !!            3.   !  2013-06  (I. Epicoco, S. Mocavero, CMCC)  init_nfdcom: setup avoiding MPI communication  
    1212   !!            4.0  !  2016-06  (G. Madec)  use domain configuration file instead of bathymetry file 
    1313   !!            4.0  !  2017-06  (J.M. Molines, T. Lovato) merge of mppini and mppini_2 
    … …  
    1515 
    1616   !!---------------------------------------------------------------------- 
    17    !!  mpp_init          : Lay out the global domain over processors with/without land processor elimination 
    18    !!  mpp_init_mask     : Read global bathymetric information to facilitate land suppression 
    19    !!  mpp_init_ioipsl   : IOIPSL initialization in mpp  
    20    !!  mpp_init_partition: Calculate MPP domain decomposition 
    21    !!  factorise         : Calculate the factors of the no. of MPI processes 
    22    !!  mpp_init_nfdcom   : Setup for north fold exchanges with explicit point-to-point messaging 
     17   !!  mpp_init       : Lay out the global domain over processors with/without land processor elimination 
     18   !!      init_ioipsl: IOIPSL initialization in mpp  
     19   !!      init_nfdcom: Setup for north fold exchanges with explicit point-to-point messaging 
     20   !!      init_doloop: set the starting/ending indices of DO-loop used in do_loop_substitute  
    2321   !!---------------------------------------------------------------------- 
    2422   USE dom_oce        ! ocean space and time domain 
    2523   USE bdy_oce        ! open BounDarY   
    2624   ! 
    27    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges  
     25   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges  
    2826   USE lib_mpp        ! distribued memory computing library 
    2927   USE iom            ! nemo I/O library  
    … …  
    3432   PRIVATE 
    3533 
    36    PUBLIC mpp_init       ! called by opa.F90 
    37  
    38    INTEGER :: numbot = -1  ! 'bottom_level' local logical unit 
    39    INTEGER :: numbdy = -1  ! 'bdy_msk'      local logical unit 
     34   PUBLIC   mpp_init       ! called by nemogcm.F90 
     35   PUBLIC   mpp_getnum     ! called by prtctl 
     36   PUBLIC   mpp_basesplit  ! called by prtctl 
     37   PUBLIC   mpp_is_ocean   ! called by prtctl 
     38    
     39   INTEGER ::   numbot = -1   ! 'bottom_level' local logical unit 
     40   INTEGER ::   numbdy = -1   ! 'bdy_msk'      local logical unit 
    4041    
    4142   !!---------------------------------------------------------------------- 
    … …  
    6162      !!---------------------------------------------------------------------- 
    6263      ! 
     64      jpiglo = Ni0glo 
     65      jpjglo = Nj0glo 
    6366      jpimax = jpiglo 
    6467      jpjmax = jpjglo 
    … …  
    6669      jpj    = jpjglo 
    6770      jpk    = jpkglo 
    68       jpim1  = jpi-1                                            ! inner domain indices 
    69       jpjm1  = jpj-1                                            !   "           " 
    70       jpkm1  = MAX( 1, jpk-1 )                                  !   "           " 
     71      jpim1  = jpi-1                         ! inner domain indices 
     72      jpjm1  = jpj-1                         !   "           " 
     73      jpkm1  = MAX( 1, jpk-1 )               !   "           " 
     74      ! 
     75      CALL init_doloop                       ! set start/end indices or do-loop depending on the halo width value (nn_hls)  
     76      ! 
    7177      jpij   = jpi*jpj 
    7278      jpni   = 1 
    7379      jpnj   = 1 
    7480      jpnij  = jpni*jpnj 
    75       nimpp  = 1           !  
     81      nn_hls = 1 
     82      nimpp  = 1 
    7683      njmpp  = 1 
    77       nlci   = jpi 
    78       nlcj   = jpj 
    79       nldi   = 1 
    80       nldj   = 1 
    81       nlei   = jpi 
    82       nlej   = jpj 
    8384      nbondi = 2 
    8485      nbondj = 2 
    … …  
    135136      !!                    njmpp     : latitudinal  index 
    136137      !!                    narea     : number for local area 
    137       !!                    nlci      : first dimension 
    138       !!                    nlcj      : second dimension 
    139138      !!                    nbondi    : mark for "east-west local boundary" 
    140139      !!                    nbondj    : mark for "north-south local boundary" 
    … …  
    147146      INTEGER ::   ji, jj, jn, jproc, jarea   ! dummy loop indices 
    148147      INTEGER ::   inijmin 
    149       INTEGER ::   i2add 
    150148      INTEGER ::   inum                       ! local logical unit 
    151       INTEGER ::   idir, ifreq, icont         ! local integers 
     149      INTEGER ::   idir, ifreq                ! local integers 
    152150      INTEGER ::   ii, il1, ili, imil         !   -       - 
    153151      INTEGER ::   ij, il2, ilj, ijm1         !   -       - 
    … …  
    162160      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   iin, ii_nono, ii_noea          ! 1D workspace 
    163161      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ijn, ii_noso, ii_nowe          !  -     - 
    164       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci, ibondi, ipproc   ! 2D workspace 
    165       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj, ibondj, ipolj    !  -     - 
    166       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilei, ildi, iono, ioea         !  -     - 
    167       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ilej, ildj, ioso, iowe         !  -     - 
     162      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi, ibondi, ipproc   ! 2D workspace 
     163      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj, ibondj, ipolj    !  -     - 
     164      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iie0, iis0, iono, ioea         !  -     - 
     165      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ije0, ijs0, ioso, iowe         !  -     - 
    168166      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   llisoce                        !  -     - 
    169167      NAMELIST/nambdy/ ln_bdy, nb_bdy, ln_coords_file, cn_coords_file,           & 
    … …  
    173171           &             cn_ice, nn_ice_dta,                                     & 
    174172           &             ln_vol, nn_volctl, nn_rimwidth 
    175       NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly 
     173      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 
    176174      !!---------------------------------------------------------------------- 
    177175      ! 
    … …  
    186184902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' )    
    187185      ! 
     186      nn_hls = MAX(1, nn_hls)   ! nn_hls must be > 0 
    188187      IF(lwp) THEN 
    189188            WRITE(numout,*) '   Namelist nammpp' 
    … …  
    195194         ENDIF 
    196195            WRITE(numout,*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather 
     196            WRITE(numout,*) '      halo width (applies to both rows and columns)       nn_hls = ', nn_hls 
    197197      ENDIF 
    198198      ! 
    199199      IF(lwm)   WRITE( numond, nammpp ) 
    200  
     200      ! 
     201!!!------------------------------------ 
     202!!!  nn_hls shloud be read in nammpp 
     203!!!------------------------------------ 
     204      jpiglo = Ni0glo + 2 * nn_hls 
     205      jpjglo = Nj0glo + 2 * nn_hls 
     206      ! 
    201207      ! do we need to take into account bdy_msk? 
    202208      READ  ( numnam_ref, nambdy, IOSTAT = ios, ERR = 903) 
    … …  
    208214      IF( ln_bdy .AND. ln_mask_file ) CALL iom_open( cn_mask_file, numbdy ) 
    209215      ! 
    210       IF( ln_listonly )   CALL mpp_init_bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. )   ! must be done by all core 
     216      IF( ln_listonly )   CALL bestpartition( MAX(mppsize,jpni*jpnj), ldlist = .TRUE. )   ! must be done by all core 
    211217      ! 
    212218      !  1. Dimension arrays for subdomains 
    213219      ! ----------------------------------- 
    214220      ! 
    215       ! If dimensions of processor grid weren't specified in the namelist file 
     221      ! If dimensions of processors grid weren't specified in the namelist file 
    216222      ! then we calculate them here now that we have our communicator size 
    217223      IF(lwp) THEN 
    … …  
    221227      ENDIF 
    222228      IF( jpni < 1 .OR. jpnj < 1 ) THEN 
    223          CALL mpp_init_bestpartition( mppsize, jpni, jpnj )           ! best mpi decomposition for mppsize mpi processes 
     229         CALL bestpartition( mppsize, jpni, jpnj )           ! best mpi decomposition for mppsize mpi processes 
    224230         llauto = .TRUE. 
    225231         llbest = .TRUE. 
    226232      ELSE 
    227233         llauto = .FALSE. 
    228          CALL mpp_init_bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes 
     234         CALL bestpartition( mppsize, inbi, inbj, icnt2 )    ! best mpi decomposition for mppsize mpi processes 
    229235         ! largest subdomain size for mpi decoposition jpni*jpnj given in the namelist 
    230          CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax ) 
    231          ! largest subdomain size for mpi decoposition inbi*inbj given by mpp_init_bestpartition 
    232          CALL mpp_basic_decomposition( inbi, inbj,  iimax,  ijmax ) 
     236         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax ) 
     237         ! largest subdomain size for mpi decoposition inbi*inbj given by bestpartition 
     238         CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, inbi, inbj,  iimax,  ijmax ) 
    233239         icnt1 = jpni*jpnj - mppsize   ! number of land subdomains that should be removed to use mppsize mpi processes 
    234240         IF(lwp) THEN 
    … …  
    261267      ! look for land mpi subdomains... 
    262268      ALLOCATE( llisoce(jpni,jpnj) ) 
    263       CALL mpp_init_isoce( jpni, jpnj, llisoce ) 
     269      CALL mpp_is_ocean( llisoce ) 
    264270      inijmin = COUNT( llisoce )   ! number of oce subdomains 
    265271 
    … …  
    270276         WRITE(ctmp4,*) '   ==>>> There is the list of best domain decompositions you should use: ' 
    271277         CALL ctl_stop( ctmp1, ctmp2, ctmp3, ' ', ctmp4, ' ' ) 
    272          CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
     278         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
    273279      ENDIF 
    274280 
    … …  
    294300            WRITE(numout,*) 
    295301         ENDIF 
    296          CALL mpp_init_bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
     302         CALL bestpartition( mppsize, ldlist = .TRUE. )   ! must be done by all core 
    297303      ENDIF 
    298304 
    … …  
    3193259003  FORMAT (a, i5) 
    320326 
    321       IF( numbot /= -1 )   CALL iom_close( numbot ) 
    322       IF( numbdy /= -1 )   CALL iom_close( numbdy ) 
    323      
    324       ALLOCATE(  nfiimpp(jpni,jpnj), nfipproc(jpni,jpnj), nfilcit(jpni,jpnj) ,    & 
    325          &       nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,    & 
    326          &       njmppt(jpnij) , ibonjt(jpnij) , nldit(jpnij) , nldjt(jpnij) ,    & 
    327          &                                       nleit(jpnij) , nlejt(jpnij) ,    & 
     327      ALLOCATE(  nfimpp(jpni ) , nfproc(jpni ) ,   nfjpi(jpni ) ,                     & 
     328         &       nimppt(jpnij) , ibonit(jpnij) ,  jpiall(jpnij) ,  jpjall(jpnij) ,    & 
     329         &       njmppt(jpnij) , ibonjt(jpnij) , nis0all(jpnij) , njs0all(jpnij) ,    & 
     330         &                                       nie0all(jpnij) , nje0all(jpnij) ,    & 
    328331         &       iin(jpnij), ii_nono(jpnij), ii_noea(jpnij),   & 
    329332         &       ijn(jpnij), ii_noso(jpnij), ii_nowe(jpnij),   & 
    330          &       iimppt(jpni,jpnj), ilci(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   & 
    331          &       ijmppt(jpni,jpnj), ilcj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   & 
    332          &       ilei(jpni,jpnj), ildi(jpni,jpnj), iono(jpni,jpnj), ioea(jpni,jpnj),   & 
    333          &       ilej(jpni,jpnj), ildj(jpni,jpnj), ioso(jpni,jpnj), iowe(jpni,jpnj),   & 
     333         &       iimppt(jpni,jpnj), ijpi(jpni,jpnj), ibondi(jpni,jpnj), ipproc(jpni,jpnj),   & 
     334         &       ijmppt(jpni,jpnj), ijpj(jpni,jpnj), ibondj(jpni,jpnj), ipolj(jpni,jpnj),   & 
     335         &         iie0(jpni,jpnj), iis0(jpni,jpnj),   iono(jpni,jpnj),  ioea(jpni,jpnj),   & 
     336         &         ije0(jpni,jpnj), ijs0(jpni,jpnj),   ioso(jpni,jpnj),  iowe(jpni,jpnj),   & 
    334337         &       STAT=ierr ) 
    335338      CALL mpp_sum( 'mppini', ierr ) 
    … …  
    345348      ! ----------------------------------- 
    346349      ! 
    347       nreci = 2 * nn_hls 
    348       nrecj = 2 * nn_hls 
    349       CALL mpp_basic_decomposition( jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ilci, ilcj ) 
    350       nfiimpp(:,:) = iimppt(:,:) 
    351       nfilcit(:,:) = ilci(:,:) 
     350      CALL mpp_basesplit( jpiglo, jpjglo, nn_hls, jpni, jpnj, jpimax, jpjmax, iimppt, ijmppt, ijpi, ijpj ) 
     351      CALL mpp_getnum( llisoce, ipproc, iin, ijn ) 
     352      ! 
     353      !DO jn = 1, jpni 
     354      !   jproc = ipproc(jn,jpnj) 
     355      !   ii = iin(jproc+1) 
     356      !   ij = ijn(jproc+1) 
     357      !   nfproc(jn) = jproc 
     358      !   nfimpp(jn) = iimppt(ii,ij) 
     359      !   nfjpi (jn) =   ijpi(ii,ij) 
     360      !END DO 
     361      nfproc(:) = ipproc(:,jpnj)  
     362      nfimpp(:) = iimppt(:,jpnj)  
     363      nfjpi (:) =   ijpi(:,jpnj) 
    352364      ! 
    353365      IF(lwp) THEN 
    … …  
    358370         WRITE(numout,*) '      jpni = ', jpni   
    359371         WRITE(numout,*) '      jpnj = ', jpnj 
     372         WRITE(numout,*) '     jpnij = ', jpnij 
    360373         WRITE(numout,*) 
    361          WRITE(numout,*) '      sum ilci(i,1) = ', sum(ilci(:,1)), ' jpiglo = ', jpiglo 
    362          WRITE(numout,*) '      sum ilcj(1,j) = ', sum(ilcj(1,:)), ' jpjglo = ', jpjglo 
     374         WRITE(numout,*) '      sum ijpi(i,1) = ', sum(ijpi(:,1)), ' jpiglo = ', jpiglo 
     375         WRITE(numout,*) '      sum ijpj(1,j) = ', sum(ijpj(1,:)), ' jpjglo = ', jpjglo 
    363376      ENDIF 
    364377      
    … …  
    375388         ii = 1 + MOD(iarea0,jpni) 
    376389         ij = 1 +     iarea0/jpni 
    377          ili = ilci(ii,ij) 
    378          ilj = ilcj(ii,ij) 
     390         ili = ijpi(ii,ij) 
     391         ilj = ijpj(ii,ij) 
    379392         ibondi(ii,ij) = 0                         ! default: has e-w neighbours 
    380393         IF( ii   ==    1 )   ibondi(ii,ij) = -1   ! first column, has only e neighbour 
    … …  
    391404         ioea(ii,ij) = iarea0 + 1 
    392405         iono(ii,ij) = iarea0 + jpni 
    393          ildi(ii,ij) =  1  + nn_hls 
    394          ilei(ii,ij) = ili - nn_hls 
    395          ildj(ii,ij) =  1  + nn_hls 
    396          ilej(ii,ij) = ilj - nn_hls 
     406         iis0(ii,ij) =  1  + nn_hls 
     407         iie0(ii,ij) = ili - nn_hls 
     408         ijs0(ii,ij) =  1  + nn_hls 
     409         ije0(ii,ij) = ilj - nn_hls 
    397410 
    398411         ! East-West periodicity: change ibondi, ioea, iowe 
    … …  
    432445      ! ---------------------------- 
    433446      ! 
    434       ! specify which subdomains are oce subdomains; other are land subdomains 
    435       ipproc(:,:) = -1 
    436       icont = -1 
    437       DO jarea = 1, jpni*jpnj 
    438          iarea0 = jarea - 1 
    439          ii = 1 + MOD(iarea0,jpni) 
    440          ij = 1 +     iarea0/jpni 
    441          IF( llisoce(ii,ij) ) THEN 
    442             icont = icont + 1 
    443             ipproc(ii,ij) = icont 
    444             iin(icont+1) = ii 
    445             ijn(icont+1) = ij 
    446          ENDIF 
    447       END DO 
    448       ! if needed add some land subdomains to reach jpnij active subdomains 
    449       i2add = jpnij - inijmin 
    450       DO jarea = 1, jpni*jpnj 
    451          iarea0 = jarea - 1 
    452          ii = 1 + MOD(iarea0,jpni) 
    453          ij = 1 +     iarea0/jpni 
    454          IF( .NOT. llisoce(ii,ij) .AND. i2add > 0 ) THEN 
    455             icont = icont + 1 
    456             ipproc(ii,ij) = icont 
    457             iin(icont+1) = ii 
    458             ijn(icont+1) = ij 
    459             i2add = i2add - 1 
    460          ENDIF 
    461       END DO 
    462       nfipproc(:,:) = ipproc(:,:) 
    463  
    464447      ! neighbour treatment: change ibondi, ibondj if next to a land zone 
    465448      DO jarea = 1, jpni*jpnj 
    … …  
    500483         ENDIF 
    501484      END DO 
    502  
    503       ! Update il[de][ij] according to modified ibond[ij] 
    504       ! ---------------------- 
    505       DO jproc = 1, jpnij 
    506          ii = iin(jproc) 
    507          ij = ijn(jproc) 
    508          IF( ibondi(ii,ij) == -1 .OR. ibondi(ii,ij) == 2 ) ildi(ii,ij) =  1 
    509          IF( ibondi(ii,ij) ==  1 .OR. ibondi(ii,ij) == 2 ) ilei(ii,ij) = ilci(ii,ij) 
    510          IF( ibondj(ii,ij) == -1 .OR. ibondj(ii,ij) == 2 ) ildj(ii,ij) =  1 
    511          IF( ibondj(ii,ij) ==  1 .OR. ibondj(ii,ij) == 2 ) ilej(ii,ij) = ilcj(ii,ij) 
    512       END DO 
    513485       
    514486      ! 5. Subdomain print 
    … …  
    523495            DO jj = jpnj, 1, -1 
    524496               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
    525                WRITE(numout,9402) jj, (ilci(ji,jj),ilcj(ji,jj),ji=il1,il2) 
     497               WRITE(numout,9402) jj, (ijpi(ji,jj),ijpj(ji,jj),ji=il1,il2) 
    526498               WRITE(numout,9404) (ipproc(ji,jj),ji=il1,il2) 
    527499               WRITE(numout,9403) ('   ',ji=il1,il2-1) 
    … …  
    580552      noea = ii_noea(narea) 
    581553      nono = ii_nono(narea) 
    582       nlci = ilci(ii,ij)   
    583       nldi = ildi(ii,ij) 
    584       nlei = ilei(ii,ij) 
    585       nlcj = ilcj(ii,ij)   
    586       nldj = ildj(ii,ij) 
    587       nlej = ilej(ii,ij) 
     554      jpi    = ijpi(ii,ij)   
     555!!$      Nis0  = iis0(ii,ij) 
     556!!$      Nie0  = iie0(ii,ij) 
     557      jpj    = ijpj(ii,ij)   
     558!!$      Njs0  = ijs0(ii,ij) 
     559!!$      Nje0  = ije0(ii,ij) 
    588560      nbondi = ibondi(ii,ij) 
    589561      nbondj = ibondj(ii,ij) 
    590562      nimpp = iimppt(ii,ij)   
    591563      njmpp = ijmppt(ii,ij) 
    592       jpi = nlci 
    593       jpj = nlcj 
    594       jpk = jpkglo                                             ! third dim 
    595 #if defined key_agrif 
    596       ! simple trick to use same vertical grid as parent but different number of levels:  
    597       ! Save maximum number of levels in jpkglo, then define all vertical grids with this number. 
    598       ! Suppress once vertical online interpolation is ok 
    599 !!$      IF(.NOT.Agrif_Root())   jpkglo = Agrif_Parent( jpkglo ) 
    600 #endif 
    601       jpim1 = jpi-1                                            ! inner domain indices 
    602       jpjm1 = jpj-1                                            !   "           " 
    603       jpkm1 = MAX( 1, jpk-1 )                                  !   "           " 
    604       jpij  = jpi*jpj                                          !  jpi x j 
     564      jpk = jpkglo                              ! third dim 
     565      ! 
     566      CALL init_doloop                          ! set start/end indices of do-loop, depending on the halo width value (nn_hls)  
     567      ! 
     568      jpim1 = jpi-1                             ! inner domain indices 
     569      jpjm1 = jpj-1                             !   "           " 
     570      jpkm1 = MAX( 1, jpk-1 )                   !   "           " 
     571      jpij  = jpi*jpj                           !  jpi x j 
    605572      DO jproc = 1, jpnij 
    606573         ii = iin(jproc) 
    607574         ij = ijn(jproc) 
    608          nlcit(jproc) = ilci(ii,ij) 
    609          nldit(jproc) = ildi(ii,ij) 
    610          nleit(jproc) = ilei(ii,ij) 
    611          nlcjt(jproc) = ilcj(ii,ij) 
    612          nldjt(jproc) = ildj(ii,ij) 
    613          nlejt(jproc) = ilej(ii,ij) 
     575         jpiall (jproc) = ijpi(ii,ij) 
     576         nis0all(jproc) = iis0(ii,ij) 
     577         nie0all(jproc) = iie0(ii,ij) 
     578         jpjall (jproc) = ijpj(ii,ij) 
     579         njs0all(jproc) = ijs0(ii,ij) 
     580         nje0all(jproc) = ije0(ii,ij) 
    614581         ibonit(jproc) = ibondi(ii,ij) 
    615582         ibonjt(jproc) = ibondj(ii,ij) 
    … …  
    625592         WRITE(inum,'(6i8,a,3i8,a)') jpnij,jpimax,jpjmax,jpk,jpiglo,jpjglo,& 
    626593   &           ' ( local: ',narea,jpi,jpj,' )' 
    627          WRITE(inum,'(a)') 'nproc nlci nlcj nldi nldj nlei nlej nimp njmp nono noso nowe noea nbondi nbondj ' 
     594         WRITE(inum,'(a)') 'nproc jpi jpj Nis0 Njs0 Nie0 Nje0 nimp njmp nono noso nowe noea nbondi nbondj ' 
    628595 
    629596         DO jproc = 1, jpnij 
    630             WRITE(inum,'(13i5,2i7)')   jproc-1, nlcit  (jproc), nlcjt  (jproc),   & 
    631                &                                nldit  (jproc), nldjt  (jproc),   & 
    632                &                                nleit  (jproc), nlejt  (jproc),   & 
     597            WRITE(inum,'(13i5,2i7)')   jproc-1,  jpiall(jproc),  jpjall(jproc),   & 
     598               &                                nis0all(jproc), njs0all(jproc),   & 
     599               &                                nie0all(jproc), nje0all(jproc),   & 
    633600               &                                nimppt (jproc), njmppt (jproc),   &  
    634601               &                                ii_nono(jproc), ii_noso(jproc),   & 
    … …  
    664631         WRITE(numout,*) '    l_Iperio = ', l_Iperio 
    665632         WRITE(numout,*) '    l_Jperio = ', l_Jperio 
    666          WRITE(numout,*) '      nlci   = ', nlci 
    667          WRITE(numout,*) '      nlcj   = ', nlcj 
    668633         WRITE(numout,*) '      nimpp  = ', nimpp 
    669634         WRITE(numout,*) '      njmpp  = ', njmpp 
    670          WRITE(numout,*) '      nreci  = ', nreci   
    671          WRITE(numout,*) '      nrecj  = ', nrecj   
    672          WRITE(numout,*) '      nn_hls = ', nn_hls  
    673635      ENDIF 
    674636 
    … …  
    692654      ENDIF 
    693655      ! 
    694       CALL mpp_init_ioipsl       ! Prepare NetCDF output file (if necessary) 
     656      CALL init_ioipsl       ! Prepare NetCDF output file (if necessary) 
    695657      !       
    696658      IF (( jperio >= 3 .AND. jperio <= 6 .AND. jpni > 1 ).AND.( ln_nnogather )) THEN 
    697          CALL mpp_init_nfdcom     ! northfold neighbour lists 
     659         CALL init_nfdcom     ! northfold neighbour lists 
    698660         IF (llwrtlay) THEN 
    699661            WRITE(inum,*) 
    700662            WRITE(inum,*) 
    701663            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 
    702             WRITE(inum,*) 'nfsloop : ', nfsloop 
    703             WRITE(inum,*) 'nfeloop : ', nfeloop 
    704664            WRITE(inum,*) 'nsndto : ', nsndto 
    705665            WRITE(inum,*) 'isendto : ', isendto 
    … …  
    711671      DEALLOCATE(iin, ijn, ii_nono, ii_noea, ii_noso, ii_nowe,    & 
    712672         &       iimppt, ijmppt, ibondi, ibondj, ipproc, ipolj,   & 
    713          &       ilci, ilcj, ilei, ilej, ildi, ildj,              & 
     673         &       ijpi, ijpj, iie0, ije0, iis0, ijs0,              & 
    714674         &       iono, ioea, ioso, iowe, llisoce) 
    715675      ! 
    … …  
    717677 
    718678 
    719     SUBROUTINE mpp_basic_decomposition( knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
    720       !!---------------------------------------------------------------------- 
    721       !!                  ***  ROUTINE mpp_basic_decomposition  *** 
     679    SUBROUTINE mpp_basesplit( kiglo, kjglo, khls, knbi, knbj, kimax, kjmax, kimppt, kjmppt, klci, klcj) 
     680      !!---------------------------------------------------------------------- 
     681      !!                  ***  ROUTINE mpp_basesplit  *** 
    722682      !!                     
    723683      !! ** Purpose :   Lay out the global domain over processors. 
    … …  
    731691      !!                    klcj       : second dimension 
    732692      !!---------------------------------------------------------------------- 
     693      INTEGER,                                 INTENT(in   ) ::   kiglo, kjglo 
     694      INTEGER,                                 INTENT(in   ) ::   khls 
    733695      INTEGER,                                 INTENT(in   ) ::   knbi, knbj 
    734696      INTEGER,                                 INTENT(  out) ::   kimax, kjmax 
    … …  
    737699      ! 
    738700      INTEGER ::   ji, jj 
     701      INTEGER ::   i2hls  
    739702      INTEGER ::   iresti, irestj, irm, ijpjmin 
    740       INTEGER ::   ireci, irecj 
    741       !!---------------------------------------------------------------------- 
     703      !!---------------------------------------------------------------------- 
     704      i2hls = 2*khls 
    742705      ! 
    743706#if defined key_nemocice_decomp 
    744       kimax = ( nx_global+2-2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim. 
    745       kjmax = ( ny_global+2-2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim.  
     707      kimax = ( nx_global+2-i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     708      kjmax = ( ny_global+2-i2hls + (knbj-1) ) / knbj + i2hls    ! second dim.  
    746709#else 
    747       kimax = ( jpiglo - 2*nn_hls + (knbi-1) ) / knbi + 2*nn_hls    ! first  dim. 
    748       kjmax = ( jpjglo - 2*nn_hls + (knbj-1) ) / knbj + 2*nn_hls    ! second dim. 
     710      kimax = ( kiglo - i2hls + (knbi-1) ) / knbi + i2hls    ! first  dim. 
     711      kjmax = ( kjglo - i2hls + (knbj-1) ) / knbj + i2hls    ! second dim. 
    749712#endif 
    750713      IF( .NOT. PRESENT(kimppt) ) RETURN 
    … …  
    753716      ! ----------------------------------- 
    754717      !  Computation of local domain sizes klci() klcj() 
    755       !  These dimensions depend on global sizes knbi,knbj and jpiglo,jpjglo 
     718      !  These dimensions depend on global sizes knbi,knbj and kiglo,kjglo 
    756719      !  The subdomains are squares lesser than or equal to the global 
    757720      !  dimensions divided by the number of processors minus the overlap array. 
    758721      ! 
    759       ireci = 2 * nn_hls 
    760       irecj = 2 * nn_hls 
    761       iresti = 1 + MOD( jpiglo - ireci -1 , knbi ) 
    762       irestj = 1 + MOD( jpjglo - irecj -1 , knbj ) 
     722      iresti = 1 + MOD( kiglo - i2hls - 1 , knbi ) 
     723      irestj = 1 + MOD( kjglo - i2hls - 1 , knbj ) 
    763724      ! 
    764725      !  Need to use kimax and kjmax here since jpi and jpj not yet defined 
    765726#if defined key_nemocice_decomp 
    766727      ! Change padding to be consistent with CICE 
    767       klci(1:knbi-1      ,:) = kimax 
    768       klci(knbi          ,:) = jpiglo - (knbi - 1) * (kimax - nreci) 
    769       klcj(:,      1:knbj-1) = kjmax 
    770       klcj(:,          knbj) = jpjglo - (knbj - 1) * (kjmax - nrecj) 
     728      klci(1:knbi-1,:       ) = kimax 
     729      klci(  knbi  ,:       ) = kiglo - (knbi - 1) * (kimax - i2hls) 
     730      klcj(:       ,1:knbj-1) = kjmax 
     731      klcj(:       ,  knbj  ) = kjglo - (knbj - 1) * (kjmax - i2hls) 
    771732#else 
    772733      klci(1:iresti      ,:) = kimax 
    773734      klci(iresti+1:knbi ,:) = kimax-1 
    774       IF( MINVAL(klci) < 3 ) THEN 
    775          WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpi must be >= 3' 
     735      IF( MINVAL(klci) < 2*i2hls ) THEN 
     736         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpi must be >= ', 2*i2hls 
    776737         WRITE(ctmp2,*) '   We have ', MINVAL(klci) 
    777738        CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    779740      IF( jperio == 3 .OR. jperio == 4 .OR. jperio == 5 .OR. jperio == 6 ) THEN 
    780741         ! minimize the size of the last row to compensate for the north pole folding coast 
    781          IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 5   ! V and F folding involves line jpj-3 that must not be south boundary 
    782          IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 4   ! V and F folding involves line jpj-2 that must not be south boundary 
    783          irm = knbj - irestj                                    ! total number of lines to be removed 
    784          klcj(:,            knbj) = MAX( ijpjmin, kjmax-irm )   ! we must have jpj >= ijpjmin in the last row 
    785          irm = irm - ( kjmax - klcj(1,knbj) )                   ! remaining number of lines to remove  
    786          irestj = knbj - 1 - irm                         
    787          klcj(:,        1:irestj) = kjmax 
     742         IF( jperio == 3 .OR. jperio == 4 )   ijpjmin = 2+3*khls   ! V and F folding must be outside of southern halos 
     743         IF( jperio == 5 .OR. jperio == 6 )   ijpjmin = 1+3*khls   ! V and F folding must be outside of southern halos 
     744         irm = knbj - irestj                                       ! total number of lines to be removed 
     745         klcj(:,knbj) = MAX( ijpjmin, kjmax-irm )                  ! we must have jpj >= ijpjmin in the last row 
     746         irm = irm - ( kjmax - klcj(1,knbj) )                      ! remaining number of lines to remove  
     747         irestj = knbj - 1 - irm 
    788748         klcj(:, irestj+1:knbj-1) = kjmax-1 
    789749      ELSE 
    790          ijpjmin = 3 
    791          klcj(:,      1:irestj) = kjmax 
    792          klcj(:, irestj+1:knbj) = kjmax-1 
    793       ENDIF 
    794       IF( MINVAL(klcj) < ijpjmin ) THEN 
    795          WRITE(ctmp1,*) '   mpp_basic_decomposition: minimum value of jpj must be >= ', ijpjmin 
     750         klcj(:, irestj+1:knbj  ) = kjmax-1 
     751      ENDIF 
     752      klcj(:,1:irestj) = kjmax 
     753      IF( MINVAL(klcj) < 2*i2hls ) THEN 
     754         WRITE(ctmp1,*) '   mpp_basesplit: minimum value of jpj must be >= ', 2*i2hls 
    796755         WRITE(ctmp2,*) '   We have ', MINVAL(klcj) 
    797756         CALL ctl_stop( 'STOP', ctmp1, ctmp2 ) 
    … …  
    807766         DO jj = 1, knbj 
    808767            DO ji = 2, knbi 
    809                kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - ireci 
     768               kimppt(ji,jj) = kimppt(ji-1,jj) + klci(ji-1,jj) - i2hls 
    810769            END DO 
    811770         END DO 
    … …  
    815774         DO jj = 2, knbj 
    816775            DO ji = 1, knbi 
    817                kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - irecj 
     776               kjmppt(ji,jj) = kjmppt(ji,jj-1) + klcj(ji,jj-1) - i2hls 
    818777            END DO 
    819778         END DO 
    820779      ENDIF 
    821780       
    822    END SUBROUTINE mpp_basic_decomposition 
    823  
    824  
    825    SUBROUTINE mpp_init_bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) 
    826       !!---------------------------------------------------------------------- 
    827       !!                 ***  ROUTINE mpp_init_bestpartition  *** 
     781   END SUBROUTINE mpp_basesplit 
     782 
     783 
     784   SUBROUTINE bestpartition( knbij, knbi, knbj, knbcnt, ldlist ) 
     785      !!---------------------------------------------------------------------- 
     786      !!                 ***  ROUTINE bestpartition  *** 
    828787      !! 
    829788      !! ** Purpose : 
    … …  
    867826      inbimax = 0 
    868827      inbjmax = 0 
    869       isziref = jpiglo*jpjglo+1 
    870       iszjref = jpiglo*jpjglo+1 
     828      isziref = Ni0glo*Nj0glo+1 
     829      iszjref = Ni0glo*Nj0glo+1 
    871830      ! 
    872831      ! get the list of knbi that gives a smaller jpimax than knbi-1 
    … …  
    876835         iszitst = ( nx_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    877836#else 
    878          iszitst = ( jpiglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls 
     837         iszitst = ( Ni0glo + (ji-1) ) / ji + 2*nn_hls 
    879838#endif 
    880839         IF( iszitst < isziref ) THEN 
    … …  
    887846         iszjtst = ( ny_global+2-2*nn_hls + (ji-1) ) / ji + 2*nn_hls    ! first  dim. 
    888847#else 
    889          iszjtst = ( jpjglo - 2*nn_hls + (ji-1) ) / ji + 2*nn_hls 
     848         iszjtst = ( Nj0glo + (ji-1) ) / ji + 2*nn_hls 
    890849#endif 
    891850         IF( iszjtst < iszjref ) THEN 
    … …  
    927886      iszij1(:) = iszi1(:) * iszj1(:) 
    928887 
    929       ! if therr is no land and no print 
     888      ! if there is no land and no print 
    930889      IF( .NOT. llist .AND. numbot == -1 .AND. numbdy == -1 ) THEN 
    931890         ! get the smaller partition which gives the smallest subdomain size 
    … …  
    942901      isz0 = 0                                                  ! number of best partitions      
    943902      inbij = 1                                                 ! start with the min value of inbij1 => 1 
    944       iszij = jpiglo*jpjglo+1                                   ! default: larger than global domain 
     903      iszij = Ni0glo*Nj0glo+1                                   ! default: larger than global domain 
    945904      DO WHILE( inbij <= inbijmax )                             ! if we did not reach the max of inbij1 
    946905         ii = MINLOC(iszij1, mask = inbij1 == inbij, dim = 1)   ! warning: send back the first occurence if multiple results 
    … …  
    975934         ji = isz0   ! initialization with the largest value 
    976935         ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    977          CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     936         CALL mpp_is_ocean( llisoce )  ! Warning: must be call by all cores (call mpp_sum) 
    978937         inbijold = COUNT(llisoce) 
    979938         DEALLOCATE( llisoce ) 
    980939         DO ji =isz0-1,1,-1 
    981940            ALLOCATE( llisoce(inbi0(ji), inbj0(ji)) ) 
    982             CALL mpp_init_isoce( inbi0(ji), inbj0(ji), llisoce ) ! Warning: must be call by all cores (call mpp_sum) 
     941            CALL mpp_is_ocean( llisoce )  ! Warning: must be call by all cores (call mpp_sum) 
    983942            inbij = COUNT(llisoce) 
    984943            DEALLOCATE( llisoce ) 
    … …  
    1006965         ii = ii -1  
    1007966         ALLOCATE( llisoce(inbi0(ii), inbj0(ii)) ) 
    1008          CALL mpp_init_isoce( inbi0(ii), inbj0(ii), llisoce )            ! must be done by all core 
     967         CALL mpp_is_ocean( llisoce )            ! must be done by all core 
    1009968         inbij = COUNT(llisoce) 
    1010969         DEALLOCATE( llisoce ) 
    … …  
    1015974      DEALLOCATE( inbi0, inbj0 ) 
    1016975      ! 
    1017    END SUBROUTINE mpp_init_bestpartition 
     976   END SUBROUTINE bestpartition 
    1018977    
    1019978    
    … …  
    1024983      !! ** Purpose : the the proportion of land points in the surface land-sea mask 
    1025984      !! 
    1026       !! ** Method  : read iproc strips (of length jpiglo) of the land-sea mask 
     985      !! ** Method  : read iproc strips (of length Ni0glo) of the land-sea mask 
    1027986      !!---------------------------------------------------------------------- 
    1028987      REAL(wp), INTENT(  out) :: propland    ! proportion of land points in the global domain (between 0 and 1) 
    … …  
    10411000 
    10421001      ! number of processes reading the bathymetry file  
    1043       iproc = MINVAL( (/mppsize, jpjglo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time 
     1002      iproc = MINVAL( (/mppsize, Nj0glo/2, 100/) )  ! read a least 2 lines, no more that 100 processes reading at the same time 
    10441003       
    10451004      ! we want to read iproc strips of the land-sea mask. -> pick up iproc processes every idiv processes starting at 1 
    … …  
    10511010      IF( MOD( narea-1, idiv ) == 0 .AND. iarea < iproc ) THEN   ! beware idiv can be = to 1 
    10521011         ! 
    1053          ijsz = jpjglo / iproc                                               ! width of the stripe to read 
    1054          IF( iarea < MOD(jpjglo,iproc) ) ijsz = ijsz + 1 
    1055          ijstr = iarea*(jpjglo/iproc) + MIN(iarea, MOD(jpjglo,iproc)) + 1    ! starting j position of the reading 
    1056          ! 
    1057          ALLOCATE( lloce(jpiglo, ijsz) )                                     ! allocate the strip 
    1058          CALL mpp_init_readbot_strip( ijstr, ijsz, lloce ) 
     1012         ijsz = Nj0glo / iproc                                               ! width of the stripe to read 
     1013         IF( iarea < MOD(Nj0glo,iproc) ) ijsz = ijsz + 1 
     1014         ijstr = iarea*(Nj0glo/iproc) + MIN(iarea, MOD(Nj0glo,iproc)) + 1    ! starting j position of the reading 
     1015         ! 
     1016         ALLOCATE( lloce(Ni0glo, ijsz) )                                     ! allocate the strip 
     1017         CALL readbot_strip( ijstr, ijsz, lloce ) 
    10591018         inboce = COUNT(lloce)                                               ! number of ocean point in the stripe 
    10601019         DEALLOCATE(lloce) 
    … …  
    10651024      CALL mpp_sum( 'mppini', inboce )   ! total number of ocean points over the global domain 
    10661025      ! 
    1067       propland = REAL( jpiglo*jpjglo - inboce, wp ) / REAL( jpiglo*jpjglo, wp )  
     1026      propland = REAL( Ni0glo*Nj0glo - inboce, wp ) / REAL( Ni0glo*Nj0glo, wp )  
    10681027      ! 
    10691028   END SUBROUTINE mpp_init_landprop 
    10701029    
    10711030    
    1072    SUBROUTINE mpp_init_isoce( knbi, knbj, ldisoce ) 
    1073       !!---------------------------------------------------------------------- 
    1074       !!                  ***  ROUTINE mpp_init_nboce  *** 
    1075       !! 
    1076       !! ** Purpose : check for a mpi domain decomposition knbi x knbj which 
    1077       !!              subdomains contain at least 1 ocean point 
    1078       !! 
    1079       !! ** Method  : read knbj strips (of length jpiglo) of the land-sea mask 
    1080       !!---------------------------------------------------------------------- 
    1081       INTEGER,                       INTENT(in   ) ::   knbi, knbj     ! domain decomposition 
    1082       LOGICAL, DIMENSION(knbi,knbj), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
    1083       ! 
    1084       INTEGER, DIMENSION(knbi,knbj) ::   inboce                        ! number oce oce pint in each mpi subdomain 
    1085       INTEGER, DIMENSION(knbi*knbj) ::   inboce_1d 
     1031   SUBROUTINE mpp_is_ocean( ldisoce ) 
     1032      !!---------------------------------------------------------------------- 
     1033      !!                  ***  ROUTINE mpp_is_ocean  *** 
     1034      !! 
     1035      !! ** Purpose : Check for a mpi domain decomposition inbi x inbj which 
     1036      !!              subdomains, including 1 halo (even if nn_hls>1), contain 
     1037      !!              at least 1 ocean point. 
     1038      !!              We must indeed ensure that each subdomain that is a neighbour 
     1039      !!              of a land subdomain as only land points on its boundary 
     1040      !!              (inside the inner subdomain) with the land subdomain. 
     1041      !!              This is needed to get the proper bondary conditions on 
     1042      !!              a subdomain with a closed boundary. 
     1043      !! 
     1044      !! ** Method  : read inbj strips (of length Ni0glo) of the land-sea mask 
     1045      !!---------------------------------------------------------------------- 
     1046      LOGICAL, DIMENSION(:,:), INTENT(  out) ::   ldisoce        ! .true. if a sub domain constains 1 ocean point  
     1047      ! 
    10861048      INTEGER :: idiv, iimax, ijmax, iarea 
     1049      INTEGER :: inbi, inbj, inx, iny, inry, isty 
    10871050      INTEGER :: ji, jn 
    1088       LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce                  ! lloce(i,j) = .true. if the point (i,j) is ocean  
    1089       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ilci 
    1090       INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ilcj 
     1051      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   inboce           ! number oce oce pint in each mpi subdomain 
     1052      INTEGER, ALLOCATABLE, DIMENSION(:  ) ::   inboce_1d 
     1053      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   iimppt, ijpi 
     1054      INTEGER, ALLOCATABLE, DIMENSION(:,:) ::   ijmppt, ijpj 
     1055      LOGICAL, ALLOCATABLE, DIMENSION(:,:) ::   lloce            ! lloce(i,j) = .true. if the point (i,j) is ocean  
    10911056      !!---------------------------------------------------------------------- 
    10921057      ! do nothing if there is no land-sea mask 
    … …  
    10951060         RETURN 
    10961061      ENDIF 
    1097  
    1098       ! we want to read knbj strips of the land-sea mask. -> pick up knbj processes every idiv processes starting at 1 
    1099       IF           ( knbj == 1 ) THEN   ;   idiv = mppsize 
    1100       ELSE IF ( mppsize < knbj ) THEN   ;   idiv = 1 
    1101       ELSE                              ;   idiv = ( mppsize - 1 ) / ( knbj - 1 ) 
    1102       ENDIF 
     1062      ! 
     1063      inbi = SIZE( ldisoce, dim = 1 ) 
     1064      inbj = SIZE( ldisoce, dim = 2 ) 
     1065      ! 
     1066      ! we want to read inbj strips of the land-sea mask. -> pick up inbj processes every idiv processes starting at 1 
     1067      IF           ( inbj == 1 ) THEN   ;   idiv = mppsize 
     1068      ELSE IF ( mppsize < inbj ) THEN   ;   idiv = 1 
     1069      ELSE                              ;   idiv = ( mppsize - 1 ) / ( inbj - 1 ) 
     1070      ENDIF 
     1071      ! 
     1072      ALLOCATE( inboce(inbi,inbj), inboce_1d(inbi*inbj) ) 
    11031073      inboce(:,:) = 0          ! default no ocean point found 
    1104  
    1105       DO jn = 0, (knbj-1)/mppsize   ! if mppsize < knbj : more strips than mpi processes (because of potential land domains) 
    1106          ! 
    1107          iarea = (narea-1)/idiv + jn * mppsize   ! involed process number (starting counting at 0) 
    1108          IF( MOD( narea-1, idiv ) == 0 .AND. iarea < knbj ) THEN   ! beware idiv can be = to 1 
     1074      ! 
     1075      DO jn = 0, (inbj-1)/mppsize   ! if mppsize < inbj : more strips than mpi processes (because of potential land domains) 
     1076         ! 
     1077         iarea = (narea-1)/idiv + jn * mppsize + 1                     ! involed process number (starting counting at 1) 
     1078         IF( MOD( narea-1, idiv ) == 0 .AND. iarea <= inbj ) THEN      ! beware idiv can be = to 1 
    11091079            ! 
    1110             ALLOCATE( iimppt(knbi,knbj), ijmppt(knbi,knbj), ilci(knbi,knbj), ilcj(knbi,knbj) ) 
    1111             CALL mpp_basic_decomposition( knbi, knbj, iimax, ijmax, iimppt, ijmppt, ilci, ilcj ) 
     1080            ALLOCATE( iimppt(inbi,inbj), ijmppt(inbi,inbj), ijpi(inbi,inbj), ijpj(inbi,inbj) ) 
     1081            CALL mpp_basesplit( Ni0glo, Nj0glo, 0, inbi, inbj, iimax, ijmax, iimppt, ijmppt, ijpi, ijpj ) 
    11121082            ! 
    1113             ALLOCATE( lloce(jpiglo, ilcj(1,iarea+1)) )                                         ! allocate the strip 
    1114             CALL mpp_init_readbot_strip( ijmppt(1,iarea+1), ilcj(1,iarea+1), lloce )           ! read the strip 
    1115             DO  ji = 1, knbi 
    1116                inboce(ji,iarea+1) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ilci(ji,1)-1,:) )   ! number of ocean point in subdomain 
     1083            inx = Ni0glo + 2   ;   iny = ijpj(1,iarea) + 2             ! strip size + 1 halo on each direction (even if nn_hls>1) 
     1084            ALLOCATE( lloce(inx, iny) )                                ! allocate the strip 
     1085            inry = iny - COUNT( (/ iarea == 1, iarea == inbj /) )      ! number of point to read in y-direction 
     1086            isty = 1 + COUNT( (/ iarea == 1 /) )                       ! read from the first or the second line? 
     1087            CALL readbot_strip( ijmppt(1,iarea) - 2 + isty, inry, lloce(2:inx-1, isty:inry+isty-1) )   ! read the strip 
     1088            !  
     1089            IF( iarea == 1    ) THEN                                   ! the first line was not read 
     1090               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
     1091                  CALL readbot_strip( Nj0glo, 1, lloce(2:inx-1, 1) )   !   read the last line -> first line of lloce 
     1092               ELSE 
     1093                  lloce(2:inx-1,  1) = .FALSE.                         !   closed boundary 
     1094               ENDIF 
     1095            ENDIF 
     1096            IF( iarea == inbj ) THEN                                   ! the last line was not read 
     1097               IF( jperio == 2 .OR. jperio == 7 ) THEN                 !   north-south periodocity 
     1098                  CALL readbot_strip( 1, 1, lloce(2:inx-1,iny) )       !      read the first line -> last line of lloce 
     1099               ELSEIF( jperio == 3 .OR. jperio == 4 ) THEN             !   north-pole folding T-pivot, T-point  
     1100                  lloce(2,iny) = lloce(2,iny-2)                        !      here we have 1 halo (even if nn_hls>1) 
     1101                  DO ji = 3,inx-1 
     1102                     lloce(ji,iny  ) = lloce(inx-ji+2,iny-2)           !      ok, we have at least 3 lines 
     1103                  END DO 
     1104                  DO ji = inx/2+2,inx-1 
     1105                     lloce(ji,iny-1) = lloce(inx-ji+2,iny-1) 
     1106                  END DO 
     1107               ELSEIF( jperio == 5 .OR. jperio == 6 ) THEN             !   north-pole folding F-pivot, T-point, 1 halo 
     1108                  lloce(inx/2+1,iny-1) = lloce(inx/2,iny-1)            !      here we have 1 halo (even if nn_hls>1) 
     1109                  lloce(inx  -1,iny-1) = lloce(2    ,iny-1) 
     1110                  DO ji = 2,inx-1 
     1111                     lloce(ji,iny) = lloce(inx-ji+1,iny-1) 
     1112                  END DO 
     1113               ELSE                                                    !   closed boundary 
     1114                  lloce(2:inx-1,iny) = .FALSE. 
     1115               ENDIF 
     1116            ENDIF 
     1117            !                                                          ! first and last column were not read 
     1118            IF( jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 ) THEN 
     1119               lloce(1,:) = lloce(inx-1,:)   ;   lloce(inx,:) = lloce(2,:)   ! east-west periodocity 
     1120            ELSE 
     1121               lloce(1,:) = .FALSE.          ;   lloce(inx,:) = .FALSE.      ! closed boundary 
     1122            ENDIF 
     1123            ! 
     1124            DO  ji = 1, inbi 
     1125               inboce(ji,iarea) = COUNT( lloce(iimppt(ji,1):iimppt(ji,1)+ijpi(ji,1)+1,:) )   ! lloce as 2 points more than Ni0glo 
    11171126            END DO 
    11181127            ! 
    11191128            DEALLOCATE(lloce) 
    1120             DEALLOCATE(iimppt, ijmppt, ilci, ilcj) 
     1129            DEALLOCATE(iimppt, ijmppt, ijpi, ijpj) 
    11211130            ! 
    11221131         ENDIF 
    11231132      END DO 
    11241133    
    1125       inboce_1d = RESHAPE(inboce, (/ knbi*knbj /)) 
     1134      inboce_1d = RESHAPE(inboce, (/ inbi*inbj /)) 
    11261135      CALL mpp_sum( 'mppini', inboce_1d ) 
    1127       inboce = RESHAPE(inboce_1d, (/knbi, knbj/)) 
     1136      inboce = RESHAPE(inboce_1d, (/inbi, inbj/)) 
    11281137      ldisoce(:,:) = inboce(:,:) /= 0 
    1129       ! 
    1130    END SUBROUTINE mpp_init_isoce 
     1138      DEALLOCATE(inboce, inboce_1d) 
     1139      ! 
     1140   END SUBROUTINE mpp_is_ocean 
    11311141    
    11321142    
    1133    SUBROUTINE mpp_init_readbot_strip( kjstr, kjcnt, ldoce ) 
    1134       !!---------------------------------------------------------------------- 
    1135       !!                  ***  ROUTINE mpp_init_readbot_strip  *** 
     1143   SUBROUTINE readbot_strip( kjstr, kjcnt, ldoce ) 
     1144      !!---------------------------------------------------------------------- 
     1145      !!                  ***  ROUTINE readbot_strip  *** 
    11361146      !! 
    11371147      !! ** Purpose : Read relevant bathymetric information in order to 
    … …  
    11391149      !!              of land domains, in an mpp computation. 
    11401150      !! 
    1141       !! ** Method  : read stipe of size (jpiglo,...) 
    1142       !!---------------------------------------------------------------------- 
    1143       INTEGER                         , INTENT(in   ) :: kjstr       ! starting j position of the reading 
    1144       INTEGER                         , INTENT(in   ) :: kjcnt       ! number of lines to read 
    1145       LOGICAL, DIMENSION(jpiglo,kjcnt), INTENT(  out) :: ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
     1151      !! ** Method  : read stipe of size (Ni0glo,...) 
     1152      !!---------------------------------------------------------------------- 
     1153      INTEGER                         , INTENT(in   ) ::   kjstr       ! starting j position of the reading 
     1154      INTEGER                         , INTENT(in   ) ::   kjcnt       ! number of lines to read 
     1155      LOGICAL, DIMENSION(Ni0glo,kjcnt), INTENT(  out) ::  ldoce       ! ldoce(i,j) = .true. if the point (i,j) is ocean  
    11461156      ! 
    11471157      INTEGER                           ::   inumsave                ! local logical unit 
    1148       REAL(wp), DIMENSION(jpiglo,kjcnt) ::   zbot, zbdy  
     1158      REAL(wp), DIMENSION(Ni0glo,kjcnt) ::   zbot, zbdy  
    11491159      !!---------------------------------------------------------------------- 
    11501160      ! 
    11511161      inumsave = numout   ;   numout = numnul   !   redirect all print to /dev/null 
    11521162      ! 
    1153       IF( numbot /= -1 ) THEN 
    1154          CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) ) 
     1163      IF( numbot /= -1 ) THEN    
     1164         CALL iom_get( numbot, jpdom_unknown, 'bottom_level', zbot, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    11551165      ELSE 
    1156          zbot(:,:) = 1.                         ! put a non-null value 
    1157       ENDIF 
    1158  
    1159        IF( numbdy /= -1 ) THEN                  ! Adjust with bdy_msk if it exists     
    1160          CALL iom_get ( numbdy, jpdom_unknown, 'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/jpiglo, kjcnt/) ) 
     1166         zbot(:,:) = 1._wp                      ! put a non-null value 
     1167      ENDIF 
     1168      ! 
     1169      IF( numbdy /= -1 ) THEN                   ! Adjust with bdy_msk if it exists     
     1170         CALL iom_get ( numbdy, jpdom_unknown,     'bdy_msk', zbdy, kstart = (/1,kjstr/), kcount = (/Ni0glo, kjcnt/) ) 
    11611171         zbot(:,:) = zbot(:,:) * zbdy(:,:) 
    11621172      ENDIF 
    11631173      ! 
    1164       ldoce(:,:) = zbot(:,:) > 0. 
     1174      ldoce(:,:) = zbot(:,:) > 0._wp 
    11651175      numout = inumsave 
    11661176      ! 
    1167    END SUBROUTINE mpp_init_readbot_strip 
    1168  
    1169  
    1170    SUBROUTINE mpp_init_ioipsl 
    1171       !!---------------------------------------------------------------------- 
    1172       !!                  ***  ROUTINE mpp_init_ioipsl  *** 
     1177   END SUBROUTINE readbot_strip 
     1178 
     1179 
     1180   SUBROUTINE mpp_getnum( ldisoce, kproc, kipos, kjpos ) 
     1181      !!---------------------------------------------------------------------- 
     1182      !!                  ***  ROUTINE mpp_getnum  *** 
     1183      !! 
     1184      !! ** Purpose : give a number to each MPI subdomains (starting at 0) 
     1185      !! 
     1186      !! ** Method  : start from bottom left. First skip land subdomain, and finally use them if needed 
     1187      !!---------------------------------------------------------------------- 
     1188      LOGICAL, DIMENSION(:,:), INTENT(in   ) ::   ldisoce     ! F if land process 
     1189      INTEGER, DIMENSION(:,:), INTENT(  out) ::   kproc       ! subdomain number (-1 if supressed, starting at 0) 
     1190      INTEGER, DIMENSION(  :), INTENT(  out) ::   kipos       ! i-position of the subdomain (from 1 to jpni) 
     1191      INTEGER, DIMENSION(  :), INTENT(  out) ::   kjpos       ! j-position of the subdomain (from 1 to jpnj) 
     1192      ! 
     1193      INTEGER :: ii, ij, jarea, iarea0 
     1194      INTEGER :: icont, i2add , ini, inj, inij 
     1195      !!---------------------------------------------------------------------- 
     1196      ! 
     1197      ini = SIZE(ldisoce, dim = 1) 
     1198      inj = SIZE(ldisoce, dim = 2) 
     1199      inij = SIZE(kipos) 
     1200      ! 
     1201      ! specify which subdomains are oce subdomains; other are land subdomains 
     1202      kproc(:,:) = -1 
     1203      icont = -1 
     1204      DO jarea = 1, ini*inj 
     1205         iarea0 = jarea - 1 
     1206         ii = 1 + MOD(iarea0,ini) 
     1207         ij = 1 +     iarea0/ini 
     1208         IF( ldisoce(ii,ij) ) THEN 
     1209            icont = icont + 1 
     1210            kproc(ii,ij) = icont 
     1211            kipos(icont+1) = ii 
     1212            kjpos(icont+1) = ij 
     1213         ENDIF 
     1214      END DO 
     1215      ! if needed add some land subdomains to reach inij active subdomains 
     1216      i2add = inij - COUNT( ldisoce ) 
     1217      DO jarea = 1, ini*inj 
     1218         iarea0 = jarea - 1 
     1219         ii = 1 + MOD(iarea0,ini) 
     1220         ij = 1 +     iarea0/ini 
     1221         IF( .NOT. ldisoce(ii,ij) .AND. i2add > 0 ) THEN 
     1222            icont = icont + 1 
     1223            kproc(ii,ij) = icont 
     1224            kipos(icont+1) = ii 
     1225            kjpos(icont+1) = ij 
     1226            i2add = i2add - 1 
     1227         ENDIF 
     1228      END DO 
     1229      ! 
     1230   END SUBROUTINE mpp_getnum 
     1231 
     1232 
     1233   SUBROUTINE init_ioipsl 
     1234      !!---------------------------------------------------------------------- 
     1235      !!                  ***  ROUTINE init_ioipsl  *** 
    11731236      !! 
    11741237      !! ** Purpose :    
    … …  
    11871250      ! Set idompar values equivalent to the jpdom_local_noextra definition 
    11881251      ! used in IOM. This works even if jpnij .ne. jpni*jpnj. 
    1189       iglo(1) = jpiglo 
    1190       iglo(2) = jpjglo 
    1191       iloc(1) = nlci 
    1192       iloc(2) = nlcj 
    1193       iabsf(1) = nimppt(narea) 
    1194       iabsf(2) = njmppt(narea) 
     1252      iglo( :) = (/ Ni0glo, Nj0glo /) 
     1253      iloc( :) = (/ Ni_0  , Nj_0   /) 
     1254      iabsf(:) = (/ Nis0  , Njs0   /) + (/ nimpp, njmpp /) - 1 - nn_hls   ! corresponds to mig0(Nis0) but mig0 is not yet defined! 
    11951255      iabsl(:) = iabsf(:) + iloc(:) - 1 
    1196       ihals(1) = nldi - 1 
    1197       ihals(2) = nldj - 1 
    1198       ihale(1) = nlci - nlei 
    1199       ihale(2) = nlcj - nlej 
    1200       idid(1) = 1 
    1201       idid(2) = 2 
     1256      ihals(:) = (/ 0     , 0      /) 
     1257      ihale(:) = (/ 0     , 0      /) 
     1258      idid( :) = (/ 1     , 2      /) 
    12021259 
    12031260      IF(lwp) THEN 
    12041261          WRITE(numout,*) 
    1205           WRITE(numout,*) 'mpp_init_ioipsl :   iloc  = ', iloc (1), iloc (2) 
    1206           WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf(1), iabsf(2) 
    1207           WRITE(numout,*) '                    ihals = ', ihals(1), ihals(2) 
    1208           WRITE(numout,*) '                    ihale = ', ihale(1), ihale(2) 
     1262          WRITE(numout,*) 'mpp init_ioipsl :   iloc  = ', iloc 
     1263          WRITE(numout,*) '~~~~~~~~~~~~~~~     iabsf = ', iabsf 
     1264          WRITE(numout,*) '                    ihals = ', ihals 
     1265          WRITE(numout,*) '                    ihale = ', ihale 
    12091266      ENDIF 
    12101267      ! 
    12111268      CALL flio_dom_set ( jpnij, nproc, idid, iglo, iloc, iabsf, iabsl, ihals, ihale, 'BOX', nidom) 
    12121269      ! 
    1213    END SUBROUTINE mpp_init_ioipsl   
    1214  
    1215  
    1216    SUBROUTINE mpp_init_nfdcom 
    1217       !!---------------------------------------------------------------------- 
    1218       !!                     ***  ROUTINE  mpp_init_nfdcom  *** 
     1270   END SUBROUTINE init_ioipsl   
     1271 
     1272 
     1273   SUBROUTINE init_nfdcom 
     1274      !!---------------------------------------------------------------------- 
     1275      !!                     ***  ROUTINE  init_nfdcom  *** 
    12191276      !! ** Purpose :   Setup for north fold exchanges with explicit  
    12201277      !!                point-to-point messaging 
    … …  
    12261283      !!---------------------------------------------------------------------- 
    12271284      INTEGER  ::   sxM, dxM, sxT, dxT, jn 
    1228       INTEGER  ::   njmppmax 
    1229       !!---------------------------------------------------------------------- 
    1230       ! 
    1231       njmppmax = MAXVAL( njmppt ) 
     1285      !!---------------------------------------------------------------------- 
    12321286      ! 
    12331287      !initializes the north-fold communication variables 
    … …  
    12351289      nsndto     = 0 
    12361290      ! 
    1237       IF ( njmpp == njmppmax ) THEN      ! if I am a process in the north 
     1291      IF ( njmpp == MAXVAL( njmppt ) ) THEN      ! if I am a process in the north 
    12381292         ! 
    12391293         !sxM is the first point (in the global domain) needed to compute the north-fold for the current process 
    1240          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 
     1294         sxM = jpiglo - nimppt(narea) - jpiall(narea) + 1 
    12411295         !dxM is the last point (in the global domain) needed to compute the north-fold for the current process 
    12421296         dxM = jpiglo - nimppt(narea) + 2 
    … …  
    12471301         DO jn = 1, jpni 
    12481302            ! 
    1249             sxT = nfiimpp(jn, jpnj)                            ! sxT = 1st  point (in the global domain) of the jn process 
    1250             dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1    ! dxT = last point (in the global domain) of the jn process 
     1303            sxT = nfimpp(jn)                    ! sxT = 1st  point (in the global domain) of the jn process 
     1304            dxT = nfimpp(jn) + nfjpi(jn) - 1    ! dxT = last point (in the global domain) of the jn process 
    12511305            ! 
    12521306            IF    ( sxT < sxM  .AND.  sxM < dxT ) THEN 
    … …  
    12621316            ! 
    12631317         END DO 
    1264          nfsloop = 1 
    1265          nfeloop = nlci 
    1266          DO jn = 2,jpni-1 
    1267             IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
    1268                IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
    1269                IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
    1270             ENDIF 
    1271          END DO 
    12721318         ! 
    12731319      ENDIF 
    12741320      l_north_nogather = .TRUE. 
    12751321      ! 
    1276    END SUBROUTINE mpp_init_nfdcom 
    1277  
     1322   END SUBROUTINE init_nfdcom 
    12781323 
    12791324#endif 
    12801325 
     1326   SUBROUTINE init_doloop 
     1327      !!---------------------------------------------------------------------- 
     1328      !!                  ***  ROUTINE init_doloop  *** 
     1329      !! 
     1330      !! ** Purpose :   set the starting/ending indices of DO-loop 
     1331      !!              These indices are used in do_loop_substitute.h90 
     1332      !!---------------------------------------------------------------------- 
     1333      ! 
     1334      Nis0 =   1+nn_hls   ;   Nis1 = Nis0-1   ;   Nis2 = MAX(  1, Nis0-2) 
     1335      Njs0 =   1+nn_hls   ;   Njs1 = Njs0-1   ;   Njs2 = MAX(  1, Njs0-2)   
     1336      !                                                  
     1337      Nie0 = jpi-nn_hls   ;   Nie1 = Nie0+1   ;   Nie2 = MIN(jpi, Nie0+2) 
     1338      Nje0 = jpj-nn_hls   ;   Nje1 = Nje0+1   ;   Nje2 = MIN(jpj, Nje0+2) 
     1339      ! 
     1340      IF( nn_hls == 1 ) THEN          !* halo size of 1 
     1341         ! 
     1342         Nis1nxt2 = Nis0   ;   Njs1nxt2 = Njs0 
     1343         Nie1nxt2 = Nie0   ;   Nje1nxt2 = Nje0 
     1344         ! 
     1345      ELSE                            !* larger halo size...  
     1346         ! 
     1347         Nis1nxt2 = Nis1   ;   Njs1nxt2 = Njs1 
     1348         Nie1nxt2 = Nie1   ;   Nje1nxt2 = Nje1 
     1349         ! 
     1350      ENDIF 
     1351      ! 
     1352      Ni_0 = Nie0 - Nis0 + 1 
     1353      Nj_0 = Nje0 - Njs0 + 1 
     1354      Ni_1 = Nie1 - Nis1 + 1 
     1355      Nj_1 = Nje1 - Njs1 + 1 
     1356      Ni_2 = Nie2 - Nis2 + 1 
     1357      Nj_2 = Nje2 - Njs2 + 1 
     1358      ! 
     1359   END SUBROUTINE init_doloop 
     1360    
    12811361   !!====================================================================== 
    12821362END MODULE mppini 

  • NEMO/trunk/src/OCE/LDF/ldfdyn.F90

    r13226 r13286  
    267267            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F(i,j) read in eddy_viscosity.nc file' 
    268268            CALL iom_open( 'eddy_viscosity_2D.nc', inum ) 
    269             CALL iom_get ( inum, jpdom_data, 'ahmt_2d', ahmt(:,:,1) ) 
    270             CALL iom_get ( inum, jpdom_data, 'ahmf_2d', ahmf(:,:,1) ) 
     269            CALL iom_get ( inum, jpdom_global, 'ahmt_2d', ahmt(:,:,1), cd_type = 'T', psgn = 1._wp ) 
     270            CALL iom_get ( inum, jpdom_global, 'ahmf_2d', ahmf(:,:,1), cd_type = 'F', psgn = 1._wp ) 
    271271            CALL iom_close( inum ) 
    272272            DO jk = 2, jpkm1 
    … …  
    284284            IF(lwp) WRITE(numout,*) '   ==>>>   eddy viscosity = F(i,j,k) read in eddy_viscosity_3D.nc file' 
    285285            CALL iom_open( 'eddy_viscosity_3D.nc', inum ) 
    286             CALL iom_get ( inum, jpdom_data, 'ahmt_3d', ahmt ) 
    287             CALL iom_get ( inum, jpdom_data, 'ahmf_3d', ahmf ) 
     286            CALL iom_get ( inum, jpdom_global, 'ahmt_3d', ahmt, cd_type = 'T', psgn = 1._wp ) 
     287            CALL iom_get ( inum, jpdom_global, 'ahmf_3d', ahmf, cd_type = 'F', psgn = 1._wp ) 
    288288            CALL iom_close( inum ) 
    289289            ! 

  • NEMO/trunk/src/OCE/LDF/ldftra.F90

    r13237 r13286  
    317317            IF(lwp) WRITE(numout,*) '   ==>>>   eddy diffusivity = F(i,j) read in eddy_diffusivity.nc file' 
    318318            CALL iom_open( 'eddy_diffusivity_2D.nc', inum ) 
    319             CALL iom_get ( inum, jpdom_data, 'ahtu_2D', ahtu(:,:,1) ) 
    320             CALL iom_get ( inum, jpdom_data, 'ahtv_2D', ahtv(:,:,1) ) 
     319            CALL iom_get ( inum, jpdom_global, 'ahtu_2D', ahtu(:,:,1), cd_type = 'U', psgn = 1._wp ) 
     320            CALL iom_get ( inum, jpdom_global, 'ahtv_2D', ahtv(:,:,1), cd_type = 'V', psgn = 1._wp ) 
    321321            CALL iom_close( inum ) 
    322322            DO jk = 2, jpkm1 
    … …  
    345345            IF(lwp) WRITE(numout,*) '   ==>>>   eddy diffusivity = F(i,j,k) read in eddy_diffusivity.nc file' 
    346346            CALL iom_open( 'eddy_diffusivity_3D.nc', inum ) 
    347             CALL iom_get ( inum, jpdom_data, 'ahtu_3D', ahtu ) 
    348             CALL iom_get ( inum, jpdom_data, 'ahtv_3D', ahtv ) 
     347            CALL iom_get ( inum, jpdom_global, 'ahtu_3D', ahtu, cd_type = 'U', psgn = 1._wp ) 
     348            CALL iom_get ( inum, jpdom_global, 'ahtv_3D', ahtv, cd_type = 'V', psgn = 1._wp ) 
    349349            CALL iom_close( inum ) 
    350350            ! 
    … …  
    572572            IF(lwp) WRITE(numout,*) '   ==>>>   eddy induced velocity coef. = F(i,j) read in eddy_diffusivity_2D.nc file' 
    573573            CALL iom_open ( 'eddy_induced_velocity_2D.nc', inum ) 
    574             CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu(:,:,1) ) 
    575             CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv(:,:,1) ) 
     574            CALL iom_get  ( inum, jpdom_global, 'aeiu', aeiu(:,:,1), cd_type = 'U', psgn = 1._wp ) 
     575            CALL iom_get  ( inum, jpdom_global, 'aeiv', aeiv(:,:,1), cd_type = 'V', psgn = 1._wp ) 
    576576            CALL iom_close( inum ) 
    577577            DO jk = 2, jpkm1 
    … …  
    596596            IF(lwp) WRITE(numout,*) '   ==>>>   eddy induced velocity coef. = F(i,j,k) read in eddy_diffusivity_3D.nc file' 
    597597            CALL iom_open ( 'eddy_induced_velocity_3D.nc', inum ) 
    598             CALL iom_get  ( inum, jpdom_data, 'aeiu', aeiu ) 
    599             CALL iom_get  ( inum, jpdom_data, 'aeiv', aeiv ) 
     598            CALL iom_get  ( inum, jpdom_global, 'aeiu', aeiu, cd_type = 'U', psgn = 1._wp ) 
     599            CALL iom_get  ( inum, jpdom_global, 'aeiv', aeiv, cd_type = 'V', psgn = 1._wp ) 
    600600            CALL iom_close( inum ) 
    601601            ! 

  • NEMO/trunk/src/OCE/OBS/find_obs_proc.h90

    r10068 r13286  
    4141      ! first and last indoor i- and j-indexes      kldi, klei,   kldj, klej 
    4242      ! exclude any obs in the bottom-left overlap region 
    43       ! also any obs outside to whole region (defined by nlci and nlcj) 
     43      ! also any obs outside to whole region (defined by jpi and jpj) 
    4444      ! I am assuming that kobsp does not need to be the correct processor  
    4545      ! number 

  • NEMO/trunk/src/OCE/OBS/mpp_map.F90

    r10068 r13286  
    1111   !!---------------------------------------------------------------------- 
    1212   USE par_kind, ONLY :   wp            ! Precision variables 
    13    USE par_oce , ONLY :   jpi, jpj      ! Ocean parameters 
    14    USE dom_oce , ONLY :   mig, mjg, nldi, nlei, nldj, nlej, nlci, nlcj, narea   ! Ocean space and time domain variables 
     13   USE par_oce , ONLY :   jpi, jpj, Nis0, Nie0, Njs0, Nje0   ! Ocean parameters 
     14   USE dom_oce , ONLY :   mig, mjg, narea                    ! Ocean space and time domain variables 
    1515#if defined key_mpp_mpi 
    16    USE lib_mpp, ONLY :   mpi_comm_oce   ! MPP library 
     16   USE lib_mpp , ONLY :   mpi_comm_oce   ! MPP library 
    1717#endif 
    1818   USE in_out_manager   ! I/O manager 
    … …  
    6565 
    6666!      ! Setup local grid points 
    67       imppmap(mig(1):mig(nlci),mjg(1):mjg(nlcj)) = narea 
     67      imppmap(mig(1):mig(jpi),mjg(1):mjg(jpj)) = narea 
    6868       
    6969      ! Get global data 

  • NEMO/trunk/src/OCE/OBS/obs_grid.F90

    r12933 r13286  
    129129            IF ( cdgrid == 'T' ) THEN 
    130130               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    131                   &                             1, nlci, 1, nlcj,         & 
     131                  &                             1, jpi, 1, jpj,           & 
    132132                  &                             nproc, jpnij,             & 
    133133                  &                             glamt, gphit, tmask,      & 
    … …  
    136136            ELSEIF ( cdgrid == 'U' ) THEN 
    137137               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    138                   &                             1, nlci, 1, nlcj,         & 
     138                  &                             1, jpi, 1, jpj,           & 
    139139                  &                             nproc, jpnij,             & 
    140140                  &                             glamu, gphiu, umask,      & 
    … …  
    143143            ELSEIF ( cdgrid == 'V' ) THEN 
    144144               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    145                   &                             1, nlci, 1, nlcj,         & 
     145                  &                             1, jpi, 1, jpj,           & 
    146146                  &                             nproc, jpnij,             & 
    147147                  &                             glamv, gphiv, vmask,      & 
    … …  
    150150            ELSEIF ( cdgrid == 'F' ) THEN 
    151151               CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo, & 
    152                   &                             1, nlci, 1, nlcj,         & 
     152                  &                             1, jpi, 1, jpj,           & 
    153153                  &                             nproc, jpnij,             & 
    154154                  &                             glamf, gphif, fmask,      & 
    … …  
    279279         zmskg(:,:) = -1.e+10 
    280280         ! Add various grids here. 
    281          DO jj = 1, nlcj 
    282             DO ji = 1, nlci 
     281         DO jj = 1, jpj 
     282            DO ji = 1, jpi 
    283283               zlamg(mig(ji),mjg(jj)) = glamt(ji,jj) 
    284284               zphig(mig(ji),mjg(jj)) = gphit(ji,jj) 
    … …  
    819819             
    820820            CALL obs_grd_bruteforce( jpi, jpj, jpiglo, jpjglo,  & 
    821                &                     1, nlci, 1, nlcj,          & 
     821               &                     1, jpi, 1, jpj,            & 
    822822               &                     nproc, jpnij,              & 
    823823               &                     glamt, gphit, tmask,       & 

  • NEMO/trunk/src/OCE/OBS/obs_read_altbias.F90

    r12377 r13286  
    125125         ! Get the Alt bias data 
    126126          
    127          CALL iom_get( numaltbias, jpdom_data, 'altbias', z_altbias(:,:), 1 ) 
     127         CALL iom_get( numaltbias, jpdom_global, 'altbias', z_altbias(:,:) ) 
    128128          
    129129         ! Close the file 

  • NEMO/trunk/src/OCE/OBS/obs_readmdt.F90

    r12377 r13286  
    9090      CALL iom_open( mdtname, nummdt )       ! Open the file 
    9191      !                                      ! Get the MDT data 
    92       CALL iom_get ( nummdt, jpdom_data, 'sossheig', z_mdt(:,:), 1 ) 
     92      CALL iom_get ( nummdt, jpdom_global, 'sossheig', z_mdt(:,:) ) 
    9393      CALL iom_close(nummdt)                 ! Close the file 
    9494       

  • NEMO/trunk/src/OCE/OBS/obs_sstbias.F90

    r12377 r13286  
    139139               cl_bias_files(jtype) ) 
    140140            ! Get the SST bias data 
    141             CALL iom_get( numsstbias, jpdom_data, 'tn', z_sstbias_2d(:,:), 1 ) 
     141            CALL iom_get( numsstbias, jpdom_global, 'tn', z_sstbias_2d(:,:), 1 ) 
    142142            z_sstbias(:,:,jtype) = z_sstbias_2d(:,:)        
    143143            ! Close the file 

  • NEMO/trunk/src/OCE/SBC/cpl_oasis3.F90

    r12527 r13286  
    6969   INTEGER, PUBLIC, PARAMETER ::   nmaxcat=5    ! Maximum number of coupling fields 
    7070   INTEGER, PUBLIC, PARAMETER ::   nmaxcpl=5    ! Maximum number of coupling fields 
    71    LOGICAL, PARAMETER         ::   ltmp_wapatch = .TRUE.   ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define   
    72    INTEGER                    ::   nldi_save, nlei_save 
    73    INTEGER                    ::   nldj_save, nlej_save 
    7471    
    7572   TYPE, PUBLIC ::   FLD_CPL               !: Type for coupling field information 
    … …  
    148145      !!-------------------------------------------------------------------- 
    149146 
    150       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    151       IF( ltmp_wapatch ) THEN 
    152          nldi_save = nldi   ;   nlei_save = nlei 
    153          nldj_save = nldj   ;   nlej_save = nlej 
    154          IF( nimpp           ==      1 ) nldi = 1 
    155          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    156          IF( njmpp           ==      1 ) nldj = 1 
    157          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    158       ENDIF  
    159147      IF(lwp) WRITE(numout,*) 
    160148      IF(lwp) WRITE(numout,*) 'cpl_define : initialization in coupled ocean/atmosphere case' 
    … …  
    182170      ! 
    183171      ishape(1) = 1 
    184       ishape(2) = nlei-nldi+1 
     172      ishape(2) = Ni_0 
    185173      ishape(3) = 1 
    186       ishape(4) = nlej-nldj+1 
     174      ishape(4) = Nj_0 
    187175      ! 
    188176      ! ... Allocate memory for data exchange 
    189177      ! 
    190       ALLOCATE(exfld(nlei-nldi+1, nlej-nldj+1), stat = nerror) 
     178      ALLOCATE(exfld(Ni_0, Nj_0), stat = nerror) 
    191179      IF( nerror > 0 ) THEN 
    192180         CALL oasis_abort ( ncomp_id, 'cpl_define', 'Failure in allocating exfld')   ;   RETURN 
    … …  
    198186       
    199187      paral(1) = 2                                              ! box partitioning 
    200       paral(2) = jpiglo * (nldj-1+njmpp-1) + (nldi-1+nimpp-1)   ! NEMO lower left corner global offset     
    201       paral(3) = nlei-nldi+1                                    ! local extent in i  
    202       paral(4) = nlej-nldj+1                                    ! local extent in j 
     188      paral(2) = jpiglo * (Njs0-1+njmpp-1) + (Nis0-1+nimpp-1)   ! NEMO lower left corner global offset     
     189      paral(3) = Ni_0                                           ! local extent in i  
     190      paral(4) = Nj_0                                           ! local extent in j 
    203191      paral(5) = jpiglo                                         ! global extent in x 
    204192       
    … …  
    206194         WRITE(numout,*) ' multiexchg: paral (1:5)', paral 
    207195         WRITE(numout,*) ' multiexchg: jpi, jpj =', jpi, jpj 
    208          WRITE(numout,*) ' multiexchg: nldi, nlei, nimpp =', nldi, nlei, nimpp 
    209          WRITE(numout,*) ' multiexchg: nldj, nlej, njmpp =', nldj, nlej, njmpp 
     196         WRITE(numout,*) ' multiexchg: Nis0, Nie0, nimpp =', Nis0, Nie0, nimpp 
     197         WRITE(numout,*) ' multiexchg: Njs0, Nje0, njmpp =', Njs0, Nje0, njmpp 
    210198      ENDIF 
    211199    
    … …  
    316304#endif 
    317305      ! 
    318       IF( ltmp_wapatch ) THEN 
    319          nldi = nldi_save   ;   nlei = nlei_save 
    320          nldj = nldj_save   ;   nlej = nlej_save 
    321       ENDIF 
    322306   END SUBROUTINE cpl_define 
    323307    
    … …  
    337321      INTEGER                                   ::   jc,jm     ! local loop index 
    338322      !!-------------------------------------------------------------------- 
    339       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    340       IF( ltmp_wapatch ) THEN 
    341          nldi_save = nldi   ;   nlei_save = nlei 
    342          nldj_save = nldj   ;   nlej_save = nlej 
    343          IF( nimpp           ==      1 ) nldi = 1 
    344          IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    345          IF( njmpp           ==      1 ) nldj = 1 
    346          IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    347       ENDIF 
    348323      ! 
    349324      ! snd data to OASIS3 
    … …  
    353328         
    354329            IF( ssnd(kid)%nid(jc,jm) /= -1 ) THEN 
    355                CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(nldi:nlei, nldj:nlej,jc), kinfo ) 
     330               CALL oasis_put ( ssnd(kid)%nid(jc,jm), kstep, pdata(Nis0:Nie0, Njs0:Nje0,jc), kinfo ) 
    356331                
    357332               IF ( sn_cfctl%l_oasout ) THEN         
    … …  
    363338                     WRITE(numout,*) 'oasis_put:  kstep ', kstep 
    364339                     WRITE(numout,*) 'oasis_put:   info ', kinfo 
    365                      WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    366                      WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    367                      WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc)) 
     340                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     341                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     342                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
    368343                     WRITE(numout,*) '****************' 
    369344                  ENDIF 
    … …  
    374349         ENDDO 
    375350      ENDDO 
    376       IF( ltmp_wapatch ) THEN 
    377          nldi = nldi_save   ;   nlei = nlei_save 
    378          nldj = nldj_save   ;   nlej = nlej_save 
    379       ENDIF 
    380351      ! 
    381352    END SUBROUTINE cpl_snd 
    … …  
    396367      !! 
    397368      INTEGER                                   ::   jc,jm     ! local loop index 
    398       LOGICAL                                   ::   llaction, llfisrt 
     369      LOGICAL                                   ::   llaction, ll_1st 
    399370      !!-------------------------------------------------------------------- 
    400       ! patch to restore wraparound rows in cpl_send, cpl_rcv, cpl_define 
    401       IF( ltmp_wapatch ) THEN 
    402          nldi_save = nldi   ;   nlei_save = nlei 
    403          nldj_save = nldj   ;   nlej_save = nlej 
    404       ENDIF 
    405371      ! 
    406372      ! receive local data from OASIS3 on every process 
    … …  
    409375      ! 
    410376      DO jc = 1, srcv(kid)%nct 
    411          IF( ltmp_wapatch ) THEN 
    412             IF( nimpp           ==      1 ) nldi = 1 
    413             IF( nimpp + jpi - 1 == jpiglo ) nlei = jpi 
    414             IF( njmpp           ==      1 ) nldj = 1 
    415             IF( njmpp + jpj - 1 == jpjglo ) nlej = jpj 
    416          ENDIF 
    417          llfisrt = .TRUE. 
     377         ll_1st = .TRUE. 
    418378 
    419379         DO jm = 1, srcv(kid)%ncplmodel 
    … …  
    431391                   
    432392                  kinfo = OASIS_Rcv 
    433                   IF( llfisrt ) THEN  
    434                      pdata(nldi:nlei,nldj:nlej,jc) =                                 exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
    435                      llfisrt = .FALSE. 
     393                  IF( ll_1st ) THEN  
     394                     pdata(Nis0:Nie0,Njs0:Nje0,jc) =   exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
     395                     ll_1st = .FALSE. 
    436396                  ELSE 
    437                      pdata(nldi:nlei,nldj:nlej,jc) = pdata(nldi:nlei,nldj:nlej,jc) + exfld(:,:) * pmask(nldi:nlei,nldj:nlej,jm) 
     397                     pdata(Nis0:Nie0,Njs0:Nje0,jc) = pdata(Nis0:Nie0,Njs0:Nje0,jc)   & 
     398                        &                                + exfld(:,:) * pmask(Nis0:Nie0,Njs0:Nje0,jm) 
    438399                  ENDIF 
    439400                   
    … …  
    444405                     WRITE(numout,*) 'oasis_get:   kstep', kstep 
    445406                     WRITE(numout,*) 'oasis_get:   info ', kinfo 
    446                      WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    447                      WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(nldi:nlei,nldj:nlej,jc)) 
    448                      WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(nldi:nlei,nldj:nlej,jc)) 
     407                     WRITE(numout,*) '     - Minimum value is ', MINVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     408                     WRITE(numout,*) '     - Maximum value is ', MAXVAL(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
     409                     WRITE(numout,*) '     -     Sum value is ',    SUM(pdata(Nis0:Nie0,Njs0:Nje0,jc)) 
    449410                     WRITE(numout,*) '****************' 
    450411                  ENDIF 
    … …  
    456417         ENDDO 
    457418 
    458          IF( ltmp_wapatch ) THEN 
    459             nldi = nldi_save   ;   nlei = nlei_save 
    460             nldj = nldj_save   ;   nlej = nlej_save 
    461          ENDIF 
    462419         !--- Fill the overlap areas and extra hallows (mpp) 
    463420         !--- check periodicity conditions (all cases) 
    464          IF( .not. llfisrt ) THEN 
     421         IF( .NOT. ll_1st ) THEN 
    465422            CALL lbc_lnk( 'cpl_oasis3', pdata(:,:,jc), srcv(kid)%clgrid, srcv(kid)%nsgn )    
    466423         ENDIF 

  • NEMO/trunk/src/OCE/SBC/fldread.F90

    r13237 r13286  
    5353      LOGICAL              ::   ln_tint     ! time interpolation or not (T/F) 
    5454      LOGICAL              ::   ln_clim     ! climatology or not (T/F) 
    55       CHARACTER(len = 8)   ::   cltype      ! type of data file 'daily', 'monthly' or yearly' 
     55      CHARACTER(len = 8)   ::   clftyp      ! type of data file 'daily', 'monthly' or yearly' 
    5656      CHARACTER(len = 256) ::   wname       ! generic name of a NetCDF weights file to be used, blank if not 
    5757      CHARACTER(len = 34)  ::   vcomp       ! symbolic component name if a vector that needs rotation 
    … …  
    6969      LOGICAL                         ::   ln_tint      ! time interpolation or not (T/F) 
    7070      LOGICAL                         ::   ln_clim      ! climatology or not (T/F) 
    71       CHARACTER(len = 8)              ::   cltype       ! type of data file 'daily', 'monthly' or yearly' 
     71      CHARACTER(len = 8)              ::   clftyp       ! type of data file 'daily', 'monthly' or yearly' 
     72      CHARACTER(len = 1)              ::   cltype       ! nature of grid-points: T, U, V... 
     73      REAL(wp)                        ::   zsgn         ! -1. the sign change across the north fold, =  1. otherwise 
    7274      INTEGER                         ::   num          ! iom id of the jpfld files to be read 
    73       INTEGER , DIMENSION(2)          ::   nrec_b       ! before record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    74       INTEGER , DIMENSION(2)          ::   nrec_a       ! after  record (1: index, 2: second since Jan. 1st 00h of nit000 year) 
    75       INTEGER , ALLOCATABLE, DIMENSION(:      ) ::   nrecsec   !  
    76       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step 
    77       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields 
     75      INTEGER , DIMENSION(2,2)        ::   nrec         ! before/after record (1: index, 2: second since Jan. 1st 00h of yr nit000) 
     76      INTEGER                         ::   nbb          ! index of before values 
     77      INTEGER                         ::   naa          ! index of after  values 
     78      INTEGER , ALLOCATABLE, DIMENSION(:) ::   nrecsec   !  
     79      REAL(wp), POINTER, DIMENSION(:,:,:  ) ::   fnow   ! input fields interpolated to now time step 
     80      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   fdta   ! 2 consecutive record of input fields 
    7881      CHARACTER(len = 256)            ::   wgtname      ! current name of the NetCDF weight file acting as a key 
    7982      !                                                 ! into the WGTLIST structure 
    … …  
    157160      INTEGER  ::   jf           ! dummy indices 
    158161      INTEGER  ::   isecsbc      ! number of seconds between Jan. 1st 00h of nit000 year and the middle of sbc time step 
     162      INTEGER  ::   ibb, iaa     ! shorter name for sd(jf)%nbb and sd(jf)%naa 
    159163      LOGICAL  ::   ll_firstcall ! true if this is the first call to fld_read for this set of fields 
    160164      REAL(wp) ::   zt_offset    ! local time offset variable 
    … …  
    204208            IF( TRIM(sd(jf)%clrootname) == 'NOT USED' )   CYCLE 
    205209            ! 
     210            ibb = sd(jf)%nbb   ;   iaa = sd(jf)%naa 
     211            ! 
    206212            IF( sd(jf)%ln_tint ) THEN              ! temporal interpolation 
    207213               IF(lwp .AND. kt - nit000 <= 100 ) THEN  
    … …  
    209215                     &    "', records b/a: ', i6.4, '/', i6.4, ' (days ', f9.4,'/', f9.4, ')')" 
    210216                  WRITE(numout, clfmt)  TRIM( sd(jf)%clvar ), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,   &             
    211                      & sd(jf)%nrec_b(1), sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     217                     & sd(jf)%nrec(1,ibb), sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 
    212218                  WRITE(numout, *) '      zt_offset is : ',zt_offset 
    213219               ENDIF 
    214220               ! temporal interpolation weights 
    215                ztinta =  REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 
     221               ztinta =  REAL( isecsbc - sd(jf)%nrec(2,ibb), wp ) / REAL( sd(jf)%nrec(2,iaa) - sd(jf)%nrec(2,ibb), wp ) 
    216222               ztintb =  1. - ztinta 
    217                sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,1) + ztinta * sd(jf)%fdta(:,:,:,2) 
     223               sd(jf)%fnow(:,:,:) = ztintb * sd(jf)%fdta(:,:,:,ibb) + ztinta * sd(jf)%fdta(:,:,:,iaa) 
    218224            ELSE   ! nothing to do... 
    219225               IF(lwp .AND. kt - nit000 <= 100 ) THEN 
    … …  
    221227                     &    "', record: ', i6.4, ' (days ', f9.4, ' <-> ', f9.4, ')')" 
    222228                  WRITE(numout, clfmt) TRIM(sd(jf)%clvar), kt, REAL(isecsbc,wp)/rday, nyear, nmonth, nday,    & 
    223                      &                 sd(jf)%nrec_a(1), REAL(sd(jf)%nrec_b(2),wp)/rday, REAL(sd(jf)%nrec_a(2),wp)/rday 
     229                     &                 sd(jf)%nrec(1,iaa), REAL(sd(jf)%nrec(2,ibb),wp)/rday, REAL(sd(jf)%nrec(2,iaa),wp)/rday 
    224230               ENDIF 
    225231            ENDIF 
    … …  
    251257      ! 
    252258      CALL fld_clopn( sdjf ) 
    253       sdjf%nrec_a(:) = (/ 1, nflag /)  ! default definition to force flp_update to read the file. 
     259      sdjf%nrec(:,sdjf%naa) = (/ 1, nflag /)  ! default definition to force flp_update to read the file. 
    254260      ! 
    255261   END SUBROUTINE fld_init 
    … …  
    262268      !! ** Purpose : Compute 
    263269      !!              if sdjf%ln_tint = .TRUE. 
    264       !!                  nrec_a: record number and its time (nrec_b is obtained from nrec_a when swapping) 
     270      !!                  nrec(:,iaa): record number and its time (nrec(:,ibb) is obtained from nrec(:,iaa) when swapping) 
    265271      !!              if sdjf%ln_tint = .FALSE. 
    266       !!                  nrec_a(1): record number 
    267       !!                  nrec_b(2) and nrec_a(2): time of the beginning and end of the record 
     272      !!                  nrec(1,iaa): record number 
     273      !!                  nrec(2,ibb) and nrec(2,iaa): time of the beginning and end of the record 
    268274      !!---------------------------------------------------------------------- 
    269275      INTEGER  ,           INTENT(in   ) ::   ksecsbc   !  
    … …  
    271277      INTEGER  , OPTIONAL, INTENT(in   ) ::   Kmm    ! ocean time level index 
    272278      ! 
    273       INTEGER  ::   ja     ! end of this record (in seconds) 
    274       !!---------------------------------------------------------------------- 
    275       ! 
    276       IF( ksecsbc > sdjf%nrec_a(2) ) THEN     ! --> we need to update after data 
     279      INTEGER  ::   ja           ! end of this record (in seconds) 
     280      INTEGER  ::   ibb, iaa     ! shorter name for sdjf%nbb and sdjf%naa 
     281      !!---------------------------------------------------------------------- 
     282      ibb = sdjf%nbb   ;   iaa = sdjf%naa 
     283      ! 
     284      IF( ksecsbc > sdjf%nrec(2,iaa) ) THEN     ! --> we need to update after data 
    277285         
    278          ! find where is the new after record... (it is not necessary sdjf%nrec_a(1)+1 ) 
    279          ja = sdjf%nrec_a(1) 
     286         ! find where is the new after record... (it is not necessary sdjf%nrec(1,iaa)+1 ) 
     287         ja = sdjf%nrec(1,iaa) 
    280288         DO WHILE ( ksecsbc >= sdjf%nrecsec(ja) .AND. ja < sdjf%nreclast )   ! Warning: make sure ja <= sdjf%nreclast in this test 
    281289            ja = ja + 1 
    … …  
    284292 
    285293         ! if ln_tint and if the new after is not ja+1, we need also to update after data before the swap 
    286          ! so, after the swap, sdjf%nrec_b(2) will still be the closest value located just before ksecsbc 
    287          IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec_a(1) + 1 .OR. sdjf%nrec_a(2) == nflag ) ) THEN 
    288             sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information 
    289             CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data 
     294         ! so, after the swap, sdjf%nrec(2,ibb) will still be the closest value located just before ksecsbc 
     295         IF( sdjf%ln_tint .AND. ( ja > sdjf%nrec(1,iaa) + 1 .OR. sdjf%nrec(2,iaa) == nflag ) ) THEN 
     296            sdjf%nrec(:,iaa) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec(:,iaa) with before information 
     297            CALL fld_get( sdjf, Kmm )                           ! read after data that will be used as before data 
    290298         ENDIF 
    291299             
    … …  
    310318            ! if ln_tint and if after is not the first record, we must (potentially again) update after data before the swap 
    311319            IF( sdjf%ln_tint .AND. ja > 1 ) THEN 
    312                IF( sdjf%nrecsec(0) /= nflag ) THEN                  ! no trick used: after file is not the current file 
    313                   sdjf%nrec_a(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec_a with before information 
    314                   CALL fld_get( sdjf, Kmm )                         ! read after data that will be used as before data 
     320               IF( sdjf%nrecsec(0) /= nflag ) THEN                    ! no trick used: after file is not the current file 
     321                  sdjf%nrec(:,iaa) = (/ ja-1, sdjf%nrecsec(ja-1) /)   ! update nrec(:,iaa) with before information 
     322                  CALL fld_get( sdjf, Kmm )                           ! read after data that will be used as before data 
    315323               ENDIF 
    316324            ENDIF 
    … …  
    318326         ENDIF 
    319327 
    320          IF( sdjf%ln_tint ) THEN  
    321             ! Swap data 
    322             sdjf%nrec_b(:)     = sdjf%nrec_a(:)                     ! swap before record informations 
    323             sdjf%rotn(1)       = sdjf%rotn(2)                       ! swap before rotate informations 
    324             sdjf%fdta(:,:,:,1) = sdjf%fdta(:,:,:,2)                 ! swap before record field 
    325          ELSE 
    326             sdjf%nrec_b(:) = (/ ja-1, sdjf%nrecsec(ja-1) /)         ! only for print  
     328         IF( sdjf%ln_tint ) THEN                                ! Swap data 
     329            sdjf%nbb = sdjf%naa                                 !    swap indices 
     330            sdjf%naa = 3 - sdjf%naa                             !    = 2(1) if naa == 1(2) 
     331         ELSE                                                   ! No swap 
     332            sdjf%nrec(:,ibb) = (/ ja-1, sdjf%nrecsec(ja-1) /)   !    only for print  
    327333         ENDIF 
    328334             
    329335         ! read new after data 
    330          sdjf%nrec_a(:) = (/ ja, sdjf%nrecsec(ja) /)                ! update nrec_a as it is used by fld_get 
    331          CALL fld_get( sdjf, Kmm )                                  ! read after data (with nrec_a informations) 
     336         sdjf%nrec(:,sdjf%naa) = (/ ja, sdjf%nrecsec(ja) /)     ! update nrec(:,naa) as it is used by fld_get 
     337         CALL fld_get( sdjf, Kmm )                              ! read after data (with nrec(:,naa) informations) 
    332338         
    333339      ENDIF 
    … …  
    346352      ! 
    347353      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
     354      INTEGER ::   iaa      ! shorter name for sdjf%naa 
    348355      INTEGER ::   iw       ! index into wgts array 
    349       INTEGER ::   ipdom    ! index of the domain 
    350356      INTEGER ::   idvar    ! variable ID 
    351357      INTEGER ::   idmspc   ! number of spatial dimensions 
    352358      LOGICAL ::   lmoor    ! C1D case: point data 
    353       !!--------------------------------------------------------------------- 
    354       ! 
    355       ipk = SIZE( sdjf%fnow, 3 ) 
    356       ! 
    357       IF( ASSOCIATED(sdjf%imap) ) THEN 
    358          IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1),   & 
    359             &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 
    360          ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1),   & 
    361             &                                        sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 
    362          ENDIF 
    363       ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN 
     359      REAL(wp), DIMENSION(:,:,:), POINTER ::   dta_alias   ! short cut 
     360      !!--------------------------------------------------------------------- 
     361      iaa = sdjf%naa 
     362      ! 
     363      IF( sdjf%ln_tint ) THEN   ;   dta_alias => sdjf%fdta(:,:,:,iaa) 
     364      ELSE                      ;   dta_alias => sdjf%fnow(:,:,:    ) 
     365      ENDIF 
     366      ipk = SIZE( dta_alias, 3 ) 
     367      ! 
     368      IF( ASSOCIATED(sdjf%imap) ) THEN              ! BDY case  
     369         CALL fld_map( sdjf%num, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa),   & 
     370            &          sdjf%imap, sdjf%igrd, sdjf%ibdy, sdjf%ltotvel, sdjf%lzint, Kmm ) 
     371      ELSE IF( LEN(TRIM(sdjf%wgtname)) > 0 ) THEN   ! On-the-fly interpolation 
    364372         CALL wgt_list( sdjf, iw ) 
    365          IF( sdjf%ln_tint ) THEN   ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fdta(:,:,:,2),          &  
    366             &                                                                          sdjf%nrec_a(1), sdjf%lsmname ) 
    367          ELSE                      ;   CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, sdjf%fnow(:,:,:  ),          & 
    368             &                                                                          sdjf%nrec_a(1), sdjf%lsmname ) 
    369          ENDIF 
    370       ELSE 
    371          IF( SIZE(sdjf%fnow, 1) == jpi ) THEN   ;   ipdom = jpdom_data 
    372          ELSE                                   ;   ipdom = jpdom_unknown 
    373          ENDIF 
     373         CALL fld_interp( sdjf%num, sdjf%clvar, iw, ipk, dta_alias(:,:,:), sdjf%nrec(1,iaa), sdjf%lsmname ) 
     374         CALL lbc_lnk( 'fldread', dta_alias(:,:,:), sdjf%cltype, sdjf%zsgn, kfillmode = jpfillcopy ) 
     375      ELSE                                          ! default case 
    374376         ! C1D case: If product of spatial dimensions == ipk, then x,y are of 
    375377         ! size 1 (point/mooring data): this must be read onto the central grid point 
    376378         idvar  = iom_varid( sdjf%num, sdjf%clvar ) 
    377379         idmspc = iom_file ( sdjf%num )%ndims( idvar ) 
    378          IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1 
    379          lmoor  = (  idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk  ) 
    380          ! 
    381          SELECT CASE( ipk ) 
    382          CASE(1) 
    383             IF( lk_c1d .AND. lmoor ) THEN 
    384                IF( sdjf%ln_tint ) THEN 
    385                   CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fdta(2,2,1,2), sdjf%nrec_a(1) ) 
    386                   CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,1,2),'Z',1.0_wp ) 
    387                ELSE 
    388                   CALL iom_get( sdjf%num, sdjf%clvar, sdjf%fnow(2,2,1  ), sdjf%nrec_a(1) ) 
    389                   CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,1  ),'Z',1.0_wp ) 
    390                ENDIF 
    391             ELSE 
    392                IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,1,2), sdjf%nrec_a(1) ) 
    393                ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,1  ), sdjf%nrec_a(1) ) 
    394                ENDIF 
    395             ENDIF 
    396          CASE DEFAULT 
    397             IF(lk_c1d .AND. lmoor ) THEN 
    398                IF( sdjf%ln_tint ) THEN 
    399                   CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fdta(2,2,:,2), sdjf%nrec_a(1) ) 
    400                   CALL lbc_lnk( 'fldread', sdjf%fdta(:,:,:,2),'Z',1.0_wp ) 
    401                ELSE 
    402                   CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, sdjf%fnow(2,2,:  ), sdjf%nrec_a(1) ) 
    403                   CALL lbc_lnk( 'fldread', sdjf%fnow(:,:,:  ),'Z',1.0_wp ) 
    404                ENDIF 
    405             ELSE 
    406                IF( sdjf%ln_tint ) THEN   ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fdta(:,:,:,2), sdjf%nrec_a(1) ) 
    407                ELSE                      ;   CALL iom_get( sdjf%num, ipdom, sdjf%clvar, sdjf%fnow(:,:,:  ), sdjf%nrec_a(1) ) 
    408                ENDIF 
    409             ENDIF 
    410          END SELECT 
    411       ENDIF 
    412       ! 
    413       sdjf%rotn(2) = .false.   ! vector not yet rotated 
     380         IF( iom_file( sdjf%num )%luld( idvar ) )   idmspc = idmspc - 1   ! id of the last spatial dimension 
     381         lmoor  = (  idmspc == 0 .OR. PRODUCT( iom_file( sdjf%num )%dimsz( 1:MAX(idmspc,1) ,idvar ) ) == ipk  )     
     382         ! 
     383         IF( lk_c1d .AND. lmoor ) THEN 
     384            CALL iom_get( sdjf%num, jpdom_unknown, sdjf%clvar, dta_alias(2,2,:), sdjf%nrec(1,iaa) )   ! jpdom_unknown -> no lbc_lnk 
     385            CALL lbc_lnk( 'fldread', dta_alias(:,:,:), 'T', 1., kfillmode = jpfillcopy ) 
     386         ELSE 
     387            CALL iom_get( sdjf%num,  jpdom_global, sdjf%clvar, dta_alias(:,:,:), sdjf%nrec(1,iaa),   & 
     388               &          sdjf%cltype, sdjf%zsgn, kfill = jpfillcopy ) 
     389         ENDIF 
     390      ENDIF 
     391      ! 
     392      sdjf%rotn(iaa) = .false.   ! vector not yet rotated 
    414393      ! 
    415394   END SUBROUTINE fld_get 
    … …  
    447426      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   zdta_read_z  ! work space local data requiring vertical interpolation 
    448427      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:)   ::   zdta_read_dz ! work space local data requiring vertical interpolation 
    449       CHARACTER(LEN=1),DIMENSION(3)             ::   clgrid 
     428      CHARACTER(LEN=1),DIMENSION(3)             ::   cltype 
    450429      LOGICAL                                   ::   lluld        ! is the variable using the unlimited dimension 
    451430      LOGICAL                                   ::   llzint       ! local value of ldzint 
    452431      !!--------------------------------------------------------------------- 
    453432      ! 
    454       clgrid = (/'t','u','v'/) 
     433      cltype = (/'t','u','v'/) 
    455434      ! 
    456435      ipi = SIZE( pdta, 1 ) 
    … …  
    487466         IF( ipkb /= ipk .OR. llzint ) THEN   ! boundary data not on model vertical grid : vertical interpolation 
    488467            ! 
    489             IF( ipk == jpk .AND. iom_varid(knum,'gdep'//clgrid(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//clgrid(kgrd)) /= -1 ) THEN 
     468            IF( ipk == jpk .AND. iom_varid(knum,'gdep'//cltype(kgrd)) /= -1 .AND. iom_varid(knum,'e3'//cltype(kgrd)) /= -1 ) THEN 
    490469                
    491470               ALLOCATE( zdta_read(ipi,ipj,ipkb), zdta_read_z(ipi,ipj,ipkb), zdta_read_dz(ipi,ipj,ipkb) ) 
    492471                 
    493472               CALL fld_map_core( zz_read, kmap, zdta_read ) 
    494                CALL iom_get ( knum, jpdom_unknown, 'gdep'//clgrid(kgrd), zz_read )   ! read only once? Potential temporal evolution? 
     473               CALL iom_get ( knum, jpdom_unknown, 'gdep'//cltype(kgrd), zz_read )   ! read only once? Potential temporal evolution? 
    495474               CALL fld_map_core( zz_read, kmap, zdta_read_z ) 
    496                CALL iom_get ( knum, jpdom_unknown,   'e3'//clgrid(kgrd), zz_read )   ! read only once? Potential temporal evolution? 
     475               CALL iom_get ( knum, jpdom_unknown,   'e3'//cltype(kgrd), zz_read )   ! read only once? Potential temporal evolution? 
    497476               CALL fld_map_core( zz_read, kmap, zdta_read_dz ) 
    498477                
    … …  
    504483               IF( ipk /= jpk ) CALL ctl_stop( 'fld_map : this should be an impossible case...' ) 
    505484               WRITE(ctmp1,*) 'fld_map : vertical interpolation for bdy variable '//TRIM(cdvar)//' requires '  
    506                IF( iom_varid(knum, 'gdep'//clgrid(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//clgrid(kgrd)//' variable' ) 
    507                IF( iom_varid(knum,   'e3'//clgrid(kgrd)) == -1 ) CALL ctl_stop( ctmp1//  'e3'//clgrid(kgrd)//' variable' ) 
     485               IF( iom_varid(knum, 'gdep'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1//'gdep'//cltype(kgrd)//' variable' ) 
     486               IF( iom_varid(knum,   'e3'//cltype(kgrd)) == -1 ) CALL ctl_stop( ctmp1//  'e3'//cltype(kgrd)//' variable' ) 
    508487 
    509488            ENDIF 
    … …  
    728707      CHARACTER (LEN=100)          ::   clcomp       ! dummy weight name 
    729708      REAL(wp), DIMENSION(jpi,jpj) ::   utmp, vtmp   ! temporary arrays for vector rotation 
     709      REAL(wp), DIMENSION(:,:,:), POINTER ::   dta_u, dta_v    ! short cut 
    730710      !!--------------------------------------------------------------------- 
    731711      ! 
    … …  
    747727                  END DO 
    748728                  IF( iv > 0 ) THEN   ! fields ju and iv are two components which need to be rotated together 
     729                     IF( sd(ju)%ln_tint ) THEN   ;   dta_u => sd(ju)%fdta(:,:,:,jn)   ;   dta_v => sd(iv)%fdta(:,:,:,jn)  
     730                     ELSE                        ;   dta_u => sd(ju)%fnow(:,:,:   )   ;   dta_v => sd(iv)%fnow(:,:,:   ) 
     731                     ENDIF 
    749732                     DO jk = 1, SIZE( sd(ju)%fnow, 3 ) 
    750                         IF( sd(ju)%ln_tint )THEN 
    751                            CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->i', utmp(:,:) ) 
    752                            CALL rot_rep( sd(ju)%fdta(:,:,jk,jn), sd(iv)%fdta(:,:,jk,jn), 'T', 'en->j', vtmp(:,:) ) 
    753                            sd(ju)%fdta(:,:,jk,jn) = utmp(:,:)   ;   sd(iv)%fdta(:,:,jk,jn) = vtmp(:,:) 
    754                         ELSE  
    755                            CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->i', utmp(:,:) ) 
    756                            CALL rot_rep( sd(ju)%fnow(:,:,jk   ), sd(iv)%fnow(:,:,jk   ), 'T', 'en->j', vtmp(:,:) ) 
    757                            sd(ju)%fnow(:,:,jk   ) = utmp(:,:)   ;   sd(iv)%fnow(:,:,jk   ) = vtmp(:,:) 
    758                         ENDIF 
     733                        CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->i', utmp(:,:) ) 
     734                        CALL rot_rep( dta_u(:,:,jk), dta_v(:,:,jk), 'T', 'en->j', vtmp(:,:) ) 
     735                        dta_u(:,:,jk) = utmp(:,:)   ;   dta_v(:,:,jk) = vtmp(:,:) 
    759736                     END DO 
    760737                     sd(ju)%rotn(jn) = .TRUE.               ! vector was rotated  
    … …  
    802779 
    803780      ! current file parameters 
    804       IF( sdjf%cltype(1:4) == 'week' ) THEN          ! find the day of the beginning of the current week 
    805          isecwk = ksec_week( sdjf%cltype(6:8) )     ! seconds between the beginning of the week and half of current time step 
    806          llprevmt = isecwk > nsec_month               ! longer time since beginning of the current week than the current month 
     781      IF( sdjf%clftyp(1:4) == 'week' ) THEN         ! find the day of the beginning of the current week 
     782         isecwk = ksec_week( sdjf%clftyp(6:8) )     ! seconds between the beginning of the week and half of current time step 
     783         llprevmt = isecwk > nsec_month             ! longer time since beginning of the current week than the current month 
    807784         llprevyr = llprevmt .AND. nmonth == 1 
    808785         iyr = nyear  - COUNT((/llprevyr/)) 
    809786         imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 
    810787         idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 
    811          isecwk = nsec_year - isecwk              ! seconds between 00h jan 1st of current year and current week beginning 
     788         isecwk = nsec_year - isecwk                ! seconds between 00h jan 1st of current year and current week beginning 
    812789      ELSE 
    813790         iyr = nyear 
    … …  
    819796      ! previous file parameters 
    820797      IF( llprev ) THEN 
    821          IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of previous week 
    822             isecwk = isecwk + 7 * idaysec         ! seconds between the beginning of previous week and half of the time step 
    823             llprevmt = isecwk > nsec_month            ! longer time since beginning of the previous week than the current month 
     798         IF( sdjf%clftyp(1:4) == 'week'    ) THEN   ! find the day of the beginning of previous week 
     799            isecwk = isecwk + 7 * idaysec           ! seconds between the beginning of previous week and half of the time step 
     800            llprevmt = isecwk > nsec_month          ! longer time since beginning of the previous week than the current month 
    824801            llprevyr = llprevmt .AND. nmonth == 1 
    825802            iyr = nyear  - COUNT((/llprevyr/)) 
    826803            imt = nmonth - COUNT((/llprevmt/)) + 12 * COUNT((/llprevyr/)) 
    827804            idy = nday + nmonth_len(nmonth-1) * COUNT((/llprevmt/)) - isecwk / idaysec 
    828             isecwk = nsec_year - isecwk           ! seconds between 00h jan 1st of current year and previous week beginning 
     805            isecwk = nsec_year - isecwk             ! seconds between 00h jan 1st of current year and previous week beginning 
    829806         ELSE 
    830             idy = nday   - COUNT((/ sdjf%cltype == 'daily'                 /)) 
    831             imt = nmonth - COUNT((/ sdjf%cltype == 'monthly' .OR. idy == 0 /)) 
    832             iyr = nyear  - COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 0 /)) 
     807            idy = nday   - COUNT((/ sdjf%clftyp == 'daily'                 /)) 
     808            imt = nmonth - COUNT((/ sdjf%clftyp == 'monthly' .OR. idy == 0 /)) 
     809            iyr = nyear  - COUNT((/ sdjf%clftyp == 'yearly'  .OR. imt == 0 /)) 
    833810            IF( idy == 0 ) idy = nmonth_len(imt) 
    834811            IF( imt == 0 ) imt = 12 
    … …  
    839816      ! next file parameters 
    840817      IF( llnext ) THEN 
    841          IF( sdjf%cltype(1:4) == 'week'    ) THEN     ! find the day of the beginning of next week 
    842             isecwk = 7 * idaysec - isecwk         ! seconds between half of the time step and the beginning of next week 
     818         IF( sdjf%clftyp(1:4) == 'week'    ) THEN   ! find the day of the beginning of next week 
     819            isecwk = 7 * idaysec - isecwk           ! seconds between half of the time step and the beginning of next week 
    843820            llnextmt = isecwk > ( nmonth_len(nmonth)*idaysec - nsec_month )   ! larger than the seconds to the end of the month 
    844821            llnextyr = llnextmt .AND. nmonth == 12 
    … …  
    846823            imt = nmonth + COUNT((/llnextmt/)) - 12 * COUNT((/llnextyr/)) 
    847824            idy = nday - nmonth_len(nmonth) * COUNT((/llnextmt/)) + isecwk / idaysec + 1 
    848             isecwk = nsec_year + isecwk           ! seconds between 00h jan 1st of current year and next week beginning 
     825            isecwk = nsec_year + isecwk             ! seconds between 00h jan 1st of current year and next week beginning 
    849826         ELSE 
    850             idy = nday   + COUNT((/ sdjf%cltype == 'daily'                                 /)) 
    851             imt = nmonth + COUNT((/ sdjf%cltype == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 
    852             iyr = nyear  + COUNT((/ sdjf%cltype == 'yearly'  .OR. imt == 13                /)) 
     827            idy = nday   + COUNT((/ sdjf%clftyp == 'daily'                                 /)) 
     828            imt = nmonth + COUNT((/ sdjf%clftyp == 'monthly' .OR. idy > nmonth_len(nmonth) /)) 
     829            iyr = nyear  + COUNT((/ sdjf%clftyp == 'yearly'  .OR. imt == 13                /)) 
    853830            IF( idy > nmonth_len(nmonth) )   idy = 1 
    854831            IF( imt == 13                )   imt = 1 
    … …  
    867844      IF    ( NINT(sdjf%freqh) == -12 ) THEN            ;   ireclast = 1    ! yearly mean: consider only 1 record 
    868845      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                ! monthly mean: 
    869          IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = 1    !  consider that the file has  1 record 
     846         IF(     sdjf%clftyp      == 'monthly' ) THEN   ;   ireclast = 1    !  consider that the file has  1 record 
    870847         ELSE                                           ;   ireclast = 12   !  consider that the file has 12 record 
    871848         ENDIF 
    872849      ELSE                                                                  ! higher frequency mean (in hours) 
    873          IF(     sdjf%cltype      == 'monthly' ) THEN   ;   ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 
    874          ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   ireclast = NINT( 24. * 7.                            / sdjf%freqh ) 
    875          ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   ireclast = NINT( 24.                                 / sdjf%freqh ) 
     850         IF(     sdjf%clftyp      == 'monthly' ) THEN   ;   ireclast = NINT( 24. * REAL(nmonth_len(indexmt), wp) / sdjf%freqh ) 
     851         ELSEIF( sdjf%clftyp(1:4) == 'week'    ) THEN   ;   ireclast = NINT( 24. * 7.                            / sdjf%freqh ) 
     852         ELSEIF( sdjf%clftyp      == 'daily'   ) THEN   ;   ireclast = NINT( 24.                                 / sdjf%freqh ) 
    876853         ELSE                                           ;   ireclast = NINT( 24. * REAL( nyear_len(indexyr), wp) / sdjf%freqh ) 
    877854         ENDIF 
    … …  
    891868         sdjf%nrecsec(1) = sdjf%nrecsec(0) + nyear_len( indexyr ) * idaysec 
    892869      ELSEIF( NINT(sdjf%freqh) ==  -1 ) THEN                                     ! monthly mean: 
    893          IF(     sdjf%cltype      == 'monthly' ) THEN                            !    monthly file 
     870         IF(     sdjf%clftyp      == 'monthly' ) THEN                            !    monthly file 
    894871            sdjf%nrecsec(0   ) = nsec1jan000 + nmonth_beg(indexmt  ) 
    895872            sdjf%nrecsec(1   ) = nsec1jan000 + nmonth_beg(indexmt+1) 
    … …  
    899876         ENDIF 
    900877      ELSE                                                                       ! higher frequency mean (in hours) 
    901          IF(     sdjf%cltype      == 'monthly' ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) 
    902          ELSEIF( sdjf%cltype(1:4) == 'week'    ) THEN   ;   istart = nsec1jan000 + isecwk 
    903          ELSEIF( sdjf%cltype      == 'daily'   ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 
     878         IF(     sdjf%clftyp      == 'monthly' ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) 
     879         ELSEIF( sdjf%clftyp(1:4) == 'week'    ) THEN   ;   istart = nsec1jan000 + isecwk 
     880         ELSEIF( sdjf%clftyp      == 'daily'   ) THEN   ;   istart = nsec1jan000 + nmonth_beg(indexmt) + ( idy - 1 ) * idaysec 
    904881         ELSEIF( indexyr          == 0         ) THEN   ;   istart = nsec1jan000 - nyear_len( 0 ) * idaysec 
    905882         ELSEIF( indexyr          == 2         ) THEN   ;   istart = nsec1jan000 + nyear_len( 1 ) * idaysec 
    … …  
    942919      IF( sdjf%num <= 0 .OR. .NOT. sdjf%ln_clim  ) THEN 
    943920         IF( sdjf%num > 0 )   CALL iom_close( sdjf%num )   ! close file if already open 
    944          CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 ) 
     921         CALL iom_open( sdjf%clname, sdjf%num, ldstop = llstop, ldiof = LEN_TRIM(sdjf%wgtname) > 0 ) 
    945922      ENDIF 
    946923      ! 
    … …  
    964941         ENDIF 
    965942         ! 
    966          CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN(TRIM(sdjf%wgtname)) > 0 )    
     943         CALL iom_open( sdjf%clname, sdjf%num, ldiof = LEN_TRIM(sdjf%wgtname) > 0 )    
    967944         ! 
    968945      ENDIF 
    … …  
    997974         sdf(jf)%ln_tint    = sdf_n(jf)%ln_tint 
    998975         sdf(jf)%ln_clim    = sdf_n(jf)%ln_clim 
    999          sdf(jf)%cltype     = sdf_n(jf)%cltype 
     976         sdf(jf)%clftyp     = sdf_n(jf)%clftyp 
     977         sdf(jf)%cltype     = 'T'   ! by default don't do any call to lbc_lnk in iom_get 
     978         sdf(jf)%zsgn       = 1.    ! by default don't do change signe across the north fold 
    1000979         sdf(jf)%num        = -1 
     980         sdf(jf)%nbb        = 1  ! start with before data in 1 
     981         sdf(jf)%naa        = 2  ! start with after  data in 2 
    1001982         sdf(jf)%wgtname    = " " 
    1002983         IF( LEN( TRIM(sdf_n(jf)%wname) ) > 0 )   sdf(jf)%wgtname = TRIM( cdir )//sdf_n(jf)%wname 
    … …  
    1005986         sdf(jf)%vcomp      = sdf_n(jf)%vcomp 
    1006987         sdf(jf)%rotn(:)    = .TRUE.   ! pretend to be rotated -> won't try to rotate data before the first call to fld_get 
    1007          IF( sdf(jf)%cltype(1:4) == 'week' .AND. nn_leapy == 0  )   & 
     988         IF( sdf(jf)%clftyp(1:4) == 'week' .AND. nn_leapy == 0  )   & 
    1008989            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs nn_leapy = 1') 
    1009          IF( sdf(jf)%cltype(1:4) == 'week' .AND. sdf(jf)%ln_clim )   & 
     990         IF( sdf(jf)%clftyp(1:4) == 'week' .AND. sdf(jf)%ln_clim )   & 
    1010991            &   CALL ctl_stop('fld_clopn: weekly file ('//TRIM(sdf(jf)%clrootname)//') needs ln_clim = .FALSE.') 
    1011992         sdf(jf)%nreclast   = -1 ! Set to non zero default value to avoid errors, is updated to meaningful value during fld_clopn 
    … …  
    10331014            WRITE(numout,*) '         weights: '        , TRIM( sdf(jf)%wgtname    ),   & 
    10341015               &                  '   pairing: '        , TRIM( sdf(jf)%vcomp      ),   & 
    1035                &                  '   data type: '      ,       sdf(jf)%cltype      ,   & 
     1016               &                  '   data type: '      ,       sdf(jf)%clftyp      ,   & 
    10361017               &                  '   land/sea mask:'   , TRIM( sdf(jf)%lsmname    ) 
    10371018            call flush(numout) 
    … …  
    10511032      !!---------------------------------------------------------------------- 
    10521033      TYPE( FLD ), INTENT(in   ) ::   sd        ! field with name of weights file 
    1053       INTEGER    , INTENT(inout) ::   kwgt      ! index of weights 
     1034      INTEGER    , INTENT(  out) ::   kwgt      ! index of weights 
    10541035      ! 
    10551036      INTEGER ::   kw, nestid   ! local integer 
    1056       LOGICAL ::   found        ! local logical 
    10571037      !!---------------------------------------------------------------------- 
    10581038      ! 
    10591039      !! search down linked list  
    10601040      !! weights filename is either present or we hit the end of the list 
    1061       found = .FALSE. 
    10621041      ! 
    10631042      !! because agrif nest part of filenames are now added in iom_open 
    … …  
    10691048#endif 
    10701049      DO kw = 1, nxt_wgt-1 
    1071          IF( TRIM(ref_wgts(kw)%wgtname) == TRIM(sd%wgtname) .AND. & 
    1072              ref_wgts(kw)%nestid == nestid) THEN 
     1050         IF( ref_wgts(kw)%wgtname == sd%wgtname .AND. & 
     1051             ref_wgts(kw)%nestid  == nestid) THEN 
    10731052            kwgt = kw 
    1074             found = .TRUE. 
    1075             EXIT 
     1053            RETURN 
    10761054         ENDIF 
    10771055      END DO 
    1078       IF( .NOT.found ) THEN 
    1079          kwgt = nxt_wgt 
    1080          CALL fld_weight( sd ) 
    1081       ENDIF 
     1056      kwgt = nxt_wgt 
     1057      CALL fld_weight( sd ) 
    10821058      ! 
    10831059   END SUBROUTINE wgt_list 
    … …  
    11221098      TYPE( FLD ), INTENT(in) ::   sd   ! field with name of weights file 
    11231099      !! 
    1124       INTEGER ::   jn         ! dummy loop indices 
     1100      INTEGER ::   ji,jj,jn   ! dummy loop indices 
    11251101      INTEGER ::   inum       ! local logical unit 
    11261102      INTEGER ::   id         ! local variable id 
    … …  
    11281104      INTEGER ::   zwrap      ! local integer 
    11291105      LOGICAL ::   cyclical   !  
    1130       CHARACTER (len=5) ::   aname   ! 
    1131       INTEGER , DIMENSION(:), ALLOCATABLE ::   ddims 
    1132       INTEGER,  DIMENSION(jpi,jpj) ::   data_src 
     1106      CHARACTER (len=5) ::   clname   ! 
     1107      INTEGER , DIMENSION(4) ::   ddims 
     1108      INTEGER                ::   isrc 
    11331109      REAL(wp), DIMENSION(jpi,jpj) ::   data_tmp 
    11341110      !!---------------------------------------------------------------------- 
    … …  
    11431119      !! current weights file 
    11441120 
    1145       !! open input data file (non-model grid) 
    1146       CALL iom_open( sd%clname, inum, ldiof =  LEN(TRIM(sd%wgtname)) > 0 ) 
    1147  
    1148       !! get dimensions: we consider 2D data as 3D data with vertical dim size = 1 
    1149       IF( SIZE(sd%fnow, 3) > 0 ) THEN 
    1150          ALLOCATE( ddims(4) ) 
    1151       ELSE 
    1152          ALLOCATE( ddims(3) ) 
    1153       ENDIF 
    1154       id = iom_varid( inum, sd%clvar, ddims ) 
    1155  
    1156       !! close it 
    1157       CALL iom_close( inum ) 
     1121      !! get data grid dimensions 
     1122      id = iom_varid( sd%num, sd%clvar, ddims ) 
    11581123 
    11591124      !! now open the weights file 
    1160  
    11611125      CALL iom_open ( sd%wgtname, inum )   ! interpolation weights 
    11621126      IF( inum > 0 ) THEN 
    … …  
    11941158         !! two possible cases: bilinear (4 weights) or bicubic (16 weights) 
    11951159         id = iom_varid(inum, 'src05', ldstop=.FALSE.) 
    1196          IF( id <= 0) THEN 
    1197             ref_wgts(nxt_wgt)%numwgt = 4 
    1198          ELSE 
    1199             ref_wgts(nxt_wgt)%numwgt = 16 
    1200          ENDIF 
    1201  
    1202          ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(jpi,jpj,4) ) 
    1203          ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(jpi,jpj,4) ) 
    1204          ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(jpi,jpj,ref_wgts(nxt_wgt)%numwgt) ) 
     1160         IF( id <= 0 ) THEN   ;   ref_wgts(nxt_wgt)%numwgt = 4 
     1161         ELSE                 ;   ref_wgts(nxt_wgt)%numwgt = 16 
     1162         ENDIF 
     1163 
     1164         ALLOCATE( ref_wgts(nxt_wgt)%data_jpi(Nis0:Nie0,Njs0:Nje0,4) ) 
     1165         ALLOCATE( ref_wgts(nxt_wgt)%data_jpj(Nis0:Nie0,Njs0:Nje0,4) ) 
     1166         ALLOCATE( ref_wgts(nxt_wgt)%data_wgt(Nis0:Nie0,Njs0:Nje0,ref_wgts(nxt_wgt)%numwgt) ) 
    12051167 
    12061168         DO jn = 1,4 
    1207             aname = ' ' 
    1208             WRITE(aname,'(a3,i2.2)') 'src',jn 
    1209             data_tmp(:,:) = 0 
    1210             CALL iom_get ( inum, jpdom_data, aname, data_tmp(:,:) ) 
    1211             data_src(:,:) = INT(data_tmp(:,:)) 
    1212             ref_wgts(nxt_wgt)%data_jpj(:,:,jn) = 1 + (data_src(:,:)-1) / ref_wgts(nxt_wgt)%ddims(1) 
    1213             ref_wgts(nxt_wgt)%data_jpi(:,:,jn) = data_src(:,:) - ref_wgts(nxt_wgt)%ddims(1)*(ref_wgts(nxt_wgt)%data_jpj(:,:,jn)-1) 
     1169            WRITE(clname,'(a3,i2.2)') 'src',jn 
     1170            CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' )   !  no call to lbc_lnk 
     1171            DO_2D_00_00 
     1172               isrc = NINT(data_tmp(ji,jj)) - 1 
     1173               ref_wgts(nxt_wgt)%data_jpi(ji,jj,jn) = 1 + MOD(isrc,  ref_wgts(nxt_wgt)%ddims(1)) 
     1174               ref_wgts(nxt_wgt)%data_jpj(ji,jj,jn) = 1 +     isrc / ref_wgts(nxt_wgt)%ddims(1) 
     1175            END_2D 
    12141176         END DO 
    12151177 
    12161178         DO jn = 1, ref_wgts(nxt_wgt)%numwgt 
    1217             aname = ' ' 
    1218             WRITE(aname,'(a3,i2.2)') 'wgt',jn 
    1219             ref_wgts(nxt_wgt)%data_wgt(:,:,jn) = 0.0 
    1220             CALL iom_get ( inum, jpdom_data, aname, ref_wgts(nxt_wgt)%data_wgt(:,:,jn) ) 
     1179            WRITE(clname,'(a3,i2.2)') 'wgt',jn 
     1180            CALL iom_get ( inum, jpdom_global, clname, data_tmp(:,:), cd_type = 'Z' )   !  no call to lbc_lnk 
     1181            DO_2D_00_00 
     1182               ref_wgts(nxt_wgt)%data_wgt(ji,jj,jn) = data_tmp(ji,jj) 
     1183            END_2D 
    12211184         END DO 
    12221185         CALL iom_close (inum) 
    12231186  
    12241187         ! find min and max indices in grid 
    1225          ref_wgts(nxt_wgt)%botleft(1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
    1226          ref_wgts(nxt_wgt)%botleft(2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
     1188         ref_wgts(nxt_wgt)%botleft( 1) = MINVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
     1189         ref_wgts(nxt_wgt)%botleft( 2) = MINVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
    12271190         ref_wgts(nxt_wgt)%topright(1) = MAXVAL(ref_wgts(nxt_wgt)%data_jpi(:,:,:)) 
    12281191         ref_wgts(nxt_wgt)%topright(2) = MAXVAL(ref_wgts(nxt_wgt)%data_jpj(:,:,:)) 
    … …  
    12481211         CALL ctl_stop( '    fld_weight : unable to read the file ' ) 
    12491212      ENDIF 
    1250  
    1251       DEALLOCATE (ddims ) 
    12521213      ! 
    12531214   END SUBROUTINE fld_weight 
    … …  
    12821243      SELECT CASE( SIZE(zfieldo(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),3) ) 
    12831244      CASE(1) 
    1284          CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1), 1, rec1_lsm, recn_lsm) 
     1245         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1),   & 
     1246            &          1, kstart = rec1_lsm, kcount = recn_lsm) 
    12851247      CASE DEFAULT 
    1286          CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:), 1, rec1_lsm, recn_lsm) 
     1248         CALL iom_get( inum, jpdom_unknown, 'LSM', zslmec1(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),   & 
     1249            &          1, kstart = rec1_lsm, kcount = recn_lsm) 
    12871250      END SELECT 
    12881251      CALL iom_close( inum ) 
    … …  
    13571320 
    13581321 
    1359    SUBROUTINE fld_interp( num, clvar, kw, kk, dta,  & 
    1360                           &         nrec, lsmfile)       
     1322   SUBROUTINE fld_interp( num, clvar, kw, kk, dta, nrec, lsmfile)       
    13611323      !!--------------------------------------------------------------------- 
    13621324      !!                    ***  ROUTINE fld_interp  *** 
    … …  
    13761338      INTEGER, DIMENSION(3) ::   rec1_lsm, recn_lsm   ! temporary arrays for start and length in case of seaoverland 
    13771339      INTEGER ::   ii_lsm1,ii_lsm2,ij_lsm1,ij_lsm2    ! temporary indices 
    1378       INTEGER ::   jk, jn, jm, jir, jjr               ! loop counters 
     1340      INTEGER ::   ji, jj, jk, jn, jir, jjr           ! loop counters 
     1341      INTEGER ::   ipk 
    13791342      INTEGER ::   ni, nj                             ! lengths 
    13801343      INTEGER ::   jpimin,jpiwid                      ! temporary indices 
    … …  
    13871350      REAL(wp),DIMENSION(:,:,:), ALLOCATABLE ::   ztmp_fly_dta                 ! local array of values on input grid      
    13881351      !!---------------------------------------------------------------------- 
     1352      ipk = SIZE(dta, 3) 
    13891353      ! 
    13901354      !! for weighted interpolation we have weights at four corners of a box surrounding  
    … …  
    14161380 
    14171381 
    1418       IF( LEN( TRIM(lsmfile) ) > 0 ) THEN 
     1382      IF( LEN_TRIM(lsmfile) > 0 ) THEN 
    14191383      !! indeces for ztmp_fly_dta 
    14201384      ! -------------------------- 
    … …  
    14461410         CASE(1) 
    14471411              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,1),   & 
    1448                  &                                                                nrec, rec1_lsm, recn_lsm) 
     1412                 &          nrec, kstart = rec1_lsm, kcount = recn_lsm) 
    14491413         CASE DEFAULT 
    14501414              CALL iom_get( num, jpdom_unknown, clvar, ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),   & 
    1451                  &                                                                nrec, rec1_lsm, recn_lsm) 
     1415                 &          nrec, kstart = rec1_lsm, kcount = recn_lsm) 
    14521416         END SELECT 
    14531417         CALL apply_seaoverland(lsmfile,ztmp_fly_dta(jpi1_lsm:jpi2_lsm,jpj1_lsm:jpj2_lsm,:),                  & 
    … …  
    14691433          
    14701434         ref_wgts(kw)%fly_dta(:,:,:) = 0.0 
    1471          CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, rec1, recn) 
     1435         CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%fly_dta(jpi1:jpi2,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 
    14721436      ENDIF 
    14731437       
    … …  
    14751439      !! first four weights common to both bilinear and bicubic 
    14761440      !! data_jpi, data_jpj have already been shifted to (1,1) corresponding to botleft 
    1477       !! note that we have to offset by 1 into fly_dta array because of halo 
    1478       dta(:,:,:) = 0.0 
    1479       DO jk = 1,4 
    1480         DO jn = 1, jpj 
    1481           DO jm = 1,jpi 
    1482             ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    1483             nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    1484             dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk) * ref_wgts(kw)%fly_dta(ni+1,nj+1,:) 
    1485           END DO 
    1486         END DO 
     1441      !! note that we have to offset by 1 into fly_dta array because of halo added to fly_dta (rec1 definition) 
     1442      dta(:,:,:) = 0._wp 
     1443      DO jn = 1,4 
     1444         DO_3D_00_00( 1,ipk ) 
     1445            ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 
     1446            nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 
     1447            dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn) * ref_wgts(kw)%fly_dta(ni,nj,jk) 
     1448         END_3D 
    14871449      END DO 
    14881450 
    14891451      IF(ref_wgts(kw)%numwgt .EQ. 16) THEN 
    14901452 
    1491         !! fix up halo points that we couldnt read from file 
    1492         IF( jpi1 == 2 ) THEN 
    1493            ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
    1494         ENDIF 
    1495         IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    1496            ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
    1497         ENDIF 
    1498         IF( jpj1 == 2 ) THEN 
    1499            ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
    1500         ENDIF 
    1501         IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .lt. jpjwid+2 ) THEN 
    1502            ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
    1503         ENDIF 
    1504  
    1505         !! if data grid is cyclic we can do better on east-west edges 
    1506         !! but have to allow for whether first and last columns are coincident 
    1507         IF( ref_wgts(kw)%cyclic ) THEN 
    1508            rec1(2) = MAX( jpjmin-1, 1 ) 
    1509            recn(1) = 1 
    1510            recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
    1511            jpj1 = 2 + rec1(2) - jpjmin 
    1512            jpj2 = jpj1 + recn(2) - 1 
    1513            IF( jpi1 == 2 ) THEN 
    1514               rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 
    1515               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1516               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    1517            ENDIF 
    1518            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
    1519               rec1(1) = 1 + ref_wgts(kw)%overlap 
    1520               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, rec1, recn) 
    1521               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
    1522            ENDIF 
    1523         ENDIF 
    1524  
    1525         ! gradient in the i direction 
    1526         DO jk = 1,4 
    1527           DO jn = 1, jpj 
    1528             DO jm = 1,jpi 
    1529               ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    1530               nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    1531               dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+4) * 0.5 *         & 
    1532                                (ref_wgts(kw)%fly_dta(ni+2,nj+1,:) - ref_wgts(kw)%fly_dta(ni,nj+1,:)) 
    1533             END DO 
    1534           END DO 
    1535         END DO 
    1536  
    1537         ! gradient in the j direction 
    1538         DO jk = 1,4 
    1539           DO jn = 1, jpj 
    1540             DO jm = 1,jpi 
    1541               ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    1542               nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    1543               dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+8) * 0.5 *         & 
    1544                                (ref_wgts(kw)%fly_dta(ni+1,nj+2,:) - ref_wgts(kw)%fly_dta(ni+1,nj,:)) 
    1545             END DO 
    1546           END DO 
    1547         END DO 
    1548  
    1549          ! gradient in the ij direction 
    1550          DO jk = 1,4 
    1551             DO jn = 1, jpj 
    1552                DO jm = 1,jpi 
    1553                   ni = ref_wgts(kw)%data_jpi(jm,jn,jk) 
    1554                   nj = ref_wgts(kw)%data_jpj(jm,jn,jk) 
    1555                   dta(jm,jn,:) = dta(jm,jn,:) + ref_wgts(kw)%data_wgt(jm,jn,jk+12) * 0.25 * ( & 
    1556                                (ref_wgts(kw)%fly_dta(ni+2,nj+2,:) - ref_wgts(kw)%fly_dta(ni  ,nj+2,:)) -   & 
    1557                                (ref_wgts(kw)%fly_dta(ni+2,nj  ,:) - ref_wgts(kw)%fly_dta(ni  ,nj  ,:))) 
    1558                END DO 
    1559             END DO 
     1453         !! fix up halo points that we couldnt read from file 
     1454         IF( jpi1 == 2 ) THEN 
     1455            ref_wgts(kw)%fly_dta(jpi1-1,:,:) = ref_wgts(kw)%fly_dta(jpi1,:,:) 
     1456         ENDIF 
     1457         IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
     1458            ref_wgts(kw)%fly_dta(jpi2+1,:,:) = ref_wgts(kw)%fly_dta(jpi2,:,:) 
     1459         ENDIF 
     1460         IF( jpj1 == 2 ) THEN 
     1461            ref_wgts(kw)%fly_dta(:,jpj1-1,:) = ref_wgts(kw)%fly_dta(:,jpj1,:) 
     1462         ENDIF 
     1463         IF( jpj2 + jpjmin - 1 == ref_wgts(kw)%ddims(2)+1 .AND. jpj2 .LT. jpjwid+2 ) THEN 
     1464            ref_wgts(kw)%fly_dta(:,jpj2+1,:) = 2.0*ref_wgts(kw)%fly_dta(:,jpj2,:) - ref_wgts(kw)%fly_dta(:,jpj2-1,:) 
     1465         ENDIF 
     1466          
     1467         !! if data grid is cyclic we can do better on east-west edges 
     1468         !! but have to allow for whether first and last columns are coincident 
     1469         IF( ref_wgts(kw)%cyclic ) THEN 
     1470            rec1(2) = MAX( jpjmin-1, 1 ) 
     1471            recn(1) = 1 
     1472            recn(2) = MIN( jpjwid+2, ref_wgts(kw)%ddims(2)-rec1(2)+1 ) 
     1473            jpj1 = 2 + rec1(2) - jpjmin 
     1474            jpj2 = jpj1 + recn(2) - 1 
     1475            IF( jpi1 == 2 ) THEN 
     1476               rec1(1) = ref_wgts(kw)%ddims(1) - ref_wgts(kw)%overlap 
     1477               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 
     1478               ref_wgts(kw)%fly_dta(jpi1-1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
     1479            ENDIF 
     1480            IF( jpi2 + jpimin - 1 == ref_wgts(kw)%ddims(1)+1 ) THEN 
     1481               rec1(1) = 1 + ref_wgts(kw)%overlap 
     1482               CALL iom_get( num, jpdom_unknown, clvar, ref_wgts(kw)%col(:,jpj1:jpj2,:), nrec, kstart = rec1, kcount = recn) 
     1483               ref_wgts(kw)%fly_dta(jpi2+1,jpj1:jpj2,:) = ref_wgts(kw)%col(1,jpj1:jpj2,:) 
     1484            ENDIF 
     1485         ENDIF 
     1486         ! 
     1487!!$         DO jn = 1,4 
     1488!!$            DO_3D_00_00( 1,ipk ) 
     1489!!$               ni = ref_wgts(kw)%data_jpi(ji,jj,jn) + 1 
     1490!!$               nj = ref_wgts(kw)%data_jpj(ji,jj,jn) + 1 
     1491!!$               dta(ji,jj,jk) = dta(ji,jj,jk)   & 
     1492!!$                  ! gradient in the i direction 
     1493!!$                  &            + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp *                                    & 
     1494!!$                  &                (ref_wgts(kw)%fly_dta(ni+1,nj  ,jk) - ref_wgts(kw)%fly_dta(ni-1,nj  ,jk))     & 
     1495!!$                  ! gradient in the j direction 
     1496!!$                  &            + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp *                                    & 
     1497!!$                  &                (ref_wgts(kw)%fly_dta(ni  ,nj+1,jk) - ref_wgts(kw)%fly_dta(ni  ,nj-1,jk))     & 
     1498!!$                  ! gradient in the ij direction 
     1499!!$                  &            + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp *                                  & 
     1500!!$                  &               ((ref_wgts(kw)%fly_dta(ni+1,nj+1,jk) - ref_wgts(kw)%fly_dta(ni-1,nj+1,jk)) -   & 
     1501!!$                  &                (ref_wgts(kw)%fly_dta(ni+1,nj-1,jk) - ref_wgts(kw)%fly_dta(ni-1,nj-1,jk))) 
     1502!!$            END_3D 
     1503!!$         END DO 
     1504         ! 
     1505         DO jn = 1,4 
     1506            DO_3D_00_00( 1,ipk ) 
     1507               ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 
     1508               nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 
     1509               ! gradient in the i direction 
     1510               dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+4) * 0.5_wp *         & 
     1511                  &                (ref_wgts(kw)%fly_dta(ni+2,nj+1,jk) - ref_wgts(kw)%fly_dta(ni  ,nj+1,jk)) 
     1512            END_3D 
     1513         END DO 
     1514         DO jn = 1,4 
     1515            DO_3D_00_00( 1,ipk ) 
     1516               ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 
     1517               nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 
     1518               ! gradient in the j direction 
     1519               dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+8) * 0.5_wp *         & 
     1520                  &                (ref_wgts(kw)%fly_dta(ni+1,nj+2,jk) - ref_wgts(kw)%fly_dta(ni+1,nj  ,jk)) 
     1521            END_3D 
     1522         END DO 
     1523         DO jn = 1,4 
     1524            DO_3D_00_00( 1,ipk ) 
     1525               ni = ref_wgts(kw)%data_jpi(ji,jj,jn) 
     1526               nj = ref_wgts(kw)%data_jpj(ji,jj,jn) 
     1527               ! gradient in the ij direction 
     1528               dta(ji,jj,jk) = dta(ji,jj,jk) + ref_wgts(kw)%data_wgt(ji,jj,jn+12) * 0.25_wp * (     & 
     1529                  &                (ref_wgts(kw)%fly_dta(ni+2,nj+2,jk) - ref_wgts(kw)%fly_dta(ni  ,nj+2,jk)) -   & 
     1530                  &                (ref_wgts(kw)%fly_dta(ni+2,nj  ,jk) - ref_wgts(kw)%fly_dta(ni  ,nj  ,jk))) 
     1531            END_3D 
    15601532         END DO 
    15611533         ! 
    … …  
    15841556      IF( .NOT. sdjf%ln_clim ) THEN    
    15851557                                         WRITE(clname, '(a,"_y",i4.4)' ) TRIM( sdjf%clrootname ), kyear    ! add year 
    1586          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname          ), kmonth   ! add month 
     1558         IF( sdjf%clftyp /= 'yearly' )   WRITE(clname, '(a, "m",i2.2)' ) TRIM( clname          ), kmonth   ! add month 
    15871559      ELSE 
    15881560         ! build the new filename if climatological data 
    1589          IF( sdjf%cltype /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
    1590       ENDIF 
    1591       IF(    sdjf%cltype == 'daily' .OR. sdjf%cltype(1:4) == 'week' ) & 
     1561         IF( sdjf%clftyp /= 'yearly' )   WRITE(clname, '(a,"_m",i2.2)' ) TRIM( sdjf%clrootname ), kmonth   ! add month 
     1562      ENDIF 
     1563      IF(    sdjf%clftyp == 'daily' .OR. sdjf%clftyp(1:4) == 'week' ) & 
    15921564         &                               WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname          ), kday     ! add day 
    15931565 
    … …  
    16131585         IF( cl_week(ijul) == TRIM(cdday) ) EXIT 
    16141586      END DO 
    1615       IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%cltype(6:8): '//TRIM(cdday) ) 
     1587      IF( ijul .GT. 7 )   CALL ctl_stop( 'ksec_week: wrong day for sdjf%clftyp(6:8): '//TRIM(cdday) ) 
    16161588      ! 
    16171589      ishift = ijul * NINT(rday) 

  • NEMO/trunk/src/OCE/SBC/sbcapr.F90

    r12489 r13286  
    154154         IF( ln_rstart .AND. iom_varid( numror, 'ssh_ibb', ldstop = .FALSE. ) > 0 ) THEN  
    155155            IF(lwp) WRITE(numout,*) 'sbc_apr:   ssh_ibb read in the restart file' 
    156             CALL iom_get( numror, jpdom_autoglo, 'ssh_ibb', ssh_ibb, ldxios = lrxios )   ! before inv. barometer ssh 
     156            CALL iom_get( numror, jpdom_auto, 'ssh_ibb', ssh_ibb, ldxios = lrxios )   ! before inv. barometer ssh 
    157157            ! 
    158158         ELSE                                         !* no restart: set from nit000 values 

  • NEMO/trunk/src/OCE/SBC/sbccpl.F90

    r13237 r13286  
    10391039         xcplmask(:,:,:) = 0. 
    10401040         CALL iom_open( 'cplmask', inum ) 
    1041          CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:nlci,1:nlcj,1:nn_cplmodel),   & 
    1042             &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ nlci,nlcj,nn_cplmodel /) ) 
     1041         CALL iom_get( inum, jpdom_unknown, 'cplmask', xcplmask(1:jpi,1:jpj,1:nn_cplmodel),   & 
     1042            &          kstart = (/ mig(1),mjg(1),1 /), kcount = (/ jpi,jpj,nn_cplmodel /) ) 
    10431043         CALL iom_close( inum ) 
    10441044      ELSE 

  • NEMO/trunk/src/OCE/SBC/sbcfwb.F90

    r13226 r13286  
    186186            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    187187            ! 
    188             IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     188            IF( lwp ) THEN                   ! control print 
    189189               IF( z_fwf < 0._wp ) THEN 
    190190                  WRITE(numout,*)'   z_fwf < 0' 

  • NEMO/trunk/src/OCE/SBC/sbcice_cice.F90

    r13237 r13286  
    880880!        pcg(:,:)=0.0 
    881881         DO jn=1,jpnij 
    882             DO jj=nldjt(jn),nlejt(jn) 
    883                DO ji=nldit(jn),nleit(jn) 
     882            DO jj=njs0all(jn),nje0all(jn) 
     883               DO ji=nis0all(jn),nie0all(jn) 
    884884                  png2(ji+nimppt(jn)-1,jj+njmppt(jn)-1)=png(ji,jj,jn) 
    885885               ENDDO 
    … …  
    10011001         png(:,:,:)=0.0 
    10021002         DO jn=1,jpnij 
    1003             DO jj=nldjt(jn),nlejt(jn) 
    1004                DO ji=nldit(jn),nleit(jn) 
     1003            DO jj=njs0all(jn),nje0all(jn) 
     1004               DO ji=nis0all(jn),nie0all(jn) 
    10051005                  png(ji,jj,jn)=pcg(ji+nimppt(jn)-1-ji_off,jj+njmppt(jn)-1-jj_off) 
    10061006               ENDDO 

  • NEMO/trunk/src/OCE/SBC/sbcmod.F90

    r13226 r13286  
    507507            & iom_varid( numror, 'utau_b', ldstop = .FALSE. ) > 0 ) THEN 
    508508            IF(lwp) WRITE(numout,*) '          nit000-1 surface forcing fields red in the restart file' 
    509             CALL iom_get( numror, jpdom_autoglo, 'utau_b', utau_b, ldxios = lrxios )   ! before i-stress  (U-point) 
    510             CALL iom_get( numror, jpdom_autoglo, 'vtau_b', vtau_b, ldxios = lrxios )   ! before j-stress  (V-point) 
    511             CALL iom_get( numror, jpdom_autoglo,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point) 
     509            CALL iom_get( numror, jpdom_auto, 'utau_b', utau_b, ldxios = lrxios, cd_type = 'U', psgn = -1._wp )   ! before i-stress  (U-point) 
     510            CALL iom_get( numror, jpdom_auto, 'vtau_b', vtau_b, ldxios = lrxios, cd_type = 'V', psgn = -1._wp )   ! before j-stress  (V-point) 
     511            CALL iom_get( numror, jpdom_auto,  'qns_b',  qns_b, ldxios = lrxios )   ! before non solar heat flux (T-point) 
    512512            ! The 3D heat content due to qsr forcing is treated in traqsr 
    513             ! CALL iom_get( numror, jpdom_autoglo, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point) 
    514             CALL iom_get( numror, jpdom_autoglo, 'emp_b', emp_b, ldxios = lrxios  )    ! before     freshwater flux (T-point) 
     513            ! CALL iom_get( numror, jpdom_auto, 'qsr_b' , qsr_b, ldxios = lrxios  ) ! before     solar heat flux (T-point) 
     514            CALL iom_get( numror, jpdom_auto, 'emp_b', emp_b, ldxios = lrxios  )    ! before     freshwater flux (T-point) 
    515515            ! To ensure restart capability with 3.3x/3.4 restart files    !! to be removed in v3.6 
    516516            IF( iom_varid( numror, 'sfx_b', ldstop = .FALSE. ) > 0 ) THEN 
    517                CALL iom_get( numror, jpdom_autoglo, 'sfx_b', sfx_b, ldxios = lrxios )  ! before salt flux (T-point) 
     517               CALL iom_get( numror, jpdom_auto, 'sfx_b', sfx_b, ldxios = lrxios )  ! before salt flux (T-point) 
    518518            ELSE 
    519519               sfx_b (:,:) = sfx(:,:) 

  • NEMO/trunk/src/OCE/SBC/sbcrnf.F90

    r13237 r13286  
    160160            & iom_varid( numror, 'rnf_b', ldstop = .FALSE. ) > 0 ) THEN 
    161161            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields red in the restart file', lrxios 
    162             CALL iom_get( numror, jpdom_autoglo, 'rnf_b', rnf_b, ldxios = lrxios )     ! before runoff 
    163             CALL iom_get( numror, jpdom_autoglo, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content of runoff 
    164             CALL iom_get( numror, jpdom_autoglo, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salinity content of runoff 
     162            CALL iom_get( numror, jpdom_auto, 'rnf_b', rnf_b, ldxios = lrxios )     ! before runoff 
     163            CALL iom_get( numror, jpdom_auto, 'rnf_hc_b', rnf_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content of runoff 
     164            CALL iom_get( numror, jpdom_auto, 'rnf_sc_b', rnf_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salinity content of runoff 
    165165         ELSE                                                   !* no restart: set from nit000 values 
    166166            IF(lwp) WRITE(numout,*) '          nit000-1 runoff forcing fields set to nit000' 
    … …  
    354354         rn_dep_file = TRIM( cn_dir )//TRIM( sn_dep_rnf%clname ) 
    355355         IF( .NOT. sn_dep_rnf%ln_clim ) THEN   ;   WRITE(rn_dep_file, '(a,"_y",i4)' ) TRIM( rn_dep_file ), nyear    ! add year  
    356             IF( sn_dep_rnf%cltype == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
    357          ENDIF 
    358          CALL iom_open ( rn_dep_file, inum )                           ! open file 
    359          CALL iom_get  ( inum, jpdom_data, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
    360          CALL iom_close( inum )                                        ! close file 
     356            IF( sn_dep_rnf%clftyp == 'monthly' )   WRITE(rn_dep_file, '(a,"m",i2)'  ) TRIM( rn_dep_file ), nmonth   ! add month  
     357         ENDIF 
     358         CALL iom_open ( rn_dep_file, inum )                             ! open file 
     359         CALL iom_get  ( inum, jpdom_global, sn_dep_rnf%clvar, h_rnf )   ! read the river mouth array 
     360         CALL iom_close( inum )                                          ! close file 
    361361         ! 
    362362         nk_rnf(:,:) = 0                               ! set the number of level over which river runoffs are applied 
    … …  
    391391         CALL iom_open( TRIM( sn_rnf%clname ), inum )    !  open runoff file 
    392392         nbrec = iom_getszuld( inum ) 
    393          zrnfcl(:,:,1) = 0._wp                                                          ! init the max to 0. in 1 
     393         zrnfcl(:,:,1) = 0._wp                                                            ! init the max to 0. in 1 
    394394         DO jm = 1, nbrec 
    395             CALL iom_get( inum, jpdom_data, TRIM( sn_rnf%clvar ), zrnfcl(:,:,2), jm )   ! read the value in 2 
    396             zrnfcl(:,:,1) = MAXVAL( zrnfcl(:,:,:), DIM=3 )                              ! store the maximum value in time in 1 
     395            CALL iom_get( inum, jpdom_global, TRIM( sn_rnf%clvar ), zrnfcl(:,:,2), jm )   ! read the value in 2 
     396            zrnfcl(:,:,1) = MAXVAL( zrnfcl(:,:,:), DIM=3 )                                ! store the maximum value in time in 1 
    397397         END DO 
    398398         CALL iom_close( inum ) 
    … …  
    519519      cl_rnfile = TRIM( cn_dir )//TRIM( sn_cnf%clname ) 
    520520      IF( .NOT. sn_cnf%ln_clim ) THEN   ;   WRITE(cl_rnfile, '(a,"_y",i4)' ) TRIM( cl_rnfile ), nyear    ! add year 
    521          IF( sn_cnf%cltype == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month 
     521         IF( sn_cnf%clftyp == 'monthly' )   WRITE(cl_rnfile, '(a,"m",i2)'  ) TRIM( cl_rnfile ), nmonth   ! add month 
    522522      ENDIF 
    523523      ! 
    524524      ! horizontal mask (read in NetCDF file) 
    525       CALL iom_open ( cl_rnfile, inum )                           ! open file 
    526       CALL iom_get  ( inum, jpdom_data, sn_cnf%clvar, rnfmsk )    ! read the river mouth array 
    527       CALL iom_close( inum )                                      ! close file 
     525      CALL iom_open ( cl_rnfile, inum )                             ! open file 
     526      CALL iom_get  ( inum, jpdom_global, sn_cnf%clvar, rnfmsk )    ! read the river mouth array 
     527      CALL iom_close( inum )                                        ! close file 
    528528      ! 
    529529      IF( l_clo_rnf )   CALL clo_rnf( rnfmsk )   ! closed sea inflow set as river mouth 

  • NEMO/trunk/src/OCE/SBC/sbcssm.F90

    r13237 r13286  
    208208         IF( ln_rstart .AND. iom_varid( numror, 'nn_fsbc', ldstop = .FALSE. ) > 0 ) THEN 
    209209            l_ssm_mean = .TRUE. 
    210             CALL iom_get( numror               , 'nn_fsbc', zf_sbc, ldxios = lrxios )    ! sbc frequency of previous run 
    211             CALL iom_get( numror, jpdom_autoglo, 'ssu_m'  , ssu_m, ldxios = lrxios )    ! sea surface mean velocity    (U-point) 
    212             CALL iom_get( numror, jpdom_autoglo, 'ssv_m'  , ssv_m, ldxios = lrxios )    !   "         "    velocity    (V-point) 
    213             CALL iom_get( numror, jpdom_autoglo, 'sst_m'  , sst_m, ldxios = lrxios )    !   "         "    temperature (T-point) 
    214             CALL iom_get( numror, jpdom_autoglo, 'sss_m'  , sss_m, ldxios = lrxios )    !   "         "    salinity    (T-point) 
    215             CALL iom_get( numror, jpdom_autoglo, 'ssh_m'  , ssh_m, ldxios = lrxios )    !   "         "    height      (T-point) 
    216             CALL iom_get( numror, jpdom_autoglo, 'e3t_m'  , e3t_m, ldxios = lrxios )    ! 1st level thickness          (T-point) 
     210            CALL iom_get( numror            , 'nn_fsbc', zf_sbc,ldxios = lrxios )     ! sbc frequency of previous run 
     211            CALL iom_get( numror, jpdom_auto, 'ssu_m'  , ssu_m, ldxios = lrxios, cd_type = 'U', psgn = -1._wp )    ! sea surface mean velocity    (U-point) 
     212            CALL iom_get( numror, jpdom_auto, 'ssv_m'  , ssv_m, ldxios = lrxios, cd_type = 'V', psgn = -1._wp )    !   "         "    velocity    (V-point) 
     213            CALL iom_get( numror, jpdom_auto, 'sst_m'  , sst_m, ldxios = lrxios )    !   "         "    temperature (T-point) 
     214            CALL iom_get( numror, jpdom_auto, 'sss_m'  , sss_m, ldxios = lrxios )    !   "         "    salinity    (T-point) 
     215            CALL iom_get( numror, jpdom_auto, 'ssh_m'  , ssh_m, ldxios = lrxios )    !   "         "    height      (T-point) 
     216            CALL iom_get( numror, jpdom_auto, 'e3t_m'  , e3t_m, ldxios = lrxios )    ! 1st level thickness          (T-point) 
    217217            ! fraction of solar net radiation absorbed in 1st T level 
    218218            IF( iom_varid( numror, 'frq_m', ldstop = .FALSE. ) > 0 ) THEN 
    219                CALL iom_get( numror, jpdom_autoglo, 'frq_m'  , frq_m, ldxios = lrxios  ) 
     219               CALL iom_get( numror, jpdom_auto, 'frq_m'  , frq_m, ldxios = lrxios  ) 
    220220            ELSE 
    221221               frq_m(:,:) = 1._wp   ! default definition 

  • NEMO/trunk/src/OCE/STO/stopar.F90

    r13226 r13286  
    709709         DO jsto = 1 , jpsto2d 
    710710            WRITE(clsto2d(7:9),'(i3.3)') jsto 
    711             CALL iom_get( numstor, jpdom_autoglo, clsto2d , sto2d(:,:,jsto) ) 
     711            CALL iom_get( numstor, jpdom_auto, clsto2d, sto2d(:,:,  jsto) ) 
    712712         END DO 
    713713         ! 3D stochastic parameters 
    714714         DO jsto = 1 , jpsto3d 
    715715            WRITE(clsto3d(7:9),'(i3.3)') jsto 
    716             CALL iom_get( numstor, jpdom_autoglo, clsto3d , sto3d(:,:,:,jsto) ) 
     716            CALL iom_get( numstor, jpdom_auto, clsto3d, sto3d(:,:,:,jsto) ) 
    717717         END DO 
    718718 

  • NEMO/trunk/src/OCE/TDE/tide_mod.F90

    r13226 r13286  
    400400      ! 
    401401      DO itide = 1, nb_harmo 
    402          CALL iom_get  ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z1', ztr(:,:) ) 
    403          CALL iom_get  ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z2', zti(:,:) ) 
     402         CALL iom_get  ( inum, jpdom_global,TRIM(tide_components(itide)%cname_tide)//'_z1', ztr(:,:) ) 
     403         CALL iom_get  ( inum, jpdom_global,TRIM(tide_components(itide)%cname_tide)//'_z2', zti(:,:) ) 
    404404         ! 
    405405         DO ji=1,jpi 

  • NEMO/trunk/src/OCE/TRA/traadv_fct.F90

    r13237 r13286  
    172172               END_2D 
    173173            ELSE                             ! no cavities: only at the ocean surface 
    174                zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 
     174               DO_2D_11_11 
     175                  zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kbb) 
     176               END_2D 
    175177            ENDIF 
    176178         ENDIF 

  • NEMO/trunk/src/OCE/TRA/tradmp.F90

    r12377 r13286  
    208208         !                          ! Read in mask from file 
    209209         CALL iom_open ( cn_resto, imask) 
    210          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto ) 
     210         CALL iom_get  ( imask, jpdom_auto, 'resto', resto ) 
    211211         CALL iom_close( imask ) 
    212212      ENDIF 

  • NEMO/trunk/src/OCE/TRA/traqsr.F90

    r13237 r13286  
    138138            IF(lwp) WRITE(numout,*) '          nit000-1 qsr tracer content forcing field read in the restart file' 
    139139            z1_2 = 0.5_wp 
    140             CALL iom_get( numror, jpdom_autoglo, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux 
     140            CALL iom_get( numror, jpdom_auto, 'qsr_hc_b', qsr_hc_b, ldxios = lrxios )   ! before heat content trend due to Qsr flux 
    141141         ELSE                                           ! No restart or restart not found: Euler forward time stepping 
    142142            z1_2 = 1._wp 
    … …  
    423423      ! 1st ocean level attenuation coefficient (used in sbcssm) 
    424424      IF( iom_varid( numror, 'fraqsr_1lev', ldstop = .FALSE. ) > 0 ) THEN 
    425          CALL iom_get( numror, jpdom_autoglo, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  ) 
     425         CALL iom_get( numror, jpdom_auto, 'fraqsr_1lev'  , fraqsr_1lev, ldxios = lrxios  ) 
    426426      ELSE 
    427427         fraqsr_1lev(:,:) = 1._wp   ! default : no penetration 

  • NEMO/trunk/src/OCE/TRA/trasbc.F90

    r13237 r13286  
    112112            zfact = 0.5_wp 
    113113            sbc_tsc(:,:,:) = 0._wp 
    114             CALL iom_get( numror, jpdom_autoglo, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend 
    115             CALL iom_get( numror, jpdom_autoglo, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend 
     114            CALL iom_get( numror, jpdom_auto, 'sbc_hc_b', sbc_tsc_b(:,:,jp_tem), ldxios = lrxios )   ! before heat content sbc trend 
     115            CALL iom_get( numror, jpdom_auto, 'sbc_sc_b', sbc_tsc_b(:,:,jp_sal), ldxios = lrxios )   ! before salt content sbc trend 
    116116         ELSE                                   ! No restart or restart not found: Euler forward time stepping 
    117117            zfact = 1._wp 

  • NEMO/trunk/src/OCE/TRD/trdmxl_rst.F90

    r11536 r13286  
    149149      IF( ln_trdmxl_instant ) THEN  
    150150         !-- Temperature 
    151          CALL iom_get( inum, jpdom_autoglo, 'tmlbb'           , tmlbb          ) 
    152          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) 
    153          CALL iom_get( inum, jpdom_autoglo, 'tmlatfb'         , tmlatfb        ) 
     151         CALL iom_get( inum, jpdom_auto, 'tmlbb'           , tmlbb          ) 
     152         CALL iom_get( inum, jpdom_auto, 'tmlbn'           , tmlbn          ) 
     153         CALL iom_get( inum, jpdom_auto, 'tmlatfb'         , tmlatfb        ) 
    154154         ! 
    155155         !-- Salinity 
    156          CALL iom_get( inum, jpdom_autoglo, 'smlbb'           , smlbb          ) 
    157          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) 
    158          CALL iom_get( inum, jpdom_autoglo, 'smlatfb'         , smlatfb        ) 
     156         CALL iom_get( inum, jpdom_auto, 'smlbb'           , smlbb          ) 
     157         CALL iom_get( inum, jpdom_auto, 'smlbn'           , smlbn          ) 
     158         CALL iom_get( inum, jpdom_auto, 'smlatfb'         , smlatfb        ) 
    159159      ELSE 
    160          CALL iom_get( inum, jpdom_autoglo, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum 
     160         CALL iom_get( inum, jpdom_auto, 'hmxlbn'          , hmxlbn         ) ! needed for hmxl_sum 
    161161         ! 
    162162         !-- Temperature 
    163          CALL iom_get( inum, jpdom_autoglo, 'tmlbn'           , tmlbn          ) ! needed for tml_sum 
    164          CALL iom_get( inum, jpdom_autoglo, 'tml_sumb'        , tml_sumb       ) 
     163         CALL iom_get( inum, jpdom_auto, 'tmlbn'           , tmlbn          ) ! needed for tml_sum 
     164         CALL iom_get( inum, jpdom_auto, 'tml_sumb'        , tml_sumb       ) 
    165165         DO jk = 1, jpltrd 
    166166            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I1)")   jk 
    167167            ELSE                 ;   WRITE(charout,FMT="('tmltrd_csum_ub_', I2)")   jk 
    168168            ENDIF 
    169             CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub(:,:,jk) ) 
     169            CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub(:,:,jk) ) 
    170170         END DO 
    171          CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 
     171         CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb' , tmltrd_atf_sumb) 
    172172         ! 
    173173         !-- Salinity 
    174          CALL iom_get( inum, jpdom_autoglo, 'smlbn'           , smlbn          ) ! needed for sml_sum 
    175          CALL iom_get( inum, jpdom_autoglo, 'sml_sumb'        , sml_sumb       ) 
     174         CALL iom_get( inum, jpdom_auto, 'smlbn'           , smlbn          ) ! needed for sml_sum 
     175         CALL iom_get( inum, jpdom_auto, 'sml_sumb'        , sml_sumb       ) 
    176176         DO jk = 1, jpltrd 
    177177            IF( jk < 10 ) THEN   ;   WRITE(charout,FMT="('smltrd_csum_ub_', I1)")   jk 
    178178            ELSE                 ;   WRITE(charout,FMT="('smltrd_csum_ub_', I2)")   jk 
    179179            ENDIF 
    180             CALL iom_get( inum, jpdom_autoglo, charout, smltrd_csum_ub(:,:,jk) ) 
     180            CALL iom_get( inum, jpdom_auto, charout, smltrd_csum_ub(:,:,jk) ) 
    181181         END DO 
    182          CALL iom_get( inum, jpdom_autoglo, 'smltrd_atf_sumb' , smltrd_atf_sumb) 
     182         CALL iom_get( inum, jpdom_auto, 'smltrd_atf_sumb' , smltrd_atf_sumb) 
    183183         ! 
    184184         CALL iom_close( inum ) 

  • NEMO/trunk/src/OCE/USR/usrdef_fmask.F90

    r12377 r13286  
    6868            ! 
    6969            IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    70             ij0 = 101   ;   ij1 = 101           ! Gibraltar strait  : partial slip (pfmsk=0.5) 
    71             ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    72             ij0 = 102   ;   ij1 = 102 
    73             ii0 = 139   ;   ii1 = 140   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
     70            ij0 = 101 + nn_hls       ;   ij1 = 101 + nn_hls           ! Gibraltar strait  : partial slip (pfmsk=0.5) 
     71            ii0 = 139 + nn_hls - 1   ;   ii1 = 140 + nn_hls - 1 
     72            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
     73            ij0 = 102 + nn_hls       ;   ij1 = 102 + nn_hls 
     74            ii0 = 139 + nn_hls - 1   ;   ii1 = 140 + nn_hls - 1 
     75            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  0.5_wp 
    7476            ! 
    7577            IF(lwp) WRITE(numout,*) '      Bab el Mandeb ' 
    76             ij0 =  87   ;   ij1 =  88           ! Bab el Mandeb : partial slip (pfmsk=1) 
    77             ii0 = 160   ;   ii1 = 160   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    78             ij0 =  88   ;   ij1 =  88 
    79             ii0 = 159   ;   ii1 = 159   ;   pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
     78            ij0 =  87 + nn_hls       ;   ij1 = 88  + nn_hls          ! Bab el Mandeb : partial slip (pfmsk=1) 
     79            ii0 = 160 + nn_hls - 1   ;   ii1 = 160 + nn_hls - 1 
     80            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
     81            ij0 =  88 + nn_hls       ;   ij1 =  88 + nn_hls 
     82            ii0 = 159 + nn_hls - 1   ;   ii1 = 159 + nn_hls - 1 
     83            pfmsk( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 1:jpk ) =  1._wp 
    8084            ! 
    8185            ! We keep this as an example but it is instable in this case  
    … …  
    9498!!gm    ! Currently these hard-wired indices relate to configuration with extend grid (jpjglo=332) 
    9599            ! 
    96             isrow = 332 - jpjglo 
     100            isrow = 332 - (Nj0glo + 1)   ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 
    97101            ! 
    98102            IF(lwp) WRITE(numout,*) 
    99103            IF(lwp) WRITE(numout,*) '   orca_r1: increase friction near the following straits : ' 
    100104            IF(lwp) WRITE(numout,*) '      Gibraltar ' 
    101             ii0 = 282           ;   ii1 = 283        ! Gibraltar Strait  
    102             ij0 = 241 - isrow   ;   ij1 = 241 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     105            ii0 = 282 + nn_hls - 1       ;   ii1 = 283 + nn_hls - 1        ! Gibraltar Strait  
     106            ij0 = 241 + nn_hls - isrow   ;   ij1 = 241 + nn_hls - isrow 
     107            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    103108            ! 
    104109            IF(lwp) WRITE(numout,*) '      Bhosporus ' 
    105             ii0 = 314           ;   ii1 = 315        ! Bhosporus Strait  
    106             ij0 = 248 - isrow   ;   ij1 = 248 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     110            ii0 = 314 + nn_hls - 1       ;   ii1 = 315 + nn_hls - 1        ! Bhosporus Strait  
     111            ij0 = 248 + nn_hls - isrow   ;   ij1 = 248 + nn_hls - isrow 
     112            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    107113            ! 
    108114            IF(lwp) WRITE(numout,*) '      Makassar (Top) ' 
    109             ii0 =  48           ;   ii1 =  48        ! Makassar Strait (Top)  
    110             ij0 = 189 - isrow   ;   ij1 = 190 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     115            ii0 =  48 + nn_hls - 1       ;   ii1 =  48 + nn_hls - 1        ! Makassar Strait (Top)  
     116            ij0 = 189 + nn_hls - isrow   ;   ij1 = 190 + nn_hls - isrow 
     117            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    111118            ! 
    112119            IF(lwp) WRITE(numout,*) '      Lombok ' 
    113             ii0 =  44           ;   ii1 =  44        ! Lombok Strait  
    114             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     120            ii0 =  44 + nn_hls - 1       ;   ii1 =  44 + nn_hls - 1        ! Lombok Strait  
     121            ij0 = 164 + nn_hls - isrow   ;   ij1 = 165 + nn_hls - isrow 
     122            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    115123            ! 
    116124            IF(lwp) WRITE(numout,*) '      Ombai ' 
    117             ii0 =  53           ;   ii1 =  53        ! Ombai Strait  
    118             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     125            ii0 =  53 + nn_hls - 1       ;   ii1 =  53 + nn_hls - 1        ! Ombai Strait  
     126            ij0 = 164 + nn_hls - isrow   ;   ij1 = 165 + nn_hls - isrow 
     127            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    119128            ! 
    120129            IF(lwp) WRITE(numout,*) '      Timor Passage ' 
    121             ii0 =  56           ;   ii1 =  56        ! Timor Passage  
    122             ij0 = 164 - isrow   ;   ij1 = 165 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
     130            ii0 =  56 + nn_hls - 1       ;   ii1 =  56 + nn_hls - 1        ! Timor Passage  
     131            ij0 = 164 + nn_hls - isrow   ;   ij1 = 165 + nn_hls - isrow 
     132            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 2._wp   
    123133            ! 
    124134            IF(lwp) WRITE(numout,*) '      West Halmahera ' 
    125             ii0 =  58           ;   ii1 =  58        ! West Halmahera Strait  
    126             ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     135            ii0 =  58 + nn_hls - 1       ;   ii1 =  58 + nn_hls - 1        ! West Halmahera Strait  
     136            ij0 = 181 + nn_hls - isrow   ;   ij1 = 182 + nn_hls - isrow 
     137            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    127138            ! 
    128139            IF(lwp) WRITE(numout,*) '      East Halmahera ' 
    129             ii0 =  55           ;   ii1 =  55        ! East Halmahera Strait  
    130             ij0 = 181 - isrow   ;   ij1 = 182 - isrow   ;   pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
     140            ii0 =  55 + nn_hls - 1       ;   ii1 =  55 + nn_hls - 1        ! East Halmahera Strait  
     141            ij0 = 181 + nn_hls - isrow   ;   ij1 = 182 + nn_hls - isrow 
     142            pfmsk( mi0(ii0):mi1(ii1),mj0(ij0):mj1(ij1),1:jpk ) = 3._wp   
    131143            ! 
    132144         CASE DEFAULT 

  • NEMO/trunk/src/OCE/USR/usrdef_hgr.F90

    r13216 r13286  
    1313   !!   usr_def_hgr   : initialize the horizontal mesh  
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce        ! ocean space and time domain 
    1616   USE par_oce        ! ocean space and time domain 
    1717   USE phycst         ! physical constants 
    … …  
    9090      zcos_alpha =   SQRT( 2._wp ) * 0.5_wp 
    9191      ze1deg = ze1 / (ra * rad) 
    92       zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
    93       zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( jpjglo-2 , wp ) 
     92      zlam0 = zlam1 + zcos_alpha * ze1deg * REAL( Ni0glo - 2, wp ) 
     93      zphi0 = zphi1 + zsin_alpha * ze1deg * REAL( Nj0glo - 2, wp ) 
    9494 
    9595#if defined key_agrif 
    … …  
    9797      ! Laurent: Should be modify in case of an east-west cyclic parent grid 
    9898      IF (.NOT.Agrif_root()) THEN 
    99          zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zcos_alpha  & 
     99         zlam0 = zlam1 + Agrif_irhox() * REAL(Agrif_Parent(Ni0glo) -2, wp) * ze1deg * zcos_alpha  & 
    100100                   &   + ( Agrif_Ix()*Agrif_irhox()-(0.5_wp+nbghostcells)) * ze1deg * zcos_alpha  & 
    101101                   &   + ( Agrif_Iy()*Agrif_irhoy()-(0.5_wp+nbghostcells)) * ze1deg * zsin_alpha 
    102          zphi0 = zphi1 + Agrif_irhoy() * REAL(Agrif_Parent(jpjglo)-2 , wp) * ze1deg * zsin_alpha  & 
     102         zphi0 = zphi1 + Agrif_irhoy() * REAL(Agrif_Parent(Nj0glo) -2, wp) * ze1deg * zsin_alpha  & 
    103103                   &   - ( Agrif_Ix()*Agrif_irhox()-nbghostcells )         * ze1deg * zsin_alpha  & 
    104104                   &   + ( Agrif_Iy()*Agrif_irhoy()-nbghostcells )         * ze1deg * zcos_alpha 
    … …  
    110110         CALL ctl_warn( ' GYRE used as Benchmark: e1=e2=106km, no need to adjust rn_Dt, ahm,aht ' ) 
    111111      ENDIF 
    112       IF( nprint==1 .AND. lwp )   THEN 
     112      IF( lwp )   THEN 
    113113         WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha 
    114114         WRITE(numout,*) 'ze1deg', ze1deg, 'zlam0', zlam0, 'zphi0', zphi0 
    … …  
    116116      !    
    117117      DO_2D_11_11 
    118          zim1 = REAL( ji + nimpp - 1 ) - 1.   ;   zim05 = REAL( ji + nimpp - 1 ) - 1.5  
    119          zjm1 = REAL( jj + njmpp - 1 ) - 1.   ;   zjm05 = REAL( jj + njmpp - 1 ) - 1.5  
     118         zim1 = REAL( mig0_oldcmp(ji), wp ) - 1.   ;   zim05 = REAL( mig0_oldcmp(ji), wp ) - 1.5 
     119         zjm1 = REAL( mjg0_oldcmp(jj), wp ) - 1.   ;   zjm05 = REAL( mjg0_oldcmp(jj), wp ) - 1.5 
    120120         !    
    121121         !glamt(i,j) longitude at T-point 

  • NEMO/trunk/src/OCE/USR/usrdef_nam.F90

    r13216 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    7070      kk_cfg = nn_GYRE 
    7171      ! 
    72       kpi = 30 * nn_GYRE + 2        ! Global Domain size 
     72      kpi = 30 * nn_GYRE + 2       !                      
    7373      kpj = 20 * nn_GYRE + 2 
    7474#if defined key_agrif 
    75       IF( .NOT. Agrif_Root() ) THEN 
    76          kpi  = nbcellsx + 2 + 2*nbghostcells_x 
    77          kpj  = nbcellsy + 2 + 2*nbghostcells_y_s 
     75      IF( .NOT.Agrif_Root() ) THEN         ! Global Domain size: add 1 land point on each side 
     76         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     77         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     78!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     79!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    7880      ENDIF 
    7981#endif 
    … …  
    9395         IF( Agrif_Root() ) THEN 
    9496#endif 
    95          WRITE(numout,*) '         jpiglo = 30*nn_GYRE+2                            jpiglo = ', kpi 
    96          WRITE(numout,*) '         jpjglo = 20*nn_GYRE+2                            jpjglo = ', kpj 
     97         WRITE(numout,*) '      Ni0glo = 30*nn_GYRE                              Ni0glo = ', kpi 
     98         WRITE(numout,*) '      Nj0glo = 20*nn_GYRE                              Nj0glo = ', kpj 
    9799#if defined key_agrif 
    98100         ENDIF 
    99101#endif 
    100          WRITE(numout,*) '      number of model levels                              jpkglo = ', kpk 
     102         WRITE(numout,*) '      number of model levels                           jpkglo = ', kpk 
    101103         WRITE(numout,*) '   ' 
    102          WRITE(numout,*) '   Lateral b.c. of the global domain set to closed        jperio = ', kperio 
     104         WRITE(numout,*) '   Lateral b.c. of the global domain set to closed     jperio = ', kperio 
    103105      ENDIF 
    104106      ! 

  • NEMO/trunk/src/OCE/USR/usrdef_zgr.F90

    r13226 r13286  
    198198      IF(lwp) WRITE(numout,*) '       GYRE case : closed flat box ocean without ocean cavities' 
    199199      ! 
    200       z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    201       ! 
    202       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1.0_wp )           ! set surrounding land to zero (here jperio=0 ==>> closed) 
     200      z2d(:,:) = REAL( jpkm1 , wp )                              ! flat bottom 
    203201      ! 
    204202      k_bot(:,:) = NINT( z2d(:,:) )          ! =jpkm1 over the ocean point, =0 elsewhere 

  • NEMO/trunk/src/OCE/ZDF/zdfdrg.F90

    r13237 r13286  
    363363         ! cl_varname is a coefficient in [0,1] giving where to apply the regional boost 
    364364         CALL iom_open ( TRIM(cl_file), inum ) 
    365          CALL iom_get  ( inum, jpdom_data, TRIM(cl_varname), zmsk_boost, 1 ) 
     365         CALL iom_get  ( inum, jpdom_global, TRIM(cl_varname), zmsk_boost, 1 ) 
    366366         CALL iom_close( inum) 
    367367         zmsk_boost(:,:) = 1._wp + rn_boost * zmsk_boost(:,:) 

  • NEMO/trunk/src/OCE/ZDF/zdfgls.F90

    r13283 r13286  
    10701070            ! 
    10711071            IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN        ! all required arrays exist 
    1072                CALL iom_get( numror, jpdom_autoglo, 'en'    , en    , ldxios = lrxios ) 
    1073                CALL iom_get( numror, jpdom_autoglo, 'avt_k' , avt_k , ldxios = lrxios ) 
    1074                CALL iom_get( numror, jpdom_autoglo, 'avm_k' , avm_k , ldxios = lrxios ) 
    1075                CALL iom_get( numror, jpdom_autoglo, 'hmxl_n', hmxl_n, ldxios = lrxios ) 
     1072               CALL iom_get( numror, jpdom_auto, 'en'    , en    , ldxios = lrxios ) 
     1073               CALL iom_get( numror, jpdom_auto, 'avt_k' , avt_k , ldxios = lrxios ) 
     1074               CALL iom_get( numror, jpdom_auto, 'avm_k' , avm_k , ldxios = lrxios ) 
     1075               CALL iom_get( numror, jpdom_auto, 'hmxl_n', hmxl_n, ldxios = lrxios ) 
    10761076            ELSE                         
    10771077               IF(lwp) WRITE(numout,*) 

  • NEMO/trunk/src/OCE/ZDF/zdfiwm.F90

    r13237 r13286  
    140140      !!---------------------------------------------------------------------- 
    141141      ! 
    142       !                       !* Set to zero the 1st and last vertical levels of appropriate variables 
    143       zemx_iwm (:,:,1) = 0._wp   ;   zemx_iwm (:,:,jpk) = 0._wp 
    144       zav_ratio(:,:,1) = 0._wp   ;   zav_ratio(:,:,jpk) = 0._wp 
    145       zav_wave (:,:,1) = 0._wp   ;   zav_wave (:,:,jpk) = 0._wp 
     142      !                        
     143      ! Set to zero the 1st and last vertical levels of appropriate variables 
     144      IF( iom_use("emix_iwm") ) THEN 
     145         DO_2D_00_00 
     146            zemx_iwm (ji,jj,1) = 0._wp   ;   zemx_iwm (ji,jj,jpk) = 0._wp 
     147         END_2D 
     148         zemx_iwm (           1:nn_hls,:,:) = 0._wp   ;   zemx_iwm (:,           1:nn_hls,:) = 0._wp 
     149         zemx_iwm (jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   zemx_iwm (:,jpj-nn_hls+1:   jpj,:) = 0._wp 
     150      ENDIF 
     151      IF( iom_use("av_ratio") ) THEN 
     152         DO_2D_00_00 
     153            zav_ratio(ji,jj,1) = 0._wp   ;   zav_ratio(ji,jj,jpk) = 0._wp 
     154         END_2D 
     155         zav_ratio(           1:nn_hls,:,:) = 0._wp   ;   zav_ratio(:,           1:nn_hls,:) = 0._wp 
     156         zav_ratio(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   zav_ratio(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
     157      ENDIF 
     158      IF( iom_use("av_wave") ) THEN 
     159         DO_2D_00_00 
     160            zav_wave (ji,jj,1) = 0._wp   ;   zav_wave (ji,jj,jpk) = 0._wp 
     161         END_2D 
     162         zav_wave(           1:nn_hls,:,:) = 0._wp   ;   zav_wave(:,           1:nn_hls,:) = 0._wp 
     163         zav_wave(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   zav_wave(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
     164      ENDIF 
    146165      ! 
    147166      !                       ! ----------------------------- ! 
    … …  
    151170      !                       !* Critical slope mixing: distribute energy over the time-varying ocean depth, 
    152171      !                                                 using an exponential decay from the seafloor. 
    153       DO_2D_11_11 
     172      DO_2D_00_00 
    154173         zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1)       ! depth of the ocean 
    155174         zfact(ji,jj) = rho0 * (  1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) )  ) 
    … …  
    157176      END_2D 
    158177!!gm gde3w ==>>>  check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 
    159       DO_3D_11_11( 2, jpkm1 ) 
     178      DO_3D_00_00( 2, jpkm1 ) 
    160179         IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
    161180            zemx_iwm(ji,jj,jk) = 0._wp 
    … …  
    177196      CASE ( 1 )               ! Dissipation scales as N (recommended) 
    178197         ! 
    179          zfact(:,:) = 0._wp 
    180          DO jk = 2, jpkm1              ! part independent of the level 
    181             zfact(:,:) =   & 
    182                &  zfact(:,:) +   & 
    183                &  e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    184          END DO 
    185          ! 
    186          DO_2D_11_11 
     198         DO_2D_00_00 
     199            zfact(ji,jj) = 0._wp 
     200         END_2D 
     201         DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     202            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
     203         END_3D 
     204         ! 
     205         DO_2D_00_00 
    187206            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    188207         END_2D 
    189208         ! 
    190          DO jk = 2, jpkm1              ! complete with the level-dependent part 
    191             zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zfact(:,:) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    192          END DO 
     209         DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     210            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
     211         END_3D 
    193212         ! 
    194213      CASE ( 2 )               ! Dissipation scales as N^2 
    195214         ! 
    196          zfact(:,:) = 0._wp 
    197          DO jk = 2, jpkm1              ! part independent of the level 
    198             zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
    199          END DO 
    200          ! 
    201          DO_2D_11_11 
     215         DO_2D_00_00 
     216            zfact(ji,jj) = 0._wp 
     217         END_2D 
     218         DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     219            zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
     220         END_3D 
     221         ! 
     222         DO_2D_00_00 
    202223            IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    203224         END_2D 
    204225         ! 
    205          DO jk = 2, jpkm1              ! complete with the level-dependent part 
    206             zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zfact(:,:) * MAX( 0._wp, rn2(:,:,jk) ) * wmask(:,:,jk) 
    207          END DO 
     226         DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     227            zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 
     228         END_3D 
    208229         ! 
    209230      END SELECT 
    … …  
    212233      !                        !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 
    213234      ! 
    214       zwkb (:,:,:) = 0._wp 
    215       zfact(:,:)   = 0._wp 
    216       DO jk = 2, jpkm1 
    217          zfact(:,:) = zfact(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) * wmask(:,:,jk) 
    218          zwkb(:,:,jk) = zfact(:,:) 
    219       END DO 
    220 !!gm even better: 
    221 !      DO jk = 2, jpkm1 
    222 !         zwkb(:,:) = zwkb(:,:) + e3w(:,:,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(:,:,jk) )  ) 
    223 !      END DO 
    224 !      zfact(:,:) = zwkb(:,:,jpkm1) 
    225 !!gm or just use zwkb(k=jpk-1) instead of zfact... 
    226 !!gm 
    227       ! 
    228       DO_3D_11_11( 2, jpkm1 ) 
     235      DO_2D_00_00 
     236         zwkb(ji,jj,1) = 0._wp 
     237      END_2D 
     238      DO_3D_00_00( 2, jpkm1 ) 
     239         zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT(  MAX( 0._wp, rn2(ji,jj,jk) )  ) * wmask(ji,jj,jk) 
     240      END_3D 
     241      DO_2D_00_00 
     242         zfact(ji,jj) = zwkb(ji,jj,jpkm1) 
     243      END_2D 
     244      ! 
     245      DO_3D_00_00( 2, jpkm1 ) 
    229246         IF( zfact(ji,jj) /= 0 )   zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) )   & 
    230247            &                                     * wmask(ji,jj,jk) / zfact(ji,jj) 
    231248      END_3D 
    232       zwkb(:,:,1) = zhdep(:,:) * wmask(:,:,1) 
    233       ! 
    234       DO_3D_11_11( 2, jpkm1 ) 
    235          IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization 
     249      DO_2D_00_00 
     250         zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 
     251      END_2D 
     252      ! 
     253      DO_3D_00_00( 2, jpkm1 ) 
     254         IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN   ! optimization: EXP coast a lot 
    236255            zweight(ji,jj,jk) = 0._wp 
    237256         ELSE 
    … …  
    241260      END_3D 
    242261      ! 
    243       zfact(:,:) = 0._wp 
    244       DO jk = 2, jpkm1              ! part independent of the level 
    245          zfact(:,:) = zfact(:,:) + zweight(:,:,jk) 
    246       END DO 
    247       ! 
    248       DO_2D_11_11 
     262      DO_2D_00_00 
     263         zfact(ji,jj) = 0._wp 
     264      END_2D 
     265      DO_3D_00_00( 2, jpkm1 )       ! part independent of the level 
     266         zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 
     267      END_3D 
     268      ! 
     269      DO_2D_00_00 
    249270         IF( zfact(ji,jj) /= 0 )   zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 
    250271      END_2D 
    251272      ! 
    252       DO jk = 2, jpkm1              ! complete with the level-dependent part 
    253          zemx_iwm(:,:,jk) = zemx_iwm(:,:,jk) + zweight(:,:,jk) * zfact(:,:) * wmask(:,:,jk)   & 
    254             &                                / ( gde3w(:,:,jk) - gde3w(:,:,jk-1) ) 
    255 !!gm  use of e3t(:,:,:,Kmm) just above? 
    256       END DO 
     273      DO_3D_00_00( 2, jpkm1 )       ! complete with the level-dependent part 
     274         zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk)   & 
     275            &                                                        / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) 
     276!!gm  use of e3t(ji,jj,:,Kmm) just above? 
     277      END_3D 
    257278      ! 
    258279!!gm  this is to be replaced by just a constant value znu=1.e-6 m2/s 
    259280      ! Calculate molecular kinematic viscosity 
    260       znu_t(:,:,:) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(:,:,:,jp_tem,Kmm) + 0.00694_wp * ts(:,:,:,jp_tem,Kmm) * ts(:,:,:,jp_tem,Kmm)  & 
    261          &                                  + 0.02305_wp * ts(:,:,:,jp_sal,Kmm)  ) * tmask(:,:,:) * r1_rho0 
    262       DO jk = 2, jpkm1 
    263          znu_w(:,:,jk) = 0.5_wp * ( znu_t(:,:,jk-1) + znu_t(:,:,jk) ) * wmask(:,:,jk) 
    264       END DO 
     281      DO_3D_00_00( 1, jpkm1 ) 
     282         znu_t(ji,jj,jk) = 1.e-4_wp * (  17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm)   & 
     283            &                                     + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm)  & 
     284            &                                     + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm)  ) * tmask(ji,jj,jk) * r1_rho0 
     285      END_3D 
     286      DO_3D_00_00( 2, jpkm1 ) 
     287         znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 
     288      END_3D 
    265289!!gm end 
    266290      ! 
    267291      ! Calculate turbulence intensity parameter Reb 
    268       DO jk = 2, jpkm1 
    269          zReb(:,:,jk) = zemx_iwm(:,:,jk) / MAX( 1.e-20_wp, znu_w(:,:,jk) * rn2(:,:,jk) ) 
    270       END DO 
     292      DO_3D_00_00( 2, jpkm1 ) 
     293         zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 
     294      END_3D 
    271295      ! 
    272296      ! Define internal wave-induced diffusivity 
    273       DO jk = 2, jpkm1 
    274          zav_wave(:,:,jk) = znu_w(:,:,jk) * zReb(:,:,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
    275       END DO 
     297      DO_3D_00_00( 2, jpkm1 ) 
     298         zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6   ! This corresponds to a constant mixing efficiency of 1/6 
     299      END_3D 
    276300      ! 
    277301      IF( ln_mevar ) THEN              ! Variable mixing efficiency case : modify zav_wave in the 
    278          DO_3D_11_11( 2, jpkm1 ) 
     302         DO_3D_00_00( 2, jpkm1 ) 
    279303            IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 
    280304               zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) 
    … …  
    285309      ENDIF 
    286310      ! 
    287       DO jk = 2, jpkm1                 ! Bound diffusivity by molecular value and 100 cm2/s 
    288          zav_wave(:,:,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(:,:,jk) ), 1.e-2_wp  ) * wmask(:,:,jk) 
    289       END DO 
     311      DO_3D_00_00( 2, jpkm1 )          ! Bound diffusivity by molecular value and 100 cm2/s 
     312         zav_wave(ji,jj,jk) = MIN(  MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp  ) * wmask(ji,jj,jk) 
     313      END_3D 
    290314      ! 
    291315      IF( kt == nit000 ) THEN        !* Control print at first time-step: diagnose the energy consumed by zav_wave 
    292316         zztmp = 0._wp 
    293317!!gm used of glosum 3D.... 
    294          DO_3D_11_11( 2, jpkm1 ) 
     318         DO_3D_00_00( 2, jpkm1 ) 
    295319            zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj)   & 
    296320               &          * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 
    … …  
    314338      IF( ln_tsdiff ) THEN          !* Option for differential mixing of salinity and temperature 
    315339         ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 
    316          DO_3D_11_11( 2, jpkm1 ) 
     340         DO_3D_00_00( 2, jpkm1 ) 
    317341            ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 
    318342            IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN 
    … …  
    323347         END_3D 
    324348         CALL iom_put( "av_ratio", zav_ratio ) 
    325          DO jk = 2, jpkm1           !* update momentum & tracer diffusivity with wave-driven mixing 
    326             p_avs(:,:,jk) = p_avs(:,:,jk) + zav_wave(:,:,jk) * zav_ratio(:,:,jk) 
    327             p_avt(:,:,jk) = p_avt(:,:,jk) + zav_wave(:,:,jk) 
    328             p_avm(:,:,jk) = p_avm(:,:,jk) + zav_wave(:,:,jk) 
    329          END DO 
     349         DO_3D_00_00( 2, jpkm1 )    !* update momentum & tracer diffusivity with wave-driven mixing 
     350            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 
     351            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     352            p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
     353         END_3D 
    330354         ! 
    331355      ELSE                          !* update momentum & tracer diffusivity with wave-driven mixing 
    332          DO jk = 2, jpkm1 
    333             p_avs(:,:,jk) = p_avs(:,:,jk) + zav_wave(:,:,jk) 
    334             p_avt(:,:,jk) = p_avt(:,:,jk) + zav_wave(:,:,jk) 
    335             p_avm(:,:,jk) = p_avm(:,:,jk) + zav_wave(:,:,jk) 
    336          END DO 
     356         DO_3D_00_00( 2, jpkm1 ) 
     357            p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 
     358            p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) 
     359            p_avm(ji,jj,jk) = p_avm(ji,jj,jk) + zav_wave(ji,jj,jk) 
     360         END_3D 
    337361      ENDIF 
    338362 
    … …  
    344368      IF( iom_use("bflx_iwm") .OR. iom_use("pcmap_iwm") ) THEN 
    345369         ALLOCATE( z2d(jpi,jpj) , z3d(jpi,jpj,jpk) ) 
    346          z3d(:,:,:) = MAX( 0._wp, rn2(:,:,:) ) * zav_wave(:,:,:) 
    347          z2d(:,:) = 0._wp 
    348          DO jk = 2, jpkm1 
    349             z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk) 
    350          END DO 
    351          z2d(:,:) = rho0 * z2d(:,:) 
    352          CALL iom_put( "bflx_iwm", z3d ) 
     370         ! Initialisation for iom_put 
     371         DO_2D_00_00 
     372            z3d(ji,jj,1) = 0._wp   ;   z3d(ji,jj,jpk) = 0._wp 
     373         END_2D 
     374         z3d(           1:nn_hls,:,:) = 0._wp   ;   z3d(:,           1:nn_hls,:) = 0._wp 
     375         z3d(jpi-nn_hls+1:jpi   ,:,:) = 0._wp   ;   z3d(:,jpj-nn_hls+1:   jpj,:) = 0._wp 
     376         z2d(           1:nn_hls,:  ) = 0._wp   ;   z2d(:,           1:nn_hls  ) = 0._wp 
     377         z2d(jpi-nn_hls+1:jpi   ,:  ) = 0._wp   ;   z2d(:,jpj-nn_hls+1:   jpj  ) = 0._wp 
     378 
     379         DO_3D_00_00( 2, jpkm1 ) 
     380            z3d(ji,jj,jk) = MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) 
     381         END_3D 
     382         DO_2D_00_00 
     383            z2d(ji,jj) = 0._wp 
     384         END_2D 
     385         DO_3D_00_00( 2, jpkm1 )  
     386            z2d(ji,jj) = z2d(ji,jj) + e3w(ji,jj,jk,Kmm) * z3d(ji,jj,jk) * wmask(ji,jj,jk) 
     387         END_3D 
     388         DO_2D_00_00 
     389            z2d(ji,jj) = rho0 * z2d(ji,jj) 
     390         END_2D 
     391         CALL iom_put(  "bflx_iwm", z3d ) 
    353392         CALL iom_put( "pcmap_iwm", z2d ) 
    354393         DEALLOCATE( z2d , z3d ) 

  • NEMO/trunk/src/OCE/ZDF/zdfosm.F90

    r13283 r13286  
    14741474        id1 = iom_varid( numror, 'wn'   , ldstop = .FALSE. ) 
    14751475        IF( id1 > 0 ) THEN                       ! 'wn' exists; read 
    1476            CALL iom_get( numror, jpdom_autoglo, 'wn', ww, ldxios = lrxios ) 
     1476           CALL iom_get( numror, jpdom_auto, 'wn', ww, ldxios = lrxios ) 
    14771477           WRITE(numout,*) ' ===>>>> :  ww read from restart file' 
    14781478        ELSE 
    … …  
    14831483        id2 = iom_varid( numror, 'hbli'   , ldstop = .FALSE. ) 
    14841484        IF( id1 > 0 .AND. id2 > 0) THEN                       ! 'hbl' exists; read and return 
    1485            CALL iom_get( numror, jpdom_autoglo, 'hbl' , hbl , ldxios = lrxios ) 
    1486            CALL iom_get( numror, jpdom_autoglo, 'hbli', hbli, ldxios = lrxios  ) 
     1485           CALL iom_get( numror, jpdom_auto, 'hbl' , hbl , ldxios = lrxios ) 
     1486           CALL iom_get( numror, jpdom_auto, 'hbli', hbli, ldxios = lrxios  ) 
    14871487           WRITE(numout,*) ' ===>>>> :  hbl & hbli read from restart file' 
    14881488           RETURN 

  • NEMO/trunk/src/OCE/ZDF/zdfric.F90

    r12489 r13286  
    214214            ! 
    215215            IF( MIN( id1, id2 ) > 0 ) THEN         ! restart exists => read it 
    216                CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k, ldxios = lrxios ) 
    217                CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k, ldxios = lrxios ) 
     216               CALL iom_get( numror, jpdom_auto, 'avt_k', avt_k, ldxios = lrxios ) 
     217               CALL iom_get( numror, jpdom_auto, 'avm_k', avm_k, ldxios = lrxios ) 
    218218            ENDIF 
    219219         ENDIF 

  • NEMO/trunk/src/OCE/ZDF/zdftke.F90

    r13237 r13286  
    737737            ! 
    738738            IF( MIN( id1, id2, id3, id4 ) > 0 ) THEN      ! fields exist 
    739                CALL iom_get( numror, jpdom_autoglo, 'en'   , en   , ldxios = lrxios ) 
    740                CALL iom_get( numror, jpdom_autoglo, 'avt_k', avt_k, ldxios = lrxios ) 
    741                CALL iom_get( numror, jpdom_autoglo, 'avm_k', avm_k, ldxios = lrxios ) 
    742                CALL iom_get( numror, jpdom_autoglo, 'dissl', dissl, ldxios = lrxios ) 
     739               CALL iom_get( numror, jpdom_auto, 'en'   , en   , ldxios = lrxios ) 
     740               CALL iom_get( numror, jpdom_auto, 'avt_k', avt_k, ldxios = lrxios ) 
     741               CALL iom_get( numror, jpdom_auto, 'avm_k', avm_k, ldxios = lrxios ) 
     742               CALL iom_get( numror, jpdom_auto, 'dissl', dissl, ldxios = lrxios ) 
    743743            ELSE                                          ! start TKE from rest 
    744744               IF(lwp) WRITE(numout,*) 

  • NEMO/trunk/src/OCE/do_loop_substitute.h90

    r12377 r13286  
    5050! includes the possibility of strides for which an extra set of DO_3DS macros are defined. 
    5151! 
    52 ! In the following definitions the inner PE domain is defined by start indices of (___kIs_, __kJs_) and end indices of (__kIe_, __kJe_) 
    53 ! The following macros are defined just below: ___kIs_, __kJs_, ___kIsm1_, __kJsm1_, ___kIe_, __kJe_, ___kIep1_, __kJep1_.  
     52! In the following definitions the inner PE domain is defined by start indices of (_Nis0, Njs0) and end indices of (Nie0, Njs0) 
     53! The following macros are defined just below: _Nis0, Njs0, _Nis1, Njs1, _Nie0, Njs0, _Nie1, Nje1.  
    5454! These names are chosen to, hopefully, avoid any future, unintended matches elsewhere in the code. 
    5555! 
     56!!gm changes ; 
     57! 
     58! -0- fortran code : defined in par_oce.F90 the folowwing valiables : 
     59!!#  
     60!!#    INTEGER, PUBLIC ::   Nis0, Nis1, Nis2   !: start I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     61!!#    INTEGER, PUBLIC ::   Nie0, Nie1, Nie2   !: end   I-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     62!!#    INTEGER, PUBLIC ::   Njs0, Njs1, Njs2   !: start J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     63!!#    INTEGER, PUBLIC ::   Nje0, Nje1, Nje2   !: end   J-index (_0: no halo, _1 & _2: 1 & 2-halos) 
     64!!#  
     65! -1- fortran code  put in  mppinit.F90 :    
     66!!#            just after the futur read of nn_hls in namXXX (to be defined) 
     67!!#            NB: currently nn_hls is defined as a parameter in par_oce.F90 
     68!!#   SUBROUTINE init_do_loop 
     69!!#      !!---------------------------------------------------------------------- 
     70!!#      !!                  ***  ROUTINE init_do_loop_indices  *** 
     71!!#      !! 
     72!!#      !! ** Purpose :   set the starting/ending indices of DO-loop 
     73!!#      !!              These indices are used in do_loop_substitute.h90 
     74!!#      !!----------------------------------------------------------------------!!# !                             !==  set the starting/ending indices of DO-loop  ==!   (used in do_loop_substitute.h90) 
     75!!#      ! 
     76!!#      IF(     nn_hls == 1 ) THEN          !* halo size of 1 
     77!!#         ! 
     78!!#         Nis0 =   2     ;   Nis1 =   1     ;   Nis2 = Nis1 
     79!!#         Njs0 = Nis0    ;   Njs1 = Nis1    ;   Njs2 = Nis1 
     80!!#         ! 
     81!!#         Nie0 = jpi-1   ;   Nje1 = jpi     ;   Nie2 = Nie1 
     82!!#         Nje0 = jpj-1   ;   Nje1 = jpj-1   ;   Nje2 = Nie1 
     83!!#         ! 
     84!!#      ELSEIF( nn_hls == 2 ) THEN          !* halo size of 2 
     85!!#         ! 
     86!!#         Nis0 =   3     ;   Nis1 =   2     ;   Nis2 =   1 
     87!!#         Njs0 = Nis0    ;   Njs1 = Nis1    ;   Njs2 = Nis2 
     88!!#         ! 
     89!!#         Nie0 = jpi-2   ;   Nje1 = jpi-1   ;   Nie2 = jpi 
     90!!#         Nje0 = jpj-2   ;   Nje1 = jpj-1   ;   Nje2 = jpj 
     91!!#         ! 
     92!!#      ELSE                                !* unexpected halo size 
     93!!#         CALL ctl_stop( 'STOP', 'ini_mpp:  wrong value of halo size : nn_hls= 1 or 2 only !') 
     94!!#      ENDIF 
     95!!# 
     96!!#      ! 
     97!!#   END SUBROUTINE init_do_loop 
     98! 
     99!  ! -2- in do_loop_substitute becomes : 
     100!  
    56101#endif 
    57 #define __kIs_     2 
    58 #define __kJs_     2 
    59 #define __kIsm1_   1 
    60 #define __kJsm1_   1 
    61  
    62 #define __kIe_     jpim1 
    63 #define __kJe_     jpjm1 
    64 #define __kIep1_   jpi 
    65 #define __kJep1_   jpj 
    66  
    67 #define DO_2D_00_00   DO jj = __kJs_, __kJe_   ;   DO ji = __kIs_, __kIe_ 
    68 #define DO_2D_00_01   DO jj = __kJs_, __kJe_   ;   DO ji = __kIs_, __kIep1_ 
    69 #define DO_2D_00_10   DO jj = __kJs_, __kJe_   ;   DO ji = __kIsm1_, __kIe_ 
    70 #define DO_2D_00_11   DO jj = __kJs_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_ 
    71   
    72 #define DO_2D_01_00   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIs_, __kIe_ 
    73 #define DO_2D_01_01   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIs_, __kIep1_ 
    74 #define DO_2D_01_10   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIsm1_, __kIe_ 
    75 #define DO_2D_01_11   DO jj = __kJs_, __kJep1_   ;   DO ji = __kIsm1_, __kIep1_ 
    76   
    77 #define DO_2D_10_00   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIs_, __kIe_ 
    78 #define DO_2D_10_10   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIe_ 
    79 #define DO_2D_10_11   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_ 
    80   
    81 #define DO_2D_11_00   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIe_ 
    82 #define DO_2D_11_01   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIep1_ 
    83 #define DO_2D_11_10   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIsm1_, __kIe_ 
    84 #define DO_2D_11_11   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIsm1_, __kIep1_ 
    85  
    86 #define DO_3D_00_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_00 
    87 #define DO_3D_00_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_10 
    88   
    89 #define DO_3D_01_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_01 
    90   
    91 #define DO_3D_10_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_00 
    92 #define DO_3D_10_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10 
    93 #define DO_3D_10_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11 
    94   
    95 #define DO_3D_11_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11 
    96  
    97 #define DO_3DS_00_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_00 
    98 #define DO_3DS_01_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_01 
    99 #define DO_3DS_10_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_10 
    100 #define DO_3DS_11_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_11 
    101  
     102 
     103! 2D loops with 1 
     104 
     105#define DO_2D_00_00   DO jj = Njs0, Nje0   ;   DO ji = Nis0, Nie0 
     106#define DO_2D_00_01   DO jj = Njs0, Nje0   ;   DO ji = Nis0, Nie1 
     107#define DO_2D_00_10   DO jj = Njs0, Nje0   ;   DO ji = Nis1, Nie0 
     108#define DO_2D_00_11   DO jj = Njs0, Nje0   ;   DO ji = Nis1, Nie1 
     109  
     110#define DO_2D_01_00   DO jj = Njs0, Nje1   ;   DO ji = Nis0, Nie0 
     111#define DO_2D_01_01   DO jj = Njs0, Nje1   ;   DO ji = Nis0, Nie1 
     112#define DO_2D_01_10   DO jj = Njs0, Nje1   ;   DO ji = Nis1, Nie0 
     113#define DO_2D_01_11   DO jj = Njs0, Nje1   ;   DO ji = Nis1, Nie1 
     114  
     115#define DO_2D_10_00   DO jj = Njs1, Nje0   ;   DO ji = Nis0, Nie0 
     116#define DO_2D_10_01   DO jj = Njs1, Nje0   ;   DO ji = Nis0, Nie1   ! not used ? 
     117#define DO_2D_10_10   DO jj = Njs1, Nje0   ;   DO ji = Nis1, Nie0 
     118#define DO_2D_10_11   DO jj = Njs1, Nje0   ;   DO ji = Nis1, Nie1 
     119  
     120#define DO_2D_11_00   DO jj = Njs1, Nje1   ;   DO ji = Nis0, Nie0 
     121#define DO_2D_11_01   DO jj = Njs1, Nje1   ;   DO ji = Nis0, Nie1 
     122#define DO_2D_11_10   DO jj = Njs1, Nje1   ;   DO ji = Nis1, Nie0 
     123#define DO_2D_11_11   DO jj = Njs1, Nje1   ;   DO ji = Nis1, Nie1 
     124 
     125! 2D loops with 1 following a 2/3D loop with 2 
     126 
     127#define DO_2D_00_01nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis0    , Nie1nxt2 
     128#define DO_2D_00_10nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis1nxt2, Nie0 
     129#define DO_2D_00_11nxt2   DO jj = Njs0    , Nje0       ;   DO ji = Nis1nxt2, Nie1nxt2 
     130 
     131#define DO_2D_01_00nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis0    , Nie0 
     132#define DO_2D_01_01nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis0    , Nie1nxt2 
     133#define DO_2D_01_10nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie0 
     134#define DO_2D_01_11nxt2   DO jj = Njs0    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie1nxt2 
     135 
     136#define DO_2D_10_00nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis0    , Nie0 
     137#define DO_2D_10_01nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis0    , Nie1nxt2   ! not used ? 
     138#define DO_2D_10_10nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis1nxt2, Nie0 
     139#define DO_2D_10_11nxt2   DO jj = Njs1nxt2, Nje0       ;   DO ji = Nis1nxt2, Nie1nxt2 
     140 
     141#define DO_2D_11_00nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis0    , Nie0 
     142#define DO_2D_11_01nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis0    , Nie1nxt2 
     143#define DO_2D_11_10nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis1nxt2, Nie0 
     144#define DO_2D_11_11nxt2   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis1nxt2, Nie1nxt2 
     145 
     146! 2D loops with 2 
     147 
     148#define DO_2D_11_12   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis1nxt2, Nie2 
     149#define DO_2D_11_21   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis2    , Nie1nxt2 
     150#define DO_2D_11_22   DO jj = Njs1nxt2, Nje1nxt2   ;   DO ji = Nis2    , Nie2 
     151 
     152#define DO_2D_12_11   DO jj = Njs1nxt2, Nje2       ;   DO ji = Nis1nxt2, Nie1nxt2 
     153#define DO_2D_12_12   DO jj = Njs1nxt2, Nje2       ;   DO ji = Nis1nxt2, Nie2 
     154#define DO_2D_12_21   DO jj = Njs1nxt2, Nje2       ;   DO ji = Nis2    , Nie1nxt2 
     155#define DO_2D_12_22   DO jj = Njs1nxt2, Nje2       ;   DO ji = Nis2    , Nie2 
     156  
     157#define DO_2D_21_11   DO jj = Njs2    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie1nxt2 
     158#define DO_2D_21_12   DO jj = Njs2    , Nje1nxt2   ;   DO ji = Nis1nxt2, Nie2        ! not used ? 
     159#define DO_2D_21_21   DO jj = Njs2    , Nje1nxt2   ;   DO ji = Nis2    , Nie1nxt2 
     160#define DO_2D_21_22   DO jj = Njs2    , Nje1nxt2   ;   DO ji = Nis2    , Nie2 
     161                                      
     162#define DO_2D_22_11   DO jj = Njs2    , Nje2       ;   DO ji = Nis1nxt2, Nie1nxt2 
     163#define DO_2D_22_12   DO jj = Njs2    , Nje2       ;   DO ji = Nis1nxt2, Nie2 
     164#define DO_2D_22_21   DO jj = Njs2    , Nje2       ;   DO ji = Nis2    , Nie1nxt2 
     165#define DO_2D_22_22   DO jj = Njs2    , Nje2       ;   DO ji = Nis2    , Nie2 
     166 
     167! 3D loops with 1 
     168 
     169#define DO_3D_00_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_00    
     170#define DO_3D_00_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_01    
     171#define DO_3D_00_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_10    
     172#define DO_3D_00_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_11    
     173 
     174#define DO_3D_01_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_00    
     175#define DO_3D_01_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_01    
     176#define DO_3D_01_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_10    
     177#define DO_3D_01_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_11    
     178 
     179#define DO_3D_10_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_00    
     180#define DO_3D_10_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_01    
     181#define DO_3D_10_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10    
     182#define DO_3D_10_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11    
     183 
     184#define DO_3D_11_00(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_00    
     185#define DO_3D_11_01(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_01    
     186#define DO_3D_11_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_10    
     187#define DO_3D_11_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11    
     188 
     189! 3D loops with 1, following a 2/3D loop with 2 
     190 
     191#define DO_3D_00_01nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_01nxt2    
     192#define DO_3D_00_10nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_10nxt2    
     193#define DO_3D_00_11nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_00_11nxt2    
     194 
     195#define DO_3D_01_00nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_00nxt2    
     196#define DO_3D_01_01nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_01nxt2    
     197#define DO_3D_01_10nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_10nxt2    
     198#define DO_3D_01_11nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_01_11nxt2    
     199 
     200#define DO_3D_10_00nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_00nxt2    
     201#define DO_3D_10_01nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_01nxt2    
     202#define DO_3D_10_10nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10nxt2    
     203#define DO_3D_10_11nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11nxt2    
     204 
     205#define DO_3D_11_00nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_00nxt2    
     206#define DO_3D_11_01nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_01nxt2    
     207#define DO_3D_11_10nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_10nxt2    
     208#define DO_3D_11_11nxt2(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11nxt2    
     209 
     210! 3D loops with 2 
     211 
     212#define DO_3D_11_12(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_12    
     213#define DO_3D_11_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_21    
     214#define DO_3D_11_22(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_22    
     215 
     216#define DO_3D_12_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_12_11    
     217#define DO_3D_12_12(ks,ke)   DO jk = ks, ke   ;   DO_2D_12_12    
     218#define DO_3D_12_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_12_21    
     219#define DO_3D_12_22(ks,ke)   DO jk = ks, ke   ;   DO_2D_12_22    
     220 
     221#define DO_3D_21_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_11    
     222#define DO_3D_21_12(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_12    
     223#define DO_3D_21_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_21    
     224#define DO_3D_21_22(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_22    
     225 
     226#define DO_3D_22_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_22_11    
     227#define DO_3D_22_12(ks,ke)   DO jk = ks, ke   ;   DO_2D_22_12    
     228#define DO_3D_22_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_22_21    
     229#define DO_3D_22_22(ks,ke)   DO jk = ks, ke   ;   DO_2D_22_22    
     230                                 
     231! 3D loops with increment with 1 
     232 
     233#define DO_3DS_00_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_00    
     234#define DO_3DS_00_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_01    
     235#define DO_3DS_00_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_10    
     236#define DO_3DS_00_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_11    
     237 
     238#define DO_3DS_01_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_00    
     239#define DO_3DS_01_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_01    
     240#define DO_3DS_01_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_10    
     241#define DO_3DS_01_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_11    
     242 
     243#define DO_3DS_10_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_00    
     244#define DO_3DS_10_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_01    
     245#define DO_3DS_10_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_10    
     246#define DO_3DS_10_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_11    
     247 
     248#define DO_3DS_11_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_00    
     249#define DO_3DS_11_01(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_01    
     250#define DO_3DS_11_10(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_10    
     251#define DO_3DS_11_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_11    
     252                                 
     253! 3D loops with increment with 1, following a 2/3D loop with 2 
     254 
     255#define DO_3DS_00_01nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_01nxt2    
     256#define DO_3DS_00_10nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_10nxt2    
     257#define DO_3DS_00_11nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_11nxt2    
     258 
     259#define DO_3DS_01_00nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_00nxt2    
     260#define DO_3DS_01_01nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_01nxt2    
     261#define DO_3DS_01_10nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_10nxt2    
     262#define DO_3DS_01_11nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_01_11nxt2    
     263 
     264#define DO_3DS_10_00nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_00nxt2    
     265#define DO_3DS_10_01nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_01nxt2    
     266#define DO_3DS_10_10nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_10nxt2    
     267#define DO_3DS_10_11nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_10_11nxt2    
     268 
     269#define DO_3DS_11_00nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_00nxt2    
     270#define DO_3DS_11_01nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_01nxt2    
     271#define DO_3DS_11_10nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_10nxt2    
     272#define DO_3DS_11_11nxt2(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_11nxt2    
     273 
     274! 3D loops with increment with 2 
     275 
     276#define DO_3DS_11_12(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_12    
     277#define DO_3DS_11_21(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_21    
     278#define DO_3DS_11_22(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_11_22    
     279 
     280#define DO_3DS_12_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_12_11    
     281#define DO_3DS_12_12(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_12_12    
     282#define DO_3DS_12_21(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_12_21    
     283#define DO_3DS_12_22(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_12_22    
     284 
     285#define DO_3DS_21_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_21_11    
     286#define DO_3DS_21_12(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_21_12    
     287#define DO_3DS_21_21(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_21_21    
     288#define DO_3DS_21_22(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_21_22    
     289 
     290#define DO_3DS_22_11(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_22_11    
     291#define DO_3DS_22_12(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_22_12    
     292#define DO_3DS_22_21(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_22_21    
     293#define DO_3DS_22_22(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_22_22    
     294                                 
    102295#define END_2D   END DO   ;   END DO 
    103296#define END_3D   END DO   ;   END DO   ;   END DO 

  • NEMO/trunk/src/OCE/nemogcm.F90

    r13237 r13286  
    4747   USE usrdef_nam     ! user defined configuration 
    4848   USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5049   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5150   USE istate         ! initial state setting          (istate_init routine) 
    … …  
    8887#endif 
    8988   ! 
     89   USE prtctl         ! Print control 
    9090   USE in_out_manager ! I/O manager 
    9191   USE lib_mpp        ! distributed memory computing 
    9292   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    93    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     93   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    9494   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    9595#if defined key_iomput 
    … …  
    9999   USE agrif_all_update   ! Master Agrif update 
    100100#endif 
     101   USE halo_mng 
    101102 
    102103   IMPLICIT NONE 
    … …  
    279280      INTEGER ::   ios, ilocal_comm   ! local integers 
    280281      !! 
    281       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    282          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    283          &             ln_timing, ln_diacfl 
     282      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     283         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    284284      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    285285      !!---------------------------------------------------------------------- 
    … …  
    399399      ! 
    400400      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    401          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     401         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    402402      ELSE                              ! user-defined namelist 
    403          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     403         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    404404      ENDIF 
    405405      ! 
    … …  
    411411      CALL mpp_init 
    412412 
     413      CALL halo_mng_init() 
    413414      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    414415      CALL nemo_alloc() 
    … …  
    554555         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    555556         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    556          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    557          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    558          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    559          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    560          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    561          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    562          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    563557         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    564558         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    565559      ENDIF 
    566560      ! 
    567       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    568       nictls    = nn_ictls 
    569       nictle    = nn_ictle 
    570       njctls    = nn_jctls 
    571       njctle    = nn_jctle 
    572       isplt     = nn_isplt 
    573       jsplt     = nn_jsplt 
    574  
     561      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    575562      IF(lwp) THEN                  ! control print 
    576563         WRITE(numout,*) 
    … …  
    583570         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    584571      ENDIF 
    585       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    586       ! 
    587       !                             ! Parameter control 
    588       ! 
    589       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    590          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    591             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    592          ELSE 
    593             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    594                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    595                   &           ' - the print control will be done over the whole domain' ) 
    596             ENDIF 
    597             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    598          ENDIF 
    599          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    600          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    601          ! 
    602          !                              ! indices used for the SUM control 
    603          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    604             lsp_area = .FALSE. 
    605          ELSE                                             ! print control done over a specific  area 
    606             lsp_area = .TRUE. 
    607             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    608                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    609                nictls = 1 
    610             ENDIF 
    611             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    612                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    613                nictle = jpiglo 
    614             ENDIF 
    615             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    616                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    617                njctls = 1 
    618             ENDIF 
    619             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    620                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    621                njctle = jpjglo 
    622             ENDIF 
    623          ENDIF 
    624       ENDIF 
    625572      ! 
    626573      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 

  • NEMO/trunk/src/OCE/par_oce.F90

    r13216 r13286  
    4747   ! global domain size for AGRIF     !!! * total AGRIF computational domain * 
    4848   INTEGER, PUBLIC            ::   nbug_in_agrif_conv_do_not_remove_or_modify = 1 - 1 
    49    INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3 !: number of ghost cells: default value 
    50    INTEGER, PUBLIC            ::   nbghostcells_x   !: number of ghost cells in i-direction 
     49   INTEGER, PUBLIC, PARAMETER ::   nbghostcells = 3   !: number of ghost cells: default value 
     50   INTEGER, PUBLIC            ::   nbghostcells_x     !: number of ghost cells in i-direction 
    5151   INTEGER, PUBLIC            ::   nbghostcells_y_s   !: number of ghost cells in j-direction at south 
    52    INTEGER, PUBLIC            ::   nbghostcells_y_n   !: number of ghost cells in j-direction at north                       !: number of ghost cells 
    53    INTEGER, PUBLIC            ::   nbcellsx   ! = jpiglo - 2 - 2*nbghostcells_x   !: number of cells in i-direction 
    54    INTEGER, PUBLIC            ::   nbcellsy   ! = jpjglo - 2 - 2*nbghostcells-y   !: number of cells in j-direction 
     52   INTEGER, PUBLIC            ::   nbghostcells_y_n   !: number of ghost cells in j-direction at north 
     53   INTEGER, PUBLIC            ::   nbcellsx           !: number of cells in i-direction 
     54   INTEGER, PUBLIC            ::   nbcellsy           !: number of cells in j-direction 
    5555 
    5656   ! local domain size                !!! * local computational domain * 
    … …  
    6262   INTEGER, PUBLIC ::   jpkm1 ! = jpk-1                                            !:   -     -      - 
    6363   INTEGER, PUBLIC ::   jpij  ! = jpi*jpj                                          !:  jpi x jpj 
    64    INTEGER, PUBLIC ::   jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi 
    65    INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj 
     64   INTEGER, PUBLIC ::   jpimax! = ( Ni0glo + jpni-1 ) / jpni + 2*nn_hls            !: maximum jpi 
     65   INTEGER, PUBLIC ::   jpjmax! = ( Nj0glo + jpnj-1 ) / jpnj + 2*nn_hls            !: maximum jpj 
    6666 
    6767   !!--------------------------------------------------------------------- 
    … …  
    8181   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo  
    8282   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo  
    83    INTEGER, PUBLIC, PARAMETER ::   nn_hls = 1   !: halo width (applies to both rows and columns) 
     83 
     84   ! halo with and starting/inding DO-loop indices 
     85   INTEGER, PUBLIC ::   nn_hls   !: halo width (applies to both rows and columns) 
     86   INTEGER, PUBLIC ::   Nis0, Nis1, Nis1nxt2, Nis2   !: start I-index (_0: without halo, _1 or _2: with 1 or 2 halos) 
     87   INTEGER, PUBLIC ::   Nie0, Nie1, Nie1nxt2, Nie2   !: end   I-index (_0: without halo, _1 or _2: with 1 or 2 halos) 
     88   INTEGER, PUBLIC ::   Njs0, Njs1, Njs1nxt2, Njs2   !: start J-index (_0: without halo, _1 or _2: with 1 or 2 halos) 
     89   INTEGER, PUBLIC ::   Nje0, Nje1, Nje1nxt2, Nje2   !: end   J-index (_0: without halo, _1 or _2: with 1 or 2 halos) 
     90   INTEGER, PUBLIC ::   Ni_0, Nj_0, Ni_1, Nj_1, Ni_2, Nj_2   !: domain size (_0: without halo, _1 or _2: with 1 or 2 halos) 
     91   INTEGER, PUBLIC ::   Ni0glo, Nj0glo 
    8492 
    8593   !!---------------------------------------------------------------------- 

  • NEMO/trunk/src/OCE/trc_oce.F90

    r12377 r13286  
    158158         zchl = zrgb(1,jc) 
    159159         irgb = NINT( 41 + 20.* LOG10( zchl ) + 1.e-15 ) 
    160          IF(lwp .AND. nn_print >= 1 ) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  irgb = ', irgb 
    161160         IF( irgb /= jc ) THEN 
    162161            IF(lwp) WRITE(numout,*) '    jc =', jc, '  Chl = ', zchl, '  Chl class = ', irgb 

  • NEMO/trunk/src/OFF/dtadyn.F90

    r13237 r13286  
    7171   INTEGER  , SAVE      ::   jf_uwd         ! index of u-transport 
    7272   INTEGER  , SAVE      ::   jf_vwd         ! index of v-transport 
    73    INTEGER  , SAVE      ::   jf_wwd         ! index of v-transport 
     73   INTEGER  , SAVE      ::   jf_wwd         ! index of w-transport 
    7474   INTEGER  , SAVE      ::   jf_avt         ! index of Kz 
    7575   INTEGER  , SAVE      ::   jf_mld         ! index of mixed layer deptht 
    … …  
    128128      ! 
    129129      IF( kt == nit000 ) THEN    ;    nprevrec = 0 
    130       ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2) 
     130      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 
    131131      ENDIF 
    132132      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
    … …  
    294294      !                                         ! fill sf with slf_i and control print 
    295295      CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 
     296      sf_dyn(jf_uwd)%cltype = 'U'   ;   sf_dyn(jf_uwd)%zsgn = -1._wp   
     297      sf_dyn(jf_vwd)%cltype = 'V'   ;   sf_dyn(jf_vwd)%zsgn = -1._wp   
     298      sf_dyn(jf_ubl)%cltype = 'U'   ;   sf_dyn(jf_ubl)%zsgn =  1._wp   
     299      sf_dyn(jf_vbl)%cltype = 'V'   ;   sf_dyn(jf_vbl)%zsgn =  1._wp   
    296300      ! 
    297301      ! Open file for each variable to get his number of dimension 
    … …  
    330334           iom_varid( numrtr, 'sshn', ldstop = .FALSE. ) > 0 ) THEN 
    331335           IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 
    332            CALL iom_get( numrtr, jpdom_autoglo, 'sshn', ssh(:,:,Kmm)   ) 
    333            CALL iom_get( numrtr, jpdom_autoglo, 'sshb', ssh(:,:,Kbb)   ) 
     336           CALL iom_get( numrtr, jpdom_auto, 'sshn', ssh(:,:,Kmm)   ) 
     337           CALL iom_get( numrtr, jpdom_auto, 'sshb', ssh(:,:,Kbb)   ) 
    334338        ELSE 
    335339           IF(lwp) WRITE(numout,*) ' ssh(:,:,Kmm) forcing fields read in the restart file for initialisation' 
    336340           CALL iom_open( 'restart', inum ) 
    337            CALL iom_get( inum, jpdom_autoglo, 'sshn', ssh(:,:,Kmm)   ) 
    338            CALL iom_get( inum, jpdom_autoglo, 'sshb', ssh(:,:,Kbb)   ) 
     341           CALL iom_get( inum, jpdom_auto, 'sshn', ssh(:,:,Kmm)   ) 
     342           CALL iom_get( inum, jpdom_auto, 'sshb', ssh(:,:,Kbb)   ) 
    339343           CALL iom_close( inum )                                        ! close file 
    340344        ENDIF 
    … …  
    388392         IF(lwp) WRITE(numout,*) ' read in the file depht over which runoffs are distributed' 
    389393         CALL iom_open ( "runoffs", inum )                           ! open file 
    390          CALL iom_get  ( inum, jpdom_data, 'rodepth', h_rnf )   ! read the river mouth array 
     394         CALL iom_get  ( inum, jpdom_global, 'rodepth', h_rnf )   ! read the river mouth array 
    391395         CALL iom_close( inum )                                        ! close file 
    392396         ! 
    … …  
    452456      ! 
    453457      IF( kt == nit000 ) THEN    ;    nprevrec = 0 
    454       ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec_a(2) 
     458      ELSE                       ;    nprevrec = sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) 
    455459      ENDIF 
    456460      CALL fld_read( kt, 1, sf_dyn )      !=  read data at kt time step   ==! 
    … …  
    711715      !!--------------------------------------------------------------------- 
    712716      ! 
    713       IF( sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace)                        
     717      IF( sf_dyn(jf_tem)%ln_tint ) THEN    ! Computes slopes (here avt is used as workspace) 
     718         ! 
    714719         IF( kt == nit000 ) THEN 
    715720            IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
    716             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:)   ! temperature 
    717             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:)   ! salinity  
    718             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:)   ! vertical diffusive coef. 
     721            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%nbb) * tmask(:,:,:)   ! temperature 
     722            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%nbb) * tmask(:,:,:)   ! salinity  
     723            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%nbb) * tmask(:,:,:)   ! vertical diffusive coef. 
    719724            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    720725            uslpdta (:,:,:,1) = zuslp (:,:,:)  
    … …  
    723728            wslpjdta(:,:,:,1) = zwslpj(:,:,:)  
    724729            ! 
    725             zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
    726             zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    727             avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     730            zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:)   ! temperature 
     731            zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:)   ! salinity  
     732            avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:)   ! vertical diffusive coef. 
    728733            CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    729734            uslpdta (:,:,:,2) = zuslp (:,:,:)  
    … …  
    734739           !  
    735740           iswap = 0 
    736            IF( sf_dyn(jf_tem)%nrec_a(2) - nprevrec /= 0 )  iswap = 1 
    737            IF( nsecdyn > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap == 1 )  THEN    ! read/update the after data 
     741           IF( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - nprevrec /= 0 )  iswap = 1 
     742           IF( nsecdyn > sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb) .AND. iswap == 1 )  THEN    ! read/update the after data 
    738743              IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt 
    739744              uslpdta (:,:,:,1) =  uslpdta (:,:,:,2)         ! swap the data 
    … …  
    742747              wslpjdta(:,:,:,1) =  wslpjdta(:,:,:,2)  
    743748              ! 
    744               zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:)   ! temperature 
    745               zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:)   ! salinity  
    746               avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:)   ! vertical diffusive coef. 
     749              zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,sf_dyn(jf_tem)%naa) * tmask(:,:,:)   ! temperature 
     750              zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,sf_dyn(jf_sal)%naa) * tmask(:,:,:)   ! salinity  
     751              avt(:,:,:)        = sf_dyn(jf_avt)%fdta(:,:,:,sf_dyn(jf_avt)%naa) * tmask(:,:,:)   ! vertical diffusive coef. 
    747752              CALL compute_slopes( kt, zts, zuslp, zvslp, zwslpi, zwslpj, Kbb, Kmm ) 
    748753              ! 
    … …  
    756761      ! 
    757762      IF( sf_dyn(jf_tem)%ln_tint )  THEN 
    758          ztinta =  REAL( nsecdyn - sf_dyn(jf_tem)%nrec_b(2), wp )  & 
    759             &    / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp ) 
     763         ztinta =  REAL( nsecdyn - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp )  & 
     764            &    / REAL( sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%naa) - sf_dyn(jf_tem)%nrec(2,sf_dyn(jf_tem)%nbb), wp ) 
    760765         ztintb =  1. - ztinta 
    761766         IF( l_ldfslp .AND. .NOT.lk_c1d ) THEN    ! Computes slopes (here avt is used as workspace) 

  • NEMO/trunk/src/OFF/nemogcm.F90

    r13237 r13286  
    3131   USE domqco         ! tools for scale factor         (dom_qco_r3c  routine) 
    3232#endif 
    33    USE bdy_oce,  ONLY : ln_bdy 
    34    USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
     33   USE bdyini         ! open boundary cond. setting        (bdy_init routine) 
    3534   !              ! ocean physics 
    3635   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) 
    … …  
    6463   USE timing         ! Timing 
    6564   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    66    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
     65   USE lbcnfd  , ONLY : isendto, nsndto   ! Setup of north fold exchanges 
    6766   USE step, ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     67   USE halo_mng 
    6868 
    6969   IMPLICIT NONE 
    … …  
    193193      INTEGER ::   ios, ilocal_comm   ! local integers 
    194194      !! 
    195       NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    196          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    197          &             ln_timing, ln_diacfl 
     195      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     196         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle 
    198197      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    199198      !!---------------------------------------------------------------------- 
    200199      ! 
    201200      cxios_context = 'nemo' 
     201      nn_hls = 1 
    202202      ! 
    203203      !                             !-------------------------------------------------! 
    … …  
    292292      ! 
    293293      IF( ln_read_cfg ) THEN              ! Read sizes in domain configuration file 
    294          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     294         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    295295      ELSE                                ! user-defined namelist 
    296          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     296         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    297297      ENDIF 
    298298      ! 
    … …  
    306306      CALL mpp_init 
    307307 
     308      CALL halo_mng_init() 
    308309      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    309310      CALL nemo_alloc() 
    … …  
    386387         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    387388         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    388          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    389          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    390          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    391          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    392          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    393          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    394          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    395389         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    396390         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    397391      ENDIF 
    398       ! 
    399       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    400       nictls    = nn_ictls 
    401       nictle    = nn_ictle 
    402       njctls    = nn_jctls 
    403       njctle    = nn_jctle 
    404       isplt     = nn_isplt 
    405       jsplt     = nn_jsplt 
    406  
     392 
     393      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    407394      IF(lwp) THEN                  ! control print 
    408395         WRITE(numout,*) 
    … …  
    414401         WRITE(numout,*) '         filename to be written                      cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    415402         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr     = ', ln_use_jattr 
    416       ENDIF 
    417       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    418       ! 
    419       !                             ! Parameter control 
    420       ! 
    421       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    422          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    423             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    424          ELSE 
    425             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    426                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    427                   &           ' - the print control will be done over the whole domain' ) 
    428             ENDIF 
    429             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    430          ENDIF 
    431          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    432          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    433          ! 
    434          !                              ! indices used for the SUM control 
    435          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    436             lsp_area = .FALSE. 
    437          ELSE                                             ! print control done over a specific  area 
    438             lsp_area = .TRUE. 
    439             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    440                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    441                nictls = 1 
    442             ENDIF 
    443             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    444                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    445                nictle = jpiglo 
    446             ENDIF 
    447             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    448                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    449                njctls = 1 
    450             ENDIF 
    451             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    452                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    453                njctle = jpjglo 
    454             ENDIF 
    455          ENDIF 
    456403      ENDIF 
    457404      ! 

  • NEMO/trunk/src/SAO/nemogcm.F90

    r12933 r13286  
    2929   USE sao_intp 
    3030   ! 
     31   USE prtctl         ! Print control 
    3132   USE in_out_manager ! I/O manager 
    3233   USE lib_mpp        ! distributed memory computing 
    3334   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    34    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     35   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges  
    3536   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3637#if defined key_iomput 
    3738   USE xios           ! xIOserver 
    3839#endif 
     40   USE halo_mng 
    3941 
    4042   IMPLICIT NONE 
    … …  
    9294      INTEGER ::   ios, ilocal_comm   ! local integer 
    9395      ! 
    94       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    95          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    96          &             ln_timing, ln_diacfl 
     96      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     97         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    9798      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    9899      !!---------------------------------------------------------------------- 
    99100      ! 
    100101      cxios_context = 'nemo' 
     102      nn_hls = 1 
    101103      ! 
    102104      !                             !-------------------------------------------------! 
    … …  
    205207      ! 
    206208      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    207          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     209         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    208210      ELSE                              ! user-defined namelist 
    209          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     211         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    210212      ENDIF 
    211213      ! 
    … …  
    217219      CALL mpp_init 
    218220 
     221      CALL halo_mng_init() 
    219222      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    220223      CALL nemo_alloc() 
    … …  
    267270         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    268271         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    269          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    270          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    271          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    272          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    273          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    274          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    275          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    276272         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    277273         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    278274      ENDIF 
    279275      ! 
    280       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    281       nictls    = nn_ictls 
    282       nictle    = nn_ictle 
    283       njctls    = nn_jctls 
    284       njctle    = nn_jctle 
    285       isplt     = nn_isplt 
    286       jsplt     = nn_jsplt 
    287  
     276      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    288277      IF(lwp) THEN                  ! control print 
    289278         WRITE(numout,*) 
    … …  
    295284         WRITE(numout,*) '         filename to be written                        cn_domcfg_out = ', TRIM(cn_domcfg_out) 
    296285         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    297       ENDIF 
    298       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    299       ! 
    300       !                             ! Parameter control 
    301       ! 
    302       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    303          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    304             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    305          ELSE 
    306             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    307                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    308                   &           ' - the print control will be done over the whole domain' ) 
    309             ENDIF 
    310             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    311          ENDIF 
    312          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    313          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    314          ! 
    315          !                              ! indices used for the SUM control 
    316          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    317             lsp_area = .FALSE. 
    318          ELSE                                             ! print control done over a specific  area 
    319             lsp_area = .TRUE. 
    320             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    321                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    322                nictls = 1 
    323             ENDIF 
    324             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    325                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    326                nictle = jpiglo 
    327             ENDIF 
    328             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    329                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    330                njctls = 1 
    331             ENDIF 
    332             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    333                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    334                njctle = jpjglo 
    335             ENDIF 
    336          ENDIF 
    337286      ENDIF 
    338287      ! 

  • NEMO/trunk/src/SAO/sao_read.F90

    r10069 r13286  
    1010   USE netcdf 
    1111   USE oce,     ONLY: tsn, sshn 
    12    USE dom_oce, ONLY: nlci, nlcj, nimpp, njmpp, tmask 
     12   USE dom_oce, ONLY: nimpp, njmpp, tmask 
    1313   USE par_oce, ONLY: jpi, jpj, jpk 
    1414   ! 
    … …  
    9494         IF (ifcst .LE. ntimes) THEN 
    9595            ! Allocate temporary temperature array 
    96             ALLOCATE(temp_tn(nlci,nlcj,jpk)) 
    97             ALLOCATE(temp_sn(nlci,nlcj,jpk)) 
    98             ALLOCATE(temp_sshn(nlci,nlcj)) 
     96            ALLOCATE(temp_tn(jpi,jpj,jpk)) 
     97            ALLOCATE(temp_sn(jpi,jpj,jpk)) 
     98            ALLOCATE(temp_sshn(jpi,jpj)) 
    9999 
    100100            ! Set temp_tn, temp_sn to 0. 
    … …  
    104104 
    105105            ! Create start and count arrays 
    106             start_n = (/ nimpp, njmpp, 1,  ifcst /) 
    107             count_n = (/ nlci,  nlcj,  jpk, 1     /) 
    108             start_s = (/ nimpp, njmpp, ifcst /) 
    109             count_s = (/ nlci,  nlcj,  1     /) 
     106            start_n = (/ nimpp, njmpp,      1, ifcst /) 
     107            count_n = (/   jpi,   jpj, jpk, 1        /) 
     108            start_s = (/ nimpp, njmpp        , ifcst /) 
     109            count_s = (/   jpi,   jpj,      1        /) 
    110110 
    111111            ! Read information into temporary arrays 
    … …  
    138138 
    139139            ! Mask out missing data index 
    140             tsn(1:nlci,1:nlcj,1:jpk,1) = temp_tn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk) 
    141             tsn(1:nlci,1:nlcj,1:jpk,2) = temp_sn(:,:,:) * tmask(1:nlci,1:nlcj,1:jpk) 
    142             sshn(1:nlci,1:nlcj)        = temp_sshn(:,:) * tmask(1:nlci,1:nlcj,1) 
    143  
    144             ! Remove halo from tmask, tsn, sshn to prevent double obs counting 
    145             IF (jpi > nlci) THEN 
    146                 tmask(nlci+1:,:,:) = 0 
    147                 tsn(nlci+1:,:,:,1) = 0 
    148                 tsn(nlci+1:,:,:,2) = 0 
    149                 sshn(nlci+1:,:) = 0 
    150             END IF 
    151             IF (jpj > nlcj) THEN 
    152                 tmask(:,nlcj+1:,:) = 0 
    153                 tsn(:,nlcj+1:,:,1) = 0 
    154                 tsn(:,nlcj+1:,:,2) = 0 
    155                 sshn(:,nlcj+1:) = 0 
    156             END IF 
    157  
     140            tsn(1:jpi,1:jpj,1:jpk,1) = temp_tn(:,:,:) * tmask(1:jpi,1:jpj,1:jpk) 
     141            tsn(1:jpi,1:jpj,1:jpk,2) = temp_sn(:,:,:) * tmask(1:jpi,1:jpj,1:jpk) 
     142            sshn(1:jpi,1:jpj)        = temp_sshn(:,:) * tmask(1:jpi,1:jpj,1) 
     143             
    158144            ! Deallocate arrays 
    159145            DEALLOCATE(temp_tn, temp_sn, temp_sshn) 

  • NEMO/trunk/src/SAS/nemogcm.F90

    r13216 r13286  
    3535   USE step_diu       ! diurnal bulk SST timestepping (called from here if run offline) 
    3636   ! 
     37   USE prtctl         ! Print control 
    3738   USE in_out_manager ! I/O manager 
    3839   USE lib_mpp        ! distributed memory computing 
    3940   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    40    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges 
     41   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
    4142   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    4243#if defined key_iomput 
    … …  
    4647   USE agrif_ice_update ! ice update 
    4748#endif 
     49   USE halo_mng 
    4850 
    4951   IMPLICIT NONE 
    … …  
    197199      INTEGER ::   ios, ilocal_comm   ! local integers 
    198200      !! 
    199       NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle,              & 
    200          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    201          &             ln_timing, ln_diacfl 
     201      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     202         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle             
    202203      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    203204      !!---------------------------------------------------------------------- 
    … …  
    206207      ELSE                  ;   cxios_context = 'nemo' 
    207208      ENDIF 
     209      nn_hls = 1 
    208210      ! 
    209211      !                             !-------------------------------------------------! 
    … …  
    324326      ! 
    325327      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    326          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     328         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    327329      ELSE                              ! user-defined namelist 
    328          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     330         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    329331      ENDIF 
    330332      ! 
    … …  
    336338      CALL mpp_init 
    337339 
     340      CALL halo_mng_init() 
    338341      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    339342      CALL nemo_alloc() 
    … …  
    409412         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    410413         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    411          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    412          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    413          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    414          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    415          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    416          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    417          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    418414         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    419415         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    420416      ENDIF 
    421417      ! 
    422       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    423       nictls    = nn_ictls 
    424       nictle    = nn_ictle 
    425       njctls    = nn_jctls 
    426       njctle    = nn_jctle 
    427       isplt     = nn_isplt 
    428       jsplt     = nn_jsplt 
    429  
     418      IF( .NOT.ln_read_cfg )   ln_closea = .FALSE.   ! dealing possible only with a domcfg file 
    430419      IF(lwp) THEN                  ! control print 
    431420         WRITE(numout,*) 
    … …  
    438427         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    439428      ENDIF 
    440       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    441       ! 
    442       !                             ! Parameter control 
    443       ! 
    444       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    445          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    446             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    447          ELSE 
    448             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    449                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    450                   &           ' - the print control will be done over the whole domain' ) 
    451             ENDIF 
    452             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    453          ENDIF 
    454          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    455          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    456          ! 
    457          !                              ! indices used for the SUM control 
    458          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    459             lsp_area = .FALSE. 
    460          ELSE                                             ! print control done over a specific  area 
    461             lsp_area = .TRUE. 
    462             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    463                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    464                nictls = 1 
    465             ENDIF 
    466             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    467                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    468                nictle = jpiglo 
    469             ENDIF 
    470             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    471                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    472                njctls = 1 
    473             ENDIF 
    474             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    475                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    476                njctle = jpjglo 
    477             ENDIF 
    478          ENDIF 
    479       ENDIF 
    480429      ! 
    481430      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 

  • NEMO/trunk/src/SAS/sbcssm.F90

    r12615 r13286  
    290290            !                                         ! fill sf with slf_i and control print 
    291291            CALL fld_fill( sf_ssm_3d, slf_3d, cn_dir, 'sbc_ssm_init', '3D Data in file', 'namsbc_ssm' ) 
     292            sf_ssm_3d(jf_usp)%cltype = 'U'   ;   sf_ssm_3d(jf_usp)%zsgn = -1._wp 
     293            sf_ssm_3d(jf_vsp)%cltype = 'V'   ;   sf_ssm_3d(jf_vsp)%zsgn = -1._wp 
    292294         ENDIF 
    293295         ! 
    … …  
    306308            ! 
    307309            CALL fld_fill( sf_ssm_2d, slf_2d, cn_dir, 'sbc_ssm_init', '2D Data in file', 'namsbc_ssm' ) 
     310            IF( .NOT. ln_3d_uve ) THEN 
     311               sf_ssm_2d(jf_usp)%cltype = 'U'   ;   sf_ssm_2d(jf_usp)%zsgn = -1._wp 
     312               sf_ssm_2d(jf_vsp)%cltype = 'V'   ;   sf_ssm_2d(jf_vsp)%zsgn = -1._wp 
     313            ENDIF 
    308314         ENDIF 
    309315         ! 

  • NEMO/trunk/src/TOP/C14/trcini_c14.F90

    r12377 r13286  
    6969        !  
    7070        CALL iom_get( numrtr, 'co2sbc', co2sbc )  
    71         CALL iom_get( numrtr, jpdom_autoglo, 'c14sbc', c14sbc )  
    72         CALL iom_get( numrtr, jpdom_autoglo, 'exch_co2', exch_co2 )  
    73         CALL iom_get( numrtr, jpdom_autoglo, 'exch_c14', exch_c14 )  
    74         CALL iom_get( numrtr, jpdom_autoglo, 'qtr_c14', qtr_c14 ) 
     71        CALL iom_get( numrtr, jpdom_auto, 'c14sbc', c14sbc )  
     72        CALL iom_get( numrtr, jpdom_auto, 'exch_co2', exch_co2 )  
     73        CALL iom_get( numrtr, jpdom_auto, 'exch_c14', exch_c14 )  
     74        CALL iom_get( numrtr, jpdom_auto, 'qtr_c14', qtr_c14 ) 
    7575        ! 
    7676      END IF 
    … …  
    8585      ELSE 
    8686        ! 
    87         CALL iom_get( numrtr, jpdom_autoglo, 'qint_c14', qint_c14 )  
     87        CALL iom_get( numrtr, jpdom_auto, 'qint_c14', qint_c14 )  
    8888        ! 
    8989      ENDIF 

  • NEMO/trunk/src/TOP/CFC/trcsms_cfc.F90

    r13237 r13286  
    298298         DO jn = jp_cfc0, jp_cfc1 
    299299            jl = jl + 1 
    300             CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
     300            CALL iom_get( numrtr, jpdom_auto, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jl) )  
    301301         END DO 
    302302      ENDIF 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zbio.F90

    r13237 r13286  
    1919   ! 
    2020   USE lbclnk          !  
    21    USE prtctl_trc      ! Print control for debbuging 
     21   USE prtctl          ! Print control for debbuging 
    2222   USE iom             ! 
    2323    
    … …  
    367367      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    368368         WRITE(charout, FMT="('bio')") 
    369          CALL prt_ctl_trc_info(charout) 
    370          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     369         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     370         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    371371      ENDIF 
    372372      ! 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zexp.F90

    r13237 r13286  
    1717   USE p2zsed 
    1818   USE lbclnk 
    19    USE prtctl_trc      ! Print control for debbuging 
     19   USE prtctl          ! Print control for debbuging 
    2020   USE trd_oce 
    2121   USE trdtrc 
    … …  
    140140      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    141141         WRITE(charout, FMT="('exp')") 
    142          CALL prt_ctl_trc_info(charout) 
    143          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     142         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     143         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    144144      ENDIF 
    145145      ! 
    … …  
    214214      ! 
    215215      IF( ln_rsttr ) THEN 
    216          CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    217          CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
     216         CALL iom_get( numrtr, jpdom_auto, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
     217         CALL iom_get( numrtr, jpdom_auto, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    218218      ELSE 
    219219         sedpocb(:,:) = 0._wp 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zopt.F90

    r13237 r13286  
    1818   USE trc 
    1919   USE sms_pisces 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    125125      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    126126         WRITE(charout, FMT="('opt')") 
    127          CALL prt_ctl_trc_info( charout ) 
    128          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     127         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     128         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    129129      ENDIF 
    130130      ! 

  • NEMO/trunk/src/TOP/PISCES/P2Z/p2zsed.F90

    r13237 r13286  
    1818   USE lbclnk          ! 
    1919   USE iom             ! 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    109109      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    110110         WRITE(charout, FMT="('sed')") 
    111          CALL prt_ctl_trc_info(charout) 
    112          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     111         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     112         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    113113      ENDIF 
    114114      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zagg.F90

    r12377 r13286  
    1717   USE trc             !  passive tracers common variables  
    1818   USE sms_pisces      !  PISCES Source Minus Sink variables 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    170170      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    171171         WRITE(charout, FMT="('agg')") 
    172          CALL prt_ctl_trc_info(charout) 
    173          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     172         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     173         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    174174      ENDIF 
    175175      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zbc.F90

    r13237 r13286  
    288288         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 
    289289         ALLOCATE( zcmask(jpi,jpj,jpk) ) 
    290          CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 
     290         CALL iom_get  ( numiron, jpdom_global, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 
    291291         CALL iom_close( numiron ) 
    292292         ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zbio.F90

    r13237 r13286  
    3030   USE p4zfechem 
    3131   USE p4zligand       !  Prognostic ligand model 
    32    USE prtctl_trc      !  print control for debugging 
     32   USE prtctl          !  print control for debugging 
    3333   USE iom             !  I/O manager 
    3434   
    … …  
    108108      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    109109         WRITE(charout, FMT="('bio ')") 
    110          CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     110         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     111         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    112112      ENDIF 
    113113      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zfechem.F90

    r13237 r13286  
    1616   USE p4zche          ! chemical model 
    1717   USE p4zbc           ! Boundary conditions from sediments 
    18    USE prtctl_trc      ! print control for debugging 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    222222      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    223223         WRITE(charout, FMT="('fechem')") 
    224          CALL prt_ctl_trc_info(charout) 
    225          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     224         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     225         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    226226      ENDIF 
    227227      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zflx.F90

    r13237 r13286  
    1919   USE sms_pisces     !  PISCES Source Minus Sink variables 
    2020   USE p4zche         !  Chemical model 
    21    USE prtctl_trc     !  print control for debugging 
     21   USE prtctl         !  print control for debugging 
    2222   USE iom            !  I/O manager 
    2323   USE fldread        !  read input fields 
    … …  
    178178      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    179179         WRITE(charout, FMT="('flx ')") 
    180          CALL prt_ctl_trc_info(charout) 
    181          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     180         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     181         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    182182      ENDIF 
    183183 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zligand.F90

    r12377 r13286  
    1212   USE trc             ! passive tracers common variables  
    1313   USE sms_pisces      ! PISCES Source Minus Sink variables 
    14    USE prtctl_trc      ! print control for debugging 
     14   USE prtctl          ! print control for debugging 
    1515   USE iom             !  I/O manager 
    1616 
    … …  
    8989      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    9090         WRITE(charout, FMT="('ligand1')") 
    91          CALL prt_ctl_trc_info(charout) 
    92          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     91         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     92         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    9393      ENDIF 
    9494      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zlys.F90

    r12377 r13286  
    2020   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2121   USE p4zche          !  Chemical model 
    22    USE prtctl_trc      !  print control for debugging 
     22   USE prtctl          !  print control for debugging 
    2323   USE iom             !  I/O manager 
    2424 
    … …  
    130130      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    131131        WRITE(charout, FMT="('lys ')") 
    132         CALL prt_ctl_trc_info(charout) 
    133         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     132        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     133        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    134134      ENDIF 
    135135      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmeso.F90

    r12839 r13286  
    1515   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1616   USE p4zprod         ! production 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818   USE iom             ! I/O manager 
    1919 
    … …  
    246246      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    247247        WRITE(charout, FMT="('meso')") 
    248         CALL prt_ctl_trc_info(charout) 
    249         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     248        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     249        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    250250      ENDIF 
    251251      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmicro.F90

    r12839 r13286  
    1717   USE p4zprod         ! production 
    1818   USE iom             ! I/O manager 
    19    USE prtctl_trc      ! print control for debugging 
     19   USE prtctl          ! print control for debugging 
    2020 
    2121   IMPLICIT NONE 
    … …  
    202202      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    203203         WRITE(charout, FMT="('micro')") 
    204          CALL prt_ctl_trc_info(charout) 
    205          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     204         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     205         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    206206      ENDIF 
    207207      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zmort.F90

    r12377 r13286  
    1515   USE p4zprod         ! Primary productivity  
    1616   USE p4zlim          ! Phytoplankton limitation terms 
    17    USE prtctl_trc      ! print control for debugging 
     17   USE prtctl          ! print control for debugging 
    1818 
    1919   IMPLICIT NONE 
    … …  
    120120       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    121121         WRITE(charout, FMT="('nano')") 
    122          CALL prt_ctl_trc_info(charout) 
    123          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     122         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     123         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    124124       ENDIF 
    125125      ! 
    … …  
    192192      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    193193         WRITE(charout, FMT="('diat')") 
    194          CALL prt_ctl_trc_info(charout) 
    195          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     194         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     195         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    196196      ENDIF 
    197197      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zopt.F90

    r13237 r13286  
    1616   USE iom            ! I/O manager 
    1717   USE fldread        !  time interpolation 
    18    USE prtctl_trc     !  print control for debugging 
     18   USE prtctl         !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zpoc.F90

    r13237 r13286  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    242242     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    243243        WRITE(charout, FMT="('poc1')") 
    244         CALL prt_ctl_trc_info(charout) 
    245         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     244        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     245        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    246246     ENDIF 
    247247 
    … …  
    434434      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    435435         WRITE(charout, FMT="('poc2')") 
    436          CALL prt_ctl_trc_info(charout) 
    437          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     436         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     437         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    438438      ENDIF 
    439439      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zprod.F90

    r13237 r13286  
    1616   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1717   USE p4zlim          ! Co-limitations of differents nutrients 
    18    USE prtctl_trc      ! print control for debugging 
     18   USE prtctl          ! print control for debugging 
    1919   USE iom             ! I/O manager 
    2020 
    … …  
    331331     IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    332332         WRITE(charout, FMT="('prod')") 
    333          CALL prt_ctl_trc_info(charout) 
    334          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     333         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     334         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    335335     ENDIF 
    336336      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zrem.F90

    r13237 r13286  
    1818   USE p4zprod         !  Growth rate of the 2 phyto groups 
    1919   USE p4zlim 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    196196       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    197197         WRITE(charout, FMT="('rem1')") 
    198          CALL prt_ctl_trc_info(charout) 
    199          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     198         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     199         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    200200       ENDIF 
    201201 
    … …  
    218218       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    219219         WRITE(charout, FMT="('rem2')") 
    220          CALL prt_ctl_trc_info(charout) 
    221          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     220         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     221         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    222222       ENDIF 
    223223 
    … …  
    249249      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    250250         WRITE(charout, FMT="('rem3')") 
    251          CALL prt_ctl_trc_info(charout) 
    252          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     251         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     252         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    253253       ENDIF 
    254254 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsed.F90

    r13237 r13286  
    1818   USE sed             !  Sediment module 
    1919   USE iom             !  I/O manager 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    315315      IF(sn_cfctl%l_prttrc) THEN  ! print mean trends (USEd for debugging) 
    316316         WRITE(charout, fmt="('sed ')") 
    317          CALL prt_ctl_trc_info(charout) 
    318          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     317         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     318         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    319319      ENDIF 
    320320      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsink.F90

    r13237 r13286  
    1717   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818   USE trcsink         !  General routine to compute sedimentation 
    19    USE prtctl_trc      !  print control for debugging 
     19   USE prtctl          !  print control for debugging 
    2020   USE iom             !  I/O manager 
    2121   USE lib_mpp 
    … …  
    144144      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    145145         WRITE(charout, FMT="('sink')") 
    146          CALL prt_ctl_trc_info(charout) 
    147          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     146         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     147         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    148148      ENDIF 
    149149      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zsms.F90

    r13237 r13286  
    2525   USE trdtrc          ! TOP trends variables 
    2626   USE sedmodel        ! Sediment model 
    27    USE prtctl_trc      ! print control for debugging 
     27   USE prtctl          ! print control for debugging 
    2828 
    2929   IMPLICIT NONE 
    … …  
    341341         !  
    342342         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 
    343             CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
     343            CALL iom_get( numrtr, jpdom_auto, 'PH' , hi(:,:,:)  ) 
    344344         ELSE 
    345345            CALL p4z_che( Kbb, Kmm )                  ! initialize the chemical constants 
    346346            CALL ahini_for_at( hi, Kbb ) 
    347347         ENDIF 
    348          CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
     348         CALL iom_get( numrtr, jpdom_auto, 'Silicalim', xksi(:,:) ) 
    349349         IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 
    350             CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  ) 
     350            CALL iom_get( numrtr, jpdom_auto, 'Silicamax' , xksimax(:,:)  ) 
    351351         ELSE 
    352352            xksimax(:,:) = xksi(:,:) 
    … …  
    361361         IF( ln_p5z ) THEN 
    362362            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 
    363                CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:)  ) 
    364                CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:)  ) 
    365                CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  ) 
     363               CALL iom_get( numrtr, jpdom_auto, 'sizep' , sizep(:,:,:)  ) 
     364               CALL iom_get( numrtr, jpdom_auto, 'sizen' , sizen(:,:,:)  ) 
     365               CALL iom_get( numrtr, jpdom_auto, 'sized' , sized(:,:,:)  ) 
    366366            ELSE 
    367367               sizep(:,:,:) = 1. 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmeso.F90

    r12377 r13286  
    1515   USE trc             !  passive tracers common variables  
    1616   USE sms_pisces      !  PISCES Source Minus Sink variables 
    17    USE prtctl_trc      !  print control for debugging 
     17   USE prtctl          !  print control for debugging 
    1818   USE iom             !  I/O manager 
    1919 
    … …  
    359359      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    360360        WRITE(charout, FMT="('meso')") 
    361         CALL prt_ctl_trc_info(charout) 
    362         CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     361        CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     362        CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    363363      ENDIF 
    364364      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmicro.F90

    r12377 r13286  
    1818   USE p5zlim          !  Phytoplankton limitation terms 
    1919   USE iom             !  I/O manager 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121 
    2222   IMPLICIT NONE 
    … …  
    306306      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    307307         WRITE(charout, FMT="('micro')") 
    308          CALL prt_ctl_trc_info(charout) 
    309          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     308         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     309         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    310310      ENDIF 
    311311      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zmort.F90

    r12377 r13286  
    1616   USE p4zlim 
    1717   USE p5zlim          !  Phytoplankton limitation terms 
    18    USE prtctl_trc      !  print control for debugging 
     18   USE prtctl          !  print control for debugging 
    1919 
    2020   IMPLICIT NONE 
    … …  
    121121       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    122122         WRITE(charout, FMT="('nano')") 
    123          CALL prt_ctl_trc_info(charout) 
    124          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     123         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     124         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    125125       ENDIF 
    126126      ! 
    … …  
    179179       IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    180180         WRITE(charout, FMT="('pico')") 
    181          CALL prt_ctl_trc_info(charout) 
    182          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     181         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     182         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    183183       ENDIF 
    184184      ! 
    … …  
    254254      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    255255         WRITE(charout, FMT="('diat')") 
    256          CALL prt_ctl_trc_info(charout) 
    257          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     256         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     257         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    258258      ENDIF 
    259259      ! 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p5zprod.F90

    r13237 r13286  
    1818   USE p4zlim 
    1919   USE p5zlim          !  Co-limitations of differents nutrients 
    20    USE prtctl_trc      !  print control for debugging 
     20   USE prtctl          !  print control for debugging 
    2121   USE iom             !  I/O manager 
    2222 
    … …  
    461461      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    462462         WRITE(charout, FMT="('prod')") 
    463          CALL prt_ctl_trc_info(charout) 
    464          CALL prt_ctl_trc(tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm) 
     463         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     464         CALL prt_ctl(tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm) 
    465465      ENDIF 
    466466      ! 

  • NEMO/trunk/src/TOP/PISCES/SED/sedrst.F90

    r12649 r13286  
    123123         cltra = TRIM(sedtrcd(jn)) 
    124124         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    125             CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta(:,:,:,jn) ) 
     125            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta(:,:,:,jn) ) 
    126126         ELSE 
    127127            zdta(:,:,:,jn) = 0.0 
    … …  
    142142         cltra = TRIM(seddia3d(jn)) 
    143143         IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    144             CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta1(:,:,:,jn) ) 
     144            CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta1(:,:,:,jn) ) 
    145145         ELSE 
    146146            zdta1(:,:,:,jn) = 0.0 
    … …  
    169169      cltra = "dbioturb" 
    170170      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    171          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     171         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    172172      ELSE 
    173173         zdta2(:,:,:) = 0.0 
    … …  
    179179      cltra = "irrig" 
    180180      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    181          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     181         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    182182      ELSE 
    183183         zdta2(:,:,:) = 0.0 
    … …  
    189189      cltra = "sedligand" 
    190190      IF( iom_varid( numrsr, TRIM(cltra) , ldstop = .FALSE. ) > 0 ) THEN 
    191          CALL iom_get( numrsr, jpdom_autoglo, TRIM(cltra), zdta2(:,:,:) ) 
     191         CALL iom_get( numrsr, jpdom_auto, TRIM(cltra), zdta2(:,:,:) ) 
    192192      ELSE 
    193193         zdta2(:,:,:) = 0.0 

  • NEMO/trunk/src/TOP/PISCES/SED/trcdmp_sed.F90

    r12377 r13286  
    2121   USE trc             ! ocean passive tracers variables 
    2222   USE trcdta 
    23    USE prtctl_trc      ! Print control for debbuging 
     23   USE prtctl          ! Print control for debbuging 
    2424   USE iom 
    2525 
    … …  
    107107      IF( sn_cfctl%l_prttrc ) THEN 
    108108         WRITE(charout, FMT="('dmp ')") 
    109          CALL prt_ctl_trc_info(charout) 
    110          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     109         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     110         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    111111      ENDIF 
    112112      ! 

  • NEMO/trunk/src/TOP/TRP/trcadv.F90

    r13237 r13286  
    2929   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    3030   ! 
    31    USE prtctl_trc     ! control print 
     31   USE prtctl         ! control print 
    3232   USE timing         ! Timing 
    3333 
    … …  
    138138      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging) 
    139139         WRITE(charout, FMT="('adv ')") 
    140          CALL prt_ctl_trc_info(charout) 
    141          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     140         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     141         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    142142      END IF 
    143143      ! 

  • NEMO/trunk/src/TOP/TRP/trcatf.F90

    r13237 r13286  
    4343   ! 
    4444   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    45    USE prtctl_trc      ! Print control for debbuging 
     45   USE prtctl          ! Print control for debbuging 
    4646 
    4747   IMPLICIT NONE 
    … …  
    184184      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    185185         WRITE(charout, FMT="('nxt')") 
    186          CALL prt_ctl_trc_info(charout) 
    187          CALL prt_ctl_trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm) 
     186         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     187         CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 
    188188      ENDIF 
    189189      ! 

  • NEMO/trunk/src/TOP/TRP/trcbbl.F90

    r12377 r13286  
    2525   USE trdtra         ! tracer trends 
    2626   USE trabbl         ! bottom boundary layer  
    27    USE prtctl_trc     ! Print control for debbuging 
     27   USE prtctl         ! Print control for debbuging 
    2828 
    2929   PUBLIC   trc_bbl   !  routine called by trctrp.F90 
    … …  
    7070         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    7171         IF( sn_cfctl%l_prttrc )   THEN 
    72             WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    73             CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     72            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     73            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7474         ENDIF 
    7575         ! 
    … …  
    8181         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm )   
    8282         IF( sn_cfctl%l_prttrc )   THEN 
    83             WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    84             CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     83            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     84            CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    8585         ENDIF 
    8686         ! 

  • NEMO/trunk/src/TOP/TRP/trcdmp.F90

    r13237 r13286  
    2424   ! 
    2525   USE iom 
    26    USE prtctl_trc      ! Print control for debbuging 
     26   USE prtctl          ! Print control for debbuging 
    2727 
    2828   IMPLICIT NONE 
    … …  
    149149      IF( sn_cfctl%l_prttrc ) THEN 
    150150         WRITE(charout, FMT="('dmp ')") 
    151          CALL prt_ctl_trc_info(charout) 
    152          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     151         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     152         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    153153      ENDIF 
    154154      ! 
    … …  
    205205         !Read in mask from file 
    206206         CALL iom_open ( cn_resto_tr, imask) 
    207          CALL iom_get  ( imask, jpdom_autoglo, 'resto', restotr) 
     207         CALL iom_get  ( imask, jpdom_auto, 'resto', restotr) 
    208208         CALL iom_close( imask ) 
    209209         ! 
    … …  
    246246            !                                           ! ======================= 
    247247            CASE ( 1 )                                  ! eORCA_R1 configuration 
    248             !                                           ! ======================= 
    249             isrow = 332 - jpjglo 
    250             ! 
    251             nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea 
    252             nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
    253             !                                         
    254             nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior 
    255             nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
    256             !                                          
    257             nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan 
    258             nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
    259             !                                         
    260             nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron 
    261             nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
    262             !                                         
    263             nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie 
    264             nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
    265             !                                         
    266             nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario 
    267             nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
    268             !                                         
    269             nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake 
    270             nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
    271             !                                         
    272             nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea 
    273             nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
    274             !                                         
    275             !                                           ! ======================= 
     248               !                                        ! ======================= 
     249               ! 
     250               isrow = 332 - (Nj0glo + 1)   ! was 332 - jpjglo -> jpjglo_old_version = Nj0glo + 1 
     251               ! 
     252               nctsi1(1)   = 333  ; nctsj1(1)   = 243 - isrow   ! Caspian Sea 
     253               nctsi2(1)   = 342  ; nctsj2(1)   = 274 - isrow 
     254               !                                         
     255               nctsi1(2)   = 198  ; nctsj1(2)   = 258 - isrow   ! Lake Superior 
     256               nctsi2(2)   = 204  ; nctsj2(2)   = 262 - isrow 
     257               !                                          
     258               nctsi1(3)   = 201  ; nctsj1(3)   = 250 - isrow   ! Lake Michigan 
     259               nctsi2(3)   = 203  ; nctsj2(3)   = 256 - isrow 
     260               !                                         
     261               nctsi1(4)   = 204  ; nctsj1(4)   = 252 - isrow   ! Lake Huron 
     262               nctsi2(4)   = 209  ; nctsj2(4)   = 256 - isrow 
     263               !                                         
     264               nctsi1(5)   = 206  ; nctsj1(5)   = 249 - isrow   ! Lake Erie 
     265               nctsi2(5)   = 209  ; nctsj2(5)   = 251 - isrow 
     266               !                                         
     267               nctsi1(6)   = 210  ; nctsj1(6)   = 252 - isrow   ! Lake Ontario 
     268               nctsi2(6)   = 212  ; nctsj2(6)   = 252 - isrow 
     269               !                                         
     270               nctsi1(7)   = 321  ; nctsj1(7)   = 180 - isrow   ! Victoria Lake 
     271               nctsi2(7)   = 322  ; nctsj2(7)   = 189 - isrow 
     272               !                                         
     273               nctsi1(8)   = 297  ; nctsj1(8)   = 270 - isrow   ! Baltic Sea 
     274               nctsi2(8)   = 308  ; nctsj2(8)   = 293 - isrow 
     275               ! 
     276               !                                        ! ======================= 
    276277            CASE ( 2 )                                  !  ORCA_R2 configuration 
    277278               !                                        ! ======================= 
    … …  
    286287               nctsi2(3)   = 181  ;  nctsj2(3)   = 112 
    287288              !                                       
    288                nctsi1(4)   =   2  ;  nctsj1(4)   = 107      ! Black Sea 2 : est part of the Black Sea 
     289               nctsi1(4)   =   2  ;  nctsj1(4)   = 107       ! Black Sea 2 : est part of the Black Sea 
    289290               nctsi2(4)   =   6  ;  nctsj2(4)   = 112 
    290291               !                                      
    291292               nctsi1(5)   =  145 ;  nctsj1(5)   = 116       ! Baltic Sea 
    292293               nctsi2(5)   =  150 ;  nctsj2(5)   = 126 
     294               ! 
    293295               !                                        ! ======================= 
    294296            CASE ( 4 )                                  !  ORCA_R4 configuration 
    … …  
    306308               nctsi1(4)   = 75  ;  nctsj1(4)   = 59         ! Baltic Sea 
    307309               nctsi2(4)   = 76  ;  nctsj2(4)   = 61 
     310               ! 
    308311               !                                        ! ======================= 
    309312            CASE ( 025 )                                ! ORCA_R025 configuration 
    … …  
    319322            ! 
    320323         ENDIF 
     324         ! 
     325         nctsi1(:) = nctsi1(:) + nn_hls - 1   ;   nctsi2(:) = nctsi2(:) + nn_hls - 1   ! -1 as x-perio included in old input files 
     326         nctsj1(:) = nctsj1(:) + nn_hls       ;   nctsj2(:) = nctsj2(:) + nn_hls 
    321327         ! 
    322328         ! convert the position in local domain indices 

  • NEMO/trunk/src/TOP/TRP/trcldf.F90

    r13237 r13286  
    2525   USE trdtra         ! trends manager: tracers 
    2626   ! 
    27    USE prtctl_trc     ! Print control 
     27   USE prtctl         ! Print control 
    2828 
    2929   IMPLICIT NONE 
    … …  
    115115      IF( sn_cfctl%l_prttrc ) THEN ! print mean trends (used for debugging) 
    116116         WRITE(charout, FMT="('ldf ')") 
    117          CALL prt_ctl_trc_info(charout) 
    118          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     117         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     118         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    119119      ENDIF 
    120120      ! 

  • NEMO/trunk/src/TOP/TRP/trcrad.F90

    r12489 r13286  
    1919   USE trd_oce 
    2020   USE trdtra 
    21    USE prtctl_trc          ! Print control for debbuging 
     21   USE prtctl              ! Print control for debbuging 
    2222   USE lib_fortran 
    2323 
    … …  
    7272      IF(sn_cfctl%l_prttrc) THEN      ! print mean trends (used for debugging) 
    7373         WRITE(charout, FMT="('rad')") 
    74          CALL prt_ctl_trc_info( charout ) 
    75          CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Kbb), mask=tmask, clinfo=ctrcnm ) 
     74         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     75         CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Kbb), mask1=tmask, clinfo=ctrcnm ) 
    7676      ENDIF 
    7777      ! 

  • NEMO/trunk/src/TOP/TRP/trcsbc.F90

    r13237 r13286  
    1818   USE oce_trc         ! ocean dynamics and active tracers variables 
    1919   USE trc             ! ocean  passive tracers variables 
    20    USE prtctl_trc      ! Print control for debbuging 
     20   USE prtctl          ! Print control for debbuging 
    2121   USE iom 
    2222   USE trd_oce 
    … …  
    8888            zfact = 0.5_wp 
    8989            DO jn = 1, jptra 
    90                CALL iom_get( numrtr, jpdom_autoglo, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
     90               CALL iom_get( numrtr, jpdom_auto, 'sbc_'//TRIM(ctrcnm(jn))//'_b', sbc_trc_b(:,:,jn) )   ! before tracer content sbc 
    9191            END DO 
    9292         ELSE                                         ! No restart or restart not found: Euler forward time stepping 
    … …  
    187187      ! 
    188188      IF( sn_cfctl%l_prttrc )   THEN 
    189          WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_trc_info(charout) 
    190                                            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     189         WRITE(charout, FMT="('sbc ')") ;  CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     190                                           CALL prt_ctl( tab4d_1=ptr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    191191      ENDIF 
    192192      IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 

  • NEMO/trunk/src/TOP/TRP/trczdf.F90

    r12489 r13286  
    2222!!gm 
    2323   USE trdtra        ! trends manager: tracers  
    24    USE prtctl_trc    ! Print control 
     24   USE prtctl        ! Print control 
    2525 
    2626   IMPLICIT NONE 
    … …  
    6969      IF( sn_cfctl%l_prttrc )   THEN 
    7070         WRITE(charout, FMT="('zdf ')") 
    71          CALL prt_ctl_trc_info(charout) 
    72          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kaa), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     71         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     72         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kaa), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    7373      END IF 
    7474      ! 

  • NEMO/trunk/src/TOP/TRP/trdmxl_trc_rst.F90

    r12377 r13286  
    144144          
    145145         DO jn = 1, jptra 
    146             CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
    147             CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) ) 
    148             CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
    149             CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
     146            CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_'  //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
     147            CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_'  //ctrcnm(jn), tmlbn_trc  (:,:,jn) ) 
     148            CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_'//ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
     149            CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_'//ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
    150150         END DO 
    151151          
    152152      ELSE 
    153          CALL iom_get( inum, jpdom_autoglo, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 
     153         CALL iom_get( inum, jpdom_auto, 'rmldbn_trc', rmldbn_trc ) ! needed for rmld_sum 
    154154          
    155155         !                                                          ! =========== 
    156156         DO jn = 1, jptra                                           ! tracer loop 
    157157            !                                                       ! =========== 
    158             CALL iom_get( inum, jpdom_autoglo, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
    159             CALL iom_get( inum, jpdom_autoglo, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
    160             CALL iom_get( inum, jpdom_autoglo, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
    161  
    162             CALL iom_get( inum, jpdom_autoglo, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum 
    163             CALL iom_get( inum, jpdom_autoglo, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 
     158            CALL iom_get( inum, jpdom_auto, 'tmlatfb_trc_' //ctrcnm(jn), tmlatfb_trc(:,:,jn) ) 
     159            CALL iom_get( inum, jpdom_auto, 'tmlbb_trc_'   //ctrcnm(jn), tmlbb_trc  (:,:,jn) ) 
     160            CALL iom_get( inum, jpdom_auto, 'tmlradb_trc_' //ctrcnm(jn), tmlradb_trc(:,:,jn) ) 
     161 
     162            CALL iom_get( inum, jpdom_auto, 'tmlbn_trc_'   //ctrcnm(jn), tmlbn_trc   (:,:,jn) ) ! needed for tml_sum 
     163            CALL iom_get( inum, jpdom_auto, 'tml_sumb_trc_'//ctrcnm(jn), tml_sumb_trc(:,:,jn) ) 
    164164             
    165165            DO jk = 1, jpltrd_trc 
    … …  
    169169                  WRITE(charout,FMT="('tmltrd_csum_ub_trc_', A3, '_', I2)") ctrcnm(jn), jk 
    170170               ENDIF 
    171                CALL iom_get( inum, jpdom_autoglo, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 
     171               CALL iom_get( inum, jpdom_auto, charout, tmltrd_csum_ub_trc(:,:,jk,jn) ) 
    172172            END DO 
    173173             
    174             CALL iom_get( inum, jpdom_autoglo, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 
     174            CALL iom_get( inum, jpdom_auto, 'tmltrd_atf_sumb_trc_'//ctrcnm(jn) , & 
    175175                 &        tmltrd_atf_sumb_trc(:,:,jn) ) 
    176176 
    177             CALL iom_get( inum, jpdom_autoglo, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 
     177            CALL iom_get( inum, jpdom_auto, 'tmltrd_rad_sumb_trc_'//ctrcnm(jn) , & 
    178178                 &        tmltrd_rad_sumb_trc(:,:,jn) ) 
    179179            !                                                       ! =========== 

  • NEMO/trunk/src/TOP/oce_trc.F90

    r12489 r13286  
    1818   USE par_oce , ONLY :   jp_tem   =>   jp_tem     !: indice for temperature 
    1919   USE par_oce , ONLY :   jp_sal   =>   jp_sal     !: indice for salinity 
     20   USE par_oce , ONLY :   nn_hls   =>   nn_hls     !:  
     21   USE par_oce , ONLY :   Nis0    =>   Nis0      !:  
     22   USE par_oce , ONLY :   Njs0    =>   Njs0      !:  
     23   USE par_oce , ONLY :   Nie0    =>   Nie0      !:  
     24   USE par_oce , ONLY :   Nje0    =>   Nje0      !:  
     25   USE par_oce , ONLY :   Nis1    =>   Nis1      !:  
     26   USE par_oce , ONLY :   Njs1    =>   Njs1      !:  
     27   USE par_oce , ONLY :   Nie1    =>   Nie1      !:  
     28   USE par_oce , ONLY :   Nje1    =>   Nje1      !:  
     29   USE par_oce , ONLY :   Nis1nxt2    =>   Nis1nxt2      !:  
     30   USE par_oce , ONLY :   Njs1nxt2    =>   Njs1nxt2      !:  
     31   USE par_oce , ONLY :   Nie1nxt2    =>   Nie1nxt2      !:  
     32   USE par_oce , ONLY :   Nje1nxt2    =>   Nje1nxt2      !:  
     33   USE par_oce , ONLY :   Nis2    =>   Nis2      !:  
     34   USE par_oce , ONLY :   Njs2    =>   Njs2      !:  
     35   USE par_oce , ONLY :   Nie2    =>   Nie2      !:  
     36   USE par_oce , ONLY :   Nje2    =>   Nje2      !:  
     37   USE par_oce , ONLY :   Ni_0    =>   Ni_0      !:  
     38   USE par_oce , ONLY :   Nj_0    =>   Nj_0      !:  
     39   USE par_oce , ONLY :   Ni_1    =>   Ni_1      !:  
     40   USE par_oce , ONLY :   Nj_1    =>   Nj_1      !:  
     41   USE par_oce , ONLY :   Ni_2    =>   Ni_2      !:  
     42   USE par_oce , ONLY :   Nj_2    =>   Nj_2      !:  
    2043 
    2144   USE in_out_manager                           !* IO manager * 

  • NEMO/trunk/src/TOP/trcini.F90

    r13237 r13286  
    2020   USE trcnam          ! Namelist read 
    2121   USE daymod          ! calendar manager 
    22    USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
     22   USE prtctl          ! Print control passive tracers (prt_ctl_init routine) 
    2323   USE trcrst 
    2424   USE lib_mpp         ! distribued memory computing library 
    … …  
    9494      INTEGER             ::  jk, jn  ! dummy loop indices 
    9595      CHARACTER (len=25) :: charout 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 
     97      CHARACTER (len=25), DIMENSION(jptra) :: clseb   
    9698      !!---------------------------------------------------------------------- 
    9799      ! 
    … …  
    125127      IF(lwp) WRITE(numout,*) 
    126128      IF(sn_cfctl%l_prttrc) THEN            ! print mean trends (used for debugging) 
    127          CALL prt_ctl_trc_init 
     129         CALL prt_ctl_init( 'top', jptra ) 
    128130         WRITE(charout, FMT="('ini ')") 
    129          CALL prt_ctl_trc_info( charout ) 
    130          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     131         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     132         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
     133         DO jn = 1, jptra 
     134            zzmsk(:,:,:,jn) = tmask(:,:,:) 
     135            WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 
     136         END DO 
     137         CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 
    131138      ENDIF 
    1321399000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 

  • NEMO/trunk/src/TOP/trcrst.F90

    r13237 r13286  
    114114      ! READ prognostic variables and computes diagnostic variable 
    115115      DO jn = 1, jptra 
    116          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
    117       END DO 
    118  
    119       DO jn = 1, jptra 
    120          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
     116         CALL iom_get( numrtr, jpdom_auto, 'TRN'//ctrcnm(jn), tr(:,:,:,jn,Kmm) ) 
     117      END DO 
     118 
     119      DO jn = 1, jptra 
     120         CALL iom_get( numrtr, jpdom_auto, 'TRB'//ctrcnm(jn), tr(:,:,:,jn,Kbb) ) 
    121121      END DO 
    122122      ! 

  • NEMO/trunk/src/TOP/trcsms.F90

    r12377 r13286  
    2020   USE trcsms_age         ! AGE 
    2121   USE trcsms_my_trc      ! MY_TRC  tracers 
    22    USE prtctl_trc         ! Print control for debbuging 
     22   USE prtctl             ! Print control for debbuging 
    2323 
    2424   IMPLICIT NONE 
    … …  
    5858      IF(sn_cfctl%l_prttrc) THEN                       ! print mean trends (used for debugging) 
    5959         WRITE(charout, FMT="('sms ')") 
    60          CALL prt_ctl_trc_info( charout ) 
    61          CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm ) 
     60         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     61         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    6262      ENDIF 
    6363      ! 

  • NEMO/trunk/src/TOP/trcstp.F90

    r13237 r13286  
    2222   USE sms_pisces,  ONLY : ln_check_mass 
    2323   ! 
    24    USE prtctl_trc     ! Print control for debbuging 
     24   USE prtctl         ! Print control for debbuging 
    2525   USE iom            ! 
    2626   USE in_out_manager ! 
    … …  
    9292      IF(sn_cfctl%l_prttrc) THEN 
    9393         WRITE(charout,FMT="('kt =', I4,'  d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear 
    94          CALL prt_ctl_trc_info(charout) 
     94         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    9595      ENDIF 
    9696      ! 
    … …  
    200200            rsecfst = INT( zkt ) * rn_Dt 
    201201            IF(lwp) WRITE(numout,*) 'trc_qsr_mean:   qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s ' 
    202             CALL iom_get( numrtr, jpdom_autoglo, 'qsr_mean', qsr_mean )   !  A mean of qsr 
     202            CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean )   !  A mean of qsr 
    203203            CALL iom_get( numrtr, 'nrdcy', zrec )   !  Number of record per days 
    204204            IF( INT( zrec ) == nb_rec_per_day ) THEN 
    … …  
    206206                  IF( jn <= 9 )  THEN 
    207207                    WRITE(cl1,'(i1)') jn 
    208                     CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr 
     208                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )   !  A mean of qsr 
    209209                  ELSE 
    210210                    WRITE(cl2,'(i2.2)') jn 
    211                     CALL iom_get( numrtr, jpdom_autoglo, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr 
     211                    CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )   !  A mean of qsr 
    212212                  ENDIF 
    213213              END DO 

  • NEMO/trunk/tests/BENCH/EXPREF/namelist_cfg_orca025_like

    r12530 r13286  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   1442     ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   1207  !!  1050    ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   1440     ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   1206  !!  1049    ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   4        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/trunk/tests/BENCH/EXPREF/namelist_cfg_orca12_like

    r12530 r13286  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   4322     ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   3147     ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   4320     ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   3146     ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   4        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/trunk/tests/BENCH/EXPREF/namelist_cfg_orca1_like

    r12530 r13286  
    1515&namusr_def    !   User defined :   BENCH configuration: Flat bottom, beta-plane 
    1616!----------------------------------------------------------------------- 
    17    nn_isize   =   362      ! number of point in i-direction of global(local) domain if >0 (<0)   
    18    nn_jsize   =   332      ! number of point in j-direction of global(local) domain if >0 (<0)   
     17   nn_isize   =   360      ! number of point in i-direction of global(local) domain if >0 (<0)   
     18   nn_jsize   =   331      ! number of point in j-direction of global(local) domain if >0 (<0)   
    1919   nn_ksize   =   75       ! total number of point in k-direction 
    2020   nn_perio   =   6        ! periodicity 
    … …  
    3030&namctl        !   Control prints                                       (default: OFF) 
    3131!----------------------------------------------------------------------- 
    32    nn_print    =    0      !  level of print (0 no extra print) 
    3332   ln_timing   = .false.   !  timing by routine write out in timing.output file 
    3433/ 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6161      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6262      ! 
    63       INTEGER  ::   ji, jj   ! dummy loop indices 
     63      INTEGER  ::   ji, jj         ! dummy loop indices 
    6464      REAL(wp) ::   zres, zf0 
    65       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     65      REAL(wp) ::   zti, ztj       ! local scalars 
    6666      !!------------------------------------------------------------------------------- 
    6767      ! 
    … …  
    7272      IF(lwp) WRITE(numout,*) '          given by rn_dx and rn_dy'  
    7373      ! 
    74       !                           
    7574      ! Position coordinates (in grid points) 
    7675      !                          ========== 
    7776      DO_2D_11_11 
    7877          
    79          zti = REAL( ji - 1 + nimpp - 1, wp )          ;  ztj = REAL( jj - 1 + njmpp - 1, wp ) 
    80          zui = REAL( ji - 1 + nimpp - 1, wp ) + 0.5_wp ;  zvj = REAL( jj - 1 + njmpp - 1, wp ) + 0.5_wp 
     78         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     79         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    8180          
    8281         plamt(ji,jj) = zti 
    83          plamu(ji,jj) = zui 
     82         plamu(ji,jj) = zti + 0.5_wp 
    8483         plamv(ji,jj) = zti 
    85          plamf(ji,jj) = zui 
     84         plamf(ji,jj) = zti + 0.5_wp 
    8685          
    8786         pphit(ji,jj) = ztj 
    88          pphiv(ji,jj) = zvj 
    8987         pphiu(ji,jj) = ztj 
    90          pphif(ji,jj) = zvj 
     88         pphiv(ji,jj) = ztj + 0.5_wp 
     89         pphif(ji,jj) = ztj + 0.5_wp 
    9190 
    9291      END_2D 
    … …  
    109108      kff = 1                       !  indicate not to compute Coriolis parameter afterward 
    110109      ! 
    111       zf0   = 2._wp * omega * SIN( rad * 45 )   ! constant coriolis factor corresponding to 45°N 
     110      zf0 = 2._wp * omega * SIN( rad * 45 )   ! constant coriolis factor corresponding to 45°N 
    112111      pff_f(:,:) = zf0 
    113112      pff_t(:,:) = zf0 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_istate.F90

    r12794 r13286  
    5757      REAL(wp) ::   zfact 
    5858      INTEGER  ::   ji, jj, jk 
     59      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow 
    5960      !!---------------------------------------------------------------------- 
    6061      ! 
    … …  
    6364      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~   ' 
    6465      ! 
    65       ! define unique value on each point. z2d ranging from 0.05 to -0.05 
    66       DO_2D_11_11 
    67          z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig(ji) + (mjg(jj)-1) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 
     66      ! define unique value on each point of the inner global domain. z2d ranging from 0.05 to -0.05 
     67      ! 
     68      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     69      ! we must define z2d as bellow. 
     70      ! Once we decide to forget trunk compatibility, we must simply define z2d as: 
     71!!$      DO_2D_00_00 
     72!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 
     73!!$      END_2D 
     74      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     75      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     76      DO_2D_00_00 
     77         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
    6878      END_2D 
    6979      ! 
    … …  
    7181      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m 
    7282      ! 
    73       DO jk = 1, jpk 
     83      DO_3D_00_00( 1, jpkm1 ) 
    7484         zfact = REAL(jk-1,wp) / REAL(jpk-1,wp)   ! 0 to 1 to add a basic stratification 
    7585         ! temperature choosen to lead to ~50% ice at the beginning if rn_thres_sst = 0.5 
    … …  
    8090         pu(:,:,jk) = z2d(:,:) *  0.1_wp * umask(:,:,jk)                  ! +/- 0.005  m/s 
    8191         pv(:,:,jk) = z2d(:,:) * 0.01_wp * vmask(:,:,jk)                  ! +/- 0.0005 m/s 
    82       ENDDO 
     92      END_3D 
     93      pts(:,:,jpk,:) = 0._wp 
     94      pu( :,:,jpk  ) = 0._wp 
     95      pv( :,:,jpk  ) = 0._wp 
    8396      ! 
    8497      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_nam.F90

    r12563 r13286  
    5858      !! 
    5959      NAMELIST/namusr_def/ nn_isize, nn_jsize, nn_ksize, nn_perio 
    60       NAMELIST/nammpp/ jpni, jpnj, ln_nnogather, ln_listonly 
     60      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly 
    6161      !!----------------------------------------------------------------------      
    6262      ! 
    … …  
    7777902      IF( ios >  0 )   CALL ctl_nam ( ios , 'nammpp in configuration namelist' ) 
    7878 
    79          kpi = ( -nn_isize - 2*nn_hls ) * jpni + 2*nn_hls 
    80          kpj = ( -nn_jsize - 2*nn_hls ) * jpnj + 2*nn_hls 
     79         kpi = -nn_isize * jpni 
     80         kpj = -nn_jsize * jpnj 
    8181      ELSE 
    8282         kpi = nn_isize 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_sbc.F90

    r12740 r13286  
    9999      REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace 
    100100      INTEGER  ::   ji, jj 
     101      INTEGER  ::   igloi, igloj   ! to be removed in the future, see comment bellow 
    101102      !!--------------------------------------------------------------------- 
    102103#if defined key_si3 
    … …  
    104105      ! 
    105106      ! define unique value on each point. z2d ranging from 0.05 to -0.05 
    106       DO_2D_11_11 
    107          z2d(ji,jj) = 0.1 * ( 0.5 - REAL( nimpp + ji - 1 + ( njmpp + jj - 2 ) * jpiglo, wp ) / REAL( jpiglo * jpjglo, wp ) ) 
     107      ! 
     108      ! WARNING: to keep compatibility with the trunk that was including periodocity into the input data,  
     109      ! we must define z2d as bellow. 
     110      ! Once we decide to forget trunk compatibility, we must simply define z2d as: 
     111!!$      DO_2D_00_00 
     112!!$         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * Ni0glo, wp ) / REAL( Ni0glo * Nj0glo, wp ) ) 
     113!!$      END_2D 
     114      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) ) 
     115      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) ) 
     116      DO_2D_00_00 
     117         z2d(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) ) 
    108118      END_2D 
    109       utau_ice(:,:) = 0.1_wp +  z2d(:,:) 
    110       vtau_ice(:,:) = 0.1_wp +  z2d(:,:) 
     119      utau_ice(:,:) = 0.1_wp + z2d(:,:) 
     120      vtau_ice(:,:) = 0.1_wp + z2d(:,:) 
    111121 
    112122      CALL lbc_lnk_multi( 'usrdef_sbc', utau_ice, 'U', -1., vtau_ice, 'V', -1. ) 

  • NEMO/trunk/tests/BENCH/MY_SRC/usrdef_zgr.F90

    r12377 r13286  
    192192      z2d(:,:) = REAL( jpkm1 , wp )          ! flat bottom 
    193193      ! 
    194       IF( jperio == 3 .OR. jperio ==4 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
    195          z2d(mi0(       1):mi1(     3),mj0(jpjglo-2):mj1(jpjglo)) = 0. 
    196          z2d(mi0(jpiglo-2):mi1(jpiglo),mj0(jpjglo-2):mj1(jpjglo)) = 0. 
    197       ENDIF 
     194      ! 
     195      ! BENCH should work without these 2 small islands on the 2 poles of the folding... 
     196      !   -> Comment out these lines if instabilities are too large... 
     197      ! 
     198       
     199!!$      IF( jperio == 3 .OR. jperio == 4 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
     200!!$         z2d(mi0(       nn_hls):mi1(                  nn_hls+2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     201!!$         z2d(mi0(jpiglo-nn_hls):mi1(MIN(jpiglo,jpiglo-nn_hls+2)),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     202!!$         z2d(mi0(jpiglo/2     ):mi1(           jpiglo/2     +2 ),mj0(jpjglo-nn_hls-1):mj1(jpjglo-nn_hls+1)) = 0. 
     203!!$      ENDIF 
     204!!$      ! 
     205!!$      IF( jperio == 5 .OR. jperio == 6 ) THEN   ! add a small island in the upper corners to avoid model instabilities... 
     206!!$         z2d(mi0(       nn_hls):mi1(       nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     207!!$         z2d(mi0(jpiglo-nn_hls):mi1(jpiglo-nn_hls+1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     208!!$         z2d(mi0(jpiglo/2     ):mi1(jpiglo/2     +1),mj0(jpjglo-nn_hls):mj1(jpjglo-nn_hls+1)) = 0. 
     209!!$      ENDIF 
     210 
    198211      ! 
    199212      CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )           ! set surrounding land to zero (here jperio=0 ==>> closed) 

  • NEMO/trunk/tests/CANAL/MY_SRC/domvvl.F90

    r12740 r13286  
    450450            ELSE 
    451451               ijk_max = MAXLOC( ze3t(:,:,:) ) 
    452                ijk_max(1) = ijk_max(1) + nimpp - 1 
    453                ijk_max(2) = ijk_max(2) + njmpp - 1 
     452               ijk_max(1) = mig0_oldcmp(ijk_max(1)) 
     453               ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 
    454454               ijk_min = MINLOC( ze3t(:,:,:) ) 
    455                ijk_min(1) = ijk_min(1) + nimpp - 1 
    456                ijk_min(2) = ijk_min(2) + njmpp - 1 
     455               ijk_min(1) = mig0_oldcmp(ijk_min(1)) 
     456               ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 
    457457            ENDIF 
    458458            IF (lwp) THEN 
    … …  
    793793         IF( ln_rstart ) THEN                   !* Read the restart file 
    794794            CALL rst_read_open                  !  open the restart file if necessary 
    795             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     795            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    796796            ! 
    797797            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    806806            ! 
    807807            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    808                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    809                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     808               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     809               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    810810               ! needed to restart if land processor not computed  
    811811               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    821821               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    822822               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    823                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     823               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    824824               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    825825               l_1st_euler = .true. 
    … …  
    828828               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    829829               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    830                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     830               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    831831               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    832832               l_1st_euler = .true. 
    … …  
    853853               !                          ! ----------------------- ! 
    854854               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    855                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    856                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     855                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     856                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    857857               ELSE                            ! one at least array is missing 
    858858                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    863863                  !                       ! ------------ ! 
    864864                  IF( id5 > 0 ) THEN  ! required array exists 
    865                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     865                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    866866                  ELSE                ! array is missing 
    867867                     hdiv_lf(:,:,:) = 0.0_wp 

  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6363      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6464      ! 
    65       INTEGER  ::   ji, jj   ! dummy loop indices 
     65      INTEGER  ::   ji, jj     ! dummy loop indices 
    6666      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    67       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     67      REAL(wp) ::   zti, ztj   ! local scalars 
    6868      !!------------------------------------------------------------------------------- 
    6969      ! 
    … …  
    7777      ! Position coordinates (in kilometers) 
    7878      !                          ========== 
    79       zlam0 = -REAL(NINT(jpiglo*rn_0xratio)-1, wp) * rn_dx 
    80       zphi0 = -REAL(NINT(jpjglo*rn_0yratio)-1, wp) * rn_dy  
     79      zlam0 = -REAL(NINT(Ni0glo*rn_0xratio)-1, wp) * rn_dx 
     80      zphi0 = -REAL(NINT(Nj0glo*rn_0yratio)-1, wp) * rn_dy  
    8181 
    8282#if defined key_agrif 
    … …  
    9090#endif 
    9191          
    92       DO_2D_11_11 
    93          zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    94          zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
     92      DO_2D_11_11          
     93         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     94         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    9595          
    96          plamt(ji,jj) = zlam0 + rn_dx * zti 
    97          plamu(ji,jj) = zlam0 + rn_dx * zui 
     96         plamt(ji,jj) = zlam0 + rn_dx *   zti 
     97         plamu(ji,jj) = zlam0 + rn_dx * ( zti + 0.5_wp )  
    9898         plamv(ji,jj) = plamt(ji,jj)  
    9999         plamf(ji,jj) = plamu(ji,jj)  
    100100          
    101          pphit(ji,jj) = zphi0 + rn_dy * ztj 
    102          pphiv(ji,jj) = zphi0 + rn_dy * zvj 
     101         pphit(ji,jj) = zphi0 + rn_dy *   ztj 
     102         pphiv(ji,jj) = zphi0 + rn_dy * ( ztj + 0.5_wp )  
    103103         pphiu(ji,jj) = pphit(ji,jj)  
    104104         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/trunk/tests/CANAL/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    106106      kk_cfg = INT( rn_dx ) 
    107107      ! 
    108       ! Global Domain size:  EW_CANAL global domain is  1800 km x 1800 Km x 5000 m 
    109       kpi = NINT( rn_domszx / rn_dx ) + 1 
    110       kpj = NINT( rn_domszy / rn_dy ) + 3 
    111       kpk = NINT( rn_domszz / rn_dz ) + 1 
    112 #if defined key_agrif 
    113       IF( .NOT. Agrif_Root() ) THEN 
    114          kpi  = nbcellsx + 2 + 2*nbghostcells 
    115          kpj  = nbcellsy + 2 + 2*nbghostcells 
     108      IF( Agrif_Root() ) THEN        ! Global Domain size:  EW_CANAL global domain is  1800 km x 1800 Km x 5000 m 
     109         kpi = NINT( rn_domszx / rn_dx ) + 1 
     110         kpj = NINT( rn_domszy / rn_dy ) + 3 
     111      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     112         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     113         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    116114      ENDIF 
    117 #endif 
     115      kpk = MAX( 2, NINT( rn_domszz / rn_dz ) + 1 ) 
    118116      ! 
    119117      zh  = (kpk-1)*rn_dz 

  • NEMO/trunk/tests/ICE_ADV1D/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6464      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6565      ! 
    66       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6767      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    68       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6969      !!------------------------------------------------------------------------------- 
    7070      ! 
    … …  
    7575 
    7676      !                          ========== 
    77       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    78       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
     77      zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 
     78      zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy 
    7979 
    8080      DO_2D_11_11 
    81          zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    82          zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
     81         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     82         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    8383          
    84          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    85          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
     84         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     85         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
    8686         plamv(ji,jj) = plamt(ji,jj)  
    8787         plamf(ji,jj) = plamu(ji,jj)  
    8888          
    89          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    90          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
     89         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     90         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
    9191         pphiu(ji,jj) = pphit(ji,jj)  
    9292         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/trunk/tests/ICE_ADV1D/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    9190         WRITE(numout,*) '         LX [km]: ', zlx 
    9291         WRITE(numout,*) '         LY [km]: ', zly 
    93          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    94          WRITE(numout,*) '                                               jpjglo = ', kpj 
     92         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     93         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    9594         WRITE(numout,*) '                                               jpkglo = ', kpk 
    9695         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/trunk/tests/ICE_ADV2D/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6464      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6565      ! 
    66       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6767      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    68       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6969      !!------------------------------------------------------------------------------- 
    7070      ! 
    … …  
    7676 
    7777      !                          ========== 
    78       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    79       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
     78      zlam0 = -REAL( (Ni0glo-2)/2, wp) * 1.e-3 * rn_dx 
     79      zphi0 = -REAL( (Nj0glo-2)/2, wp) * 1.e-3 * rn_dy  
    8080 
    8181#if defined key_agrif  
    … …  
    8383!clem         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 
    8484!clem         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 
    85          zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     85         zlam0 = ( 0.5_wp - REAL( (Agrif_parent(Ni0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    8686            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    87          zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     87         zphi0 = ( 0.5_wp - REAL( (Agrif_parent(Nj0glo) - 2 ) / 2, wp ) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    8888            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8989      ENDIF 
    … …  
    9191 
    9292      DO_2D_11_11 
    93          zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    94          zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
     93         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     94         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    9595          
    96          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    97          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
     96         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     97         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
    9898         plamv(ji,jj) = plamt(ji,jj)  
    9999         plamf(ji,jj) = plamu(ji,jj)  
    100100          
    101          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    102          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
     101         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     102         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
    103103         pphiu(ji,jj) = pphit(ji,jj)  
    104104         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/trunk/tests/ICE_ADV2D/MY_SRC/usrdef_nam.F90

    r12740 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp, Agrif_Root            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8282      kk_cfg = NINT( rn_dx ) 
    8383      ! 
    84       IF( Agrif_Root() ) THEN        ! Global Domain size:  ICE_AGRIF domain is  300 km x 300 Km x 10 m 
     84      IF( Agrif_Root() ) THEN        ! Global Domain size: ICE_AGRIF domain is  300 km x 300 Km x 10 m 
    8585         kpi = NINT( 300.e3 / rn_dx ) - 1 
    8686         kpj = NINT( 300.e3 / rn_dy ) - 1 
    87       ELSE 
    88          kpi = nbcellsx + 2 + 2*nbghostcells 
    89          kpj = nbcellsy + 2 + 2*nbghostcells 
     87      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     88         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     89         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    9090      ENDIF 
    91       kpk = 1 
     91      kpk = 2 
    9292      ! 
    9393!!      zlx = (kpi-2)*rn_dx*1.e-3 
    … …  
    110110         WRITE(numout,*) '         LX [km]: ', zlx 
    111111         WRITE(numout,*) '         LY [km]: ', zly 
    112          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    113          WRITE(numout,*) '                                               jpjglo = ', kpj 
     112         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     113         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    114114         WRITE(numout,*) '                                               jpkglo = ', kpk 
    115115         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/trunk/tests/ICE_AGRIF/EXPREF/AGRIF_FixedGrids.in

    r9159 r13286  
    111 
    2 34 63 34 63 3 3 3 
     233 62 33 62 3 3 3 
    330 

  • NEMO/trunk/tests/ICE_AGRIF/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6464      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6565      ! 
    66       INTEGER  ::   ji, jj   ! dummy loop indices 
     66      INTEGER  ::   ji, jj     ! dummy loop indices 
    6767      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    68       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     68      REAL(wp) ::   zti, ztj   ! local scalars 
    6969      !!------------------------------------------------------------------------------- 
    7070      ! 
    … …  
    7676 
    7777      !                          ========== 
    78       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    79       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy 
    80  
    8178#if defined key_agrif  
    82       IF( .NOT. Agrif_Root() ) THEN 
     79      IF( Agrif_Root() ) THEN 
     80#endif 
     81         ! Compatibility WITH old version:  
     82         ! jperio = 7 =>  Ni0glo = jpigo_old_version - 2 
     83         !            =>  jpiglo-1 replaced by Ni0glo+1 
     84         zlam0 = -REAL( (Ni0glo+1)/2, wp) * 1.e-3 * rn_dx 
     85         zphi0 = -REAL( (Nj0glo+1)/2, wp) * 1.e-3 * rn_dy   ! +1 for compatibility with old version --> to be replaced by -1 as before 
     86#if defined key_agrif  
     87      ELSE 
     88         ! ! let lower left longitude and latitude from parent 
    8389!clem         zlam0  = Agrif_Parent(zlam0) + (Agrif_ix())*Agrif_Parent(rn_dx) * 1.e-5 
    8490!clem         zphi0  = Agrif_Parent(zphi0) + (Agrif_iy())*Agrif_Parent(rn_dy) * 1.e-5 
    85          zlam0 = ( 0.5_wp - ( Agrif_parent(jpiglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     91         ! Compatibility WITH old version:  
     92         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     93         !            =>  Agrif_parent(jpiglo)-1 replaced by  Agrif_parent(Ni0glo)-1 
     94         zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
    8695            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
    87          zphi0 = ( 0.5_wp - ( Agrif_parent(jpjglo) - 1 ) / 2 ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     96         zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
    8897            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8998      ENDIF 
    … …  
    91100 
    92101      DO_2D_11_11 
    93          zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    94          zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
     102         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     103         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    95104          
    96          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    97          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
     105         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     106         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
    98107         plamv(ji,jj) = plamt(ji,jj)  
    99108         plamf(ji,jj) = plamu(ji,jj)  
    100109          
    101          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    102          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
     110         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     111         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
    103112         pphiu(ji,jj) = pphit(ji,jj)  
    104113         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/trunk/tests/ICE_AGRIF/MY_SRC/usrdef_nam.F90

    r12597 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8585         kpi = NINT( 300.e3 / rn_dx ) - 1 
    8686         kpj = NINT( 300.e3 / rn_dy ) - 1 
    87       ELSE 
    88          kpi = nbcellsx + 2 + 2*nbghostcells 
    89          kpj = nbcellsy + 2 + 2*nbghostcells 
     87         kpi = kpi - 2   ! for compatibility with old version (because kerio=7) --> to be removed 
     88         kpj = kpj - 2   ! for compatibility with old version (because kerio=7) --> to be removed 
     89      ELSE                           ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     90         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     91         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     92!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     93!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    9094      ENDIF 
    9195      kpk = 2 
    … …  
    110114         WRITE(numout,*) '         LX [km]: ', zlx 
    111115         WRITE(numout,*) '         LY [km]: ', zly 
    112          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    113          WRITE(numout,*) '                                               jpjglo = ', kpj 
     116         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     117         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    114118         WRITE(numout,*) '                                               jpkglo = ', kpk 
    115119         WRITE(numout,*) '         Coriolis:', ln_corio 

  • NEMO/trunk/tests/ISOMIP+/MY_SRC/sbcfwb.F90

    r12905 r13286  
    211211            erp(:,:) = erp(:,:) + zerp_cor(:,:) 
    212212            ! 
    213             IF( nprint == 1 .AND. lwp ) THEN                   ! control print 
     213            IF( lwp ) THEN                   ! control print 
    214214               IF( z_fwf < 0._wp ) THEN 
    215215                  WRITE(numout,*)'   z_fwf < 0' 

  • NEMO/trunk/tests/ISOMIP+/MY_SRC/tradmp.F90

    r12905 r13286  
    208208         !                          ! Read in mask from file 
    209209         CALL iom_open ( cn_resto, imask) 
    210          CALL iom_get  ( imask, jpdom_autoglo, 'resto', resto ) 
     210         CALL iom_get  ( imask, jpdom_auto, 'resto', resto ) 
    211211         CALL iom_close( imask ) 
    212212      ENDIF 

  • NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    1414   !!   usr_def_hgr    : initialize the horizontal mesh for ISOMIP configuration 
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     16   USE dom_oce 
    1717   USE par_oce         ! ocean space and time domain 
    1818   USE phycst          ! physical constants 
    … …  
    7979      DO_2D_11_11 
    8080         !                       ! longitude   (west coast at lon=0°) 
    81          plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    82          plamu(ji,jj) = rn_e1deg * (          REAL( ji-1 + nimpp-1 , wp )  ) 
     81         plamt(ji,jj) = rn_e1deg * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     82         plamu(ji,jj) = rn_e1deg * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
    8383         plamv(ji,jj) = plamt(ji,jj) 
    8484         plamf(ji,jj) = plamu(ji,jj) 
    8585         !                       ! latitude   (south coast at lat= 81°) 
    86          pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) - 80._wp 
     86         pphit(ji,jj) = rn_e2deg * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) - 80._wp 
    8787         pphiu(ji,jj) = pphit(ji,jj) 
    88          pphiv(ji,jj) = rn_e2deg * (          REAL( jj-1 + njmpp-1 , wp )  ) - 80_wp 
     88         pphiv(ji,jj) = rn_e2deg * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) - 80_wp 
    8989         pphif(ji,jj) = pphiv(ji,jj) 
    9090      END_2D 

  • NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1515   !!   usr_def_hgr   : initialize the horizontal mesh  
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1817   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1918   USE par_oce        ! ocean space and time domain 
    … …  
    9594         WRITE(numout,*) '         vertical   resolution                 rn_e3    = ', rn_e3   , ' meters' 
    9695         WRITE(numout,*) '      ISOMIP domain = 15° x 10° x 900 m' 
    97          WRITE(numout,*) '         resulting global domain size :        jpiglo   = ', kpi 
    98          WRITE(numout,*) '                                               jpjglo   = ', kpj 
     96         WRITE(numout,*) '         resulting global domain size :        Ni0glo   = ', kpi 
     97         WRITE(numout,*) '                                               Nj0glo   = ', kpj 
    9998         WRITE(numout,*) '                                               jpkglo   = ', kpk 
    10099         WRITE(numout,*) '   ' 

  • NEMO/trunk/tests/ISOMIP/MY_SRC/usrdef_zgr.F90

    r12740 r13286  
    1616   !!--------------------------------------------------------------------- 
    1717   USE oce            ! ocean variables 
    18    USE dom_oce ,  ONLY: mj0   , mj1   , nimpp , njmpp  ! ocean space and time domain 
    19    USE dom_oce ,  ONLY: glamt , gphit                   ! ocean space and time domain 
     18   USE dom_oce ,  ONLY: mj0   , mj1    ! ocean space and time domain 
     19   USE dom_oce ,  ONLY: glamt , gphit  ! ocean space and time domain 
    2020   USE usrdef_nam     ! User defined : namelist variables 
    2121   ! 
    … …  
    6767      REAL(wp), DIMENSION(jpi,jpj) ::   zht  , zhu         ! bottom depth 
    6868      REAL(wp), DIMENSION(jpi,jpj) ::   zhisf, zhisfu      ! top depth 
    69       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk  
    70       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                ! 2d workspace 
    7169      !!---------------------------------------------------------------------- 
    7270      ! 
    … …  
    8785      !                       !==  isfdraft  ==! 
    8886      ! 
    89       ! the ocean basin surrounded by land (1 grid-point) set through lbc_lnk call as jperio=0  
    90       z2d(:,:) = 1._wp                    ! surface ocean is the 1st level 
    91       CALL lbc_lnk( 'usrdef_zgr', z2d, 'T', 1. )        ! closed basin since jperio = 0 (see userdef_nam.F90) 
    92       zmsk(:,:) = NINT( z2d(:,:) ) 
    93       ! 
    94       ! 
    9587      zht  (:,:) = rbathy  
    9688      zhisf(:,:) = 200._wp 
    97       ij0 = 1 ; ij1 = 40 
     89      ij0 = 1   ;   ij1 = 40+nn_hls 
    9890      DO jj = mj0(ij0), mj1(ij1) 
    9991         zhisf(:,jj)=700.0_wp-(gphit(:,jj)+80.0_wp)*125.0_wp 
    10092      END DO 
    101       zhisf(:,:) = zhisf(:,:) * zmsk(:,:) 
    10293      ! 
    10394      CALL zgr_z1d( pdept_1d, pdepw_1d, pe3t_1d , pe3w_1d )   ! Reference z-coordinate system 

  • NEMO/trunk/tests/LOCK_EXCHANGE/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for LOCK_EXCHANGE configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    7676      DO_2D_11_11 
    7777         !                       ! longitude 
    78          plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    79          plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
    8080         plamv(ji,jj) = plamt(ji,jj) 
    8181         plamf(ji,jj) = plamu(ji,jj) 
    8282         !                       ! latitude 
    83          pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8484         pphiu(ji,jj) = pphit(ji,jj) 
    85          pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8686         pphif(ji,jj) = pphiv(ji,jj) 
    8787      END_2D 

  • NEMO/trunk/tests/LOCK_EXCHANGE/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    8584         WRITE(numout,*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters' 
    8685         WRITE(numout,*) '      LOCK_EXCHANGE domain = 64 km  x  3 grid-points  x  20 m' 
    87          WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    88          WRITE(numout,*) '                                               jpjglo = ', kpj 
     86         WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     87         WRITE(numout,*) '                                               Nj0glo = ', kpj 
    8988         WRITE(numout,*) '                                               jpkglo = ', kpk 
    9089         WRITE(numout,*) '   ' 

  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for OVERFLOW configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    7676      DO_2D_11_11 
    7777         !                       ! longitude 
    78          plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    79          plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
    8080         plamv(ji,jj) = plamt(ji,jj) 
    8181         plamf(ji,jj) = plamu(ji,jj) 
    8282         !                       ! latitude 
    83          pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8484         pphiu(ji,jj) = pphit(ji,jj) 
    85          pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8686         pphif(ji,jj) = pphiv(ji,jj) 
    8787      END_2D 

  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1817   USE par_oce        ! ocean space and time domain 
    … …  
    8685      WRITE(numout,*) '      vertical   resolution                    rn_dz  = ', rn_dz, ' meters' 
    8786      WRITE(numout,*) '      OVERFLOW domain = 200 km x 3 grid-points x 2000 m' 
    88       WRITE(numout,*) '         resulting global domain size :        jpiglo = ', kpi 
    89       WRITE(numout,*) '                                               jpjglo = ', kpj 
     87      WRITE(numout,*) '         resulting global domain size :        Ni0glo = ', kpi 
     88      WRITE(numout,*) '                                               Nj0glo = ', kpj 
    9089      WRITE(numout,*) '                                               jpkglo = ', kpk 
    9190      ! 

  • NEMO/trunk/tests/OVERFLOW/MY_SRC/usrdef_zgr.F90

    r12740 r13286  
    1515   !!--------------------------------------------------------------------- 
    1616   USE oce            ! ocean variables 
    17    USE dom_oce ,  ONLY: mi0, mi1, nimpp, njmpp   ! ocean space and time domain 
    18    USE dom_oce ,  ONLY: glamt                    ! ocean space and time domain 
     17   USE dom_oce ,  ONLY: mi0, mi1   ! ocean space and time domain 
     18   USE dom_oce ,  ONLY: glamt      ! ocean space and time domain 
    1919   USE usrdef_nam     ! User defined : namelist variables 
    2020   ! 

  • NEMO/trunk/tests/STATION_ASF/MY_SRC/nemogcm.F90

    r13011 r13286  
    3030   USE step_c1d       ! Time stepping loop for the 1D configuration 
    3131   ! 
     32   USE prtctl         ! Print control 
    3233   USE in_out_manager ! I/O manager 
    3334   USE lib_mpp        ! distributed memory computing 
    … …  
    131132      INTEGER ::   ios, ilocal_comm   ! local integers 
    132133      !! 
    133       NAMELIST/namctl/ sn_cfctl,  nn_print, nn_ictls, nn_ictle,             & 
    134          &             nn_isplt , nn_jsplt, nn_jctls, nn_jctle,             & 
    135          &             ln_timing, ln_diacfl 
     134      NAMELIST/namctl/ sn_cfctl, ln_timing, ln_diacfl,                                & 
     135         &             nn_isplt,  nn_jsplt,  nn_ictls, nn_ictle, nn_jctls, nn_jctle 
    136136      NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr 
    137137      !!---------------------------------------------------------------------- 
    … …  
    232232      ! 
    233233      IF( ln_read_cfg ) THEN            ! Read sizes in domain configuration file 
    234          CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     234         CALL domain_cfg ( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    235235      ELSE                              ! user-defined namelist 
    236          CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio ) 
     236         CALL usr_def_nam( cn_cfg, nn_cfg, Ni0glo, Nj0glo, jpkglo, jperio ) 
    237237      ENDIF 
    238238      ! 
    … …  
    306306         WRITE(numout,*) '                              sn_cfctl%procincr  = ', sn_cfctl%procincr  
    307307         WRITE(numout,*) '                              sn_cfctl%ptimincr  = ', sn_cfctl%ptimincr  
    308          WRITE(numout,*) '      level of print                  nn_print   = ', nn_print 
    309          WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls 
    310          WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle 
    311          WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls 
    312          WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle 
    313          WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt 
    314          WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt 
    315308         WRITE(numout,*) '      timing by routine               ln_timing  = ', ln_timing 
    316309         WRITE(numout,*) '      CFL diagnostics                 ln_diacfl  = ', ln_diacfl 
    317310      ENDIF 
    318311      ! 
    319       nprint    = nn_print          ! convert DOCTOR namelist names into OLD names 
    320       nictls    = nn_ictls 
    321       nictle    = nn_ictle 
    322       njctls    = nn_jctls 
    323       njctle    = nn_jctle 
    324       isplt     = nn_isplt 
    325       jsplt     = nn_jsplt 
    326  
     312      IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    327313      IF(lwp) THEN                  ! control print 
    328314         WRITE(numout,*) 
    … …  
    335321         WRITE(numout,*) '      use file attribute if exists as i/p j-start   ln_use_jattr     = ', ln_use_jattr 
    336322      ENDIF 
    337       IF( .NOT.ln_read_cfg )   ln_closea = .false.   ! dealing possible only with a domcfg file 
    338       ! 
    339       !                             ! Parameter control 
    340       ! 
    341       IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN              ! sub-domain area indices for the control prints 
    342          IF( lk_mpp .AND. jpnij > 1 ) THEN 
    343             isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain 
    344          ELSE 
    345             IF( isplt == 1 .AND. jsplt == 1  ) THEN 
    346                CALL ctl_warn( ' - isplt & jsplt are equal to 1',   & 
    347                   &           ' - the print control will be done over the whole domain' ) 
    348             ENDIF 
    349             ijsplt = isplt * jsplt            ! total number of processors ijsplt 
    350          ENDIF 
    351          IF(lwp) WRITE(numout,*)'          - The total number of processors over which the' 
    352          IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt 
    353          ! 
    354          !                              ! indices used for the SUM control 
    355          IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area 
    356             lsp_area = .FALSE. 
    357          ELSE                                             ! print control done over a specific  area 
    358             lsp_area = .TRUE. 
    359             IF( nictls < 1 .OR. nictls > jpiglo )   THEN 
    360                CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' ) 
    361                nictls = 1 
    362             ENDIF 
    363             IF( nictle < 1 .OR. nictle > jpiglo )   THEN 
    364                CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' ) 
    365                nictle = jpiglo 
    366             ENDIF 
    367             IF( njctls < 1 .OR. njctls > jpjglo )   THEN 
    368                CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' ) 
    369                njctls = 1 
    370             ENDIF 
    371             IF( njctle < 1 .OR. njctle > jpjglo )   THEN 
    372                CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' ) 
    373                njctle = jpjglo 
    374             ENDIF 
    375          ENDIF 
    376       ENDIF 
    377323      ! 
    378324      IF( 1._wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.',  & 

  • NEMO/trunk/tests/STATION_ASF/MY_SRC/usrdef_hgr.F90

    r12629 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    1716   USE c1d      ,  ONLY: rn_lon1d, rn_lat1d ! ocean lon/lat define by namelist 
    1817   USE par_oce        ! ocean space and time domain 

  • NEMO/trunk/tests/STATION_ASF/MY_SRC/usrdef_nam.F90

    r12629 r13286  
    1515   !!   usr_def_hgr   : initialize the horizontal mesh  
    1616   !!---------------------------------------------------------------------- 
    17    USE dom_oce  , ONLY: nimpp, njmpp       ! ocean space and time domain 
    18 !!!   USE dom_oce  , ONLY: ln_zco, ln_zps, ln_sco   ! flag of type of coordinate 
    1917   USE par_oce        ! ocean space and time domain 
    2018   USE phycst         ! physical constants 

  • NEMO/trunk/tests/VORTEX/MY_SRC/domvvl.F90

    r12740 r13286  
    450450            ELSE 
    451451               ijk_max = MAXLOC( ze3t(:,:,:) ) 
    452                ijk_max(1) = ijk_max(1) + nimpp - 1 
    453                ijk_max(2) = ijk_max(2) + njmpp - 1 
     452               ijk_max(1) = mig0_oldcmp(ijk_max(1)) 
     453               ijk_max(2) = mjg0_oldcmp(ijk_max(2)) 
    454454               ijk_min = MINLOC( ze3t(:,:,:) ) 
    455                ijk_min(1) = ijk_min(1) + nimpp - 1 
    456                ijk_min(2) = ijk_min(2) + njmpp - 1 
     455               ijk_min(1) = mig0_oldcmp(ijk_min(1)) 
     456               ijk_min(2) = mjg0_oldcmp(ijk_min(2)) 
    457457            ENDIF 
    458458            IF (lwp) THEN 
    … …  
    793793         IF( ln_rstart ) THEN                   !* Read the restart file 
    794794            CALL rst_read_open                  !  open the restart file if necessary 
    795             CALL iom_get( numror, jpdom_autoglo, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
     795            CALL iom_get( numror, jpdom_auto, 'sshn'   , ssh(:,:,Kmm), ldxios = lrxios    ) 
    796796            ! 
    797797            id1 = iom_varid( numror, 'e3t_b', ldstop = .FALSE. ) 
    … …  
    806806            ! 
    807807            IF( MIN( id1, id2 ) > 0 ) THEN       ! all required arrays exist 
    808                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    809                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     808               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     809               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    810810               ! needed to restart if land processor not computed  
    811811               IF(lwp) write(numout,*) 'dom_vvl_rst : e3t(:,:,:,Kbb) and e3t(:,:,:,Kmm) found in restart files' 
    … …  
    821821               IF(lwp) write(numout,*) 'e3t_n set equal to e3t_b.' 
    822822               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    823                CALL iom_get( numror, jpdom_autoglo, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
     823               CALL iom_get( numror, jpdom_auto, 'e3t_b', e3t(:,:,:,Kbb), ldxios = lrxios ) 
    824824               e3t(:,:,:,Kmm) = e3t(:,:,:,Kbb) 
    825825               l_1st_euler = .true. 
    … …  
    828828               IF(lwp) write(numout,*) 'e3t_b set equal to e3t_n.' 
    829829               IF(lwp) write(numout,*) 'l_1st_euler is forced to true' 
    830                CALL iom_get( numror, jpdom_autoglo, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
     830               CALL iom_get( numror, jpdom_auto, 'e3t_n', e3t(:,:,:,Kmm), ldxios = lrxios ) 
    831831               e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 
    832832               l_1st_euler = .true. 
    … …  
    853853               !                          ! ----------------------- ! 
    854854               IF( MIN( id3, id4 ) > 0 ) THEN  ! all required arrays exist 
    855                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
    856                   CALL iom_get( numror, jpdom_autoglo, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
     855                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_b', tilde_e3t_b(:,:,:), ldxios = lrxios ) 
     856                  CALL iom_get( numror, jpdom_auto, 'tilde_e3t_n', tilde_e3t_n(:,:,:), ldxios = lrxios ) 
    857857               ELSE                            ! one at least array is missing 
    858858                  tilde_e3t_b(:,:,:) = 0.0_wp 
    … …  
    863863                  !                       ! ------------ ! 
    864864                  IF( id5 > 0 ) THEN  ! required array exists 
    865                      CALL iom_get( numror, jpdom_autoglo, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
     865                     CALL iom_get( numror, jpdom_auto, 'hdiv_lf', hdiv_lf(:,:,:), ldxios = lrxios ) 
    866866                  ELSE                ! array is missing 
    867867                     hdiv_lf(:,:,:) = 0.0_wp 

  • NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    6363      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pe1e2u, pe1e2v               ! u- & v-surfaces (if reduction in strait)   [m2] 
    6464      ! 
    65       INTEGER  ::   ji, jj   ! dummy loop indices 
     65      INTEGER  ::   ji, jj     ! dummy loop indices 
    6666      REAL(wp) ::   zphi0, zlam0, zbeta, zf0 
    67       REAL(wp) ::   zti, zui, ztj, zvj   ! local scalars 
     67      REAL(wp) ::   zti, ztj   ! local scalars 
    6868      !!------------------------------------------------------------------------------- 
    6969      ! 
    … …  
    7777      ! Position coordinates (in kilometers) 
    7878      !                          ========== 
    79       zlam0 = -(jpiglo-1)/2 * 1.e-3 * rn_dx 
    80       zphi0 = -(jpjglo-1)/2 * 1.e-3 * rn_dy  
    81  
     79#if defined key_agrif  
     80      IF( Agrif_Root() ) THEN 
     81#endif 
     82         ! Compatibility WITH old version:  
     83         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     84         !            =>  jpiglo-1 replaced by Ni0glo-1 
     85         zlam0 = -REAL( (Ni0glo-1)/2, wp) * 1.e-3 * rn_dx 
     86         zphi0 = -REAL( (Nj0glo-1)/2, wp) * 1.e-3 * rn_dy  
    8287#if defined key_agrif 
    83       ! ! let lower left longitude and latitude from parent 
    84       IF (.NOT.Agrif_root()) THEN 
    85           zlam0 = (0.5_wp-(Agrif_parent(jpiglo)-1)/2)*1.e-3*Agrif_irhox()*rn_dx & 
    86              &+(Agrif_Ix()+nbghostcells-1)*Agrif_irhox()*rn_dx*1.e-3-(0.5_wp+nbghostcells)*rn_dx*1.e-3 
    87           zphi0 = (0.5_wp-(Agrif_parent(jpjglo)-1)/2)*1.e-3*Agrif_irhoy()*rn_dy & 
    88              &+(Agrif_Iy()+nbghostcells-1)*Agrif_irhoy()*rn_dy*1.e-3-(0.5_wp+nbghostcells)*rn_dy*1.e-3 
     88      ELSE 
     89         ! ! let lower left longitude and latitude from parent 
     90         ! Compatibility WITH old version:  
     91         ! jperio = 0 =>  Ni0glo = jpigo_old_version 
     92         !            =>  Agrif_parent(jpiglo)-1 replaced by  Agrif_parent(Ni0glo)-1 
     93         zlam0 = ( 0.5_wp - REAL( ( Agrif_parent(Ni0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhox() * rn_dx  & 
     94            &  + ( Agrif_Ix() + nbghostcells - 1 ) * Agrif_irhox() * rn_dx * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dx * 1.e-3 
     95         zphi0 = ( 0.5_wp - REAL( ( Agrif_parent(Nj0glo)-1 ) / 2, wp) ) * 1.e-3 * Agrif_irhoy() * rn_dy  & 
     96            &  + ( Agrif_Iy() + nbghostcells - 1 ) * Agrif_irhoy() * rn_dy * 1.e-3 - ( 0.5_wp + nbghostcells ) * rn_dy * 1.e-3 
    8997      ENDIF  
    9098#endif 
    9199          
    92100      DO_2D_11_11 
    93          zti = FLOAT( ji - 1 + nimpp - 1 )          ;  ztj = FLOAT( jj - 1 + njmpp - 1 ) 
    94          zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5_wp ;  zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5_wp 
     101         zti = REAL( mig0_oldcmp(ji) - 1, wp )   ! start at i=0 in the global grid without halos 
     102         ztj = REAL( mjg0_oldcmp(jj) - 1, wp )   ! start at j=0 in the global grid without halos 
    95103          
    96          plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 * zti 
    97          plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * zui 
     104         plamt(ji,jj) = zlam0 + rn_dx * 1.e-3 *   zti 
     105         plamu(ji,jj) = zlam0 + rn_dx * 1.e-3 * ( zti + 0.5_wp ) 
    98106         plamv(ji,jj) = plamt(ji,jj)  
    99107         plamf(ji,jj) = plamu(ji,jj)  
    100108          
    101          pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 * ztj 
    102          pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * zvj 
     109         pphit(ji,jj) = zphi0 + rn_dy * 1.e-3 *   ztj 
     110         pphiv(ji,jj) = zphi0 + rn_dy * 1.e-3 * ( ztj + 0.5_wp ) 
    103111         pphiu(ji,jj) = pphit(ji,jj)  
    104112         pphif(ji,jj) = pphiv(ji,jj)  

  • NEMO/trunk/tests/VORTEX/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
     16   USE dom_oce 
    1717   USE par_oce        ! ocean space and time domain 
    1818   USE phycst         ! physical constants 
    … …  
    8484         kpi = NINT( 1800.e3  / rn_dx ) + 3   
    8585         kpj = NINT( 1800.e3  / rn_dy ) + 3  
    86       ELSE 
    87          kpi  = nbcellsx + 2 + 2*nbghostcells 
    88          kpj  = nbcellsy + 2 + 2*nbghostcells 
     86      ELSE                          ! Global Domain size: add nbghostcells + 1 "land" point on each side 
     87         kpi  = nbcellsx + 2 * ( nbghostcells + 1 ) 
     88         kpj  = nbcellsy + 2 * ( nbghostcells + 1 ) 
     89!!$         kpi  = nbcellsx + nbghostcells_x   + nbghostcells_x   + 2 
     90!!$         kpj  = nbcellsy + nbghostcells_y_s + nbghostcells_y_n + 2 
    8991      ENDIF 
    9092      kpk = NINT( 5000._wp / rn_dz ) + 1 
    … …  
    104106         WRITE(numout,*) '      horizontal resolution             rn_dy  = ', rn_dy, ' m' 
    105107         WRITE(numout,*) '      vertical resolution               rn_dz  = ', rn_dz, ' m' 
     108         WRITE(numout,*) '      resulting global domain size :    Ni0glo = ', kpi 
     109         WRITE(numout,*) '                                        Nj0glo = ', kpj 
     110         WRITE(numout,*) '                                        jpkglo = ', kpk 
    106111         WRITE(numout,*) '      VORTEX domain: ' 
    107112         WRITE(numout,*) '         LX [km]: ', zlx 

  • NEMO/trunk/tests/WAD/MY_SRC/usrdef_hgr.F90

    r12740 r13286  
    1313   !!   usr_def_hgr    : initialize the horizontal mesh for WAD_TEST_CASES configuration 
    1414   !!---------------------------------------------------------------------- 
    15    USE dom_oce  ,  ONLY: nimpp, njmpp       ! ocean space and time domain 
     15   USE dom_oce 
    1616   USE par_oce         ! ocean space and time domain 
    1717   USE phycst          ! physical constants 
    … …  
    7676      DO_2D_11_11 
    7777         !                       ! longitude 
    78          plamt(ji,jj) = zfact * (  - 0.5 + REAL( ji-1 + nimpp-1 , wp )  )   
    79          plamu(ji,jj) = zfact * (          REAL( ji-1 + nimpp-1 , wp )  ) 
     78         plamt(ji,jj) = zfact * (  - 0.5 + REAL( mig0_oldcmp(ji)-1 , wp )  )   
     79         plamu(ji,jj) = zfact * (          REAL( mig0_oldcmp(ji)-1 , wp )  ) 
    8080         plamv(ji,jj) = plamt(ji,jj) 
    8181         plamf(ji,jj) = plamu(ji,jj) 
    8282         !                       ! latitude 
    83          pphit(ji,jj) = zfact * (  - 0.5 + REAL( jj-1 + njmpp-1 , wp )  ) 
     83         pphit(ji,jj) = zfact * (  - 0.5 + REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8484         pphiu(ji,jj) = pphit(ji,jj) 
    85          pphiv(ji,jj) = zfact * (          REAL( jj-1 + njmpp-1 , wp )  ) 
     85         pphiv(ji,jj) = zfact * (          REAL( mjg0_oldcmp(jj)-1 , wp )  ) 
    8686         pphif(ji,jj) = pphiv(ji,jj) 
    8787      END_2D 

  • NEMO/trunk/tests/WAD/MY_SRC/usrdef_nam.F90

    r12377 r13286  
    1414   !!   usr_def_hgr   : initialize the horizontal mesh  
    1515   !!---------------------------------------------------------------------- 
    16    USE dom_oce  , ONLY: nimpp , njmpp            ! i- & j-indices of the local domain 
    1716   USE par_oce        ! ocean space and time domain 
    1817   USE phycst         ! physical constants 
    … …  
    7776      !                             ! Set the lateral boundary condition of the global domain 
    7877      kperio = 0                    ! WAD_TEST_CASES configuration : closed domain 
    79       IF( nn_wad_test == 8 ) kperio = 7 ! North-South cyclic test 
     78      IF( nn_wad_test == 8 ) THEN 
     79         kperio = 7         ! North-South cyclic test 
     80         kpi = kpi - 2      ! no closed boundary 
     81         kpj = kpj - 2      ! no closed boundary 
     82      ENDIF 
    8083      ! 
    8184      !                             ! control print 

  • NEMO/trunk/tests/WAD/MY_SRC/usrdef_zgr.F90

    r12740 r13286  
    1515   !!--------------------------------------------------------------------- 
    1616   USE oce            ! ocean variables 
    17    USE dom_oce ,  ONLY: ht_0, mi0, mi1, nimpp, njmpp,  & 
    18                       & mj0, mj1, glamt, gphit         ! ocean space and time domain 
     17   USE dom_oce ,  ONLY: ht_0, mi0, mi1, mj0, mj1, glamt, gphit         ! ocean space and time domain 
    1918   USE usrdef_nam     ! User defined : namelist variables 
    2019   USE wet_dry ,  ONLY: rn_wdmin1, rn_wdmin2, rn_wdld  ! Wetting and drying 
Note: See TracChangeset for help on using the changeset viewer.