Changeset 11380


Ignore:
Timestamp:
2019-07-31T15:56:02+02:00 (14 months ago)
Author:
girrmann
Message:

dev_r10984_HPC-13 : adding extra halos in dyn_spg_ts is now possible, only works with a single halo when used with tide or bdy, see #2308

Location:
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization
Files:
34 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/ice.F90

    r11377 r11380  
    102102   !! vt_i        |      -      |    Total ice vol. per unit area | m     | 
    103103   !! vt_s        |      -      |    Total snow vol. per unit ar. | m     | 
    104    !! st_i        |      -      |    Total Sea ice salt content   | pss.m | 
    105104   !! sm_i        |      -      |    Mean sea ice salinity        | pss   | 
    106105   !! tm_i        |      -      |    Mean sea ice temperature     | K     | 
     
    136135   REAL(wp), PUBLIC ::   rn_ishlat        !: lateral boundary condition for sea-ice 
    137136   LOGICAL , PUBLIC ::   ln_landfast_L16  !: landfast ice parameterizationfrom lemieux2016  
     137   LOGICAL , PUBLIC ::   ln_landfast_home !: landfast ice parameterizationfrom home made  
    138138   REAL(wp), PUBLIC ::   rn_depfra        !:    fraction of ocean depth that ice must reach to initiate landfast ice 
    139139   REAL(wp), PUBLIC ::   rn_icebfr        !:    maximum bottom stress per unit area of contact (lemieux2016) or per unit volume (home)  
     
    252252   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   wfx_err_sub !: mass flux error after sublimation                        [kg.m-2.s-1] 
    253253 
     254   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   afx_tot     !: ice concentration tendency (total)        [s-1] 
     255 
    254256   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bog     !: salt flux due to ice bottom growth                   [pss.kg.m-2.s-1 => g.m-2.s-1] 
    255257   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sfx_bom     !: salt flux due to ice bottom melt                     [pss.kg.m-2.s-1 => g.m-2.s-1] 
     
    307309   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   u_ice, v_ice !: components of the ice velocity                          (m/s) 
    308310   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vt_i , vt_s  !: ice and snow total volume per unit area                 (m) 
    309    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   st_i         !: Total ice salinity content                              (pss.m) 
    310311   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   at_i         !: ice total fractional area (ice concentration) 
    311312   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ato_i        !: =1-at_i ; total open water fractional area 
     
    408409         &      wfx_bog    (jpi,jpj) , wfx_dyn   (jpi,jpj) , wfx_bom(jpi,jpj) , wfx_sum(jpi,jpj) ,           & 
    409410         &      wfx_res    (jpi,jpj) , wfx_sni   (jpi,jpj) , wfx_opw(jpi,jpj) , wfx_spr(jpi,jpj) ,           & 
    410          &      rn_amax_2d (jpi,jpj) ,                                                                       & 
     411         &      afx_tot    (jpi,jpj) , rn_amax_2d(jpi,jpj),                                                  & 
    411412         &      qsb_ice_bot(jpi,jpj) , qlead     (jpi,jpj) ,                                                 & 
    412413         &      sfx_res    (jpi,jpj) , sfx_bri   (jpi,jpj) , sfx_dyn(jpi,jpj) , sfx_sub(jpi,jpj) , sfx_lam(jpi,jpj) ,  & 
     
    428429      ii = ii + 1 
    429430      ALLOCATE( u_ice(jpi,jpj) , v_ice(jpi,jpj) ,                                   & 
    430          &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , st_i(jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  & 
    431          &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s(jpi,jpj) ,  & 
    432          &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s(jpi,jpj) ,  & 
     431         &      vt_i (jpi,jpj) , vt_s (jpi,jpj) , at_i(jpi,jpj) , ato_i(jpi,jpj) ,  & 
     432         &      et_i (jpi,jpj) , et_s (jpi,jpj) , tm_i(jpi,jpj) , tm_s (jpi,jpj) ,  & 
     433         &      sm_i (jpi,jpj) , tm_su(jpi,jpj) , hm_i(jpi,jpj) , hm_s (jpi,jpj) ,  & 
    433434         &      om_i (jpi,jpj) , bvm_i(jpi,jpj) , tau_icebfr(jpi,jpj)            , STAT=ierr(ii) ) 
    434435 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icecor.F90

    r11371 r11380  
    8484      !                             !----------------------------------------------------- 
    8585      IF ( nn_icesal == 2 ) THEN    !  salinity must stay in bounds [Simin,Simax]        ! 
    86          !                          !----------------------------------------------------- 
     86      !                             !----------------------------------------------------- 
    8787         zzc = rhoi * r1_rdtice 
    8888         DO jl = 1, jpl 
     
    117117            END DO 
    118118         END DO 
    119          CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     119         CALL lbc_lnk_multi( 'icecor', u_ice, 'U', -1., v_ice, 'V', -1. )            ! lateral boundary conditions 
    120120      ENDIF 
    121121 
     122!!gm I guess the trends are only out on demand  
     123!!   So please, only do this is it exite an iom_use of on a these variables 
     124!!   furthermore, only allocate the diag_ arrays in this case  
     125!!   and do the iom_put here so that it is only a local allocation 
     126!!gm  
    122127      !                             !----------------------------------------------------- 
    123128      SELECT CASE( kn )             !  Diagnostics                                       ! 
     
    138143         END DO 
    139144         !                       ! concentration tendency (dynamics) 
    140          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
    141             zafx(:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
    142             CALL iom_put( 'afxdyn' , zafx ) 
    143          ENDIF 
     145         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice  
     146         afx_tot(:,:) = zafx(:,:) 
     147         IF( iom_use('afxdyn') )   CALL iom_put( 'afxdyn' , zafx(:,:) ) 
    144148         ! 
    145149      CASE( 2 )                        !--- thermo trend diagnostics & ice aging 
     
    160164         END DO 
    161165         !                       ! concentration tendency (total + thermo) 
    162          IF( iom_use('afxdyn') .OR. iom_use('afxthd') .OR. iom_use('afxtot') ) THEN  
    163             zafx(:,:) = zafx(:,:) + SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
    164             CALL iom_put( 'afxthd' , SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice ) 
    165             CALL iom_put( 'afxtot' , zafx ) 
    166          ENDIF 
     166         zafx   (:,:) = SUM( a_i(:,:,:) - a_i_b(:,:,:), dim=3 ) * r1_rdtice 
     167         afx_tot(:,:) = afx_tot(:,:) + zafx(:,:) 
     168         IF( iom_use('afxthd') )   CALL iom_put( 'afxthd' , zafx(:,:) ) 
     169         IF( iom_use('afxtot') )   CALL iom_put( 'afxtot' , afx_tot(:,:) ) 
    167170         ! 
    168171      END SELECT 
     
    171174      IF( ln_icediachk   )   CALL ice_cons_hsm(1, 'icecor', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    172175      IF( ln_ctl         )   CALL ice_prt3D   ('icecor')                                                             ! prints 
    173       IF( ln_icectl .AND. kn == 2 ) & 
    174          &                   CALL ice_prt     ( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                       ! prints 
     176      IF( ln_icectl .AND. kn == 2 )   CALL ice_prt( kt, iiceprt, jiceprt, 2, ' - Final state - ' )                   ! prints 
    175177      IF( ln_timing      )   CALL timing_stop ('icecor')                                                             ! timing 
    176178      ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedia.F90

    r11371 r11380  
    3434   PUBLIC   ice_dia_init   ! called in icestp.F90 
    3535 
    36    REAL(wp), SAVE ::   z1_e1e2  ! inverse of the ocean area 
    37    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini                    ! initial volume, salt and heat contents 
     36   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   vol_loc_ini, sal_loc_ini, tem_loc_ini ! initial volume, salt and heat contents 
    3837   REAL(wp)                              ::   frc_sal, frc_voltop, frc_volbot, frc_temtop, frc_tembot  ! global forcing trends 
    3938    
     
    8180      ENDIF 
    8281 
    83       IF( kt == nit000 ) THEN 
    84          z1_e1e2 = 1._wp / glob_sum( 'icedia', e1e2t(:,:) ) 
    85       ENDIF 
     82!!gm glob_sum includes a " * tmask_i ", so remove  " * tmask(:,:,1) " 
     83 
     84      ! ----------------------- ! 
     85      ! 1 -  Contents ! 
     86      ! ----------------------- ! 
     87      zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9                  ! ice volume (km3) 
     88      zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9                  ! snow volume (km3) 
     89      zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6                  ! area (km2) 
     90      zbg_isal = glob_sum( 'icedia', SUM( sv_i(:,:,:), dim=3 ) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3) 
     91      zbg_item = glob_sum( 'icedia', et_i * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J) 
     92      zbg_stem = glob_sum( 'icedia', et_s * e1e2t(:,:) ) * 1.e-20                      ! heat content (1.e20 J) 
    8693       
    87       ! ----------------------- ! 
    88       ! 1 -  Contents           ! 
    89       ! ----------------------- ! 
    90       IF(  iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. & 
    91          & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN 
    92  
    93          zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice volume (km3) 
    94          zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9  ! snow volume (km3) 
    95          zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6  ! area (km2) 
    96          zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3) 
    97          zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
    98          zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
    99  
    100          CALL iom_put( 'ibgvol_tot'  , zbg_ivol )  
    101          CALL iom_put( 'sbgvol_tot'  , zbg_svol )  
    102          CALL iom_put( 'ibgarea_tot' , zbg_area )  
    103          CALL iom_put( 'ibgsalt_tot' , zbg_isal )  
    104          CALL iom_put( 'ibgheat_tot' , zbg_item )  
    105          CALL iom_put( 'sbgheat_tot' , zbg_stem )  
    106   
    107       ENDIF 
    108  
    10994      ! ---------------------------! 
    11095      ! 2 - Trends due to forcing  ! 
    11196      ! ---------------------------! 
    112       ! they must be kept outside an IF(iom_use) because of the call to dia_rst below 
    11397      z_frc_volbot = r1_rau0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean  
    11498      z_frc_voltop = r1_rau0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm 
     
    122106      frc_temtop  = frc_temtop  + z_frc_temtop  * rdt_ice ! 1.e20 J 
    123107      frc_tembot  = frc_tembot  + z_frc_tembot  * rdt_ice ! 1.e20 J 
    124  
    125       CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
    126       CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)  
    127       CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)    
    128       CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)    
    129       CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
    130  
    131       IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN 
    132          CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ice/snw/ocean      (W/m2) 
    133          CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rdt ) ! heat on top of ocean(below ice)   (W/m2)  
    134       ENDIF 
    135        
    136       ! ---------------------------------- ! 
    137       ! 3 -  Content variations and drifts ! 
    138       ! ---------------------------------- ! 
    139       IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN 
    140108             
    141          zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)  
    142          zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss) 
    143          zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
    144          !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
    145           
    146          zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
    147          zdiff_sal = zdiff_sal - frc_sal 
    148          zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
    149           
    150          CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
    151          CALL iom_put( 'ibgsaltco' , zdiff_sal )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
    152          CALL iom_put( 'ibgheatco' , zdiff_tem )   ! ice/snow heat content drift       (1.e20 J) 
    153          ! 
    154       ENDIF 
    155        
     109      ! ----------------------- ! 
     110      ! 3 -  Content variations ! 
     111      ! ----------------------- ! 
     112      zdiff_vol = r1_rau0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3)  
     113      zdiff_sal = r1_rau0 * glob_sum( 'icedia', ( rhoi* SUM( sv_i(:,:,:), dim=3 ) - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss) 
     114      zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
     115      !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
     116 
     117      ! ----------------------- ! 
     118      ! 4 -  Drifts             ! 
     119      ! ----------------------- ! 
     120      zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
     121      zdiff_sal = zdiff_sal - frc_sal 
     122      zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
     123 
     124      ! ----------------------- ! 
     125      ! 5 - Diagnostics writing ! 
     126      ! ----------------------- ! 
     127!!gm I don't understand the division by the ocean surface (i.e. glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt ) 
     128!!   and its multiplication bu kt ! is it really what we want ? what is this quantity ? 
     129!!   IF it is really what we want, compute it at kt=nit000, not 3 time by time-step ! 
     130!!   kt*rdt  : you mean rdtice ? 
     131!!gm 
     132      ! 
     133      IF( iom_use('ibgvolume')    )   CALL iom_put( 'ibgvolume' , zdiff_vol     )   ! ice/snow volume  drift            (km3 equivalent ocean water)          
     134      IF( iom_use('ibgsaltco')    )   CALL iom_put( 'ibgsaltco' , zdiff_sal     )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
     135      IF( iom_use('ibgheatco')    )   CALL iom_put( 'ibgheatco' , zdiff_tem     )   ! ice/snow heat content drift       (1.e20 J) 
     136      IF( iom_use('ibgheatfx')    )   CALL iom_put( 'ibgheatfx' ,               &   ! ice/snow heat flux drift          (W/m2) 
     137         &                                                     zdiff_tem /glob_sum( 'icedia', e1e2t(:,:) * 1.e-20 * kt*rdt ) ) 
     138 
     139      IF( iom_use('ibgfrcvoltop') )   CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water)  
     140      IF( iom_use('ibgfrcvolbot') )   CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water)  
     141      IF( iom_use('ibgfrcsal')    )   CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water)    
     142      IF( iom_use('ibgfrctemtop') )   CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J)    
     143      IF( iom_use('ibgfrctembot') )   CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J)    
     144      IF( iom_use('ibgfrchfxtop') )   CALL iom_put( 'ibgfrchfxtop' ,            &   ! heat on top of ice/snw/ocean      (W/m2)  
     145         &                                                          frc_temtop / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
     146      IF( iom_use('ibgfrchfxbot') )   CALL iom_put( 'ibgfrchfxbot' ,            &   ! heat on top of ocean(below ice)   (W/m2)  
     147         &                                                          frc_tembot / glob_sum( 'icedia', e1e2t(:,:) ) * 1.e-20 * kt*rdt  ) 
     148 
     149      IF( iom_use('ibgvol_tot' )  )   CALL iom_put( 'ibgvol_tot'  , zbg_ivol     )   ! ice volume                       (km3) 
     150      IF( iom_use('sbgvol_tot' )  )   CALL iom_put( 'sbgvol_tot'  , zbg_svol     )   ! snow volume                      (km3) 
     151      IF( iom_use('ibgarea_tot')  )   CALL iom_put( 'ibgarea_tot' , zbg_area     )   ! ice area                         (km2) 
     152      IF( iom_use('ibgsalt_tot')  )   CALL iom_put( 'ibgsalt_tot' , zbg_isal     )   ! ice salinity content             (pss*km3) 
     153      IF( iom_use('ibgheat_tot')  )   CALL iom_put( 'ibgheat_tot' , zbg_item     )   ! ice heat content                 (1.e20 J) 
     154      IF( iom_use('sbgheat_tot')  )   CALL iom_put( 'sbgheat_tot' , zbg_stem     )   ! snow heat content                (1.e20 J) 
     155      ! 
    156156      IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice ) 
    157157      ! 
     
    248248            vol_loc_ini(:,:) = rhoi * vt_i(:,:) + rhos * vt_s(:,:)  ! ice/snow volume (kg/m2) 
    249249            tem_loc_ini(:,:) = et_i(:,:) + et_s(:,:)                ! ice/snow heat content (J) 
    250             sal_loc_ini(:,:) = rhoi * st_i(:,:)                     ! ice salt content (pss*kg/m2) 
     250            sal_loc_ini(:,:) = rhoi * SUM( sv_i(:,:,:), dim=3 )     ! ice salt content (pss*kg/m2) 
    251251         ENDIF 
    252252         ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn.F90

    r11377 r11380  
    163163            END DO 
    164164            CALL lbc_lnk( 'icedyn', zdivu_i, 'T', 1. ) 
    165             ! output 
    166             CALL iom_put( 'icediv' , zdivu_i ) 
    167  
     165            CALL iom_put( "icediv" , zdivu_i(:,:) ) 
    168166            DEALLOCATE( zdivu_i ) 
    169167 
     
    221219      NAMELIST/namdyn/ ln_dynALL, ln_dynRHGADV, ln_dynADV1D, ln_dynADV2D, rn_uice, rn_vice,  & 
    222220         &             rn_ishlat ,                                                           & 
    223          &             ln_landfast_L16, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
     221         &             ln_landfast_L16, ln_landfast_home, rn_depfra, rn_icebfr, rn_lfrelax, rn_tensile 
    224222      !!------------------------------------------------------------------- 
    225223      ! 
     
    244242         WRITE(numout,*) '      lateral boundary condition for sea ice dynamics        rn_ishlat       = ', rn_ishlat 
    245243         WRITE(numout,*) '      Landfast: param from Lemieux 2016                      ln_landfast_L16 = ', ln_landfast_L16 
     244         WRITE(numout,*) '      Landfast: param from home made                         ln_landfast_home= ', ln_landfast_home 
    246245         WRITE(numout,*) '         fraction of ocean depth that ice must reach         rn_depfra       = ', rn_depfra 
    247246         WRITE(numout,*) '         maximum bottom stress per unit area of contact      rn_icebfr       = ', rn_icebfr 
     
    270269      ENDIF 
    271270      !                                      !--- Landfast ice 
    272       IF( .NOT.ln_landfast_L16 )   tau_icebfr(:,:) = 0._wp 
     271      IF( .NOT.ln_landfast_L16 .AND. .NOT.ln_landfast_home )   tau_icebfr(:,:) = 0._wp 
     272      ! 
     273      IF ( ln_landfast_L16 .AND. ln_landfast_home ) THEN 
     274         CALL ctl_stop( 'ice_dyn_init: choose one and only one landfast parameterization (ln_landfast_L16 or ln_landfast_home)' ) 
     275      ENDIF 
    273276      ! 
    274277      CALL ice_dyn_rdgrft_init          ! set ice ridging/rafting parameters 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_adv.F90

    r11371 r11380  
    100100      diag_trp_vi(:,:) = SUM(     v_i (:,:,:)          - v_i_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    101101      diag_trp_vs(:,:) = SUM(     v_s (:,:,:)          - v_s_b (:,:,:)                  , dim=3 ) * r1_rdtice 
    102       IF( iom_use('icemtrp') )   CALL iom_put( 'icemtrp' , diag_trp_vi * rhoi          )   ! ice mass transport 
    103       IF( iom_use('snwmtrp') )   CALL iom_put( 'snwmtrp' , diag_trp_vs * rhos          )   ! snw mass transport 
    104       IF( iom_use('salmtrp') )   CALL iom_put( 'salmtrp' , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s) 
    105       IF( iom_use('dihctrp') )   CALL iom_put( 'dihctrp' , -diag_trp_ei                 )   ! advected ice heat content (W/m2) 
    106       IF( iom_use('dshctrp') )   CALL iom_put( 'dshctrp' , -diag_trp_es                 )   ! advected snw heat content (W/m2) 
     102      IF( iom_use('icemtrp') )   CALL iom_put( "icemtrp" , diag_trp_vi * rhoi          )   ! ice mass transport 
     103      IF( iom_use('snwmtrp') )   CALL iom_put( "snwmtrp" , diag_trp_vs * rhos          )   ! snw mass transport 
     104      IF( iom_use('salmtrp') )   CALL iom_put( "salmtrp" , diag_trp_sv * rhoi * 1.e-03 )   ! salt mass transport (kg/m2/s) 
     105      IF( iom_use('dihctrp') )   CALL iom_put( "dihctrp" , -diag_trp_ei                )   ! advected ice heat content (W/m2) 
     106      IF( iom_use('dshctrp') )   CALL iom_put( "dshctrp" , -diag_trp_es                )   ! advected snw heat content (W/m2) 
    107107 
    108108      ! controls 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_rhg.F90

    r11377 r11380  
    6969         WRITE(numout,*)'ice_dyn_rhg: sea-ice rheology' 
    7070         WRITE(numout,*)'~~~~~~~~~~~' 
     71      ENDIF 
     72      ! 
     73      IF( ln_landfast_home ) THEN      !-- Landfast ice parameterization 
     74         tau_icebfr(:,:) = 0._wp 
     75         DO jl = 1, jpl 
     76            WHERE( h_i(:,:,jl) > ht_n(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
     77         END DO 
    7178      ENDIF 
    7279      ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icedyn_rhg_evp.F90

    r11377 r11380  
    112112      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      ! 
    113113      !! 
     114      LOGICAL, PARAMETER ::   ll_bdy_substep = .TRUE. ! temporary option to call bdy at each sub-time step (T) 
     115      !                                                                              or only at the main time step (F) 
    114116      INTEGER ::   ji, jj       ! dummy loop indices 
    115117      INTEGER ::   jter         ! local integers 
     
    135137      ! 
    136138      REAL(wp), DIMENSION(jpi,jpj) ::   zdt_m                           ! (dt / ice-snow_mass) on T points 
    137       REAL(wp), DIMENSION(jpi,jpj) ::   zaU  , zaV                      ! ice fraction on U/V points 
     139      REAL(wp), DIMENSION(jpi,jpj) ::   zaU   , zaV                     ! ice fraction on U/V points 
    138140      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! (ice-snow_mass / dt) on U/V points 
    139141      REAL(wp), DIMENSION(jpi,jpj) ::   zmf                             ! coriolis parameter at T points 
     142      REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ia , ztauV_ia             ! ice-atm. stress at U-V points 
     143      REAL(wp), DIMENSION(jpi,jpj) ::   zTauU_ib , ztauV_ib             ! ice-bottom stress at U-V points (landfast param) 
     144      REAL(wp), DIMENSION(jpi,jpj) ::   zspgU , zspgV                   ! surface pressure gradient at U/V points 
    140145      REAL(wp), DIMENSION(jpi,jpj) ::   v_oceU, u_oceV, v_iceU, u_iceV  ! ocean/ice u/v component on V/U points                            
     146      REAL(wp), DIMENSION(jpi,jpj) ::   zfU   , zfV                     ! internal stresses 
    141147      ! 
    142148      REAL(wp), DIMENSION(jpi,jpj) ::   zds                             ! shear 
     
    146152      !                                                                 !    ocean surface (ssh_m) if ice is not embedded 
    147153      !                                                                 !    ice bottom surface if ice is embedded    
    148       REAL(wp), DIMENSION(jpi,jpj) ::   zfU  , zfV                      ! internal stresses 
    149       REAL(wp), DIMENSION(jpi,jpj) ::   zspgU, zspgV                    ! surface pressure gradient at U/V points 
    150       REAL(wp), DIMENSION(jpi,jpj) ::   zCorU, zCorV                    ! Coriolis stress array 
    151       REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_ai, ztauy_ai              ! ice-atm. stress at U-V points 
    152       REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! ice-ocean stress at U-V points 
    153       REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast) 
    154       REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    155       ! 
    156       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    157       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
     154      REAL(wp), DIMENSION(jpi,jpj) ::   zCorx, zCory                    ! Coriolis stress array 
     155      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_oi, ztauy_oi              ! Ocean-to-ice stress array 
     156      ! 
     157      REAL(wp), DIMENSION(jpi,jpj) ::   zswitchU, zswitchV              ! dummy arrays 
     158      REAL(wp), DIMENSION(jpi,jpj) ::   zmaskU, zmaskV                  ! mask for ice presence 
    158159      REAL(wp), DIMENSION(jpi,jpj) ::   zfmask, zwf                     ! mask at F points for the ice 
    159160 
     
    162163      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
    163164      !! --- diags 
    164       REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
     165      REAL(wp), DIMENSION(jpi,jpj) ::   zswi 
    165166      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig1, zsig2, zsig3 
    166167      !! --- SIMIP diags 
     168      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig1      ! Average normal stress in sea ice    
     169      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_sig2      ! Maximum shear stress in sea ice 
     170      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dx   ! X-direction sea-surface tilt term (N/m2) 
     171      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_dssh_dy   ! X-direction sea-surface tilt term (N/m2) 
     172      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstrx   ! X-direction coriolis stress (N/m2) 
     173      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_corstry   ! Y-direction coriolis stress (N/m2) 
     174      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstrx   ! X-direction internal stress (N/m2) 
     175      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_intstry   ! Y-direction internal stress (N/m2) 
     176      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_utau_oi   ! X-direction ocean-ice stress 
     177      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_vtau_oi   ! Y-direction ocean-ice stress   
    167178      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xmtrp_ice ! X-component of ice mass transport (kg/s) 
    168179      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_ymtrp_ice ! Y-component of ice mass transport (kg/s) 
     
    253264 
    254265      ! landfast param from Lemieux(2016): add isotropic tensile strength (following Konig Beatty and Holland, 2010) 
    255       IF( ln_landfast_L16 ) THEN   ;   zkt = rn_tensile 
    256       ELSE                         ;   zkt = 0._wp 
     266      IF( ln_landfast_L16 .OR. ln_landfast_home ) THEN   ;   zkt = rn_tensile 
     267      ELSE                                               ;   zkt = 0._wp 
    257268      ENDIF 
    258269      ! 
     
    297308             
    298309            ! Drag ice-atm. 
    299             ztaux_ai(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
    300             ztauy_ai(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
     310            zTauU_ia(ji,jj) = zaU(ji,jj) * utau_ice(ji,jj) 
     311            zTauV_ia(ji,jj) = zaV(ji,jj) * vtau_ice(ji,jj) 
    301312 
    302313            ! Surface pressure gradient (- m*g*GRAD(ssh)) at U-V points 
     
    305316 
    306317            ! masks 
    307             zmsk00x(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
    308             zmsk00y(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
     318            zmaskU(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
     319            zmaskV(ji,jj) = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
    309320 
    310321            ! switches 
    311             IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
    312             ELSE                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
    313             IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
    314             ELSE                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF 
     322            IF( zmassU <= zmmin .AND. zaU(ji,jj) <= zamin ) THEN   ;   zswitchU(ji,jj) = 0._wp 
     323            ELSE                                                   ;   zswitchU(ji,jj) = 1._wp   ;   ENDIF 
     324            IF( zmassV <= zmmin .AND. zaV(ji,jj) <= zamin ) THEN   ;   zswitchV(ji,jj) = 0._wp 
     325            ELSE                                                   ;   zswitchV(ji,jj) = 1._wp   ;   ENDIF 
    315326 
    316327         END DO 
     
    328339               ! ice-bottom stress at U points 
    329340               zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj) 
    330                ztaux_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
     341               zTauU_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    331342               ! ice-bottom stress at V points 
    332343               zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj) 
    333                ztauy_base(ji,jj) = - rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
     344               zTauV_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    334345               ! ice_bottom stress at T points 
    335346               zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj) 
    336                tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
     347               tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    337348            END DO 
    338349         END DO 
    339350         CALL lbc_lnk( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1. ) 
    340351         ! 
    341       ELSE                               !-- no landfast 
     352      ELSEIF( ln_landfast_home ) THEN          !-- Home made 
    342353         DO jj = 2, jpjm1 
    343354            DO ji = fs_2, fs_jpim1 
    344                ztaux_base(ji,jj) = 0._wp 
    345                ztauy_base(ji,jj) = 0._wp 
     355               zTauU_ib(ji,jj) = tau_icebfr(ji,jj) 
     356               zTauV_ib(ji,jj) = tau_icebfr(ji,jj) 
     357            END DO 
     358         END DO 
     359         ! 
     360      ELSE                                     !-- no landfast 
     361         DO jj = 2, jpjm1 
     362            DO ji = fs_2, fs_jpim1 
     363               zTauU_ib(ji,jj) = 0._wp 
     364               zTauV_ib(ji,jj) = 0._wp 
    346365            END DO 
    347366         END DO 
    348367      ENDIF 
     368      IF( iom_use('tau_icebfr') )   CALL iom_put( 'tau_icebfr', tau_icebfr(:,:) ) 
    349369 
    350370      !------------------------------------------------------------------------------! 
     
    484504                  !                 !--- tau_bottom/v_ice 
    485505                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    486                   zTauB = ztauy_base(ji,jj) / zvel 
    487                   !                 !--- OceanBottom-to-Ice stress 
    488                   ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
     506                  zTauB = - zTauV_ib(ji,jj) / zvel 
    489507                  ! 
    490508                  !                 !--- Coriolis at V-points (energy conserving formulation) 
    491                   zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     509                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    492510                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    493511                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    494512                  ! 
    495513                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    496                   zTauE = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     514                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    497515                  ! 
    498516                  !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    499                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztauy_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     517                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    500518                  ! 
    501519                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    502                      v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    503                         &                                  + zTauE + zTauO * v_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    504                         &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    505                         &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    506                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    507                         &           )   * zmsk00y(ji,jj) 
     520                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     521                     &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     522                     &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     523                                    + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     524                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     525                     &           ) * zmaskV(ji,jj) 
    508526                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    509                      v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity 
    510                         &                                     + zTauE + zTauO * v_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    511                         &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    512                         &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    513                         &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    514                         &            )   * zmsk00y(ji,jj) 
     527                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             & ! previous velocity 
     528                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     529                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
     530                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
     531                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     532                     &            ) * zmaskV(ji,jj) 
    515533                  ENDIF 
    516534               END DO 
     
    522540            CALL agrif_interp_ice( 'V' ) 
    523541#endif 
    524             IF( ln_bdy CALL bdy_ice_dyn( 'V' ) 
     542            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' ) 
    525543            ! 
    526544            DO jj = 2, jpjm1 
     
    534552                  !                 !--- tau_bottom/u_ice 
    535553                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    536                   zTauB = ztaux_base(ji,jj) / zvel 
    537                   !                 !--- OceanBottom-to-Ice stress 
    538                   ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
     554                  zTauB = - zTauU_ib(ji,jj) / zvel 
    539555                  ! 
    540556                  !                 !--- Coriolis at U-points (energy conserving formulation) 
    541                   zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     557                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    542558                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    543559                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    544560                  ! 
    545561                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    546                   zTauE = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     562                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    547563                  ! 
    548564                  !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    549                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztaux_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     565                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    550566                  ! 
    551567                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    552                      u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    553                         &                                  + zTauE + zTauO * u_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    554                         &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    555                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    556                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    557                         &            )   * zmsk00x(ji,jj) 
     568                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     569                     &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     570                     &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     571                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0 
     572                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     573                     &            ) * zmaskU(ji,jj) 
    558574                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    559                      u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity 
    560                         &                                     + zTauE + zTauO * u_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    561                         &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    562                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    563                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    564                         &            )   * zmsk00x(ji,jj) 
     575                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             & ! previous velocity 
     576                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     577                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
     578                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
     579                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     580                     &            ) * zmaskU(ji,jj) 
    565581                  ENDIF 
    566582               END DO 
     
    572588            CALL agrif_interp_ice( 'U' ) 
    573589#endif 
    574             IF( ln_bdy CALL bdy_ice_dyn( 'U' ) 
     590            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' ) 
    575591            ! 
    576592         ELSE ! odd iterations 
     
    586602                  !                 !--- tau_bottom/u_ice 
    587603                  zvel  = 5.e-05_wp + SQRT( v_iceU(ji,jj) * v_iceU(ji,jj) + u_ice(ji,jj) * u_ice(ji,jj) ) 
    588                   zTauB = ztaux_base(ji,jj) / zvel 
    589                   !                 !--- OceanBottom-to-Ice stress 
    590                   ztaux_bi(ji,jj) = zTauB * u_ice(ji,jj) 
     604                  zTauB = - zTauU_ib(ji,jj) / zvel 
    591605                  ! 
    592606                  !                 !--- Coriolis at U-points (energy conserving formulation) 
    593                   zCorU(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
     607                  zCorx(ji,jj)  =   0.25_wp * r1_e1u(ji,jj) *  & 
    594608                     &    ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * v_ice(ji  ,jj) + e1v(ji  ,jj-1) * v_ice(ji  ,jj-1) )  & 
    595609                     &    + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 
    596610                  ! 
    597611                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    598                   zTauE = zfU(ji,jj) + ztaux_ai(ji,jj) + zCorU(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
     612                  zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + ztaux_oi(ji,jj) 
    599613                  ! 
    600614                  !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    601                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE + ztaux_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     615                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, ztauE - zTauU_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    602616                  ! 
    603617                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    604                      u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )       & ! previous velocity 
    605                         &                                  + zTauE + zTauO * u_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    606                         &                                  / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    607                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    608                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
    609                         &            )   * zmsk00x(ji,jj) 
     618                  u_ice(ji,jj) = ( (          rswitch * ( zmU_t(ji,jj) * ( zbeta(ji,jj) * u_ice(ji,jj) + u_ice_b(ji,jj) )         & ! previous velocity 
     619                     &                                     + zTauE + zTauO * u_ice(ji,jj)                                         & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     620                     &                                  ) / MAX( zepsi, zmU_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     621                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )              & ! static friction => slow decrease to v=0 
     622                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin  
     623                     &            ) * zmaskU(ji,jj) 
    610624                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    611                      u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                                       & ! previous velocity 
    612                         &                                     + zTauE + zTauO * u_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    613                         &                                     / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    614                         &                + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    615                         &              ) * zmsk01x(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01x(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    616                         &            )   * zmsk00x(ji,jj) 
     625                  u_ice(ji,jj) = ( (           rswitch   * ( zmU_t(ji,jj)  * u_ice(ji,jj)                             & ! previous velocity 
     626                     &                                     + zTauE + zTauO * u_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     627                     &                                     ) / MAX( zepsi, zmU_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
     628                     &              + ( 1._wp - rswitch ) * u_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
     629                     &              ) * zswitchU(ji,jj) + u_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchU(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     630                     &            ) * zmaskU(ji,jj) 
    617631                  ENDIF 
    618632               END DO 
     
    624638            CALL agrif_interp_ice( 'U' ) 
    625639#endif 
    626             IF( ln_bdy CALL bdy_ice_dyn( 'U' ) 
     640            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'U' ) 
    627641            ! 
    628642            DO jj = 2, jpjm1 
     
    636650                  !                 !--- tau_bottom/v_ice 
    637651                  zvel  = 5.e-05_wp + SQRT( v_ice(ji,jj) * v_ice(ji,jj) + u_iceV(ji,jj) * u_iceV(ji,jj) ) 
    638                   zTauB = ztauy_base(ji,jj) / zvel 
    639                   !                 !--- OceanBottom-to-Ice stress 
    640                   ztauy_bi(ji,jj) = zTauB * v_ice(ji,jj) 
     652                  zTauB = - zTauV_ib(ji,jj) / zvel 
    641653                  ! 
    642654                  !                 !--- Coriolis at v-points (energy conserving formulation) 
    643                   zCorV(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
     655                  zCory(ji,jj)  = - 0.25_wp * r1_e2v(ji,jj) *  & 
    644656                     &    ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    645657                     &    + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    646658                  ! 
    647659                  !                 !--- Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 
    648                   zTauE = zfV(ji,jj) + ztauy_ai(ji,jj) + zCorV(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
     660                  zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + ztauy_oi(ji,jj) 
    649661                  ! 
    650662                  !                 !--- landfast switch => 0 = static friction ; 1 = sliding friction 
    651                   rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE + ztauy_base(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
     663                  rswitch = 1._wp - MIN( 1._wp, ABS( SIGN( 1._wp, zTauE - zTauV_ib(ji,jj) ) - SIGN( 1._wp, zTauE ) ) ) 
    652664                  ! 
    653665                  IF( ln_aEVP ) THEN !--- ice velocity using aEVP (Kimmritz et al 2016 & 2017) 
    654                      v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )       & ! previous velocity 
    655                         &                                  + zTauE + zTauO * v_ice(ji,jj) )                                        & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    656                         &                                  / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
    657                         &               + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
    658                         &             ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    659                         &           )   * zmsk00y(ji,jj) 
     666                  v_ice(ji,jj) = ( (          rswitch * ( zmV_t(ji,jj) * ( zbeta(ji,jj) * v_ice(ji,jj) + v_ice_b(ji,jj) )         & ! previous velocity 
     667                     &                                  + zTauE + zTauO * v_ice(ji,jj)                                            & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     668                     &                                  ) / MAX( zepsi, zmV_t(ji,jj) * ( zbeta(ji,jj) + 1._wp ) + zTauO - zTauB ) & ! m/dt + tau_io(only ice part) + landfast 
     669                                    + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )           & ! static friction => slow decrease to v=0 
     670                     &             ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )                     & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     671                     &           ) * zmaskV(ji,jj) 
    660672                  ELSE               !--- ice velocity using EVP implicit formulation (cf Madec doc & Bouillon 2009) 
    661                      v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                                       & ! previous velocity 
    662                         &                                     + zTauE + zTauO * v_ice(ji,jj) )                                     & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
    663                         &                                     / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )                         & ! m/dt + tau_io(only ice part) + landfast 
    664                         &                + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )          & ! static friction => slow decrease to v=0 
    665                         &              ) * zmsk01y(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zmsk01y(ji,jj) )                    & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
    666                         &            )   * zmsk00y(ji,jj) 
     673                  v_ice(ji,jj) = ( (           rswitch   * ( zmV_t(ji,jj)  * v_ice(ji,jj)                             & ! previous velocity 
     674                     &                                     + zTauE + zTauO * v_ice(ji,jj)                             & ! F + tau_ia + Coriolis + spg + tau_io(only ocean part) 
     675                     &                                     ) / MAX( zepsi, zmV_t(ji,jj) + zTauO - zTauB )             & ! m/dt + tau_io(only ice part) + landfast 
     676                     &              + ( 1._wp - rswitch ) * v_ice(ji,jj) * MAX( 0._wp, 1._wp - zdtevp * rn_lfrelax )  & ! static friction => slow decrease to v=0 
     677                     &              ) * zswitchV(ji,jj) + v_oce(ji,jj) * 0.01_wp * ( 1._wp - zswitchV(ji,jj) )        & ! v_ice = v_oce/100 if mass < zmmin & conc < zamin 
     678                     &            ) * zmaskV(ji,jj) 
    667679                  ENDIF 
    668680               END DO 
     
    674686            CALL agrif_interp_ice( 'V' ) 
    675687#endif 
    676             IF( ln_bdy CALL bdy_ice_dyn( 'V' ) 
     688            IF( ln_bdy .AND. ll_bdy_substep ) CALL bdy_ice_dyn( 'V' ) 
    677689            ! 
    678690         ENDIF 
     
    689701      END DO                                              !  end loop over jter  ! 
    690702      !                                                   ! ==================== ! 
     703      ! 
     704      IF( ln_bdy .AND. .NOT.ll_bdy_substep ) THEN 
     705         CALL bdy_ice_dyn( 'U' ) 
     706         CALL bdy_ice_dyn( 'V' ) 
     707      ENDIF 
    691708      ! 
    692709      !------------------------------------------------------------------------------! 
     
    747764      DO jj = 1, jpj 
    748765         DO ji = 1, jpi 
    749             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
     766            zswi(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
    750767         END DO 
    751768      END DO 
    752769 
    753       ! --- ice-ocean, ice-atm. & ice-oceanbottom(landfast) stresses --- ! 
    754       IF(  iom_use('utau_oi') .OR. iom_use('vtau_oi') .OR. iom_use('utau_ai') .OR. iom_use('vtau_ai') .OR. & 
    755          & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 
    756          ! 
    757          CALL lbc_lnk_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1., & 
    758             &                                  ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
    759          ! 
    760          CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
    761          CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 
    762          CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 
    763          CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 
    764          CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 
    765          CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 
    766       ENDIF 
    767         
    768770      ! --- divergence, shear and strength --- ! 
    769       IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
    770       IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
    771       IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    772  
    773       ! --- stress tensor --- ! 
    774       IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') .OR. iom_use('normstr') .OR. iom_use('sheastr') ) THEN 
     771      IF( iom_use('icediv') )   CALL iom_put( "icediv" , pdivu_i (:,:) * zswi(:,:) )   ! divergence 
     772      IF( iom_use('iceshe') )   CALL iom_put( "iceshe" , pshear_i(:,:) * zswi(:,:) )   ! shear 
     773      IF( iom_use('icestr') )   CALL iom_put( "icestr" , strength(:,:) * zswi(:,:) )   ! Ice strength 
     774 
     775      ! --- charge ellipse --- ! 
     776      IF( iom_use('isig1') .OR. iom_use('isig2') .OR. iom_use('isig3') ) THEN 
    775777         ! 
    776778         ALLOCATE( zsig1(jpi,jpj) , zsig2(jpi,jpj) , zsig3(jpi,jpj) ) 
     
    778780         DO jj = 2, jpjm1 
    779781            DO ji = 2, jpim1 
    780                zdum1 = ( zmsk00(ji-1,jj) * pstress12_i(ji-1,jj) + zmsk00(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
    781                   &      zmsk00(ji  ,jj) * pstress12_i(ji  ,jj) + zmsk00(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
    782                   &    / MAX( 1._wp, zmsk00(ji-1,jj) + zmsk00(ji,jj-1) + zmsk00(ji,jj) + zmsk00(ji-1,jj-1) ) 
     782               zdum1 = ( zswi(ji-1,jj) * pstress12_i(ji-1,jj) + zswi(ji  ,jj-1) * pstress12_i(ji  ,jj-1) +  &  ! stress12_i at T-point 
     783                  &      zswi(ji  ,jj) * pstress12_i(ji  ,jj) + zswi(ji-1,jj-1) * pstress12_i(ji-1,jj-1) )  & 
     784                  &    / MAX( 1._wp, zswi(ji-1,jj) + zswi(ji,jj-1) + zswi(ji,jj) + zswi(ji-1,jj-1) ) 
    783785 
    784786               zshear = SQRT( pstress2_i(ji,jj) * pstress2_i(ji,jj) + 4._wp * zdum1 * zdum1 ) ! shear stress   
    785787 
    786                zdum2 = zmsk00(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
     788               zdum2 = zswi(ji,jj) / MAX( 1._wp, strength(ji,jj) ) 
    787789 
    788790!!               zsig1(ji,jj) = 0.5_wp * zdum2 * ( pstress1_i(ji,jj) + zshear ) ! principal stress (y-direction, see Hunke & Dukowicz 2002) 
     
    797799         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zsig1, 'T', 1., zsig2, 'T', 1., zsig3, 'T', 1. ) 
    798800         ! 
    799          CALL iom_put( 'isig1' , zsig1 ) 
    800          CALL iom_put( 'isig2' , zsig2 ) 
    801          CALL iom_put( 'isig3' , zsig3 ) 
    802          ! 
    803          ! Stress tensor invariants (normal and shear stress N/m) 
    804          IF( iom_use('normstr') )   CALL iom_put( 'normstr' ,       ( zs1(:,:) + zs2(:,:) )                       * zmsk00(:,:) ) ! Normal stress 
    805          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr' , SQRT( ( zs1(:,:) - zs2(:,:) )**2 + 4*zs12(:,:)**2 ) * zmsk00(:,:) ) ! Shear stress 
    806  
     801         IF( iom_use('isig1') )   CALL iom_put( "isig1" , zsig1 ) 
     802         IF( iom_use('isig2') )   CALL iom_put( "isig2" , zsig2 ) 
     803         IF( iom_use('isig3') )   CALL iom_put( "isig3" , zsig3 ) 
     804         ! 
    807805         DEALLOCATE( zsig1 , zsig2 , zsig3 ) 
    808806      ENDIF 
    809807       
    810808      ! --- SIMIP --- ! 
    811       IF(  iom_use('dssh_dx') .OR. iom_use('dssh_dy') .OR. & 
    812          & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    813          ! 
    814          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    815             &                                  zCorU, 'U', -1., zCorV, 'V', -1., zfU, 'U', -1., zfV, 'V', -1. ) 
    816  
    817          CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
    818          CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y) 
    819          CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x) 
    820          CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y) 
    821          CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
    822          CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y) 
    823       ENDIF 
    824  
    825       IF(  iom_use('xmtrpice') .OR. iom_use('ymtrpice') .OR. & 
    826          & iom_use('xmtrpsnw') .OR. iom_use('ymtrpsnw') .OR. iom_use('xatrp') .OR. iom_use('yatrp') ) THEN 
    827          ! 
    828          ALLOCATE( zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) , & 
    829             &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
    830          ! 
     809      IF ( iom_use( 'normstr'  ) .OR. iom_use( 'sheastr'  ) .OR. iom_use( 'dssh_dx'  ) .OR. iom_use( 'dssh_dy'  ) .OR. & 
     810         & iom_use( 'corstrx'  ) .OR. iom_use( 'corstry'  ) .OR. iom_use( 'intstrx'  ) .OR. iom_use( 'intstry'  ) .OR. & 
     811         & iom_use( 'utau_oi'  ) .OR. iom_use( 'vtau_oi'  ) .OR. iom_use( 'xmtrpice' ) .OR. iom_use( 'ymtrpice' ) .OR. & 
     812         & iom_use( 'xmtrpsnw' ) .OR. iom_use( 'ymtrpsnw' ) .OR. iom_use( 'xatrp'    ) .OR. iom_use( 'yatrp'    ) ) THEN 
     813 
     814         ALLOCATE( zdiag_sig1     (jpi,jpj) , zdiag_sig2     (jpi,jpj) , zdiag_dssh_dx  (jpi,jpj) , zdiag_dssh_dy  (jpi,jpj) ,  & 
     815            &      zdiag_corstrx  (jpi,jpj) , zdiag_corstry  (jpi,jpj) , zdiag_intstrx  (jpi,jpj) , zdiag_intstry  (jpi,jpj) ,  & 
     816            &      zdiag_utau_oi  (jpi,jpj) , zdiag_vtau_oi  (jpi,jpj) , zdiag_xmtrp_ice(jpi,jpj) , zdiag_ymtrp_ice(jpi,jpj) ,  & 
     817            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp    (jpi,jpj) , zdiag_yatrp    (jpi,jpj) ) 
     818          
    831819         DO jj = 2, jpjm1 
    832820            DO ji = 2, jpim1 
     821               rswitch  = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 
     822                
     823               ! Stress tensor invariants (normal and shear stress N/m) 
     824               zdiag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * rswitch                                 ! normal stress 
     825               zdiag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * rswitch   ! shear stress 
     826                
     827               ! Stress terms of the momentum equation (N/m2) 
     828               zdiag_dssh_dx(ji,jj) = zspgU(ji,jj) * rswitch     ! sea surface slope stress term 
     829               zdiag_dssh_dy(ji,jj) = zspgV(ji,jj) * rswitch 
     830                
     831               zdiag_corstrx(ji,jj) = zCorx(ji,jj) * rswitch     ! Coriolis stress term 
     832               zdiag_corstry(ji,jj) = zCory(ji,jj) * rswitch 
     833                
     834               zdiag_intstrx(ji,jj) = zfU(ji,jj)   * rswitch     ! internal stress term 
     835               zdiag_intstry(ji,jj) = zfV(ji,jj)   * rswitch 
     836                
     837               zdiag_utau_oi(ji,jj) = ztaux_oi(ji,jj) * rswitch  ! oceanic stress 
     838               zdiag_vtau_oi(ji,jj) = ztauy_oi(ji,jj) * rswitch 
     839                
    833840               ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    834                zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
    835                zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    836  
     841               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * rswitch 
     842               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * rswitch 
     843                
    837844               zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
    838845               zdiag_ymtrp_ice(ji,jj) = rhoi * zfac_y * ( vt_i(ji,jj+1) + vt_i(ji,jj) ) !        ''           Y-   '' 
    839  
     846                
    840847               zdiag_xmtrp_snw(ji,jj) = rhos * zfac_x * ( vt_s(ji+1,jj) + vt_s(ji,jj) ) ! snow mass transport, X-component 
    841848               zdiag_ymtrp_snw(ji,jj) = rhos * zfac_y * ( vt_s(ji,jj+1) + vt_s(ji,jj) ) !          ''          Y-   '' 
    842  
     849                
    843850               zdiag_xatrp(ji,jj)     = zfac_x * ( at_i(ji+1,jj) + at_i(ji,jj) )        ! area transport,      X-component 
    844851               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   '' 
    845  
    846             END DO 
    847          END DO 
    848  
    849          CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    850             &                                  zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    851             &                                  zdiag_xatrp    , 'U', -1., zdiag_yatrp    , 'V', -1. ) 
    852  
    853          CALL iom_put( 'xmtrpice' , zdiag_xmtrp_ice )   ! X-component of sea-ice mass transport (kg/s) 
    854          CALL iom_put( 'ymtrpice' , zdiag_ymtrp_ice )   ! Y-component of sea-ice mass transport  
    855          CALL iom_put( 'xmtrpsnw' , zdiag_xmtrp_snw )   ! X-component of snow mass transport (kg/s) 
    856          CALL iom_put( 'ymtrpsnw' , zdiag_ymtrp_snw )   ! Y-component of snow mass transport 
    857          CALL iom_put( 'xatrp'    , zdiag_xatrp     )   ! X-component of ice area transport 
    858          CALL iom_put( 'yatrp'    , zdiag_yatrp     )   ! Y-component of ice area transport 
    859  
    860          DEALLOCATE( zdiag_xmtrp_ice , zdiag_ymtrp_ice , & 
    861             &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp , zdiag_yatrp ) 
     852                
     853            END DO 
     854         END DO 
     855          
     856         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_sig1   , 'T',  1., zdiag_sig2   , 'T',  1.,   & 
     857            &                zdiag_dssh_dx, 'U', -1., zdiag_dssh_dy, 'V', -1.,   & 
     858            &                zdiag_corstrx, 'U', -1., zdiag_corstry, 'V', -1.,   &  
     859            &                zdiag_intstrx, 'U', -1., zdiag_intstry, 'V', -1.    ) 
     860                   
     861         CALL lbc_lnk_multi( 'icedyn_rhg_evp', zdiag_utau_oi  , 'U', -1., zdiag_vtau_oi  , 'V', -1.,   & 
     862            &                zdiag_xmtrp_ice, 'U', -1., zdiag_xmtrp_snw, 'U', -1.,   & 
     863            &                zdiag_xatrp    , 'U', -1., zdiag_ymtrp_ice, 'V', -1.,   & 
     864            &                zdiag_ymtrp_snw, 'V', -1., zdiag_yatrp    , 'V', -1.    ) 
     865          
     866         IF( iom_use('normstr' ) )   CALL iom_put( 'normstr'  ,  zdiag_sig1(:,:)      )   ! Normal stress 
     867         IF( iom_use('sheastr' ) )   CALL iom_put( 'sheastr'  ,  zdiag_sig2(:,:)      )   ! Shear stress 
     868         IF( iom_use('dssh_dx' ) )   CALL iom_put( 'dssh_dx'  ,  zdiag_dssh_dx(:,:)   )   ! Sea-surface tilt term in force balance (x) 
     869         IF( iom_use('dssh_dy' ) )   CALL iom_put( 'dssh_dy'  ,  zdiag_dssh_dy(:,:)   )   ! Sea-surface tilt term in force balance (y) 
     870         IF( iom_use('corstrx' ) )   CALL iom_put( 'corstrx'  ,  zdiag_corstrx(:,:)   )   ! Coriolis force term in force balance (x) 
     871         IF( iom_use('corstry' ) )   CALL iom_put( 'corstry'  ,  zdiag_corstry(:,:)   )   ! Coriolis force term in force balance (y) 
     872         IF( iom_use('intstrx' ) )   CALL iom_put( 'intstrx'  ,  zdiag_intstrx(:,:)   )   ! Internal force term in force balance (x) 
     873         IF( iom_use('intstry' ) )   CALL iom_put( 'intstry'  ,  zdiag_intstry(:,:)   )   ! Internal force term in force balance (y) 
     874         IF( iom_use('utau_oi' ) )   CALL iom_put( 'utau_oi'  ,  zdiag_utau_oi(:,:)   )   ! Ocean stress term in force balance (x) 
     875         IF( iom_use('vtau_oi' ) )   CALL iom_put( 'vtau_oi'  ,  zdiag_vtau_oi(:,:)   )   ! Ocean stress term in force balance (y) 
     876         IF( iom_use('xmtrpice') )   CALL iom_put( 'xmtrpice' ,  zdiag_xmtrp_ice(:,:) )   ! X-component of sea-ice mass transport (kg/s) 
     877         IF( iom_use('ymtrpice') )   CALL iom_put( 'ymtrpice' ,  zdiag_ymtrp_ice(:,:) )   ! Y-component of sea-ice mass transport  
     878         IF( iom_use('xmtrpsnw') )   CALL iom_put( 'xmtrpsnw' ,  zdiag_xmtrp_snw(:,:) )   ! X-component of snow mass transport (kg/s) 
     879         IF( iom_use('ymtrpsnw') )   CALL iom_put( 'ymtrpsnw' ,  zdiag_ymtrp_snw(:,:) )   ! Y-component of snow mass transport 
     880         IF( iom_use('xatrp'   ) )   CALL iom_put( 'xatrp'    ,  zdiag_xatrp(:,:)     )   ! X-component of ice area transport 
     881         IF( iom_use('yatrp'   ) )   CALL iom_put( 'yatrp'    ,  zdiag_yatrp(:,:)     )   ! Y-component of ice area transport 
     882 
     883         DEALLOCATE( zdiag_sig1      , zdiag_sig2      , zdiag_dssh_dx   , zdiag_dssh_dy   ,  & 
     884            &        zdiag_corstrx   , zdiag_corstry   , zdiag_intstrx   , zdiag_intstry   ,  & 
     885            &        zdiag_utau_oi   , zdiag_vtau_oi   , zdiag_xmtrp_ice , zdiag_ymtrp_ice ,  & 
     886            &        zdiag_xmtrp_snw , zdiag_ymtrp_snw , zdiag_xatrp     , zdiag_yatrp     ) 
    862887 
    863888      ENDIF 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icesbc.F90

    r11371 r11380  
    114114      INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk or Pure Coupled) 
    115115      ! 
    116       INTEGER  ::   ji, jj, jl      ! dummy loop index 
    117       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    118       REAL(wp), DIMENSION(jpi,jpj,jpl)              ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
    119       REAL(wp), DIMENSION(:,:)        , ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
     116      INTEGER  ::   ji, jj, jl                                ! dummy loop index 
     117      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zalb_os, zalb_cs  ! ice albedo under overcast/clear sky 
     118      REAL(wp), DIMENSION(jpi,jpj)     ::   zalb              ! 2D workspace 
    120119      !!-------------------------------------------------------------------- 
    121120      ! 
     
    127126         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    128127      ENDIF 
    129  
    130       ! get missing value from xml 
    131       CALL iom_miss_val( "icetemp", zmiss_val ) 
    132128 
    133129      ! --- cloud-sky and overcast-sky ice albedos --- ! 
     
    156152 
    157153      !--- output ice albedo and surface albedo ---! 
    158       IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 
    159  
    160          ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 
    161  
    162          WHERE( at_i_b <= epsi06 ) 
    163             zmsk00(:,:) = 0._wp 
    164             zalb  (:,:) = rn_alb_oce 
    165          ELSEWHERE 
    166             zmsk00(:,:) = 1._wp             
    167             zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
     154      IF( iom_use('icealb') ) THEN 
     155         WHERE( at_i_b <= epsi06 )   ;   zalb(:,:) = rn_alb_oce 
     156         ELSEWHERE                   ;   zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    168157         END WHERE 
    169          ! ice albedo 
    170          CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 
    171          ! ice+ocean albedo 
     158         CALL iom_put( "icealb" , zalb(:,:) ) 
     159      ENDIF 
     160      IF( iom_use('albedo') ) THEN 
    172161         zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 
    173          CALL iom_put( 'albedo' , zalb ) 
    174  
    175          DEALLOCATE( zalb, zmsk00 ) 
    176  
     162         CALL iom_put( "albedo" , zalb(:,:) ) 
    177163      ENDIF 
    178164      ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icestp.F90

    r11371 r11380  
    425425      wfx_err_sub(:,:) = 0._wp 
    426426      ! 
     427      afx_tot(:,:) = 0._wp   ; 
     428      ! 
    427429      diag_heat(:,:) = 0._wp ;   diag_sice(:,:) = 0._wp 
    428430      diag_vice(:,:) = 0._wp ;   diag_vsnw(:,:) = 0._wp 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/iceupdate.F90

    r11371 r11380  
    198198      ! --- salt fluxes [kg/m2/s] --- ! 
    199199      !                           ! sfxice =  sfxbog + sfxbom + sfxsum + sfxsni + sfxopw + sfxres + sfxdyn + sfxbri + sfxsub + sfxlam 
    200       IF( iom_use('sfxice'  ) )   CALL iom_put( 'sfxice', sfx     * 1.e-03 )   ! salt flux from total ice growth/melt 
    201       IF( iom_use('sfxbog'  ) )   CALL iom_put( 'sfxbog', sfx_bog * 1.e-03 )   ! salt flux from bottom growth 
    202       IF( iom_use('sfxbom'  ) )   CALL iom_put( 'sfxbom', sfx_bom * 1.e-03 )   ! salt flux from bottom melting 
    203       IF( iom_use('sfxsum'  ) )   CALL iom_put( 'sfxsum', sfx_sum * 1.e-03 )   ! salt flux from surface melting 
    204       IF( iom_use('sfxlam'  ) )   CALL iom_put( 'sfxlam', sfx_lam * 1.e-03 )   ! salt flux from lateral melting 
    205       IF( iom_use('sfxsni'  ) )   CALL iom_put( 'sfxsni', sfx_sni * 1.e-03 )   ! salt flux from snow ice formation 
    206       IF( iom_use('sfxopw'  ) )   CALL iom_put( 'sfxopw', sfx_opw * 1.e-03 )   ! salt flux from open water formation 
    207       IF( iom_use('sfxdyn'  ) )   CALL iom_put( 'sfxdyn', sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting 
    208       IF( iom_use('sfxbri'  ) )   CALL iom_put( 'sfxbri', sfx_bri * 1.e-03 )   ! salt flux from brines 
    209       IF( iom_use('sfxres'  ) )   CALL iom_put( 'sfxres', sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes 
    210       IF( iom_use('sfxsub'  ) )   CALL iom_put( 'sfxsub', sfx_sub * 1.e-03 )   ! salt flux from sublimation 
     200      IF( iom_use('sfxice'  ) )   CALL iom_put( "sfxice", sfx     * 1.e-03 )   ! salt flux from total ice growth/melt 
     201      IF( iom_use('sfxbog'  ) )   CALL iom_put( "sfxbog", sfx_bog * 1.e-03 )   ! salt flux from bottom growth 
     202      IF( iom_use('sfxbom'  ) )   CALL iom_put( "sfxbom", sfx_bom * 1.e-03 )   ! salt flux from bottom melting 
     203      IF( iom_use('sfxsum'  ) )   CALL iom_put( "sfxsum", sfx_sum * 1.e-03 )   ! salt flux from surface melting 
     204      IF( iom_use('sfxlam'  ) )   CALL iom_put( "sfxlam", sfx_lam * 1.e-03 )   ! salt flux from lateral melting 
     205      IF( iom_use('sfxsni'  ) )   CALL iom_put( "sfxsni", sfx_sni * 1.e-03 )   ! salt flux from snow ice formation 
     206      IF( iom_use('sfxopw'  ) )   CALL iom_put( "sfxopw", sfx_opw * 1.e-03 )   ! salt flux from open water formation 
     207      IF( iom_use('sfxdyn'  ) )   CALL iom_put( "sfxdyn", sfx_dyn * 1.e-03 )   ! salt flux from ridging rafting 
     208      IF( iom_use('sfxbri'  ) )   CALL iom_put( "sfxbri", sfx_bri * 1.e-03 )   ! salt flux from brines 
     209      IF( iom_use('sfxres'  ) )   CALL iom_put( "sfxres", sfx_res * 1.e-03 )   ! salt flux from undiagnosed processes 
     210      IF( iom_use('sfxsub'  ) )   CALL iom_put( "sfxsub", sfx_sub * 1.e-03 )   ! salt flux from sublimation 
    211211 
    212212      ! --- mass fluxes [kg/m2/s] --- ! 
    213       CALL iom_put( 'emp_oce', emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice) 
    214       CALL iom_put( 'emp_ice', emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice) 
     213      IF( iom_use('emp_oce' ) )   CALL iom_put( "emp_oce", emp_oce )   ! emp over ocean (taking into account the snow blown away from the ice) 
     214      IF( iom_use('emp_ice' ) )   CALL iom_put( "emp_ice", emp_ice )   ! emp over ice   (taking into account the snow blown away from the ice) 
    215215 
    216216      !                           ! vfxice = vfxbog + vfxbom + vfxsum + vfxsni + vfxopw + vfxdyn + vfxres + vfxlam + vfxpnd 
    217       CALL iom_put( 'vfxice'    , wfx_ice    )   ! mass flux from total ice growth/melt 
    218       CALL iom_put( 'vfxbog'    , wfx_bog    )   ! mass flux from bottom growth 
    219       CALL iom_put( 'vfxbom'    , wfx_bom    )   ! mass flux from bottom melt  
    220       CALL iom_put( 'vfxsum'    , wfx_sum    )   ! mass flux from surface melt  
    221       CALL iom_put( 'vfxlam'    , wfx_lam    )   ! mass flux from lateral melt  
    222       CALL iom_put( 'vfxsni'    , wfx_sni    )   ! mass flux from snow-ice formation 
    223       CALL iom_put( 'vfxopw'    , wfx_opw    )   ! mass flux from growth in open water 
    224       CALL iom_put( 'vfxdyn'    , wfx_dyn    )   ! mass flux from dynamics (ridging) 
    225       CALL iom_put( 'vfxres'    , wfx_res    )   ! mass flux from undiagnosed processes  
    226       CALL iom_put( 'vfxpnd'    , wfx_pnd    )   ! mass flux from melt ponds 
    227       CALL iom_put( 'vfxsub'    , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.) 
    228       CALL iom_put( 'vfxsub_err', wfx_err_sub )   ! "excess" of sublimation sent to ocean       
    229  
    230       IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations   
     217      IF( iom_use('vfxice'  ) )   CALL iom_put( "vfxice" , wfx_ice )   ! mass flux from total ice growth/melt 
     218      IF( iom_use('vfxbog'  ) )   CALL iom_put( "vfxbog" , wfx_bog )   ! mass flux from bottom growth 
     219      IF( iom_use('vfxbom'  ) )   CALL iom_put( "vfxbom" , wfx_bom )   ! mass flux from bottom melt  
     220      IF( iom_use('vfxsum'  ) )   CALL iom_put( "vfxsum" , wfx_sum )   ! mass flux from surface melt  
     221      IF( iom_use('vfxlam'  ) )   CALL iom_put( "vfxlam" , wfx_lam )   ! mass flux from lateral melt  
     222      IF( iom_use('vfxsni'  ) )   CALL iom_put( "vfxsni" , wfx_sni )   ! mass flux from snow-ice formation 
     223      IF( iom_use('vfxopw'  ) )   CALL iom_put( "vfxopw" , wfx_opw )   ! mass flux from growth in open water 
     224      IF( iom_use('vfxdyn'  ) )   CALL iom_put( "vfxdyn" , wfx_dyn )   ! mass flux from dynamics (ridging) 
     225      IF( iom_use('vfxres'  ) )   CALL iom_put( "vfxres" , wfx_res )   ! mass flux from undiagnosed processes  
     226      IF( iom_use('vfxpnd'  ) )   CALL iom_put( "vfxpnd" , wfx_pnd )   ! mass flux from melt ponds 
     227      IF( iom_use('vfxsub'  ) )   CALL iom_put( "vfxsub" , wfx_ice_sub )   ! mass flux from ice sublimation (ice-atm.) 
     228      IF( iom_use('vfxsub_err') ) CALL iom_put( "vfxsub_err", wfx_err_sub )   ! "excess" of sublimation sent to ocean       
     229 
     230      IF ( iom_use( "vfxthin" ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations   
    231231         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 
    232232         ELSEWHERE                                     ; z2d = 0._wp 
    233233         END WHERE 
    234          CALL iom_put( 'vfxthin', wfx_opw + z2d ) 
    235       ENDIF 
    236  
    237       !                            ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 
    238       CALL iom_put( 'vfxsnw'     , wfx_snw     )   ! mass flux from total snow growth/melt 
    239       CALL iom_put( 'vfxsnw_sum' , wfx_snw_sum )   ! mass flux from snow melt at the surface 
    240       CALL iom_put( 'vfxsnw_sni' , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation  
    241       CALL iom_put( 'vfxsnw_dyn' , wfx_snw_dyn )   ! mass flux from dynamics (ridging)  
    242       CALL iom_put( 'vfxsnw_sub' , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)  
    243       CALL iom_put( 'vfxsnw_pre' , wfx_spr     )   ! snow precip 
     234         CALL iom_put( "vfxthin", wfx_opw + z2d ) 
     235      ENDIF 
     236 
     237      !                              ! vfxsnw = vfxsnw_sni + vfxsnw_dyn + vfxsnw_sum 
     238      IF( iom_use('vfxsnw'     ) )   CALL iom_put( "vfxsnw"     , wfx_snw     )   ! mass flux from total snow growth/melt 
     239      IF( iom_use('vfxsnw_sum' ) )   CALL iom_put( "vfxsnw_sum" , wfx_snw_sum )   ! mass flux from snow melt at the surface 
     240      IF( iom_use('vfxsnw_sni' ) )   CALL iom_put( "vfxsnw_sni" , wfx_snw_sni )   ! mass flux from snow melt during snow-ice formation  
     241      IF( iom_use('vfxsnw_dyn' ) )   CALL iom_put( "vfxsnw_dyn" , wfx_snw_dyn )   ! mass flux from dynamics (ridging)  
     242      IF( iom_use('vfxsnw_sub' ) )   CALL iom_put( "vfxsnw_sub" , wfx_snw_sub )   ! mass flux from snow sublimation (ice-atm.)  
     243      IF( iom_use('vfxsnw_pre' ) )   CALL iom_put( "vfxsnw_pre" , wfx_spr     )   ! snow precip 
    244244 
    245245      ! --- heat fluxes [W/m2] --- ! 
    246246      !                              ! qt_atm_oi - qt_oce_ai = hfxdhc - ( dihctrp + dshctrp ) 
    247       IF( iom_use('qsr_oce'    ) )   CALL iom_put( 'qsr_oce'    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface 
    248       IF( iom_use('qns_oce'    ) )   CALL iom_put( 'qns_oce'    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface 
    249       IF( iom_use('qsr_ice'    ) )   CALL iom_put( 'qsr_ice'    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
    250       IF( iom_use('qns_ice'    ) )   CALL iom_put( 'qns_ice'    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
    251       IF( iom_use('qtr_ice_bot') )   CALL iom_put( 'qtr_ice_bot', SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
    252       IF( iom_use('qtr_ice_top') )   CALL iom_put( 'qtr_ice_top', SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
    253       IF( iom_use('qt_oce'     ) )   CALL iom_put( 'qt_oce'     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
    254       IF( iom_use('qt_ice'     ) )   CALL iom_put( 'qt_ice'     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
    255       IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( 'qt_oce_ai'  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
    256       IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( 'qt_atm_oi'  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
    257       IF( iom_use('qemp_oce'   ) )   CALL iom_put( 'qemp_oce'   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
    258       IF( iom_use('qemp_ice'   ) )   CALL iom_put( 'qemp_ice'   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
     247      IF( iom_use('qsr_oce'    ) )   CALL iom_put( "qsr_oce"    , qsr_oce * ( 1._wp - at_i_b )                               )   !     solar flux at ocean surface 
     248      IF( iom_use('qns_oce'    ) )   CALL iom_put( "qns_oce"    , qns_oce * ( 1._wp - at_i_b ) + qemp_oce                    )   ! non-solar flux at ocean surface 
     249      IF( iom_use('qsr_ice'    ) )   CALL iom_put( "qsr_ice"    , SUM( qsr_ice * a_i_b, dim=3 )                              )   !     solar flux at ice surface 
     250      IF( iom_use('qns_ice'    ) )   CALL iom_put( "qns_ice"    , SUM( qns_ice * a_i_b, dim=3 ) + qemp_ice                   )   ! non-solar flux at ice surface 
     251      IF( iom_use('qtr_ice_bot') )   CALL iom_put( "qtr_ice_bot", SUM( qtr_ice_bot * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice 
     252      IF( iom_use('qtr_ice_top') )   CALL iom_put( "qtr_ice_top", SUM( qtr_ice_top * a_i_b, dim=3 )                          )   !     solar flux transmitted thru ice surface 
     253      IF( iom_use('qt_oce'     ) )   CALL iom_put( "qt_oce"     ,      ( qsr_oce + qns_oce ) * ( 1._wp - at_i_b ) + qemp_oce ) 
     254      IF( iom_use('qt_ice'     ) )   CALL iom_put( "qt_ice"     , SUM( ( qns_ice + qsr_ice ) * a_i_b, dim=3 )     + qemp_ice ) 
     255      IF( iom_use('qt_oce_ai'  ) )   CALL iom_put( "qt_oce_ai"  , qt_oce_ai * tmask(:,:,1)                                   )   ! total heat flux at the ocean   surface: interface oce-(ice+atm)  
     256      IF( iom_use('qt_atm_oi'  ) )   CALL iom_put( "qt_atm_oi"  , qt_atm_oi * tmask(:,:,1)                                   )   ! total heat flux at the oce-ice surface: interface atm-(ice+oce)  
     257      IF( iom_use('qemp_oce'   ) )   CALL iom_put( "qemp_oce"   , qemp_oce                                                   )   ! Downward Heat Flux from E-P over ocean 
     258      IF( iom_use('qemp_ice'   ) )   CALL iom_put( "qemp_ice"   , qemp_ice                                                   )   ! Downward Heat Flux from E-P over ice 
    259259 
    260260      ! heat fluxes from ice transformations 
    261       !                            ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 
    262       CALL iom_put ('hfxbog'     , hfx_bog     )   ! heat flux used for ice bottom growth  
    263       CALL iom_put ('hfxbom'     , hfx_bom     )   ! heat flux used for ice bottom melt 
    264       CALL iom_put ('hfxsum'     , hfx_sum     )   ! heat flux used for ice surface melt 
    265       CALL iom_put ('hfxopw'     , hfx_opw     )   ! heat flux used for ice formation in open water 
    266       CALL iom_put ('hfxdif'     , hfx_dif     )   ! heat flux used for ice temperature change 
    267       CALL iom_put ('hfxsnw'     , hfx_snw     )   ! heat flux used for snow melt  
    268       CALL iom_put ('hfxerr'     , hfx_err_dif )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
     261      !                              ! hfxdhc = hfxbog + hfxbom + hfxsum + hfxopw + hfxdif + hfxsnw - ( hfxthd + hfxdyn + hfxres + hfxsub + hfxspr ) 
     262      IF( iom_use('hfxbog'     ) )   CALL iom_put ("hfxbog"     , hfx_bog             )   ! heat flux used for ice bottom growth  
     263      IF( iom_use('hfxbom'     ) )   CALL iom_put ("hfxbom"     , hfx_bom             )   ! heat flux used for ice bottom melt 
     264      IF( iom_use('hfxsum'     ) )   CALL iom_put ("hfxsum"     , hfx_sum             )   ! heat flux used for ice surface melt 
     265      IF( iom_use('hfxopw'     ) )   CALL iom_put ("hfxopw"     , hfx_opw             )   ! heat flux used for ice formation in open water 
     266      IF( iom_use('hfxdif'     ) )   CALL iom_put ("hfxdif"     , hfx_dif             )   ! heat flux used for ice temperature change 
     267      IF( iom_use('hfxsnw'     ) )   CALL iom_put ("hfxsnw"     , hfx_snw             )   ! heat flux used for snow melt  
     268      IF( iom_use('hfxerr'     ) )   CALL iom_put ("hfxerr"     , hfx_err_dif        )   ! heat flux error after heat diffusion (included in qt_oce_ai) 
    269269 
    270270      ! heat fluxes associated with mass exchange (freeze/melt/precip...) 
    271       CALL iom_put ('hfxthd'     , hfx_thd     )   !   
    272       CALL iom_put ('hfxdyn'     , hfx_dyn     )   !   
    273       CALL iom_put ('hfxres'     , hfx_res     )   !   
    274       CALL iom_put ('hfxsub'     , hfx_sub     )   !   
    275       CALL iom_put ('hfxspr'     , hfx_spr     )   ! Heat flux from snow precip heat content  
     271      IF( iom_use('hfxthd'     ) )   CALL iom_put ("hfxthd"     , hfx_thd             )   !   
     272      IF( iom_use('hfxdyn'     ) )   CALL iom_put ("hfxdyn"     , hfx_dyn             )   !   
     273      IF( iom_use('hfxres'     ) )   CALL iom_put ("hfxres"     , hfx_res             )   !   
     274      IF( iom_use('hfxsub'     ) )   CALL iom_put ("hfxsub"     , hfx_sub             )   !   
     275      IF( iom_use('hfxspr'     ) )   CALL iom_put ("hfxspr"     , hfx_spr             )   ! Heat flux from snow precip heat content  
    276276 
    277277      ! other heat fluxes 
    278       IF( iom_use('hfxsensib'  ) )   CALL iom_put( 'hfxsensib'  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux 
    279       IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
    280       IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
     278      IF( iom_use('hfxsensib'  ) )   CALL iom_put( "hfxsensib"  ,     -qsb_ice_bot * at_i_b         )   ! Sensible oceanic heat flux 
     279      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( "hfxcndbot"  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
     280      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( "hfxcndtop"  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
    281281 
    282282      ! diags 
    283       CALL iom_put ('hfxdhc'     , diag_heat   )   ! Heat content variation in snow and ice  
     283      IF( iom_use('hfxdhc'     ) )   CALL iom_put ("hfxdhc"     , diag_heat           )   ! Heat content variation in snow and ice  
    284284      ! 
    285285      ! controls 
     
    413413      !! ** Method  :   use of IOM library 
    414414      !!---------------------------------------------------------------------- 
    415       CHARACTER(len=*) , INTENT(in) ::   cdrw   ! 'READ'/'WRITE' flag 
     415      CHARACTER(len=*) , INTENT(in) ::   cdrw   ! "READ"/"WRITE" flag 
    416416      INTEGER, OPTIONAL, INTENT(in) ::   kt     ! ice time-step 
    417417      ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icevar.F90

    r11362 r11380  
    3232   !!                        - vt_s(jpi,jpj) 
    3333   !!                        - at_i(jpi,jpj) 
    34    !!                        - st_i(jpi,jpj) 
    3534   !!                        - et_s(jpi,jpj)  total snow heat content 
    3635   !!                        - et_i(jpi,jpj)  total ice thermal content  
     
    105104      ! 
    106105      !                                      ! integrated values 
    107       vt_i(:,:) =       SUM( v_i (:,:,:)           , dim=3 ) 
    108       vt_s(:,:) =       SUM( v_s (:,:,:)           , dim=3 ) 
    109       st_i(:,:) =       SUM( sv_i(:,:,:)           , dim=3 ) 
    110       at_i(:,:) =       SUM( a_i (:,:,:)           , dim=3 ) 
    111       et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 
    112       et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 
     106      vt_i(:,:) =       SUM( v_i(:,:,:)           , dim=3 ) 
     107      vt_s(:,:) =       SUM( v_s(:,:,:)           , dim=3 ) 
     108      at_i(:,:) =       SUM( a_i(:,:,:)           , dim=3 ) 
     109      et_s(:,:)  = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 ) 
     110      et_i(:,:)  = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 ) 
    113111      ! 
    114112      at_ip(:,:) = SUM( a_ip(:,:,:), dim=3 ) ! melt ponds 
     
    140138         tm_si(:,:) = SUM( t_si(:,:,:) * a_i(:,:,:) , dim=3 ) * z1_at_i(:,:) 
    141139         om_i (:,:) = SUM( oa_i(:,:,:)              , dim=3 ) * z1_at_i(:,:) 
    142          sm_i (:,:) =      st_i(:,:)                          * z1_vt_i(:,:) 
     140         sm_i (:,:) = SUM( sv_i(:,:,:)              , dim=3 ) * z1_vt_i(:,:) 
    143141         ! 
    144142         tm_i(:,:) = 0._wp 
     
    265263      ! 
    266264      ! integrated values  
    267       vt_i (:,:) = SUM( v_i , dim=3 ) 
    268       vt_s (:,:) = SUM( v_s , dim=3 ) 
    269       at_i (:,:) = SUM( a_i , dim=3 ) 
     265      vt_i (:,:) = SUM( v_i, dim=3 ) 
     266      vt_s (:,:) = SUM( v_s, dim=3 ) 
     267      at_i (:,:) = SUM( a_i, dim=3 ) 
    270268      ! 
    271269   END SUBROUTINE ice_var_glo2eqv 
     
    535533 
    536534      ! to be sure that at_i is the sum of a_i(jl) 
    537       at_i (:,:) = SUM( a_i (:,:,:), dim=3 ) 
    538       vt_i (:,:) = SUM( v_i (:,:,:), dim=3 ) 
    539 !!clem add? 
    540 !      vt_s (:,:) = SUM( v_s (:,:,:), dim=3 ) 
    541 !      st_i (:,:) = SUM( sv_i(:,:,:), dim=3 ) 
    542 !      et_s(:,:)  = SUM( SUM( e_s (:,:,:,:), dim=4 ), dim=3 ) 
    543 !      et_i(:,:)  = SUM( SUM( e_i (:,:,:,:), dim=4 ), dim=3 ) 
    544 !!clem 
     535      at_i (:,:) = SUM( a_i(:,:,:), dim=3 ) 
     536      vt_i (:,:) = SUM( v_i(:,:,:), dim=3 ) 
    545537 
    546538      ! open water = 1 if at_i=0 
     
    10931085         !                              ! ---------------------- ! 
    10941086         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:) ) 
    1095 !!         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
    1096 !!            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 
     1087!!$         CALL  ice_var_itd_1cMc( phti(:,1), phts(:,1), pati (:,1),            ph_i(:,:), ph_s(:,:), pa_i (:,:), & 
     1088!!$            &                    ptmi(:,1), ptms(:,1), ptmsu(:,1), psmi(:,1), pt_i(:,:), pt_s(:,:), pt_su(:,:), ps_i(:,:) ) 
    10971089         !                              ! ---------------------- ! 
    10981090      ELSEIF( jpl == 1 ) THEN           ! output cat = 1         ! 
    10991091         !                              ! ---------------------- ! 
    1100          CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1) ) 
    1101 !!         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
    1102 !!            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) )          
     1092         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1) )          
     1093!!$         CALL  ice_var_itd_Nc1c( phti(:,:), phts(:,:), pati (:,:),            ph_i(:,1), ph_s(:,1), pa_i (:,1), & 
     1094!!$            &                    ptmi(:,:), ptms(:,:), ptmsu(:,:), psmi(:,:), pt_i(:,1), pt_s(:,1), pt_su(:,1), ps_i(:,1) )          
    11031095         !                              ! ----------------------- ! 
    11041096      ELSE                              ! input cat /= output cat ! 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/ICE/icewri.F90

    r11371 r11380  
    5050      INTEGER  ::   ji, jj, jk, jl  ! dummy loop indices 
    5151      REAL(wp) ::   z2da, z2db, zrho1, zrho2 
    52       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios  
    53       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace 
     52      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast !  2D workspace 
    5453      REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 
    5554      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zmsk00l, zmsksnl               ! cat masks 
     
    5958      REAL(wp) ::   zdiag_area_sh, zdiag_extt_sh, zdiag_volu_sh  
    6059      !!------------------------------------------------------------------- 
    61       ! 
     60 
    6261      IF( ln_timing )   CALL timing_start('icewri') 
    63  
    64       ! get missing value from xml 
    65       CALL iom_miss_val( 'icetemp', zmiss_val ) 
    6662 
    6763      ! brine volume 
     
    8985      ! Standard outputs 
    9086      !----------------- 
    91       zrho1 = ( rau0 - rhoi ) * r1_rau0 ; zrho2 = rhos * r1_rau0 
     87      zrho1 = ( rau0 - rhoi ) * r1_rau0; zrho2 = rhos * r1_rau0 
    9288      ! masks 
    93       CALL iom_put( 'icemask'  , zmsk00 )   ! ice mask 0% 
    94       CALL iom_put( 'icemask05', zmsk05 )   ! ice mask 5% 
    95       CALL iom_put( 'icemask15', zmsk15 )   ! ice mask 15% 
    96       CALL iom_put( 'icepres'  , zmsk00 )   ! Ice presence (1 or 0)  
     89      IF( iom_use('icemask'  ) )   CALL iom_put( "icemask"  , zmsk00              )   ! ice mask 0% 
     90      IF( iom_use('icemask05') )   CALL iom_put( "icemask05", zmsk05              )   ! ice mask 5% 
     91      IF( iom_use('icemask15') )   CALL iom_put( "icemask15", zmsk15              )   ! ice mask 15% 
    9792      ! 
    9893      ! general fields 
    99       IF( iom_use('icemass' ) )   CALL iom_put( 'icemass', vt_i * rhoi * zmsk00 )                                           ! Ice mass per cell area  
    100       IF( iom_use('snwmass' ) )   CALL iom_put( 'snwmass', vt_s * rhos * zmsksn )                                           ! Snow mass per cell area 
    101       IF( iom_use('iceconc' ) )   CALL iom_put( 'iceconc', at_i        * zmsk00 )                                           ! ice concentration 
    102       IF( iom_use('icevolu' ) )   CALL iom_put( 'icevolu', vt_i        * zmsk00 )                                           ! ice volume = mean ice thickness over the cell 
    103       IF( iom_use('icethic' ) )   CALL iom_put( 'icethic', hm_i        * zmsk00 )                                           ! ice thickness 
    104       IF( iom_use('snwthic' ) )   CALL iom_put( 'snwthic', hm_s        * zmsk00 )                                           ! snw thickness 
    105       IF( iom_use('icebrv'  ) )   CALL iom_put( 'icebrv' , bvm_i* 100. * zmsk00 )                                           ! brine volume 
    106       IF( iom_use('iceage'  ) )   CALL iom_put( 'iceage' , om_i / rday * zmsk15 + zmiss_val * ( 1._wp - zmsk15 ) )          ! ice age 
    107       IF( iom_use('icehnew' ) )   CALL iom_put( 'icehnew', ht_i_new             )                                           ! new ice thickness formed in the leads 
    108       IF( iom_use('snwvolu' ) )   CALL iom_put( 'snwvolu', vt_s        * zmsksn )                                           ! snow volume 
    109       IF( iom_use('icefrb'  ) ) THEN                                                                                        ! Ice freeboard 
     94      IF( iom_use('icemass'  ) )   CALL iom_put( "icemass", rhoi * vt_i * zmsk00  )   ! Ice mass per cell area  
     95      IF( iom_use('snwmass'  ) )   CALL iom_put( "snwmass", rhos * vt_s * zmsksn  )   ! Snow mass per cell area 
     96      IF( iom_use('icepres'  ) )   CALL iom_put( "icepres", zmsk00                )   ! Ice presence (1 or 0)  
     97      IF( iom_use('iceconc'  ) )   CALL iom_put( "iceconc", at_i  * zmsk00        )   ! ice concentration 
     98      IF( iom_use('icevolu'  ) )   CALL iom_put( "icevolu", vt_i  * zmsk00        )   ! ice volume = mean ice thickness over the cell 
     99      IF( iom_use('icethic'  ) )   CALL iom_put( "icethic", hm_i  * zmsk00        )   ! ice thickness 
     100      IF( iom_use('snwthic'  ) )   CALL iom_put( "snwthic", hm_s  * zmsk00        )   ! snw thickness 
     101      IF( iom_use('icebrv'   ) )   CALL iom_put( "icebrv" , bvm_i * zmsk00 * 100. )   ! brine volume 
     102      IF( iom_use('iceage'   ) )   CALL iom_put( "iceage" , om_i  * zmsk15 / rday )   ! ice age 
     103      IF( iom_use('icehnew'  ) )   CALL iom_put( "icehnew", ht_i_new              )   ! new ice thickness formed in the leads 
     104      IF( iom_use('snwvolu'  ) )   CALL iom_put( "snwvolu", vt_s  * zmsksn        )   ! snow volume 
     105      IF( iom_use('icefrb') ) THEN 
    110106         z2d(:,:) = ( zrho1 * hm_i(:,:) - zrho2 * hm_s(:,:) )                                          
    111107         WHERE( z2d < 0._wp )   z2d = 0._wp 
    112                                   CALL iom_put( 'icefrb' , z2d * zmsk00         ) 
     108                                   CALL iom_put( "icefrb" , z2d * zmsk00          )   ! Ice freeboard 
    113109      ENDIF 
     110      ! 
    114111      ! melt ponds 
    115       IF( iom_use('iceapnd' ) )   CALL iom_put( 'iceapnd', at_ip  * zmsk00      )                                           ! melt pond total fraction 
    116       IF( iom_use('icevpnd' ) )   CALL iom_put( 'icevpnd', vt_ip  * zmsk00      )                                           ! melt pond total volume per unit area 
     112      IF( iom_use('iceapnd'  ) )   CALL iom_put( "iceapnd", at_ip  * zmsk00       )   ! melt pond total fraction 
     113      IF( iom_use('icevpnd'  ) )   CALL iom_put( "icevpnd", vt_ip  * zmsk00       )   ! melt pond total volume per unit area 
     114      ! 
    117115      ! salt 
    118       IF( iom_use('icesalt' ) )   CALL iom_put( 'icesalt', sm_i                 * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) ! mean ice salinity 
    119       IF( iom_use('icesalm' ) )   CALL iom_put( 'icesalm', st_i * rhoi * 1.0e-3 * zmsk00 )                                  ! Mass of salt in sea ice per cell area 
     116      IF( iom_use('icesalt'  ) )   CALL iom_put( "icesalt", sm_i  * zmsk00        )   ! mean ice salinity 
     117      IF( iom_use('icesalm'  ) )   CALL iom_put( "icesalm", SUM( sv_i, DIM = 3 ) * rhoi * 1.0e-3 * zmsk00 )   ! Mass of salt in sea ice per cell area 
     118 
    120119      ! heat 
    121       IF( iom_use('icetemp' ) )   CALL iom_put( 'icetemp', ( tm_i  - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! ice mean temperature 
    122       IF( iom_use('snwtemp' ) )   CALL iom_put( 'snwtemp', ( tm_s  - rt0 ) * zmsksn + zmiss_val * ( 1._wp - zmsksn ) )      ! snw mean temperature 
    123       IF( iom_use('icettop' ) )   CALL iom_put( 'icettop', ( tm_su - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the ice surface 
    124       IF( iom_use('icetbot' ) )   CALL iom_put( 'icetbot', ( t_bo  - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the ice bottom 
    125       IF( iom_use('icetsni' ) )   CALL iom_put( 'icetsni', ( tm_si - rt0 ) * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) )      ! temperature at the snow-ice interface 
    126       IF( iom_use('icehc'   ) )   CALL iom_put( 'icehc'  ,  -et_i          * zmsk00 )                                       ! ice heat content 
    127       IF( iom_use('snwhc'   ) )   CALL iom_put( 'snwhc'  ,  -et_s          * zmsksn )                                       ! snow heat content 
     120      IF( iom_use('icetemp'  ) )   CALL iom_put( "icetemp", ( tm_i  - rt0 ) * zmsk00 )   ! ice mean temperature 
     121      IF( iom_use('snwtemp'  ) )   CALL iom_put( "snwtemp", ( tm_s  - rt0 ) * zmsksn )   ! snw mean temperature 
     122      IF( iom_use('icettop'  ) )   CALL iom_put( "icettop", ( tm_su - rt0 ) * zmsk00 )   ! temperature at the ice surface 
     123      IF( iom_use('icetbot'  ) )   CALL iom_put( "icetbot", ( t_bo  - rt0 ) * zmsk00 )   ! temperature at the ice bottom 
     124      IF( iom_use('icetsni'  ) )   CALL iom_put( "icetsni", ( tm_si - rt0 ) * zmsk00 )   ! temperature at the snow-ice interface 
     125      IF( iom_use('icehc'    ) )   CALL iom_put( "icehc"  ,  -et_i          * zmsk00 )   ! ice heat content 
     126      IF( iom_use('snwhc'    ) )   CALL iom_put( "snwhc"  ,  -et_s          * zmsksn )   ! snow heat content 
     127 
    128128      ! momentum 
    129       IF( iom_use('uice'    ) )   CALL iom_put( 'uice'   , u_ice    )                                                       ! ice velocity u 
    130       IF( iom_use('vice'    ) )   CALL iom_put( 'vice'   , v_ice    )                                                       ! ice velocity v 
    131       ! 
    132       IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity 
     129      IF( iom_use('uice'     ) )   CALL iom_put( "uice"   , u_ice                 )   ! ice velocity u component 
     130      IF( iom_use('vice'     ) )   CALL iom_put( "vice"   , v_ice                 )   ! ice velocity v component 
     131      IF( iom_use('utau_ai'  ) )   CALL iom_put( "utau_ai", utau_ice * zmsk00     )   ! Wind stress term in force balance (x) 
     132      IF( iom_use('vtau_ai'  ) )   CALL iom_put( "vtau_ai", vtau_ice * zmsk00     )   ! Wind stress term in force balance (y) 
     133 
     134      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN  
     135        ! module of ice velocity 
    133136         DO jj = 2 , jpjm1 
    134137            DO ji = 2 , jpim1 
    135                z2da  = u_ice(ji,jj) + u_ice(ji-1,jj) 
    136                z2db  = v_ice(ji,jj) + v_ice(ji,jj-1) 
     138               z2da  = ( u_ice(ji,jj) + u_ice(ji-1,jj) ) 
     139               z2db  = ( v_ice(ji,jj) + v_ice(ji,jj-1) ) 
    137140               z2d(ji,jj) = 0.5_wp * SQRT( z2da * z2da + z2db * z2db ) 
    138141           END DO 
    139142         END DO 
    140143         CALL lbc_lnk( 'icewri', z2d, 'T', 1. ) 
    141          CALL iom_put( 'icevel', z2d ) 
    142  
    143          WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp                                      ! record presence of fast ice 
     144         IF( iom_use('icevel') )   CALL iom_put( "icevel" , z2d ) 
     145 
     146        ! record presence of fast ice 
     147         WHERE( z2d(:,:) < 5.e-04_wp .AND. zmsk15(:,:) == 1._wp ) ; zfast(:,:) = 1._wp 
    144148         ELSEWHERE                                                ; zfast(:,:) = 0._wp 
    145149         END WHERE 
    146          CALL iom_put( 'fasticepres', zfast ) 
     150         IF( iom_use('fasticepres') )   CALL iom_put( "fasticepres" , zfast ) 
    147151      ENDIF 
    148152 
    149153      ! --- category-dependent fields --- ! 
    150       IF( iom_use('icemask_cat' ) )   CALL iom_put( 'icemask_cat' ,                  zmsk00l                                   ) ! ice mask 0% 
    151       IF( iom_use('iceconc_cat' ) )   CALL iom_put( 'iceconc_cat' , a_i            * zmsk00l                                   ) ! area for categories 
    152       IF( iom_use('icethic_cat' ) )   CALL iom_put( 'icethic_cat' , h_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! thickness for categories 
    153       IF( iom_use('snwthic_cat' ) )   CALL iom_put( 'snwthic_cat' , h_s            * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow depth for categories 
    154       IF( iom_use('icesalt_cat' ) )   CALL iom_put( 'icesalt_cat' , s_i            * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! salinity for categories 
    155       IF( iom_use('iceage_cat'  ) )   CALL iom_put( 'iceage_cat'  , o_i / rday     * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice age 
    156       IF( iom_use('icetemp_cat' ) )   CALL iom_put( 'icetemp_cat' , ( SUM( t_i, dim=3 ) * r1_nlay_i - rt0 ) & 
    157          &                                                                         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! ice temperature 
    158       IF( iom_use('snwtemp_cat' ) )   CALL iom_put( 'snwtemp_cat' , ( SUM( t_s, dim=3 ) * r1_nlay_s - rt0 ) & 
    159          &                                                                         * zmsksnl + zmiss_val * ( 1._wp - zmsksnl ) ) ! snow temperature 
    160       IF( iom_use('icettop_cat' ) )   CALL iom_put( 'icettop_cat' , ( t_su - rt0 ) * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! surface temperature 
    161       IF( iom_use('icebrv_cat'  ) )   CALL iom_put( 'icebrv_cat'  ,   bv_i * 100.  * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! brine volume 
    162       IF( iom_use('iceapnd_cat' ) )   CALL iom_put( 'iceapnd_cat' ,   a_ip         * zmsk00l                                   ) ! melt pond frac for categories 
    163       IF( iom_use('icehpnd_cat' ) )   CALL iom_put( 'icehpnd_cat' ,   h_ip         * zmsk00l + zmiss_val * ( 1._wp - zmsk00l ) ) ! melt pond frac for categories 
    164       IF( iom_use('iceafpnd_cat') )   CALL iom_put( 'iceafpnd_cat',   a_ip_frac    * zmsk00l                                   ) ! melt pond frac for categories 
     154      IF( iom_use('icemask_cat' ) )   CALL iom_put( "icemask_cat" , zmsk00l                                                    )   ! ice mask 0% 
     155      IF( iom_use('iceconc_cat' ) )   CALL iom_put( "iceconc_cat" , a_i * zmsk00l                                              )   ! area for categories 
     156      IF( iom_use('icethic_cat' ) )   CALL iom_put( "icethic_cat" , h_i * zmsk00l                                              )   ! thickness for categories 
     157      IF( iom_use('snwthic_cat' ) )   CALL iom_put( "snwthic_cat" , h_s * zmsksnl                                              )   ! snow depth for categories 
     158      IF( iom_use('icesalt_cat' ) )   CALL iom_put( "icesalt_cat" , s_i * zmsk00l                                              )   ! salinity for categories 
     159      IF( iom_use('iceage_cat'  ) )   CALL iom_put( "iceage_cat"  , o_i * zmsk00l / rday                                       )   ! ice age 
     160      IF( iom_use('icetemp_cat' ) )   CALL iom_put( "icetemp_cat" , ( SUM( t_i(:,:,:,:), dim=3 ) * r1_nlay_i - rt0 ) * zmsk00l )   ! ice temperature 
     161      IF( iom_use('snwtemp_cat' ) )   CALL iom_put( "snwtemp_cat" , ( SUM( t_s(:,:,:,:), dim=3 ) * r1_nlay_s - rt0 ) * zmsksnl )   ! snow temperature 
     162      IF( iom_use('icettop_cat' ) )   CALL iom_put( "icettop_cat" , ( t_su - rt0 ) * zmsk00l                                   )   ! surface temperature 
     163      IF( iom_use('icebrv_cat'  ) )   CALL iom_put( "icebrv_cat"  ,   bv_i * 100.  * zmsk00l                                   )   ! brine volume 
     164      IF( iom_use('iceapnd_cat' ) )   CALL iom_put( "iceapnd_cat" ,   a_ip         * zmsk00l                                   )   ! melt pond frac for categories 
     165      IF( iom_use('icehpnd_cat' ) )   CALL iom_put( "icehpnd_cat" ,   h_ip         * zmsk00l                                   )   ! melt pond frac for categories 
     166      IF( iom_use('iceafpnd_cat') )   CALL iom_put( "iceafpnd_cat",   a_ip_frac    * zmsk00l                                   )   ! melt pond frac for categories 
    165167 
    166168      !------------------ 
     
    168170      !------------------ 
    169171      ! trends 
    170       IF( iom_use('dmithd') )   CALL iom_put( 'dmithd', - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics 
    171       IF( iom_use('dmidyn') )   CALL iom_put( 'dmidyn', - wfx_dyn + rhoi * diag_trp_vi                                        ) ! Sea-ice mass change from dynamics(kg/m2/s) 
    172       IF( iom_use('dmiopw') )   CALL iom_put( 'dmiopw', - wfx_opw                                                             ) ! Sea-ice mass change through growth in open water 
    173       IF( iom_use('dmibog') )   CALL iom_put( 'dmibog', - wfx_bog                                                             ) ! Sea-ice mass change through basal growth 
    174       IF( iom_use('dmisni') )   CALL iom_put( 'dmisni', - wfx_sni                                                             ) ! Sea-ice mass change through snow-to-ice conversion 
    175       IF( iom_use('dmisum') )   CALL iom_put( 'dmisum', - wfx_sum                                                             ) ! Sea-ice mass change through surface melting 
    176       IF( iom_use('dmibom') )   CALL iom_put( 'dmibom', - wfx_bom                                                             ) ! Sea-ice mass change through bottom melting 
    177       IF( iom_use('dmtsub') )   CALL iom_put( 'dmtsub', - wfx_sub                                                             ) ! Sea-ice mass change through evaporation and sublimation 
    178       IF( iom_use('dmssub') )   CALL iom_put( 'dmssub', - wfx_snw_sub                                                         ) ! Snow mass change through sublimation 
    179       IF( iom_use('dmisub') )   CALL iom_put( 'dmisub', - wfx_ice_sub                                                         ) ! Sea-ice mass change through sublimation 
    180       IF( iom_use('dmsspr') )   CALL iom_put( 'dmsspr', - wfx_spr                                                             ) ! Snow mass change through snow fall 
    181       IF( iom_use('dmsssi') )   CALL iom_put( 'dmsssi',   wfx_sni*rhos*r1_rhoi                                                ) ! Snow mass change through snow-to-ice conversion 
    182       IF( iom_use('dmsmel') )   CALL iom_put( 'dmsmel', - wfx_snw_sum                                                         ) ! Snow mass change through melt 
    183       IF( iom_use('dmsdyn') )   CALL iom_put( 'dmsdyn', - wfx_snw_dyn + rhos * diag_trp_vs                                    ) ! Snow mass change through dynamics(kg/m2/s) 
    184        
     172      IF( iom_use('dmithd') )   CALL iom_put( "dmithd", - wfx_bog - wfx_bom - wfx_sum - wfx_sni - wfx_opw - wfx_lam - wfx_res ) ! Sea-ice mass change from thermodynamics 
     173      IF( iom_use('dmidyn') )   CALL iom_put( "dmidyn", - wfx_dyn + rhoi * diag_trp_vi      )  ! Sea-ice mass change from dynamics(kg/m2/s) 
     174      IF( iom_use('dmiopw') )   CALL iom_put( "dmiopw", - wfx_opw                           )  ! Sea-ice mass change through growth in open water 
     175      IF( iom_use('dmibog') )   CALL iom_put( "dmibog", - wfx_bog                           )  ! Sea-ice mass change through basal growth 
     176      IF( iom_use('dmisni') )   CALL iom_put( "dmisni", - wfx_sni                           )  ! Sea-ice mass change through snow-to-ice conversion 
     177      IF( iom_use('dmisum') )   CALL iom_put( "dmisum", - wfx_sum                           )  ! Sea-ice mass change through surface melting 
     178      IF( iom_use('dmibom') )   CALL iom_put( "dmibom", - wfx_bom                           )  ! Sea-ice mass change through bottom melting 
     179      IF( iom_use('dmtsub') )   CALL iom_put( "dmtsub", - wfx_sub                           )  ! Sea-ice mass change through evaporation and sublimation 
     180      IF( iom_use('dmssub') )   CALL iom_put( "dmssub", - wfx_snw_sub                       )  ! Snow mass change through sublimation 
     181      IF( iom_use('dmisub') )   CALL iom_put( "dmisub", - wfx_ice_sub                       )  ! Sea-ice mass change through sublimation 
     182      IF( iom_use('dmsspr') )   CALL iom_put( "dmsspr", - wfx_spr                           )  ! Snow mass change through snow fall 
     183      IF( iom_use('dmsssi') )   CALL iom_put( "dmsssi",   wfx_sni*rhos*r1_rhoi              )  ! Snow mass change through snow-to-ice conversion 
     184      IF( iom_use('dmsmel') )   CALL iom_put( "dmsmel", - wfx_snw_sum                       )  ! Snow mass change through melt 
     185      IF( iom_use('dmsdyn') )   CALL iom_put( "dmsdyn", - wfx_snw_dyn + rhos * diag_trp_vs  )  ! Snow mass change through dynamics(kg/m2/s) 
     186 
    185187      ! Global ice diagnostics 
    186       IF(  iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') .OR. & 
    187          & iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') ) THEN 
    188          ! 
    189          WHERE( ff_t(:,:) > 0._wp )   ;   z2d(:,:) = 1._wp 
    190          ELSEWHERE                    ;   z2d(:,:) = 0. 
    191          END WHERE 
    192          ! 
    193          IF( iom_use('NH_icearea') )   zdiag_area_nh = glob_sum( 'icewri', at_i *           z2d   * e1e2t * 1.e-12 ) 
    194          IF( iom_use('NH_icevolu') )   zdiag_volu_nh = glob_sum( 'icewri', vt_i *           z2d   * e1e2t * 1.e-12 ) 
    195          IF( iom_use('NH_iceextt') )   zdiag_extt_nh = glob_sum( 'icewri',                  z2d   * e1e2t * 1.e-12 * zmsk15 ) 
    196          ! 
    197          IF( iom_use('SH_icearea') )   zdiag_area_sh = glob_sum( 'icewri', at_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 
    198          IF( iom_use('SH_icevolu') )   zdiag_volu_sh = glob_sum( 'icewri', vt_i * ( 1._wp - z2d ) * e1e2t * 1.e-12 ) 
    199          IF( iom_use('SH_iceextt') )   zdiag_extt_sh = glob_sum( 'icewri',        ( 1._wp - z2d ) * e1e2t * 1.e-12 * zmsk15 ) 
    200          ! 
    201          CALL iom_put( 'NH_icearea' , zdiag_area_nh ) 
    202          CALL iom_put( 'NH_icevolu' , zdiag_volu_nh ) 
    203          CALL iom_put( 'NH_iceextt' , zdiag_extt_nh ) 
    204          CALL iom_put( 'SH_icearea' , zdiag_area_sh ) 
    205          CALL iom_put( 'SH_icevolu' , zdiag_volu_sh ) 
    206          CALL iom_put( 'SH_iceextt' , zdiag_extt_sh ) 
     188      IF( iom_use('NH_icearea') .OR. iom_use('NH_icevolu') .OR. iom_use('NH_iceextt') )   THEN   ! NH diagnostics 
     189         ! 
     190         WHERE( ff_t > 0._wp )   ;   zmsk00(:,:) = 1.0e-12 
     191         ELSEWHERE               ;   zmsk00(:,:) = 0. 
     192         END WHERE  
     193         zdiag_area_nh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 
     194         zdiag_volu_nh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 
     195         ! 
     196         WHERE( ff_t > 0._wp .AND. at_i > 0.15 )   ; zmsk00(:,:) = 1.0e-12 
     197         ELSEWHERE                                 ; zmsk00(:,:) = 0. 
     198         END WHERE  
     199         zdiag_extt_nh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) ) 
     200         ! 
     201         IF( iom_use('NH_icearea') )   CALL iom_put( "NH_icearea" ,  zdiag_area_nh ) 
     202         IF( iom_use('NH_icevolu') )   CALL iom_put( "NH_icevolu" ,  zdiag_volu_nh ) 
     203         IF( iom_use('NH_iceextt') )   CALL iom_put( "NH_iceextt" ,  zdiag_extt_nh ) 
    207204         ! 
    208205      ENDIF 
     206      ! 
     207      IF( iom_use('SH_icearea') .OR. iom_use('SH_icevolu') .OR. iom_use('SH_iceextt') )   THEN   ! SH diagnostics 
     208         ! 
     209         WHERE( ff_t < 0._wp ); zmsk00(:,:) = 1.0e-12;  
     210         ELSEWHERE            ; zmsk00(:,:) = 0. 
     211         END WHERE  
     212         zdiag_area_sh = glob_sum( 'icewri', at_i(:,:) * zmsk00(:,:) * e1e2t(:,:) )  
     213         zdiag_volu_sh = glob_sum( 'icewri', vt_i(:,:) * zmsk00(:,:) * e1e2t(:,:) ) 
     214         ! 
     215         WHERE( ff_t < 0._wp .AND. at_i > 0.15 ); zmsk00(:,:) = 1.0e-12 
     216         ELSEWHERE                              ; zmsk00(:,:) = 0. 
     217         END WHERE  
     218         zdiag_extt_sh = glob_sum( 'icewri', zmsk00(:,:) * e1e2t(:,:) ) 
     219         ! 
     220         IF( iom_use('SH_icearea') ) CALL iom_put( "SH_icearea", zdiag_area_sh ) 
     221         IF( iom_use('SH_icevolu') ) CALL iom_put( "SH_icevolu", zdiag_volu_sh ) 
     222         IF( iom_use('SH_iceextt') ) CALL iom_put( "SH_iceextt", zdiag_extt_sh ) 
     223         ! 
     224      ENDIF  
    209225      ! 
    210226!!CR      !     !  Create an output files (output.lim.abort.nc) if S < 0 or u > 20 m/s 
    211227!!CR      !     IF( kindic < 0 )   CALL ice_wri_state( 'output.abort' ) 
    212228!!CR      !     not yet implemented 
    213 !!gm  idem for the ocean...  Ask Seb how to get rid of ioipsl.... 
     229!!gm  idem for the ocean...  Ask Seb how to get read of ioipsl.... 
    214230      ! 
    215231      IF( ln_timing )  CALL timing_stop('icewri') 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdy_oce.F90

    r11223 r11380  
    1515   IMPLICIT NONE 
    1616   PUBLIC 
     17 
    1718 
    1819   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
     
    122123                                                                          !: =1 => some data to be read in from data files 
    123124!$AGRIF_DO_NOT_TREAT 
    124    TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    125    TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
     125   ! regular :  interior domain + global halo || extended : interior domain + global halo + halo extension for time-splitting 
     126   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy_reg, idx_bdy_xtd    !: bdy indices (local process) 
     127   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy_reg, dta_bdy_xtd    !: bdy external data (local process) 
     128   ! pointers to switch between regular and extended, _save for the OBC_INDEX not currently used 
     129   TYPE(OBC_INDEX), DIMENSION(:)     , POINTER     ::   idx_bdy, idx_bdy_save       !: bdy indices (local process) 
     130   TYPE(OBC_DATA) , DIMENSION(:)     , POINTER     ::   dta_bdy, dta_bdy_save       !: bdy external data (local process) 
    126131!$AGRIF_END_DO_NOT_TREAT 
    127    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdy      !: mark needed communication for given boundary, grid and neighbour 
    128    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdy      !:  when searching in any direction 
    129    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyint   !: mark needed communication for given boundary, grid and neighbour 
    130    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyint   !:  when searching towards the interior of the computational domain 
    131    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lsend_bdyext   !: mark needed communication for given boundary, grid and neighbour 
    132    LOGICAL, ALLOCATABLE, DIMENSION(:,:,:,:) ::   lrecv_bdyext   !:  when searching towards the exterior of the computational domain 
     132   ! regular :  interior domain + global halo 
     133   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_reg      !: mark com for given boundary, grid, neighbour and rim 
     134   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_reg      !:  when searching in any direction 
     135   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_reg   !: mark com for given boundary, grid, neighbour and rim 
     136   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_reg   !:  when searching towards the interior of the domain 
     137   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_reg   !: mark com for given boundary, grid, neighbour and rim 
     138   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_reg   !:  when searching towards the exterior of the domain 
     139   ! extended : interior domain + global halo + halo extension for time-splitting 
     140   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdy_xtd      !: mark com for given boundary, grid, neighbour and rim 
     141   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdy_xtd      !:  when searching in any direction 
     142   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyint_xtd   !: mark com for given boundary, grid, neighbour and rim 
     143   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyint_xtd   !:  when searching towards the interior of the domain 
     144   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lsend_bdyext_xtd   !: mark com for given boundary, grid, neighbour and rim 
     145   LOGICAL, ALLOCATABLE, TARGET, DIMENSION(:,:,:,:) :: lrecv_bdyext_xtd   !:  when searching towards the exterior of the domain 
     146   ! pointers to switch between regular and extended, _save for the logical array not currently used 
     147   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdy   , lsend_bdy_save 
     148   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdy   , lrecv_bdy_save 
     149   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyint, lsend_bdyint_save 
     150   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyint, lrecv_bdyint_save 
     151   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lsend_bdyext, lsend_bdyext_save 
     152   LOGICAL,             POINTER, DIMENSION(:,:,:,:) :: lrecv_bdyext, lrecv_bdyext_save 
    133153   !!---------------------------------------------------------------------- 
    134154   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    158178   END FUNCTION bdy_oce_alloc 
    159179 
     180 
     181   SUBROUTINE swap_bdyptr 
     182      !!---------------------------------------------------------------------- 
     183      !!                 ***  ROUTINE  swap_bdyptr  *** 
     184      !!          
     185      !! ** Purpose :   swap all pointers for bdy treatment 
     186      !!---------------------------------------------------------------------- 
     187      CALL swap_obciptr(idx_bdy     , idx_bdy_save     ) 
     188      CALL swap_obcdptr(dta_bdy     , dta_bdy_save     ) 
     189      CALL swap_lptr   (lsend_bdy   , lsend_bdy_save   ) 
     190      CALL swap_lptr   (lrecv_bdy   , lrecv_bdy_save   ) 
     191      CALL swap_lptr   (lsend_bdyint, lsend_bdyint_save) 
     192      CALL swap_lptr   (lrecv_bdyint, lrecv_bdyint_save) 
     193      CALL swap_lptr   (lsend_bdyext, lsend_bdyext_save) 
     194      CALL swap_lptr   (lrecv_bdyext, lrecv_bdyext_save) 
     195      ! 
     196   END SUBROUTINE swap_bdyptr 
     197 
     198 
     199   SUBROUTINE swap_lptr( ptr1, ptr2 ) 
     200      !!---------------------------------------------------------------------- 
     201      !!                 ***  ROUTINE swap_lptr  *** 
     202      !!          
     203      !! ** Purpose :   swap logical pointers 
     204      !! ** Method  :   use temporary pointer to save the target 
     205      !!----------------------------------------------------------------------       
     206      LOGICAL, DIMENSION(:,:,:,:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     207      LOGICAL, DIMENSION(:,:,:,:), POINTER                  :: ptrtmp 
     208      !!---------------------------------------------------------------------- 
     209      ptrtmp => ptr1 
     210      ptr1 => ptr2 
     211      ptr2 => ptrtmp 
     212   END SUBROUTINE swap_lptr 
     213 
     214 
     215   SUBROUTINE swap_obciptr( ptr1, ptr2 ) 
     216      !!---------------------------------------------------------------------- 
     217      !!                 ***  ROUTINE swap_obciptr  *** 
     218      !!          
     219      !! ** Purpose :   swap pointers on OBC_INDEX types 
     220      !! ** Method  :   use temporary pointer to save the target 
     221      !!----------------------------------------------------------------------       
     222      TYPE(OBC_INDEX), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     223      TYPE(OBC_INDEX), DIMENSION(:), POINTER                  :: ptrtmp 
     224      !!---------------------------------------------------------------------- 
     225      ptrtmp => ptr1 
     226      ptr1 => ptr2 
     227      ptr2 => ptrtmp 
     228   END SUBROUTINE swap_obciptr 
     229 
     230 
     231   SUBROUTINE swap_obcdptr( ptr1, ptr2 ) 
     232      !!---------------------------------------------------------------------- 
     233      !!                 ***  ROUTINE swap_obcdptr  *** 
     234      !!          
     235      !! ** Purpose :   swap pointers on OBC_DATA types 
     236      !! ** Method  :   use temporary pointer to save the target 
     237      !!----------------------------------------------------------------------       
     238      TYPE(OBC_DATA), DIMENSION(:), POINTER, INTENT(inout)   :: ptr1, ptr2 
     239      TYPE(OBC_DATA), DIMENSION(:), POINTER                  :: ptrtmp 
     240      !!---------------------------------------------------------------------- 
     241      ptrtmp => ptr1 
     242      ptr1 => ptr2 
     243      ptr2 => ptrtmp 
     244   END SUBROUTINE swap_obcdptr 
     245 
    160246   !!====================================================================== 
    161247END MODULE bdy_oce 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn.F90

    r10068 r11380  
    9797      !------------------------------------------------------- 
    9898 
    99       IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha ) 
     99      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, pua2d, pva2d, ub_b, vb_b, r1_hu_a(:,:), r1_hv_a(:,:), ssha, 1, jpi, 1, jpj ) 
    100100 
    101101      IF( ll_dyn3d )   CALL bdy_dyn3d( kt ) 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn2d.F90

    r11258 r11380  
    3636CONTAINS 
    3737 
    38    SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh  ) 
     38   SUBROUTINE bdy_dyn2d( kt, pua2d, pva2d, pub2d, pvb2d, phur, phvr, pssh           & 
     39        &              , kdbi, kdei, kdbj, kdej, ldcomall, pumask, pvmask, khlcom   ) 
    3940      !!---------------------------------------------------------------------- 
    4041      !!                  ***  SUBROUTINE bdy_dyn2d  *** 
     
    4344      !! 
    4445      !!---------------------------------------------------------------------- 
    45       INTEGER,                      INTENT(in) ::   kt   ! Main time step counter 
    46       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
    47       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pub2d, pvb2d 
    48       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phur, phvr 
    49       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pssh 
     46      INTEGER,                                            INTENT(in   ) ::   kt   ! Main time step counter 
     47      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d  
     48      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pub2d, pvb2d 
     49      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   phur, phvr 
     50      REAL(wp),           DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pssh 
     51      INTEGER ,                                           INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array 
     52      LOGICAL , OPTIONAL,                                 INTENT(in   ) ::   ldcomall   ! communicate with all neighbours 
     53      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pumask  ! optional mask for extended domain 
     54      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pvmask  !     -     -  
     55      INTEGER , OPTIONAL,                                 INTENT(in   ) ::   khlcom  ! number of halos to communicate 
    5056      !! 
    5157      INTEGER  ::   ib_bdy, ir     ! BDY set index, rim index 
     
    6470               CYCLE 
    6571            CASE('frs')   ! treat the whole boundary at once 
    66                IF( llrim0 )   CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d ) 
     72               IF( llrim0 )   CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d,   & 
     73                    & kdbi, kdei, kdbj, kdej, pumask=pumask, pvmask=pvmask ) 
    6774            CASE('flather') 
    68                CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 ) 
     75               CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0,   & 
     76                    & kdbi, kdei, kdbj, kdej ) 
    6977            CASE('orlanski') 
    7078               CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
    71                     & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.false. ) 
     79                    & pua2d, pva2d, pub2d, pvb2d, .false., llrim0, kdbi, kdei, kdbj, kdej ) 
    7280            CASE('orlanski_npo') 
    7381               CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, & 
    74                     & pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo=.true.  ) 
     82                    & pua2d, pva2d, pub2d, pvb2d, .true. , llrim0, kdbi, kdei, kdbj, kdej  ) 
    7583            CASE DEFAULT 
    7684               CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
    7785            END SELECT 
    78          ENDDO 
     86         END DO 
    7987         ! 
    8088         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
     
    101109            END SELECT 
    102110         END DO 
     111         IF( PRESENT(ldcomall) ) THEN 
     112            IF( ldcomall ) THEN   ! if ldcomall is present and true   then communicate with all neighbours 
     113               CALL lbc_lnk_multi( 'bdydyn2d',  pua2d, 'U',  1.,  pva2d, 'V',  1., kfillmode=jpfillnothing, khlcom=khlcom ) 
     114               CYCLE 
     115            END IF 
     116         END IF 
    103117         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    104             CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     118            CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1., kfillmode=jpfillnothing ,ldsend=llsend2, ldrecv=llrecv2, khlcom=khlcom ) 
    105119         END IF 
    106120         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    107             CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     121            CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1., kfillmode=jpfillnothing ,ldsend=llsend3, ldrecv=llrecv3, khlcom=khlcom ) 
    108122         END IF 
    109123         ! 
     
    112126   END SUBROUTINE bdy_dyn2d 
    113127 
    114    SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d ) 
     128   SUBROUTINE bdy_dyn2d_frs( idx, dta, ib_bdy, pua2d, pva2d, kdbi, kdei, kdbj, kdej, pumask, pvmask ) 
    115129      !!---------------------------------------------------------------------- 
    116130      !!                  ***  SUBROUTINE bdy_dyn2d_frs  *** 
     
    123137      !!               topography. Tellus, 365-382. 
    124138      !!---------------------------------------------------------------------- 
    125       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    126       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    127       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    128       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d  
     139      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx  ! OBC indices 
     140      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta  ! OBC external data 
     141      INTEGER,                                  INTENT(in   ) ::   ib_bdy  ! BDY set index 
     142      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d 
     143      INTEGER ,                                                     INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array 
     144      REAL(wp), OPTIONAL, TARGET, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in   ) ::   pumask  ! optional mask for extended domain 
     145      REAL(wp), OPTIONAL, TARGET, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in   ) ::   pvmask  !     -     -  
    129146      !! 
    130147      INTEGER  ::   jb             ! dummy loop indices 
    131148      INTEGER  ::   ii, ij, igrd   ! local integers 
    132149      REAL(wp) ::   zwgt           ! boundary weight 
     150      REAL(wp), POINTER, DIMENSION(:,:,:)      :: pmask         ! land/sea mask for field 
    133151      !!---------------------------------------------------------------------- 
    134152      ! 
    135153      igrd = 2                      ! Relaxation of zonal velocity 
     154      IF( PRESENT(pumask) ) THEN   ;   pmask => pumask 
     155      ELSE                         ;   pmask => umask 
     156      END IF 
    136157      DO jb = 1, idx%nblen(igrd) 
    137158         ii   = idx%nbi(jb,igrd) 
    138159         ij   = idx%nbj(jb,igrd) 
    139160         zwgt = idx%nbw(jb,igrd) 
    140          pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
     161         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * pmask(ii,ij,1) 
    141162      END DO 
    142163      ! 
    143164      igrd = 3                      ! Relaxation of meridional velocity 
     165      IF( PRESENT(pvmask) ) THEN   ;   pmask => pvmask 
     166      ELSE                         ;   pmask => vmask 
     167      END IF 
    144168      DO jb = 1, idx%nblen(igrd) 
    145169         ii   = idx%nbi(jb,igrd) 
    146170         ij   = idx%nbj(jb,igrd) 
    147171         zwgt = idx%nbw(jb,igrd) 
    148          pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
     172         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * pmask(ii,ij,1) 
    149173      END DO  
    150174      ! 
     
    152176 
    153177 
    154    SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr, llrim0 ) 
     178   SUBROUTINE bdy_dyn2d_fla( idx, dta, ib_bdy, pua2d, pva2d, pssh, phur, phvr, ldrim0   & 
     179        &                  , kdbi, kdei, kdbj, kdej   ) 
    155180      !!---------------------------------------------------------------------- 
    156181      !!                 ***  SUBROUTINE bdy_dyn2d_fla  *** 
     
    171196      !!              continental shelf. Mem. Soc. R. Sci. Liege, Ser. 6,10, 141-164.      
    172197      !!---------------------------------------------------------------------- 
    173       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    174       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    175       INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
    176       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
    177       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh, phur, phvr 
    178       LOGICAL                     , INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
     198      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx  ! OBC indices 
     199      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta  ! OBC external data 
     200      INTEGER,                                  INTENT(in   ) ::   ib_bdy  ! BDY set index 
     201      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d 
     202      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pssh, phur, phvr 
     203      LOGICAL                                 , INTENT(in   ) ::   ldrim0   ! indicate if rim 0 is treated 
     204      INTEGER ,                                 INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array 
     205      !! 
    179206      INTEGER  ::   ibeg, iend                       ! length of rim to be treated (rim 0 or rim 1) 
    180207      INTEGER  ::   jb, igrd                         ! dummy loop indices 
     
    185212      REAL(wp) ::   zfla                             ! Flather correction 
    186213      REAL(wp) ::   z1_2                             !  
    187       REAL(wp), DIMENSION(jpi,jpj) ::   sshdta       ! 2D version of dta%ssh 
     214      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej) ::   sshdta       ! 2D version of dta%ssh 
    188215      !!---------------------------------------------------------------------- 
    189216 
     
    196223      ! Fill temporary array with ssh data (here we use spgu with the alias sshdta): 
    197224      igrd = 1 
    198       IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     225      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
    199226      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
    200227      END IF 
     
    211238      !             ! remember that flagu=-1 if normal velocity direction is outward 
    212239      !             ! I think we should rather use after ssh ? 
    213       IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     240      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
    214241      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
    215242      END IF 
     
    225252            ! 
    226253            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received 
    227             IF( iiTrim > jpi .OR. iiToce > jpi .OR. iiUoce > jpi .OR. iiUoce < 1 )   CYCLE    
     254            IF( iiTrim > kdei .OR. iiToce > kdei .OR. iiUoce > kdei .OR. iiUoce < kdbi )   CYCLE    
    228255            ! 
    229256            zfla = dta%u2d(jb) - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iiToce,ij) - sshdta(iiTrim,ij) ) 
     
    237264      igrd = 3      ! Flather bc on v-velocity 
    238265      !             ! remember that flagv=-1 if normal velocity direction is outward 
    239       IF( llrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
     266      IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd) 
    240267      ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd) 
    241268      END IF 
     
    251278            ! 
    252279            ! Rare case : rim is parallel to the mpi subdomain border and on the halo : point will be received 
    253             IF( ijTrim > jpj .OR. ijToce > jpj .OR. ijVoce > jpj .OR. ijVoce < 1 )   CYCLE 
     280            IF( ijTrim > kdej .OR. ijToce > kdej .OR. ijVoce > kdej .OR. ijVoce < kdbj )   CYCLE 
    254281            ! 
    255282            zfla = dta%v2d(jb) - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii,ijToce) - sshdta(ii,ijTrim) ) 
     
    264291 
    265292 
    266    SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, llrim0, ll_npo ) 
     293   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, pua2d, pva2d, pub2d, pvb2d, ld_npo, ldrim0, kdbi, kdei, kdbj, kdej ) 
    267294      !!---------------------------------------------------------------------- 
    268295      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
     
    275302      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    276303      !!---------------------------------------------------------------------- 
    277       TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    278       TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    279       INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
    280       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pua2d, pva2d 
    281       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pub2d, pvb2d  
    282       LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
    283       LOGICAL,                      INTENT(in) ::   llrim0   ! indicate if rim 0 is treated 
    284       INTEGER  ::   ib, igrd                               ! dummy loop indices 
    285       INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices 
     304      TYPE(OBC_INDEX),                          INTENT(in   ) ::   idx      ! OBC indices 
     305      TYPE(OBC_DATA),                           INTENT(in   ) ::   dta      ! OBC external data 
     306      INTEGER,                                  INTENT(in   ) ::   ib_bdy   ! number of current open boundary set 
     307      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(inout) ::   pua2d, pva2d 
     308      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej), INTENT(in   ) ::   pub2d, pvb2d  
     309      LOGICAL,                                  INTENT(in   ) ::   ld_npo   ! flag for NPO version 
     310      LOGICAL,                                  INTENT(in   ) ::   ldrim0   ! indicate if rim 0 is treated 
     311      INTEGER ,                                 INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of array 
     312      INTEGER  ::   ib, igrd               ! dummy loop indices 
     313      INTEGER  ::   ii, ij, iibm1, ijbm1   ! indices 
    286314      !!---------------------------------------------------------------------- 
    287315      ! 
    288316      igrd = 2      ! Orlanski bc on u-velocity;  
    289317      !             
    290       CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, llrim0, ll_npo ) 
     318      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ldrim0, ld_npo ) 
    291319 
    292320      igrd = 3      ! Orlanski bc on v-velocity 
    293321      !   
    294       CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, llrim0, ll_npo ) 
     322      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ldrim0, ld_npo ) 
    295323      ! 
    296324   END SUBROUTINE bdy_dyn2d_orlanski 
    297325 
    298326 
    299    SUBROUTINE bdy_ssh( zssh ) 
     327   SUBROUTINE bdy_ssh( zssh, kdbi, kdei, kdbj, kdej, ldcomall, pmask, khlcom ) 
    300328      !!---------------------------------------------------------------------- 
    301329      !!                  ***  SUBROUTINE bdy_ssh  *** 
     
    304332      !! 
    305333      !!---------------------------------------------------------------------- 
    306       REAL(wp), DIMENSION(jpi,jpj,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
     334      REAL(wp), DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(inout) ::   zssh ! Sea level, need 3 dimensions to be used by bdy_nmn 
     335      INTEGER ,                                   INTENT(in   ) ::   kdbi, kdei, kdbj, kdej   ! size of ssh array 
     336      LOGICAL , OPTIONAL,                         INTENT(in   ) ::   ldcomall   ! communicate with all neighbours 
     337      REAL(wp), OPTIONAL, DIMENSION(kdbi:kdei,kdbj:kdej,1), INTENT(in)  ::   pmask  ! optional mask for extended domain 
     338      INTEGER , OPTIONAL,                                   INTENT(in)  ::   khlcom  ! number of halos to communicate 
    307339      !! 
    308340      INTEGER ::   ib_bdy, ir      ! bdy index, rim index 
    309341      INTEGER ::   ibeg, iend      ! length of rim to be treated (rim 0 or rim 1) 
     342      INTEGER ::   ihl             ! thickness of halo 
    310343      LOGICAL ::   llrim0          ! indicate if rim 0 is treated 
    311344      LOGICAL, DIMENSION(4) :: llsend1, llrecv1  ! indicate how communications are to be carried out 
    312345      !!---------------------------------------------------------------------- 
    313346      llsend1(:) = .false.   ;   llrecv1(:) = .false. 
     347      ! 
    314348      DO ir = 1, 0, -1   ! treat rim 1 before rim 0 
    315349         IF( nn_hls == 1 ) THEN   ;   llsend1(:) = .false.   ;   llrecv1(:) = .false.   ;   END IF 
     
    318352         END IF 
    319353         DO ib_bdy = 1, nb_bdy 
    320             CALL bdy_nmn( idx_bdy(ib_bdy), 1, zssh, llrim0 )   ! zssh is masked 
     354            CALL bdy_nmn( idx_bdy(ib_bdy), 1, kdbi, kdei, kdbj, kdej, 1, zssh, ldrim0=llrim0, pmask=pmask )   ! zssh is masked 
    321355            llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    322356            llrecv1(:) = llrecv1(:) .OR. lrecv_bdyint(ib_bdy,1,:,ir)   ! possibly every direction, T points 
    323357         END DO 
    324358         IF( nn_hls > 1 .AND. ir == 1 ) CYCLE   ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 
    325          IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    326             CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     359                                                ! N.B. ihl>1 is not enough as values are usually wrong on extended domain 
     360         IF( PRESENT(ldcomall) ) THEN 
     361            IF( ldcomall ) THEN   ! if ldcomall is present and true 
     362               CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., kfillmode=jpfillnothing, khlcom=khlcom )   ! com with all neighbours 
     363            END IF 
     364         ELSEIF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
     365            CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1., kfillmode=jpfillnothing, ldsend=llsend1, ldrecv=llrecv1, khlcom=khlcom ) 
    327366         END IF 
    328367      END DO 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdydyn3d.F90

    r11234 r11380  
    9797         ! 
    9898         IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    99             CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     99            CALL lbc_lnk( 'bdydyn2d', ua, 'U', -1., kfillmode=jpfillnothing, ldsend=llsend2, ldrecv=llrecv2 ) 
    100100         END IF 
    101101         IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    102             CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     102            CALL lbc_lnk( 'bdydyn2d', va, 'V', -1., kfillmode=jpfillnothing, ldsend=llsend3, ldrecv=llrecv3 ) 
    103103         END IF 
    104104      END DO   ! ir 
     
    387387      igrd = 2      ! Neumann bc on u-velocity;  
    388388      !             
    389       CALL bdy_nmn( idx, igrd, ua, llrim0 )   ! ua is masked 
     389      CALL bdy_nmn( idx, igrd, 1, jpi, 1, jpj, 1, ua, llrim0 )   ! ua is masked 
    390390 
    391391      igrd = 3      ! Neumann bc on v-velocity 
    392392      !   
    393       CALL bdy_nmn( idx, igrd, va, llrim0 )   ! va is masked 
     393      CALL bdy_nmn( idx, igrd, 1, jpi, 1, jpj, 1, va, llrim0 )   ! va is masked 
    394394      ! 
    395395   END SUBROUTINE bdy_dyn3d_nmn 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyice.F90

    r11210 r11380  
    9696                 &                      , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1. & 
    9797                 &                      , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.                & 
    98                  &                      , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1      ) 
     98                 &                      , kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1    ) 
    9999            ! exchange 4d arrays :   third dimension = 1   and then   third dimension = jpk 
    100             CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
    101             CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     100            CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 ) 
     101            CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 ) 
    102102         END IF 
    103103      END DO   ! ir 
     
    418418            END DO 
    419419            IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN   ! if need to send/recv in at least one direction 
    420                CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 
     420               CALL lbc_lnk( 'bdyice', u_ice, 'U', -1., kfillmode=jpfillnothing ,ldsend=llsend2, ldrecv=llrecv2 ) 
    421421            END IF 
    422422         CASE ( 'V' ) 
     
    432432            END DO 
    433433            IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN   ! if need to send/recv in at least one direction 
    434                CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 
     434               CALL lbc_lnk( 'bdyice', v_ice, 'V', -1., kfillmode=jpfillnothing ,ldsend=llsend3, ldrecv=llrecv3 ) 
    435435            END IF 
    436436         END SELECT 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdyini.F90

    r11356 r11380  
    3737 
    3838   INTEGER, PARAMETER ::   jp_nseg = 100   !  
     39   INTEGER  ::   ihl                                    ! number of halos to be communicated 
    3940   ! Straight open boundary segment parameters: 
    4041   INTEGER  ::   nbdysege, nbdysegw, nbdysegn, nbdysegs  
     
    7071         &             ln_vol, nn_volctl, nn_rimwidth 
    7172         ! 
    72       INTEGER  ::   ios                 ! Local integer output status for namelist read 
     73      INTEGER  ::   ios                     ! Local integer output status for namelist read 
     74      INTEGER  :: idbi, idbj, idei, idej    ! start/end of the subdomain for extended and regular bdy treatment 
    7375      !!---------------------------------------------------------------------- 
    7476 
     
    105107 
    106108      IF( nb_bdy == 0 ) ln_bdy = .FALSE. 
    107        
     109 
     110      IF( nn_hlts > 1 .AND. MOD(nn_hlts,2)==0 ) THEN 
     111         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   & 
     112              &        ,'   in namelist, is here set to   ', nn_hlts-1 ,'   must be odd' 
     113         CALL ctl_warn( ctmp1 ) 
     114         nn_hlts = nn_hlts - 1 
     115      END IF 
     116      ! 
     117      IF( nn_hlts > 1 .AND. ln_tide ) THEN 
     118         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   & 
     119              &        ,'   in namelist, is here set to 1 for compatibility with tide treatment' 
     120         CALL ctl_warn( ctmp1 ) 
     121         nn_hlts = 1 
     122      END IF 
     123      ! 
     124      IF( nn_hlts > 1 .AND. ln_bdy ) THEN 
     125         WRITE(ctmp1,*) 'Number of added halos for time splitting nn_hlts set to   ',nn_hlts   & 
     126              &        ,'   in namelist, is here set to 1 for compatibility with boundary treatment' 
     127         CALL ctl_warn( ctmp1 ) 
     128         nn_hlts = 1 
     129      END IF 
    108130      ! ----------------------------------------- 
    109131      ! unstructured open boundaries use control 
     
    115137         ! 
    116138         ! Open boundaries definition (arrays and masks) 
    117          CALL bdy_def 
     139         ! extended : interior domain + global halo + halo extension for time-splitting 
     140         idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts 
     141         idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts 
     142         idx_bdy      => idx_bdy_xtd 
     143         dta_bdy      => dta_bdy_xtd 
     144         lsend_bdy    => lsend_bdy_xtd(:,:,:,:) 
     145         lrecv_bdy    => lrecv_bdy_xtd(:,:,:,:) 
     146         lsend_bdyint => lsend_bdyint_xtd(:,:,:,:) 
     147         lrecv_bdyint => lrecv_bdyint_xtd(:,:,:,:) 
     148         lsend_bdyext => lsend_bdyext_xtd(:,:,:,:) 
     149         lrecv_bdyext => lrecv_bdyext_xtd(:,:,:,:) 
     150         CALL bdy_def( idbi, idbj, idei, idej, .true. ) 
     151         CALL swap_bdyptr 
     152         ! regular : interior domain + global halo 
     153         idbi = 1      ;   idbj = 1          ;   idei = jpi      ;   idej = jpj 
     154         idx_bdy      => idx_bdy_reg 
     155         dta_bdy      => dta_bdy_reg 
     156         lsend_bdy    => lsend_bdy_reg(:,:,:,:) 
     157         lrecv_bdy    => lrecv_bdy_reg(:,:,:,:) 
     158         lsend_bdyint => lsend_bdyint_reg(:,:,:,:) 
     159         lrecv_bdyint => lrecv_bdyint_reg(:,:,:,:) 
     160         lsend_bdyext => lsend_bdyext_reg(:,:,:,:) 
     161         lrecv_bdyext => lrecv_bdyext_reg(:,:,:,:) 
     162         CALL bdy_def( idbi, idbj, idei, idej ) 
     163         ! current bdy treated is regular 
     164         ! 
    118165         IF( ln_meshmask )   CALL bdy_meshwri() 
    119166         ! 
     
    134181 
    135182 
    136    SUBROUTINE bdy_def 
     183   SUBROUTINE bdy_def( idbi, idbj, idei, idej, ldxtd ) 
    137184      !!---------------------------------------------------------------------- 
    138185      !!                 ***  ROUTINE bdy_init  *** 
     
    144191      !! 
    145192      !! ** Input   :  bdy_init.nc, input file for unstructured open boundaries 
    146       !!----------------------------------------------------------------------       
     193      !!----------------------------------------------------------------------     
     194      INTEGER          , INTENT(in)  :: idbi, idbj, idei, idej   ! start/end of the subdomain for extended and regular bdy treatment 
     195      LOGICAL, OPTIONAL, INTENT(in)  :: ldxtd                    ! indicate if extended domain is treated (for time splitting) 
    147196      INTEGER  ::   ib_bdy, ii, ij, igrd, ib, ir, iseg     ! dummy loop indices 
    148197      INTEGER  ::   icount, icountr, icountr0, ibr_max     ! local integers 
    149       INTEGER  ::   ilen1                                  !   -       - 
    150198      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       - 
    151       INTEGER  ::   jpbdta                                 !   -       - 
     199      INTEGER  ::   jpbdta, ilen1                          !   -       - 
    152200      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
    153201      INTEGER  ::   ii1, ii2, ii3, ij1, ij2, ij3           !   -       - 
    154202      INTEGER  ::   iibe, ijbe, iibi, ijbi                 !   -       - 
     203      INTEGER  ::   iint1, iout1, iint2, iout2             !   -       - 
    155204      INTEGER  ::   flagu, flagv                           ! short cuts 
    156205      INTEGER  ::   nbdyind, nbdybeg, nbdyend 
     206      INTEGER  ::   ihl                                    ! total number of halos ( with added halos for time splitting) 
    157207      INTEGER              , DIMENSION(4)             ::   kdimsz 
    158208      INTEGER              , DIMENSION(jpbgrd,jp_bdy) ::   nblendta          ! Length of index arrays  
     
    162212      REAL(wp), ALLOCATABLE, DIMENSION(:,:)     ::   zz_read                 ! work space for 2D global boundary data 
    163213      REAL(wp), POINTER    , DIMENSION(:,:)     ::   zmask                   ! pointer to 2D mask fields 
    164       REAL(wp)             , DIMENSION(jpi,jpj) ::   zfmask   ! temporary fmask array excluding coastal boundary condition (shlat) 
    165       REAL(wp)             , DIMENSION(jpi,jpj) ::   ztmask, zumask, zvmask  ! temporary u/v mask array 
     214      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zfmask   ! temporary fmask array excluding coastal boundary condition (shlat) 
     215      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   ztmask, zumask, zvmask  ! temporary u/v mask array 
     216      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zbdytmask, zbdyumask, zbdyvmask  ! temporary u/v mask array 
    166217      !!---------------------------------------------------------------------- 
    167218      ! 
    168219      cgrid = (/'t','u','v'/) 
    169220 
     221      ihl = nn_hls 
     222      IF( PRESENT(ldxtd) ) THEN   ;   IF( ldxtd )   ihl = nn_hls + nn_hlts   ;   ENDIF 
     223 
     224      ALLOCATE( zfmask(idbi:idei,idbj:idej), ztmask(idbi:idei,idbj:idej) & 
     225           &  , zumask(idbi:idei,idbj:idej), zvmask(idbi:idei,idbj:idej) ) 
     226 
     227      ALLOCATE( zbdytmask(idbi:idei,idbj:idej), zbdyumask(idbi:idei,idbj:idej), zbdyvmask(idbi:idei,idbj:idej) ) 
    170228      ! ----------------------------------------- 
    171229      ! Check and write out namelist parameters 
     
    488546      !------------------------------------------------------ 
    489547      ! 
    490       iwe = mig(1) 
    491       ies = mig(jpi) 
    492       iso = mjg(1)  
    493       ino = mjg(jpj)  
     548      iwe = idbi + nimpp - 1 
     549      ies = idei + nimpp - 1 
     550      iso = idbj + njmpp - 1 
     551      ino = idej + njmpp - 1 
    494552      ! 
    495553      DO ib_bdy = 1, nb_bdy 
     
    551609                     ! 
    552610                     icount = icount  + 1 
    553                      idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- mig(1)+1   ! global to local indexes 
    554                      idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- mjg(1)+1   ! global to local indexes 
     611                     idx_bdy(ib_bdy)%nbi(icount,igrd)   = nbidta(ib,igrd,ib_bdy)- (1+nimpp-1)+1   ! global to local indexes 
     612                     idx_bdy(ib_bdy)%nbj(icount,igrd)   = nbjdta(ib,igrd,ib_bdy)- (1+njmpp-1)+1   ! global to local indexes 
    555613                     idx_bdy(ib_bdy)%nbr(icount,igrd)   = nbrdta(ib,igrd,ib_bdy) 
    556614                     idx_bdy(ib_bdy)%nbmap(icount,igrd) = ib 
     
    579637               ! check if point has to be sent     to   a neighbour 
    580638               ! W neighbour and on the inner left  side 
    581                IF( ii == 2    .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true. 
     639               IF( ii == idbi + 1 .and. (nbondi == 0 .or. nbondi ==  1) )   lsend_bdy(ib_bdy,igrd,1,ir) = .true. 
    582640               ! E neighbour and on the inner right side 
    583                IF( ii == jpi-1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true. 
     641               IF( ii == idei - 1 .and. (nbondi == 0 .or. nbondi == -1) )   lsend_bdy(ib_bdy,igrd,2,ir) = .true. 
    584642               ! S neighbour and on the inner down side 
    585                IF( ij == 2    .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true. 
     643               IF( ij == idbj + 1 .and. (nbondj == 0 .or. nbondj ==  1) )   lsend_bdy(ib_bdy,igrd,3,ir) = .true. 
    586644               ! N neighbour and on the inner up   side 
    587                IF( ij == jpj-1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true. 
     645               IF( ij == idej - 1 .and. (nbondj == 0 .or. nbondj == -1) )   lsend_bdy(ib_bdy,igrd,4,ir) = .true. 
    588646               ! 
    589647               ! check if point has to be received from a neighbour 
    590648               ! W neighbour and on the outter left  side 
    591                IF( ii == 1    .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true. 
     649               IF( ii == idbi .and. (nbondi == 0 .or. nbondi ==  1) )   lrecv_bdy(ib_bdy,igrd,1,ir) = .true. 
    592650               ! E neighbour and on the outter right side 
    593                IF( ii == jpi  .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true. 
     651               IF( ii == idei .and. (nbondi == 0 .or. nbondi == -1) )   lrecv_bdy(ib_bdy,igrd,2,ir) = .true. 
    594652               ! S neighbour and on the outter down side 
    595                IF( ij == 1    .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true. 
     653               IF( ij == idbj .and. (nbondj == 0 .or. nbondj ==  1) )   lrecv_bdy(ib_bdy,igrd,3,ir) = .true. 
    596654               ! N neighbour and on the outter up   side 
    597                IF( ij == jpj  .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true. 
     655               IF( ij == idej .and. (nbondj == 0 .or. nbondj == -1) )   lrecv_bdy(ib_bdy,igrd,4,ir) = .true. 
    598656               ! 
    599657            END DO 
     
    633691      ! ------------------------------------------ 
    634692 
    635       ztmask(:,:) = tmask(:,:,1)   ;   zumask(:,:) = umask(:,:,1)   ;   zvmask(:,:) = vmask(:,:,1) 
     693      ztmask(1:jpi,1:jpj) = tmask(1:jpi,1:jpj,1) 
     694      zumask(1:jpi,1:jpj) = umask(1:jpi,1:jpj,1) 
     695      zvmask(1:jpi,1:jpj) = vmask(1:jpi,1:jpj,1) 
    636696      ! For the flagu/flagv calculation below we require a version of fmask without 
    637697      ! the land boundary condition (shlat) included: 
    638       DO ij = 1, jpjm1 
    639          DO ii = 1, jpim1 
     698      DO ij = 1, idej - 1 
     699         DO ii = 1, idei - 1 
    640700            zfmask(ii,ij) =  ztmask(ii,ij  ) * ztmask(ii+1,ij  )   & 
    641701               &           * ztmask(ii,ij+1) * ztmask(ii+1,ij+1) 
    642702         END DO 
    643703      END DO 
    644       CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
     704      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl ) 
    645705 
    646706      ! Read global 2D mask at T-points: bdytmask 
     
    648708      ! bdytmask = 1  on the computational domain AND on open boundaries 
    649709      !          = 0  elsewhere    
    650  
    651       bdytmask(:,:) = ssmask(:,:) 
     710      zbdytmask(1:jpi,1:jpj) = ssmask(1:jpi,1:jpj) 
    652711 
    653712      ! Derive mask on U and V grid from mask on T grid 
    654       DO ij = 1, jpjm1 
    655          DO ii = 1, jpim1 
    656             bdyumask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii+1,ij  ) 
    657             bdyvmask(ii,ij) = bdytmask(ii,ij) * bdytmask(ii  ,ij+1)   
     713      DO ij = 1, idej - 1 
     714         DO ii = 1, idei - 1 
     715            zbdyumask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii+1,ij  ) 
     716            zbdyvmask(ii,ij) = zbdytmask(ii,ij) * zbdytmask(ii  ,ij+1)   
    658717         END DO 
    659718      END DO 
    660       CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1., bdyvmask, 'V', 1. )   ! Lateral boundary cond. 
     719      CALL lbc_lnk_multi( 'bdyini', zbdytmask, 'T', 1., zbdyumask, 'U', 1., zbdyvmask, 'V', 1., khlcom = ihl )   ! Lateral boundary cond. 
    661720 
    662721      ! bdy masks are now set to zero on rim 0 points: 
    663722      DO ib_bdy = 1, nb_bdy 
    664723         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(1)   ! extent of rim 0 
    665             bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
     724            zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
    666725         END DO 
    667726         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(2)   ! extent of rim 0 
    668             bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
     727            zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
    669728         END DO 
    670729         DO ib = 1, idx_bdy(ib_bdy)%nblenrim0(3)   ! extent of rim 0 
    671             bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
     730            zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
    672731         END DO 
    673732      END DO 
    674  
    675       CALL bdy_rim_treat( zumask, zvmask, zfmask, .true. )   ! compute flagu, flagv, ntreat on rim 0 
     733      ! compute flagu, flagv, ntreat on rim 0 
     734      CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .true., idbi, idei, idbj, idej, ldxtd ) 
    676735 
    677736      ! ------------------------------------ 
     
    699758         END DO 
    700759      END DO 
    701       CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. ) 
     760      CALL lbc_lnk( 'bdyini', zfmask, 'F', 1., khlcom = ihl ) 
    702761 
    703762      ! bdy masks are now set to zero on rim1 points: 
    704763      DO ib_bdy = 1, nb_bdy 
    705764         DO ib = idx_bdy(ib_bdy)%nblenrim0(1) + 1,  idx_bdy(ib_bdy)%nblenrim(1)   ! extent of rim 1 
    706             bdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
     765            zbdytmask(idx_bdy(ib_bdy)%nbi(ib,1), idx_bdy(ib_bdy)%nbj(ib,1)) = 0._wp 
    707766         END DO 
    708767         DO ib = idx_bdy(ib_bdy)%nblenrim0(2) + 1,  idx_bdy(ib_bdy)%nblenrim(2)   ! extent of rim 1 
    709             bdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
     768            zbdyumask(idx_bdy(ib_bdy)%nbi(ib,2), idx_bdy(ib_bdy)%nbj(ib,2)) = 0._wp 
    710769         END DO 
    711770         DO ib = idx_bdy(ib_bdy)%nblenrim0(3) + 1,  idx_bdy(ib_bdy)%nblenrim(3)   ! extent of rim 1 
    712             bdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
     771            zbdyvmask(idx_bdy(ib_bdy)%nbi(ib,3), idx_bdy(ib_bdy)%nbj(ib,3)) = 0._wp 
    713772         END DO 
    714773      END DO 
    715  
    716       CALL bdy_rim_treat( zumask, zvmask, zfmask, .false. )   ! compute flagu, flagv, ntreat on rim 1 
     774      ! compute flagu, flagv, ntreat on rim 1 
     775      CALL bdy_rim_treat( zumask, zvmask, zfmask, zbdytmask, zbdyumask, zbdyvmask, .false., idbi, idei, idbj, idej, ldxtd ) 
    717776      ! 
    718777      ! Check which boundaries might need communication 
     
    743802               !      <--    (o exterior)     -->   
    744803               ! (1)  o|x         OR    (2)   x|o 
    745                !       |___                 ___|  
    746                IF( iibi == 0     .OR. ii1 == 0     .OR. ii2 == 0     .OR. ii3 == 0     )   lrecv_bdyint(ib_bdy,igrd,1,ir) = .true. 
    747                IF( iibi == jpi+1 .OR. ii1 == jpi+1 .OR. ii2 == jpi+1 .OR. ii3 == jpi+1 )   lrecv_bdyint(ib_bdy,igrd,2,ir) = .true.   
    748                IF( iibe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,1,ir) = .true. 
    749                IF( iibe == jpi+1                                                       )   lrecv_bdyext(ib_bdy,igrd,2,ir) = .true.   
     804               !       |___                 ___| 
     805               iout1 = idbi-1   ;   iout2 = idei+1 
     806               IF( iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1 )  lrecv_bdyint(ib_bdy,igrd,1,ir)=.true. 
     807               IF( iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2 )  lrecv_bdyint(ib_bdy,igrd,2,ir)=.true. 
     808               IF( iibe == iout1                                                       )  lrecv_bdyext(ib_bdy,igrd,1,ir)=.true. 
     809               IF( iibe == iout2                                                       )  lrecv_bdyext(ib_bdy,igrd,2,ir)=.true.  
    750810               ! Check if neighbour has its rim parallel to its mpi subdomain border and located next to its halo 
    751811               ! :¨¨¨¨¨|¨¨-->    |                                             |    <--¨¨|¨¨¨¨¨:  
    752812               ! :     |  x:o    |    neighbour limited by ... would need o    |    o:x  |     : 
    753813               ! :.....|_._:_____|   (1) W neighbour         E neighbour (2)   |_____:_._|.....: 
    754                IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. & 
    755                   & ( iibi == 3     .OR. ii1 == 3     .OR. ii2 == 3     .OR. ii3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,1,ir)=.true. 
    756                IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. & 
    757                   & ( iibi == jpi-2 .OR. ii1 == jpi-2 .OR. ii2 == jpi-2 .OR. ii3 == jpi-2) )   lsend_bdyint(ib_bdy,igrd,2,ir)=.true. 
    758                IF( ii == 2     .AND. ( nbondi ==  1 .OR. nbondi == 0 ) .AND. iibe == 3     )   lsend_bdyext(ib_bdy,igrd,1,ir)=.true. 
    759                IF( ii == jpi-1 .AND. ( nbondi == -1 .OR. nbondi == 0 ) .AND. iibe == jpi-2 )   lsend_bdyext(ib_bdy,igrd,2,ir)=.true. 
     814               iout1 = idbi+2*ihl   ;   iint1 = iout1-1   ;   iout2 = idei-2*ihl   ;   iint2 = iout2+1 
     815               IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. & 
     816                 & (iibi == iout1 .OR. ii1 == iout1 .OR. ii2 == iout1 .OR. ii3 == iout1) )  lsend_bdyint(ib_bdy,igrd,1,ir)=.true. 
     817               IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. & 
     818                 & (iibi == iout2 .OR. ii1 == iout2 .OR. ii2 == iout2 .OR. ii3 == iout2) )  lsend_bdyint(ib_bdy,igrd,2,ir)=.true. 
     819               IF( ii == iint1 .AND. (nbondi== 1 .OR. nbondi==0) .AND. iibe == iout1     )  lsend_bdyext(ib_bdy,igrd,1,ir)=.true. 
     820               IF( ii == iint2 .AND. (nbondi==-1 .OR. nbondi==0) .AND. iibe == iout2     )  lsend_bdyext(ib_bdy,igrd,2,ir)=.true. 
    760821               ! 
    761822               ! search neighbour in the north/south direction    
     
    764825               !  |   |___x___|   OR    |  |   x   | 
    765826               !  v       o           (4)  |       | 
    766                IF( ijbi == 0     .OR. ij1 == 0     .OR. ij2 == 0     .OR. ij3 == 0     )   lrecv_bdyint(ib_bdy,igrd,3,ir) = .true. 
    767                IF( ijbi == jpj+1 .OR. ij1 == jpj+1 .OR. ij2 == jpj+1 .OR. ij3 == jpj+1 )   lrecv_bdyint(ib_bdy,igrd,4,ir) = .true. 
    768                IF( ijbe == 0                                                           )   lrecv_bdyext(ib_bdy,igrd,3,ir) = .true. 
    769                IF( ijbe == jpj+1                                                       )   lrecv_bdyext(ib_bdy,igrd,4,ir) = .true. 
     827               iout1 = idbj-1   ;   iout2 = idej+1 
     828               IF( ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1 )  lrecv_bdyint(ib_bdy,igrd,3,ir)=.true. 
     829               IF( ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2 )  lrecv_bdyint(ib_bdy,igrd,4,ir)=.true. 
     830               IF( ijbe == iout1                                                       )  lrecv_bdyext(ib_bdy,igrd,3,ir)=.true. 
     831               IF( ijbe == iout2                                                       )  lrecv_bdyext(ib_bdy,igrd,4,ir)=.true. 
    770832               ! Check if neighbour has its rim parallel to its mpi subdomain     _________  border and next to its halo 
    771833               !   ^  |    o    |                                                :         :  
    772834               !   |  |¨¨¨¨x¨¨¨¨|   neighbour limited by ... would need o     |  |....x....| 
    773835               !      :_________:  (3) S neighbour          N neighbour (4)   v  |    o    |    
    774                IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. & 
    775                   & ( ijbi == 3     .OR. ij1 == 3     .OR. ij2 == 3     .OR. ij3 == 3    ) )   lsend_bdyint(ib_bdy,igrd,3,ir)=.true. 
    776                IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. & 
    777                   & ( ijbi == jpj-2 .OR. ij1 == jpj-2 .OR. ij2 == jpj-2 .OR. ij3 == jpj-2) )   lsend_bdyint(ib_bdy,igrd,4,ir)=.true. 
    778                IF( ij == 2     .AND. ( nbondj ==  1 .OR. nbondj == 0 ) .AND. ijbe == 3     )   lsend_bdyext(ib_bdy,igrd,3,ir)=.true. 
    779                IF( ij == jpj-1 .AND. ( nbondj == -1 .OR. nbondj == 0 ) .AND. ijbe == jpj-2 )   lsend_bdyext(ib_bdy,igrd,4,ir)=.true. 
     836               iout1 = idbj+2*ihl   ;   iint1 = iout1-1   ;   iout2 = idej-2*ihl   ;   iint2 = iout2+1 
     837               IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. & 
     838                 & (ijbi == iout1 .OR. ij1 == iout1 .OR. ij2 == iout1 .OR. ij3 == iout1) )  lsend_bdyint(ib_bdy,igrd,3,ir)=.true. 
     839               IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. & 
     840                 & (ijbi == iout2 .OR. ij1 == iout2 .OR. ij2 == iout2 .OR. ij3 == iout2) )  lsend_bdyint(ib_bdy,igrd,4,ir)=.true. 
     841               IF( ij == iint1 .AND. (nbondj== 1 .OR. nbondj==0) .AND. ijbe == iout1     )  lsend_bdyext(ib_bdy,igrd,3,ir)=.true. 
     842               IF( ij == iint2 .AND. (nbondj==-1 .OR. nbondj==0) .AND. ijbe == iout2     )  lsend_bdyext(ib_bdy,igrd,4,ir)=.true. 
    780843            END DO 
    781844         END DO 
     
    799862      END DO 
    800863      ! 
    801       DEALLOCATE( nbidta, nbjdta, nbrdta ) 
     864      ! initialize bdyXmask for global use 
     865      bdytmask(1:jpi,1:jpj) = zbdytmask(1:jpi,1:jpj) 
     866      bdyumask(1:jpi,1:jpj) = zbdyumask(1:jpi,1:jpj) 
     867      bdyvmask(1:jpi,1:jpj) = zbdyvmask(1:jpi,1:jpj) 
     868      ! 
     869      DEALLOCATE( nbidta, nbjdta, nbrdta, zfmask, ztmask, zumask, zvmask, zbdytmask, zbdyumask, zbdyvmask ) 
    802870      ! 
    803871   END SUBROUTINE bdy_def 
    804872 
    805873 
    806    SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, lrim0 ) 
     874   SUBROUTINE bdy_rim_treat( pumask, pvmask, pfmask, pbdytmask, pbdyumask, pbdyvmask, lrim0, idbi, idei, idbj, idej, ldxtd ) 
    807875      !!---------------------------------------------------------------------- 
    808876      !!                 ***  ROUTINE bdy_rim_treat  *** 
     
    821889      !!                - and look at the ocean neighbours to compute ntreat 
    822890      !!---------------------------------------------------------------------- 
    823       REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pfmask   ! temporary fmask excluding coastal boundary condition (shlat) 
    824       REAL(wp), TARGET, DIMENSION(jpi,jpj), INTENT (in   ) :: pumask, pvmask   ! temporary t/u/v mask array 
    825       LOGICAL                             , INTENT (in   ) :: lrim0    ! .true. -> rim 0   .false. -> rim 1 
     891      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pfmask   ! temporary fmask excluding coastal boundary condition (shlat) 
     892      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pumask, pvmask   ! temporary t/u/v mask array 
     893      REAL(wp), TARGET, DIMENSION(idbi:idei,idbj:idej), INTENT(in   ) :: pbdytmask, pbdyumask, pbdyvmask    
     894      LOGICAL                             , INTENT(in   ) :: lrim0    ! .true. -> rim 0   .false. -> rim 1 
     895      INTEGER                             , INTENT(in   ) :: idbi, idbj, idei, idej    ! start/end of the subdomain  
     896                                                                                   ! for extended and regular bdy treatment 
     897      LOGICAL, OPTIONAL                   , INTENT(in   ) :: ldxtd    ! number of halos added to nn_hls for time splitting 
     898      ! 
    826899      INTEGER  ::   ib_bdy, ii, ij, igrd, ib, icount       ! dummy loop indices 
    827       INTEGER  ::   i_offset, j_offset, inn                ! local integer 
     900      INTEGER  ::   i_offset, j_offset, inn, ihl           ! local integer 
    828901      INTEGER  ::   ibeg, iend                             ! local integer 
    829902      LOGICAL  ::   llnon, llson, llean, llwen             ! local logicals indicating the presence of a ocean neighbour 
     
    831904      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    832905      CHARACTER(LEN=1), DIMENSION(jpbgrd)     ::   cgrid 
    833       REAL(wp)        , DIMENSION(jpi,jpj)    ::   ztmp 
     906      REAL(wp)        , DIMENSION(idbi:idei,idbj:idej)    ::   ztmp 
    834907      !!---------------------------------------------------------------------- 
    835908 
    836909      cgrid = (/'t','u','v'/) 
     910      ihl = nn_hls 
     911      IF( PRESENT(ldxtd) ) THEN   ;   IF( ldxtd )   ihl = nn_hls + nn_hlts   ;   ENDIF 
    837912 
    838913      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
     
    844919         DO igrd = 1, jpbgrd  
    845920            SELECT CASE( igrd ) 
    846                CASE( 1 )   ;   zmask => pumask     ;   i_offset = 0 
    847                CASE( 2 )   ;   zmask => bdytmask   ;   i_offset = 1 
    848                CASE( 3 )   ;   zmask => pfmask     ;   i_offset = 0 
     921               CASE( 1 )   ;   zmask => pumask      ;   i_offset = 0 
     922               CASE( 2 )   ;   zmask => pbdytmask   ;   i_offset = 1 
     923               CASE( 3 )   ;   zmask => pfmask      ;   i_offset = 0 
    849924            END SELECT  
    850925            icount = 0 
     
    858933               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    859934               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    860                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     935               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE 
    861936               zwfl = zmask(ii+i_offset-1,ij) 
    862937               zefl = zmask(ii+i_offset  ,ij) 
     
    873948                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
    874949               CALL ctl_stop( ctmp1 ) 
    875             ENDIF  
     950            ENDIF 
    876951            SELECT CASE( igrd ) 
    877                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    878                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    879                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
    880             END SELECT  
     952               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl )  
     953               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl )  
     954               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl ) 
     955            END SELECT 
    881956            DO ib = ibeg, iend 
    882957               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    892967         DO igrd = 1, jpbgrd  
    893968            SELECT CASE( igrd ) 
    894                CASE( 1 )   ;   zmask => pvmask     ;   j_offset = 0 
    895                CASE( 2 )   ;   zmask => pfmask     ;   j_offset = 0 
    896                CASE( 3 )   ;   zmask => bdytmask   ;   j_offset = 1 
     969               CASE( 1 )   ;   zmask => pvmask      ;   j_offset = 0 
     970               CASE( 2 )   ;   zmask => pfmask      ;   j_offset = 0 
     971               CASE( 3 )   ;   zmask => pbdytmask   ;   j_offset = 1 
    897972            END SELECT  
    898973            icount = 0 
     
    906981               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    907982               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    908                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )  CYCLE 
     983               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE 
    909984               zsfl = zmask(ii,ij+j_offset-1) 
    910985               znfl = zmask(ii,ij+j_offset  ) 
     
    923998            ENDIF 
    924999            SELECT CASE( igrd ) 
    925                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    926                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    927                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
    928             END SELECT  
     1000               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl )  
     1001               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl )  
     1002               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl )  
     1003            END SELECT 
    9291004            DO ib = ibeg, iend 
    9301005               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    9391014         DO igrd = 1, jpbgrd 
    9401015            SELECT CASE( igrd ) 
    941                CASE( 1 )   ;   zmask => bdytmask  
    942                CASE( 2 )   ;   zmask => bdyumask  
    943                CASE( 3 )   ;   zmask => bdyvmask  
     1016               CASE( 1 )   ;   zmask => pbdytmask  
     1017               CASE( 2 )   ;   zmask => pbdyumask  
     1018               CASE( 3 )   ;   zmask => pbdyvmask  
    9441019            END SELECT 
    9451020            ztmp(:,:) = -999._wp 
     
    9521027               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    9531028               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    954                IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj )   CYCLE 
     1029               IF( ii == idbi .OR. ii == idei .OR. ij == idbj .OR. ij == idej )  CYCLE 
    9551030               llnon = zmask(ii  ,ij+1) == 1.   
    9561031               llson = zmask(ii  ,ij-1) == 1.  
     
    10111086            END DO 
    10121087            SELECT CASE( igrd ) 
    1013                CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )  
    1014                CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )  
    1015                CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )  
    1016             END SELECT  
     1088               CASE( 1 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'T', 1., khlcom = ihl )  
     1089               CASE( 2 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'U', 1., khlcom = ihl )  
     1090               CASE( 3 )   ;   CALL lbc_lnk( 'bdyini', ztmp, 'V', 1., khlcom = ihl )  
     1091            END SELECT 
    10171092            DO ib = ibeg, iend 
    10181093               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     
    10401115      INTEGER, INTENT(  out)      ::   ii1, ij1, ii2, ij2, ii3, ij3 
    10411116      !!---------------------------------------------------------------------- 
    1042       SELECT CASE( itreat )   ! points that will be used by bdy routines, -1 will be discarded 
     1117      SELECT CASE( itreat )   ! points that will be used by bdy routines, -99 will be discarded 
    10431118         !               !               !     _____     !     _____      
    10441119         !  1 |   o      !  2  o   |     !  3 | x        !  4     x |     
    10451120         !    |_x_ _     !    _ _x_|     !    |   o      !      o   | 
    1046       CASE( 1 )    ;   ii1 = ii+1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1047       CASE( 2 )    ;   ii1 = ii-1   ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1048       CASE( 3 )    ;   ii1 = ii+1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1049       CASE( 4 )    ;   ii1 = ii-1   ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1121      CASE( 1 )    ;   ii1 = ii+1   ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1122      CASE( 2 )    ;   ii1 = ii-1   ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1123      CASE( 3 )    ;   ii1 = ii+1   ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1124      CASE( 4 )    ;   ii1 = ii-1   ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
    10501125         !    |          !         |     !      o        !    ______                   ! or incomplete corner 
    10511126         ! 5  | x o      ! 6   o x |     ! 7  __x__      ! 8    x                      !  7  ____ o 
    10521127         !    |          !         |     !               !      o                      !         |x___ 
    1053       CASE( 5 )    ;   ii1 = ii+1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1054       CASE( 6 )    ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1055       CASE( 7 )    ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
    1056       CASE( 8 )    ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = -1     ;   ij2 = -1     ;   ii3 = -1     ;   ij3 = -1 
     1128      CASE( 5 )    ;   ii1 = ii+1   ;   ij1 = ij     ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1129      CASE( 6 )    ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1130      CASE( 7 )    ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
     1131      CASE( 8 )    ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = -99    ;   ij2 = -99    ;   ii3 = -99    ;   ij3 = -99 
    10571132         !        o      !        o      !    _____|     !       |_____   
    10581133         !  9 ____x o    ! 10   o x___   ! 11     x o    ! 12   o x       
    10591134         !         |     !       |       !        o      !        o       
    1060       CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1  
    1061       CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
    1062       CASE( 11 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
    1063       CASE( 12 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -1     ;   ij3 = -1 
     1135      CASE( 9  )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99 
     1136      CASE( 10 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99 
     1137      CASE( 11 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99 
     1138      CASE( 12 )   ;   ii1 = ii     ;   ij1 = ij-1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = -99    ;   ij3 = -99 
    10641139         !    |_  o      !        o  _|  !     ¨¨|_|¨¨   !       o          
    10651140         ! 13  _| x o    !  14  o x |_   !  15  o x o    ! 16  o x o        
    10661141         !    |   o      !        o   |  !        o      !    __|¨|__  
    1067       CASE( 13 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1    
    1068       CASE( 14 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1  
     1142      CASE( 13 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii+1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1  
     1143      CASE( 14 )   ;   ii1 = ii     ;   ij1 = ij+1   ;   ii2 = ii-1   ;   ij2 = ij     ;   ii3 = ii     ;   ij3 = ij-1 
    10691144      CASE( 15 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij-1   ;   ii3 = ii+1   ;   ij3 = ij    
    10701145      CASE( 16 )   ;   ii1 = ii-1   ;   ij1 = ij     ;   ii2 = ii     ;   ij2 = ij+1   ;   ii3 = ii+1   ;   ij3 = ij 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdylib.F90

    r11258 r11380  
    449449   END SUBROUTINE bdy_orlanski_3d 
    450450 
    451    SUBROUTINE bdy_nmn( idx, igrd, phia, lrim0 ) 
     451   SUBROUTINE bdy_nmn( idx, igrd, idbi, idei, idbj, idej, ipk, phia, ldrim0, pmask ) 
    452452      !!---------------------------------------------------------------------- 
    453453      !!                 ***  SUBROUTINE bdy_nmn  *** 
     
    463463      !!                                                   !      o       
    464464      !!---------------------------------------------------------------------- 
    465       INTEGER,                    INTENT(in   )  ::   igrd     ! grid index 
    466       REAL(wp), DIMENSION(:,:,:), INTENT(inout)  ::   phia     ! model after 3D field (to be updated), must be masked 
    467       TYPE(OBC_INDEX),            INTENT(in   )  ::   idx      ! OBC indices 
    468       LOGICAL, OPTIONAL,          INTENT(in   )  ::   lrim0    ! indicate if rim 0 is treated 
    469       !!  
     465      TYPE(OBC_INDEX),                              INTENT(in   )  ::   idx    ! OBC indices 
     466      INTEGER ,                                     INTENT(in   )  ::   igrd   ! grid index 
     467      INTEGER ,                                     INTENT(in   )  ::   idbi, idei, idbj, idej, ipk   ! size of phia array 
     468      REAL(wp), DIMENSION(idbi:idei,idbj:idej,ipk), INTENT(inout)  ::   phia   ! model after 3D field (to be updated), must be masked 
     469      LOGICAL , OPTIONAL,                                           INTENT(in   )  ::   ldrim0   ! indicate if rim 0 is treated 
     470      REAL(wp), OPTIONAL, TARGET, DIMENSION(idbi:idei,idbj:idej,1), INTENT(in   )  ::   pmask    ! optional mask for extended domain 
     471      !!                                                                                         ! always 2d : used by dyn_spg_ts 
    470472      REAL(wp) ::   zweight 
    471473      REAL(wp), POINTER, DIMENSION(:,:,:)      :: zmask         ! land/sea mask for field 
     
    477479      !!---------------------------------------------------------------------- 
    478480      ! 
    479       ipkm1 = MAX( SIZE(phia,3) - 1, 1 )  
    480       ! 
    481       SELECT CASE(igrd) 
     481      ipkm1 = MAX( ipk-1, 1 )  
     482      ! 
     483      IF( PRESENT(pmask) ) THEN 
     484                       zmask => pmask   ! mask for extended domain   ! N.B. do not specify (:,:,:) as it does not work for arrays  
     485      ELSE                                                           !      with LBOUND < 1 
     486         SELECT CASE(igrd) 
    482487         CASE(1)   ;   zmask => tmask(:,:,:) 
    483488         CASE(2)   ;   zmask => umask(:,:,:) 
    484489         CASE(3)   ;   zmask => vmask(:,:,:) 
    485490         CASE DEFAULT ;   CALL ctl_stop( 'unrecognised value for igrd in bdy_nmn' ) 
    486       END SELECT 
    487       ! 
    488       IF( PRESENT(lrim0) ) THEN 
    489          IF( lrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0 
    490          ELSE               ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1 
     491         END SELECT 
     492      END IF 
     493      ! 
     494      IF( PRESENT(ldrim0) ) THEN 
     495         IF( ldrim0 ) THEN   ;   ibeg = 1                       ;   iend = idx%nblenrim0(igrd)   ! rim 0 
     496         ELSE                ;   ibeg = idx%nblenrim0(igrd)+1   ;   iend = idx%nblenrim(igrd)    ! rim 1 
    491497         END IF 
    492       ELSE                  ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both 
     498      ELSE                   ;   ibeg = 1                       ;   iend = idx%nblenrim(igrd)    ! both 
    493499      END IF 
    494500      ! 
     
    500506         SELECT CASE( itreat ) 
    501507         CASE( 1:8 ) 
    502             IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
     508            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE 
    503509            DO ik = 1, ipkm1 
    504510               IF( zmask(ii1,ij1,ik) /= 0. )   phia(ii,ij,ik) = phia(ii1,ij1,ik)   
    505511            END DO 
    506512         CASE( 9:12 ) 
    507             IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
    508             IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
     513            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE 
     514            IF( ii2 < idbi .OR. ii2 > idei .OR. ij2 < idbj .OR. ij2 > idej )   CYCLE 
    509515            DO ik = 1, ipkm1 
    510516               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) 
     
    512518            END DO 
    513519         CASE( 13:16 ) 
    514             IF( ii1 < 1 .OR. ii1 > jpi .OR. ij1 < 1 .OR. ij1 > jpj )   CYCLE 
    515             IF( ii2 < 1 .OR. ii2 > jpi .OR. ij2 < 1 .OR. ij2 > jpj )   CYCLE 
    516             IF( ii3 < 1 .OR. ii3 > jpi .OR. ij3 < 1 .OR. ij3 > jpj )   CYCLE 
     520            IF( ii1 < idbi .OR. ii1 > idei .OR. ij1 < idbj .OR. ij1 > idej )   CYCLE 
     521            IF( ii2 < idbi .OR. ii2 > idei .OR. ij2 < idbj .OR. ij2 > idej )   CYCLE 
     522            IF( ii3 < idbi .OR. ii3 > idei .OR. ij3 < idbj .OR. ij3 > idej )   CYCLE 
    517523            DO ik = 1, ipkm1 
    518524               zweight = zmask(ii1,ij1,ik) + zmask(ii2,ij2,ik) + zmask(ii3,ij3,ik) 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/BDY/bdytra.F90

    r11210 r11380  
    7373               CASE('specified'   )   ! treat the whole rim      at once 
    7474                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
    75                CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked 
     75               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd, 1,jpi, 1,jpj, 1, tsa(:,:,:,jn), llrim0 )  !tsa masked 
    7676               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), & 
    7777                    & zdta(jn)%tra, llrim0, ll_npo=.false. ) 
     
    9898         END DO 
    9999         IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction 
    100             CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 
     100            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,ldsend=llsend1, ldrecv=llrecv1 ) 
    101101         END IF 
    102102         ! 
     
    126126      igrd = 1                       ! Everything is at T-points here 
    127127      IF(      jpa == jp_tem ) THEN 
    128          CALL bdy_nmn( idx, igrd, pta, llrim0 ) 
     128         CALL bdy_nmn( idx, igrd, 1,jpi, 1,jpj, 1, pta, llrim0 ) 
    129129      ELSE IF( jpa == jp_sal ) THEN 
    130130         IF( .NOT. llrim0 )   RETURN 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diadct.F90

    r11365 r11380  
    1111   !!            3.4  ! 09/2011 (C Bricaud) 
    1212   !!---------------------------------------------------------------------- 
    13    !! 
     13#if defined key_diadct 
     14   !!---------------------------------------------------------------------- 
     15   !!   'key_diadct' : 
     16   !!---------------------------------------------------------------------- 
    1417   !!---------------------------------------------------------------------- 
    1518   !!   dia_dct      :  Compute the transport through a sec. 
     
    3942 
    4043   PUBLIC   dia_dct      ! routine called by step.F90 
    41    PUBLIC   dia_dct_init ! routine called by nemogcm.F90 
    42  
    43    !                         !!** namelist variables ** 
    44    LOGICAL, PUBLIC ::   ln_diadct     ! Calculate transport thru a section or not 
    45    INTEGER         ::   nn_dct        ! Frequency of computation 
    46    INTEGER         ::   nn_dctwri     ! Frequency of output 
    47    INTEGER         ::   nn_secdebug   ! Number of the section to debug 
     44   PUBLIC   dia_dct_init ! routine called by opa.F90 
     45   PUBLIC   diadct_alloc ! routine called by nemo_init in nemogcm.F90  
     46   PRIVATE  readsec 
     47   PRIVATE  removepoints 
     48   PRIVATE  transport 
     49   PRIVATE  dia_dct_wri 
     50 
     51   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .TRUE.   !: model-data diagnostics flag 
     52 
     53   INTEGER :: nn_dct        ! Frequency of computation 
     54   INTEGER :: nn_dctwri     ! Frequency of output 
     55   INTEGER :: nn_secdebug   ! Number of the section to debug 
    4856    
    4957   INTEGER, PARAMETER :: nb_class_max  = 10 
     
    96104CONTAINS 
    97105  
    98    INTEGER FUNCTION diadct_alloc()  
    99       !!----------------------------------------------------------------------  
    100       !!                   ***  FUNCTION diadct_alloc  ***  
    101       !!----------------------------------------------------------------------  
    102  
    103       ALLOCATE( transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), & 
    104          &      transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=diadct_alloc )  
    105  
    106       CALL mpp_sum( 'diadct', diadct_alloc )  
    107       IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' )  
    108  
    109    END FUNCTION diadct_alloc 
     106  INTEGER FUNCTION diadct_alloc()  
     107     !!----------------------------------------------------------------------  
     108     !!                   ***  FUNCTION diadct_alloc  ***  
     109     !!----------------------------------------------------------------------  
     110     INTEGER :: ierr(2)  
     111     !!----------------------------------------------------------------------  
     112 
     113     ALLOCATE(transports_3d(nb_3d_vars,nb_sec_max,nb_point_max,jpk), STAT=ierr(1) )  
     114     ALLOCATE(transports_2d(nb_2d_vars,nb_sec_max,nb_point_max)    , STAT=ierr(2) )  
     115 
     116     diadct_alloc = MAXVAL( ierr )  
     117     IF( diadct_alloc /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' )  
     118  
     119  END FUNCTION diadct_alloc  
     120 
    110121 
    111122   SUBROUTINE dia_dct_init 
     
    119130      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    120131      !! 
    121       NAMELIST/nam_diadct/ln_diadct, nn_dct, nn_dctwri, nn_secdebug 
     132      NAMELIST/namdct/nn_dct,nn_dctwri,nn_secdebug 
    122133      !!--------------------------------------------------------------------- 
    123134 
    124      REWIND( numnam_ref )              ! Namelist nam_diadct in reference namelist : Diagnostic: transport through sections 
    125      READ  ( numnam_ref, nam_diadct, IOSTAT = ios, ERR = 901) 
    126 901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diadct in reference namelist' ) 
    127  
    128      REWIND( numnam_cfg )              ! Namelist nam_diadct in configuration namelist : Diagnostic: transport through sections 
    129      READ  ( numnam_cfg, nam_diadct, IOSTAT = ios, ERR = 902 ) 
    130 902  IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diadct in configuration namelist' ) 
    131      IF(lwm) WRITE ( numond, nam_diadct ) 
     135     REWIND( numnam_ref )              ! Namelist namdct in reference namelist : Diagnostic: transport through sections 
     136     READ  ( numnam_ref, namdct, IOSTAT = ios, ERR = 901) 
     137901  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdct in reference namelist' ) 
     138 
     139     REWIND( numnam_cfg )              ! Namelist namdct in configuration namelist : Diagnostic: transport through sections 
     140     READ  ( numnam_cfg, namdct, IOSTAT = ios, ERR = 902 ) 
     141902  IF( ios >  0 ) CALL ctl_nam ( ios , 'namdct in configuration namelist' ) 
     142     IF(lwm) WRITE ( numond, namdct ) 
    132143 
    133144     IF( lwp ) THEN 
     
    135146        WRITE(numout,*) "diadct_init: compute transports through sections " 
    136147        WRITE(numout,*) "~~~~~~~~~~~~~~~~~~~~~" 
    137         WRITE(numout,*) "       Calculate transport thru sections: ln_diadct = ", ln_diadct 
    138         WRITE(numout,*) "       Frequency of computation:          nn_dct    = ", nn_dct 
    139         WRITE(numout,*) "       Frequency of write:                nn_dctwri = ", nn_dctwri 
     148        WRITE(numout,*) "       Frequency of computation: nn_dct    = ",nn_dct 
     149        WRITE(numout,*) "       Frequency of write:       nn_dctwri = ",nn_dctwri 
    140150 
    141151        IF      ( nn_secdebug .GE. 1 .AND. nn_secdebug .LE. nb_sec_max )THEN 
     
    145155        ELSE                              ; WRITE(numout,*)"       Wrong value for nn_secdebug : ",nn_secdebug 
    146156        ENDIF 
     157 
     158        IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  & 
     159          &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 
     160 
    147161     ENDIF 
    148162 
    149      IF( ln_diadct ) THEN 
    150         ! control 
    151         IF(nn_dct .GE. nn_dctwri .AND. MOD(nn_dct,nn_dctwri) .NE. 0)  & 
    152            &  CALL ctl_stop( 'diadct: nn_dct should be smaller and a multiple of nn_dctwri' ) 
    153  
    154         ! allocate dia_dct arrays 
    155         IF( diadct_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'diadct_alloc: failed to allocate arrays' ) 
    156  
    157         !Read section_ijglobal.diadct 
    158         CALL readsec 
    159  
    160         !open output file 
    161         IF( lwm ) THEN 
    162            CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    163            CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    164            CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    165         ENDIF 
    166  
    167         ! Initialise arrays to zero  
    168         transports_3d(:,:,:,:)=0.0  
    169         transports_2d(:,:,:)  =0.0  
    170         ! 
     163     !Read section_ijglobal.diadct 
     164     CALL readsec 
     165 
     166     !open output file 
     167     IF( lwm ) THEN 
     168        CALL ctl_opn( numdct_vol,  'volume_transport', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
     169        CALL ctl_opn( numdct_heat, 'heat_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
     170        CALL ctl_opn( numdct_salt, 'salt_transport'  , 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, numout,  .FALSE. ) 
    171171     ENDIF 
     172 
     173     ! Initialise arrays to zero  
     174     transports_3d(:,:,:,:)=0.0  
     175     transports_2d(:,:,:)  =0.0  
    172176     ! 
    173177  END SUBROUTINE dia_dct_init 
     
    12351239   END FUNCTION interp 
    12361240 
     1241#else 
     1242   !!---------------------------------------------------------------------- 
     1243   !!   Default option :                                       Dummy module 
     1244   !!---------------------------------------------------------------------- 
     1245   LOGICAL, PUBLIC, PARAMETER ::   lk_diadct = .FALSE.    !: diamht flag 
     1246   PUBLIC  
     1247   !! $Id$ 
     1248CONTAINS 
     1249 
     1250   SUBROUTINE dia_dct_init          ! Dummy routine 
     1251      IMPLICIT NONE 
     1252      WRITE(*,*) 'dia_dct_init: You should not have seen this print! error?' 
     1253   END SUBROUTINE dia_dct_init 
     1254 
     1255   SUBROUTINE dia_dct( kt )         ! Dummy routine 
     1256      IMPLICIT NONE 
     1257      INTEGER, INTENT( in ) :: kt   ! ocean time-step index 
     1258      WRITE(*,*) 'dia_dct: You should not have seen this print! error?', kt 
     1259   END SUBROUTINE dia_dct 
     1260#endif 
     1261 
    12371262   !!====================================================================== 
    12381263END MODULE diadct 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DIA/diaharm.F90

    r11374 r11380  
    55   !!====================================================================== 
    66   !! History :  3.1  !  2007  (O. Le Galloudec, J. Chanut)  Original code 
     7   !!---------------------------------------------------------------------- 
     8#if defined key_diaharm 
     9   !!---------------------------------------------------------------------- 
     10   !!   'key_diaharm' 
    711   !!---------------------------------------------------------------------- 
    812   USE oce             ! ocean dynamics and tracers variables 
     
    2226   IMPLICIT NONE 
    2327   PRIVATE 
     28 
     29   LOGICAL, PUBLIC, PARAMETER :: lk_diaharm  = .TRUE. 
    2430    
    2531   INTEGER, PARAMETER :: jpincomax    = 2.*jpmax_harmo 
     
    2733 
    2834   !                         !!** namelist variables ** 
    29    LOGICAL, PUBLIC ::   ln_diaharm    ! Choose tidal harmonic output or not 
    30    INTEGER         ::   nit000_han    ! First time step used for harmonic analysis 
    31    INTEGER         ::   nitend_han    ! Last time step used for harmonic analysis 
    32    INTEGER         ::   nstep_han     ! Time step frequency for harmonic analysis 
    33    INTEGER         ::   nb_ana        ! Number of harmonics to analyse 
     35   INTEGER ::   nit000_han    ! First time step used for harmonic analysis 
     36   INTEGER ::   nitend_han    ! Last time step used for harmonic analysis 
     37   INTEGER ::   nstep_han     ! Time step frequency for harmonic analysis 
     38   INTEGER ::   nb_ana        ! Number of harmonics to analyse 
    3439 
    3540   INTEGER , ALLOCATABLE, DIMENSION(:)       ::   name 
     
    4853   CHARACTER (LEN=4), DIMENSION(jpmax_harmo) ::   tname   ! Names of tidal constituents ('M2', 'K1',...) 
    4954 
    50    PUBLIC   dia_harm        ! routine called by step.F90 
    51    PUBLIC   dia_harm_init   ! routine called by nemogcm.F90 
     55   PUBLIC   dia_harm   ! routine called by step.F90 
    5256 
    5357   !!---------------------------------------------------------------------- 
     
    6771      !! 
    6872      !!-------------------------------------------------------------------- 
    69       INTEGER ::   jh, nhan, ji 
     73      INTEGER :: jh, nhan, jk, ji 
    7074      INTEGER ::   ios                 ! Local integer output status for namelist read 
    7175 
    72       NAMELIST/nam_diaharm/ ln_diaharm, nit000_han, nitend_han, nstep_han, tname 
     76      NAMELIST/nam_diaharm/ nit000_han, nitend_han, nstep_han, tname 
    7377      !!---------------------------------------------------------------------- 
    7478 
     
    7882         WRITE(numout,*) '~~~~~~~ ' 
    7983      ENDIF 
     84      ! 
     85      IF( .NOT. ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
     86      ! 
     87      CALL tide_init_Wave 
    8088      ! 
    8189      REWIND( numnam_ref )              ! Namelist nam_diaharm in reference namelist : Tidal harmonic analysis 
     
    8896      ! 
    8997      IF(lwp) THEN 
    90          WRITE(numout,*) 'Tidal diagnostics = ', ln_diaharm 
    91          WRITE(numout,*) '   First time step used for analysis:         nit000_han= ', nit000_han 
    92          WRITE(numout,*) '   Last  time step used for analysis:         nitend_han= ', nitend_han 
    93          WRITE(numout,*) '   Time step frequency for harmonic analysis: nstep_han = ', nstep_han 
     98         WRITE(numout,*) 'First time step used for analysis:  nit000_han= ', nit000_han 
     99         WRITE(numout,*) 'Last  time step used for analysis:  nitend_han= ', nitend_han 
     100         WRITE(numout,*) 'Time step frequency for harmonic analysis:  nstep_han= ', nstep_han 
    94101      ENDIF 
    95102 
    96       IF( ln_diaharm .AND. .NOT.ln_tide )   CALL ctl_stop( 'dia_harm_init : ln_tide must be true for harmonic analysis') 
    97  
    98       IF( ln_diaharm ) THEN 
    99  
    100          CALL tide_init_Wave 
    101          ! 
    102          ! Basic checks on harmonic analysis time window: 
    103          ! ---------------------------------------------- 
    104          IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
    105             &                                       ' restart capability not implemented' ) 
    106          IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
    107             &                                       'restart capability not implemented' ) 
    108  
    109          IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
    110             &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
    111          ! 
    112          nb_ana = 0 
    113          DO jh=1,jpmax_harmo 
    114             DO ji=1,jpmax_harmo 
    115                IF(TRIM(tname(jh)) == Wave(ji)%cname_tide) THEN 
    116                   nb_ana=nb_ana+1 
    117                ENDIF 
    118             END DO 
    119          END DO 
    120          ! 
    121          IF(lwp) THEN 
    122             WRITE(numout,*) '        Namelist nam_diaharm' 
    123             WRITE(numout,*) '        nb_ana    = ', nb_ana 
    124             CALL flush(numout) 
    125          ENDIF 
    126          ! 
    127          IF (nb_ana > jpmax_harmo) THEN 
    128             WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo' 
    129             WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
    130             CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
    131          ENDIF 
    132  
    133          ALLOCATE(name    (nb_ana)) 
    134          DO jh=1,nb_ana 
    135             DO ji=1,jpmax_harmo 
    136                IF (TRIM(tname(jh)) ==  Wave(ji)%cname_tide) THEN 
    137                   name(jh) = ji 
    138                   EXIT 
    139                END IF 
    140             END DO 
    141          END DO 
    142  
    143          ! Initialize frequency array: 
    144          ! --------------------------- 
    145          ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) ) 
    146  
    147          CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana ) 
    148  
    149          IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
    150  
    151          DO jh = 1, nb_ana 
    152             IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh) 
    153          END DO 
    154  
    155          ! Initialize temporary arrays: 
    156          ! ---------------------------- 
    157          ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
    158          ana_temp(:,:,:,:) = 0._wp 
    159  
     103      ! Basic checks on harmonic analysis time window: 
     104      ! ---------------------------------------------- 
     105      IF( nit000 > nit000_han )   CALL ctl_stop( 'dia_harm_init : nit000_han must be greater than nit000',   & 
     106         &                                       ' restart capability not implemented' ) 
     107      IF( nitend < nitend_han )   CALL ctl_stop( 'dia_harm_init : nitend_han must be lower than nitend',   & 
     108         &                                       'restart capability not implemented' ) 
     109 
     110      IF( MOD( nitend_han-nit000_han+1 , nstep_han ) /= 0 )   & 
     111         &                        CALL ctl_stop( 'dia_harm_init : analysis time span must be a multiple of nstep_han' ) 
     112 
     113      nb_ana = 0 
     114      DO jk=1,jpmax_harmo 
     115         DO ji=1,jpmax_harmo 
     116            IF(TRIM(tname(jk)) == Wave(ji)%cname_tide) THEN 
     117               nb_ana=nb_ana+1 
     118            ENDIF 
     119         END DO 
     120      END DO 
     121      ! 
     122      IF(lwp) THEN 
     123         WRITE(numout,*) '        Namelist nam_diaharm' 
     124         WRITE(numout,*) '        nb_ana    = ', nb_ana 
     125         CALL flush(numout) 
    160126      ENDIF 
     127      ! 
     128      IF (nb_ana > jpmax_harmo) THEN 
     129         WRITE(ctmp1,*) ' nb_ana must be lower than jpmax_harmo' 
     130         WRITE(ctmp2,*) ' jpmax_harmo= ', jpmax_harmo 
     131         CALL ctl_stop( 'dia_harm_init', ctmp1, ctmp2 ) 
     132      ENDIF 
     133 
     134      ALLOCATE(name    (nb_ana)) 
     135      DO jk=1,nb_ana 
     136       DO ji=1,jpmax_harmo 
     137          IF (TRIM(tname(jk)) ==  Wave(ji)%cname_tide) THEN 
     138             name(jk) = ji 
     139             EXIT 
     140          END IF 
     141       END DO 
     142      END DO 
     143 
     144      ! Initialize frequency array: 
     145      ! --------------------------- 
     146      ALLOCATE( ana_freq(nb_ana), ut(nb_ana), vt(nb_ana), ft(nb_ana) ) 
     147 
     148      CALL tide_harmo( ana_freq, vt, ut, ft, name, nb_ana ) 
     149 
     150      IF(lwp) WRITE(numout,*) 'Analysed frequency  : ',nb_ana ,'Frequency ' 
     151 
     152      DO jh = 1, nb_ana 
     153        IF(lwp) WRITE(numout,*) '                    : ',tname(jh),' ',ana_freq(jh) 
     154      END DO 
     155 
     156      ! Initialize temporary arrays: 
     157      ! ---------------------------- 
     158      ALLOCATE( ana_temp(jpi,jpj,2*nb_ana,3) ) 
     159      ana_temp(:,:,:,:) = 0._wp 
    161160 
    162161   END SUBROUTINE dia_harm_init 
     
    178177      !!-------------------------------------------------------------------- 
    179178      IF( ln_timing )   CALL timing_start('dia_harm') 
     179      ! 
     180      IF( kt == nit000 )   CALL dia_harm_init 
    180181      ! 
    181182      IF( kt >= nit000_han .AND. kt <= nitend_han .AND. MOD(kt,nstep_han) == 0 ) THEN 
     
    421422      INTEGER, INTENT(in) ::   init  
    422423      ! 
    423       INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jh1_sd, jh2_sd 
     424      INTEGER                         :: ji_sd, jj_sd, ji1_sd, ji2_sd, jk1_sd, jk2_sd 
    424425      REAL(wp)                        :: zval1, zval2, zx1 
    425426      REAL(wp), DIMENSION(jpincomax) :: ztmpx, zcol1, zcol2 
     
    433434         ztmp3(:,:) = 0._wp 
    434435         ! 
    435          DO jh1_sd = 1, nsparse 
    436             DO jh2_sd = 1, nsparse 
    437                nisparse(jh2_sd) = nisparse(jh2_sd) 
    438                njsparse(jh2_sd) = njsparse(jh2_sd) 
    439                IF( nisparse(jh2_sd) == nisparse(jh1_sd) ) THEN 
    440                   ztmp3(njsparse(jh1_sd),njsparse(jh2_sd)) = ztmp3(njsparse(jh1_sd),njsparse(jh2_sd))  & 
    441                      &                                     + valuesparse(jh1_sd)*valuesparse(jh2_sd) 
     436         DO jk1_sd = 1, nsparse 
     437            DO jk2_sd = 1, nsparse 
     438               nisparse(jk2_sd) = nisparse(jk2_sd) 
     439               njsparse(jk2_sd) = njsparse(jk2_sd) 
     440               IF( nisparse(jk2_sd) == nisparse(jk1_sd) ) THEN 
     441                  ztmp3(njsparse(jk1_sd),njsparse(jk2_sd)) = ztmp3(njsparse(jk1_sd),njsparse(jk2_sd))  & 
     442                     &                                     + valuesparse(jk1_sd)*valuesparse(jk2_sd) 
    442443               ENDIF 
    443444            END DO 
     
    514515   END SUBROUTINE SUR_DETERMINE 
    515516 
     517#else 
     518   !!---------------------------------------------------------------------- 
     519   !!   Default case :   Empty module 
     520   !!---------------------------------------------------------------------- 
     521   LOGICAL, PUBLIC, PARAMETER ::   lk_diaharm = .FALSE. 
     522CONTAINS 
     523   SUBROUTINE dia_harm ( kt )     ! Empty routine 
     524      INTEGER, INTENT( IN ) :: kt   
     525      WRITE(*,*) 'dia_harm: you should not have seen this print' 
     526   END SUBROUTINE dia_harm 
     527#endif 
     528 
    516529   !!====================================================================== 
    517530END MODULE diaharm 
  • NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_DYN_optimization/src/OCE/DYN/dynspg_ts.F90

    r11372 r11380  
    6464   USE diatmb          ! Top,middle,bottom output 
    6565 
    66    USE iom   ! to remove 
    6766 
    6867   IMPLICIT NONE 
     
    7877   REAL(wp),SAVE :: rdtbt       ! Barotropic time step 
    7978   ! 
    80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::   wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields 
    81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   zwz                ! ff_f/h at F points 
    82    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftnw, ftne         ! triad of coriolis parameter 
    83    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ftsw, ftse         ! (only used with een vorticity scheme) 
     79   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:)   ::  wgtbtp1, wgtbtp2   ! 1st & 2nd weights used in time filtering of barotropic fields 
     80   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  zwz                ! ff_f/h at F points 
     81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftnw, ftne         ! triad of coriolis parameter 
     82   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ftsw, ftse         ! (only used with een vorticity scheme) 
     83 
     84   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  ! 
     85   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ubb_e  ,  ub_e  ,  un_e  , ua_e   !: u-external velocity 
     86   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   vbb_e  ,  vb_e  ,  vn_e  , va_e   !: v-external velocity 
     87   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   sshbb_e,  sshb_e,  sshn_e, ssha_e !: external ssh 
     88   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hu_e   !: external u-depth 
     89   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hv_e   !: external v-depth 
     90   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hur_e  !: inverse of u-depth 
     91   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::                              hvr_e  !: inverse of v-depth 
     92   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b  , vb2_b          !: Half step fluxes (ln_bt_fw=T) 
     93   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_bf  , vn_bf          !: Asselin filtered half step fluxes (ln_bt_fw=T) 
     94 
     95   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ht_0_xtd    , hu_0_xtd    , hv_0_xtd 
     96   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::                 hu_n_xtd    , hv_n_xtd 
     97   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1e2t_xtd, r1_e1e2u_xtd, r1_e1e2v_xtd 
     98   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e1e2t_xtd 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   e2u_xtd   , e1v_xtd 
     100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   r1_e1u_xtd, r1_e2v_xtd 
     101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask_xtd, ssumask_xtd, ssvmask_xtd 
     102   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_t_xtd   ! used in ENT scheme 
     103 
     104#if defined key_agrif 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_i_b, vb2_i_b         !: Half step time integrated fluxes  
     106#endif 
    84107 
    85108   REAL(wp) ::   r1_12 = 1._wp / 12._wp   ! local ratios 
     
    101124      !!                  ***  routine dyn_spg_ts_alloc  *** 
    102125      !!---------------------------------------------------------------------- 
    103       INTEGER :: ierr(3) 
     126      INTEGER :: ierr(6) 
     127      INTEGER :: idbi, idei, idbj, idej   ! lower/upper bounds of extended arrays 
    104128      !!---------------------------------------------------------------------- 
    105129      ierr(:) = 0 
    106       ! 
    107       ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT=ierr(1) ) 
    108       IF( ln_dynvor_een .OR. ln_dynvor_eeT )   & 
    109          &     ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , ftsw(jpi,jpj) , ftse(jpi,jpj), STAT=ierr(2)   ) 
     130      idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts 
     131      idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts 
     132      ! 
     133      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(idbi:idei,idbj:idej), STAT=ierr(1) ) 
     134      IF( ln_dynvor_een .OR. ln_dynvor_eeT ) THEN 
     135         ALLOCATE( ftnw(idbi:idei,idbj:idej) , ftne(idbi:idei,idbj:idej) , ftsw(idbi:idei,idbj:idej) , ftse(idbi:idei,idbj:idej) & 
     136         &                                      , STAT=ierr(2) ) 
     137      ELSEIF( ln_dynvor_enT ) THEN 
     138         ALLOCATE( ff_t_xtd(idbi:idei,idbj:idej), STAT=ierr(2) ) 
     139      END IF 
    110140         ! 
    111141      ALLOCATE( un_adv(jpi,jpj), vn_adv(jpi,jpj)                    , STAT=ierr(3) ) 
     142      ALLOCATE( ssha_e(idbi:idei,idbj:idej), sshn_e(idbi:idei,idbj:idej), sshb_e(idbi:idei,idbj:idej), sshbb_e(idbi:idei,idbj:idej) & 
     143         &      , ua_e(idbi:idei,idbj:idej),   un_e(idbi:idei,idbj:idej),   ub_e(idbi:idei,idbj:idej),   ubb_e(idbi:idei,idbj:idej) & 
     144         &      , va_e(idbi:idei,idbj:idej),   vn_e(idbi:idei,idbj:idej),   vb_e(idbi:idei,idbj:idej),   vbb_e(idbi:idei,idbj:idej) & 
     145         &      , hu_e(idbi:idei,idbj:idej),  hur_e(idbi:idei,idbj:idej),   hv_e(idbi:idei,idbj:idej),   hvr_e(idbi:idei,idbj:idej) & 
     146         &      , STAT=ierr(4) ) 
     147         ! 
     148      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), un_bf(jpi,jpj), vn_bf(jpi,jpj)     , STAT=ierr(5) ) 
     149 
     150#if defined key_agrif 
     151      ALLOCATE( ub2_i_b(jpi,jpj), vb2_i_b(jpi,jpj)                                  , STAT=ierr(5) ) 
     152#endif 
     153      ALLOCATE( ht_0_xtd    (idbi:idei,idbj:idej), hu_0_xtd    (idbi:idei,idbj:idej), hv_0_xtd    (idbi:idei,idbj:idej) & 
     154         &    , r1_e1e2t_xtd(idbi:idei,idbj:idej), r1_e1e2u_xtd(idbi:idei,idbj:idej), r1_e1e2v_xtd(idbi:idei,idbj:idej) & 
     155         &    , ssmask_xtd  (idbi:idei,idbj:idej), ssumask_xtd (idbi:idei,idbj:idej), ssvmask_xtd (idbi:idei,idbj:idej) & 
     156         &    , e1e2t_xtd   (idbi:idei,idbj:idej), e2u_xtd     (idbi:idei,idbj:idej), e1v_xtd     (idbi:idei,idbj:idej) & 
     157         &    , r1_e1u_xtd  (idbi:idei,idbj:idej), r1_e2v_xtd  (idbi:idei,idbj:idej)                                    & 
     158         &    , STAT=ierr(6) ) 
    112159      ! 
    113160      dyn_spg_ts_alloc = MAXVAL( ierr(:) ) 
     
    146193      INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
    147194      ! 
    148       INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
     195      INTEGER  ::   ji, jj, jk, jm        ! dummy loop indices 
    149196      LOGICAL  ::   ll_fw_start           ! =T : forward integration  
    150197      LOGICAL  ::   ll_init               ! =T : special startup of 2d equations 
     
    155202      REAL(wp) ::   zhu_bck, zhv_bck, zhdiv         !   -      - 
    156203      REAL(wp) ::   zun_save, zvn_save              !   -      - 
    157       REAL(wp), DIMENSION(jpi,jpj) :: zu_trd, zu_frc, zu_spg, zssh_frc 
    158       REAL(wp), DIMENSION(jpi,jpj) :: zv_trd, zv_frc, zv_spg 
    159       REAL(wp), DIMENSION(jpi,jpj) :: zsshu_a, zhup2_e, zhtp2_e 
    160       REAL(wp), DIMENSION(jpi,jpj) :: zsshv_a, zhvp2_e, zsshp2_e 
    161       REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v   ! top/bottom stress at u- & v-points 
    162       REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV         ! fluxes 
     204      ! 
     205      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_trd, zssh_frc 
     206      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zv_trd 
     207      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zhU   , zhV 
     208      ! 
     209      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: hu_n_xtd, hv_n_xtd 
     210      ! 
     211      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_spg , zv_spg 
     212      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zu_frc , zv_frc 
     213      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsshu_a, zhup2_e, zhtp2_e 
     214      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zsshv_a, zhvp2_e, zsshp2_e 
     215      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zCdU_u , zCdU_v   ! top/bottom stress at u- & v-points 
     216 
    163217      ! 
    164218      REAL(wp) ::   zwdramp                     ! local scalar - only used if ln_wd_dl = .True.  
     
    170224      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points 
    171225      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask 
    172       !!---------------------------------------------------------------------- 
    173       ! 
     226 
     227 
     228      INTEGER  :: idbi, idei, idbj, idej   ! lower/upper bounds of extended arrays 
     229      INTEGER  :: ixtd                     ! number of halos over which the solution is currently correct 
     230      INTEGER  :: ibi, iei, ibj, iej       ! lower and upper bounds over which the solution is currently correct 
     231      !!---------------------------------------------------------------------- 
     232      ! 
     233 
     234 
    174235      IF( ln_wd_il ) ALLOCATE( zcpx(jpi,jpj), zcpy(jpi,jpj) ) 
    175236      !                                         !* Allocate temporary arrays 
    176       IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj)) 
     237      IF( ln_wd_dl ) ALLOCATE( ztwdmask(jpi,jpj), zuwdmask(jpi,jpj), zvwdmask(jpi,jpj), zuwdav2(jpi,jpj), zvwdav2(jpi,jpj) ) 
     238       
     239      idbi = 1   - nn_hlts   ;   idbj = 1   - nn_hlts 
     240      idei = jpi + nn_hlts   ;   idej = jpj + nn_hlts 
     241      !                                  ! allocate local arrays 
     242      ALLOCATE( zu_spg  (idbi:idei,idbj:idej), zv_spg  (idbi:idei,idbj:idej)  & 
     243         &    , zsshu_a (idbi:idei,idbj:idej), zsshv_a (idbi:idei,idbj:idej)  & 
     244         &    , zhup2_e (idbi:idei,idbj:idej), zhvp2_e (idbi:idei,idbj:idej)  & 
     245         &    ,  zCdU_u (idbi:idei,idbj:idej), zCdU_v  (idbi:idei,idbj:idej)  & 
     246         &    , zhtp2_e (idbi:idei,idbj:idej), zsshp2_e(idbi:idei,idbj:idej)  &  
     247         &    , zu_trd  (idbi:idei,idbj:idej), zu_frc  (idbi:idei,idbj:idej)  & 
     248         &    , zv_trd  (idbi:idei,idbj:idej), zv_frc  (idbi:idei,idbj:idej)  & 
     249         &    , zhU     (idbi:idei,idbj:idej), zhV     (idbi:idei,idbj:idej)  & 
     250         &    , zssh_frc(idbi:idei,idbj:idej)                                 ) 
     251      !                                  ! allocate redundant arrays 
     252      ALLOCATE( hu_n_xtd(idbi:idei,idbj:idej), hv_n_xtd(idbi:idei,idbj:idej)  ) 
    177253      ! 
    178254      zmdi=1.e+20                               !  missing data indicator for masking 
     
    227303      !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends) 
    228304      !                                   !  ---------------------------  ! 
    229       zu_frc(:,:) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:) 
    230       zv_frc(:,:) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:) 
     305      zu_frc(1:jpi,1:jpj) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:) 
     306      zv_frc(1:jpi,1:jpj) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:) 
    231307      ! 
    232308      ! 
    233309      !                                   !=  Ua => baroclinic trend  =!   (remove its vertical mean) 
    234310      DO jk = 1, jpkm1                    !  ------------------------  ! 
    235          ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(:,:) ) * umask(:,:,jk) 
    236          va(:,:,jk) = ( va(:,:,jk) - zv_frc(:,:) ) * vmask(:,:,jk) 
     311         ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(1:jpi,1:jpj) ) * umask(:,:,jk) 
     312         va(:,:,jk) = ( va(:,:,jk) - zv_frc(1:jpi,1:jpj) ) * vmask(:,:,jk) 
    237313      END DO 
    238314       
     
    243319      !                                   !  -------------------------------------------------  ! 
    244320      ! 
    245       IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init   ! Set zwz, the barotropic Coriolis force coefficient 
    246       !       ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes 
     321      ! Set zwz, the barotropic Coriolis force coefficient 
     322      ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes 
     323      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2d_init( idbi, idei, idbj, idej ) 
    247324      ! 
    248325      !                                         !* 2D Coriolis trends 
    249       zhU(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    250       zhV(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    251       ! 
    252       CALL dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in 
    253          &                               zu_trd, zv_trd   )   ! ==>> out 
     326      zhU(1:jpi,1:jpj) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
     327      zhV(1:jpi,1:jpj) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
     328      ! 
     329      !                            ! ht_n, hu_n, hv_n, un_b, vn_b are of size    1:jpi      1:jpj 
     330      !                            ! zhU, zhV, zu_trd, zv_trd     are of size idbi:idei  idbj:idej 
     331      CALL dyn_cor_2d( ht_n, hu_n, hv_n, un_b, vn_b, zhU, zhV,  1   , jpi , 1   ,  jpj   &   ! <<== in 
     332         &                                   , zu_trd, zv_trd,  idbi, idei, idbj, idej   )   ! ==>> out 
    254333      ! 
    255334      IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only) 
     
    285364      !                                   !=  Add bottom stress contribution from baroclinic velocities  =! 
    286365      !                                   !  -----------------------------------------------------------  ! 
    287       CALL dyn_drg_init( zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients 
     366      CALL drg_init( idbi, idei, idbj, idej,  zu_frc, zv_frc,  zCdU_u, zCdU_v )   ! also provide the barotropic drag coefficients 
     367      !                                                                           ! arrays are computed on inner domain 
    288368      ! 
    289369      !                                   !=  Add atmospheric pressure forcing  =! 
     
    335415      !                                   ! ---------------------------------------------------  ! 
    336416      IF (ln_bt_fw) THEN                          ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2) 
    337          zssh_frc(:,:) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  ) 
     417         zssh_frc(1:jpi,1:jpj) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  ) 
    338418      ELSE                                        ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW) 
    339419         zztmp = r1_rau0 * r1_2 
    340          zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  ) 
     420         zssh_frc(1:jpi,1:jpj) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  ) 
    341421      ENDIF 
    342422      !                                   !=  Add Stokes drift divergence  =!   (if exist) 
    343423      IF( ln_sdw ) THEN                   !  -----------------------------  ! 
    344          zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 
     424         zssh_frc(1:jpi,1:jpj) = zssh_frc(1:jpi,1:jpj) + div_sd(:,:) 
    345425      ENDIF 
    346426      ! 
     
    349429      !                                   !  ------------------------------------  ! 
    350430      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
    351          zssh_frc(:,:) = zssh_frc(:,:) - ssh_iau(:,:) 
     431         zssh_frc(1:jpi,1:jpj) = zssh_frc(1:jpi,1:jpj) - ssh_iau(:,:) 
    352432      ENDIF 
    353433#endif 
     
    357437         IF( .NOT.Agrif_Root() ) CALL agrif_dta_ts( kt ) 
    358438#endif 
     439 
     440 
    359441      ! 
    360442      ! ----------------------------------------------------------------------- 
     
    366448      !                                             ! ==================== !   
    367449      ! Initialize barotropic variables:       
    368       IF( ll_init )THEN 
     450      IF( ll_init ) THEN 
    369451         sshbb_e(:,:) = 0._wp 
    370452         ubb_e  (:,:) = 0._wp 
     
    376458      ! 
    377459      IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0) 
    378          zhup2_e(:,:) = hu_n(:,:) 
    379          zhvp2_e(:,:) = hv_n(:,:) 
    380          zhtp2_e(:,:) = ht_n(:,:) 
     460         zhtp2_e(1:jpi,1:jpj) = ht_n(1:jpi,1:jpj) 
     461         zhup2_e(1:jpi,1:jpj) = hu_n(1:jpi,1:jpj)  
     462         zhvp2_e(1:jpi,1:jpj) = hv_n(1:jpi,1:jpj) 
    381463      ENDIF 
    382464      ! 
    383465      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    384          sshn_e(:,:) =    sshn(:,:)             
    385          un_e  (:,:) =    un_b(:,:)             
    386          vn_e  (:,:) =    vn_b(:,:) 
    387          ! 
    388          hu_e  (:,:) =    hu_n(:,:)        
    389          hv_e  (:,:) =    hv_n(:,:)  
    390          hur_e (:,:) = r1_hu_n(:,:)     
    391          hvr_e (:,:) = r1_hv_n(:,:) 
     466         sshn_e(1:jpi,1:jpj) =    sshn(1:jpi,1:jpj) 
     467         un_e  (1:jpi,1:jpj) =    un_b(1:jpi,1:jpj) 
     468         vn_e  (1:jpi,1:jpj) =    vn_b(1:jpi,1:jpj) 
     469         ! 
     470         hu_e  (1:jpi,1:jpj) =    hu_n(1:jpi,1:jpj) 
     471         hv_e  (1:jpi,1:jpj) =    hv_n(1:jpi,1:jpj) 
     472         hur_e (1:jpi,1:jpj) = r1_hu_n(1:jpi,1:jpj) 
     473         hvr_e (1:jpi,1:jpj) = r1_hv_n(1:jpi,1:jpj) 
    392474      ELSE                                ! CENTRED integration: start from BEFORE fields 
    393          sshn_e(:,:) =    sshb(:,:) 
    394          un_e  (:,:) =    ub_b(:,:)          
    395          vn_e  (:,:) =    vb_b(:,:) 
    396          ! 
    397          hu_e  (:,:) =    hu_b(:,:)        
    398          hv_e  (:,:) =    hv_b(:,:)  
    399          hur_e (:,:) = r1_hu_b(:,:)     
    400          hvr_e (:,:) = r1_hv_b(:,:) 
    401       ENDIF 
     475         sshn_e(1:jpi,1:jpj) =    sshb(1:jpi,1:jpj) 
     476         un_e  (1:jpi,1:jpj) =    ub_b(1:jpi,1:jpj) 
     477         vn_e  (1:jpi,1:jpj) =    vb_b(1:jpi,1:jpj) 
     478         ! 
     479         hu_e  (1:jpi,1:jpj) =    hu_b(1:jpi,1:jpj) 
     480         hv_e  (1:jpi,1:jpj) =    hv_b(1:jpi,1:jpj) 
     481         hur_e (1:jpi,1:jpj) = r1_hu_b(1:jpi,1:jpj) 
     482         hvr_e (1:jpi,1:jpj) = r1_hv_b(1:jpi,1:jpj) 
     483      ENDIF 
     484      ! 
     485      hu_n_xtd(1:jpi,1:jpj) = hu_n(1:jpi,1:jpj) 
     486      hv_n_xtd(1:jpi,1:jpj) = hv_n(1:jpi,1:jpj) 
     487      ! 
     488      ! 
     489      !                                   !  Extend arrays  
     490      !                                   ! -------------- 
     491      ! 
     492      IF( ln_linssh ) THEN 
     493         CALL lbc_lnk_multi( 'dynspg_ts', hu_n_xtd, 'U', -1._wp,   hv_n_xtd, 'V', -1._wp   & 
     494              &                         , zCdU_u  , 'U', -1._wp,   zCdU_v  , 'V', -1._wp   & 
     495              &                         , zu_frc  , 'U', -1._wp,   zv_frc  , 'V', -1._wp   & 
     496              &                         ,  un_e   , 'U', -1._wp,   vn_e    , 'V', -1._wp   & 
     497              &                         ,  hu_e   , 'U', -1._wp,   hv_e    , 'V', -1._wp   & 
     498              &                         ,  hur_e  , 'U', -1._wp,   hvr_e   , 'V', -1._wp   & 
     499              &  , zhtp2_e , 'T',  1._wp,  zhup2_e, 'U', -1._wp,   zhvp2_e , 'V', -1._wp   & 
     500              &  , zssh_frc, 'T',  1._wp,  sshn_e , 'T',  1._wp,   khlcom = nn_hls+nn_hlts ) 
     501      ELSE 
     502         CALL lbc_lnk_multi( 'dynspg_ts', hu_n_xtd, 'U', -1._wp,   hv_n_xtd, 'V', -1._wp   & 
     503              &                         , zCdU_u  , 'U', -1._wp,   zCdU_v  , 'V', -1._wp   & 
     504              &                         , zu_frc  , 'U', -1._wp,   zv_frc  , 'V', -1._wp   & 
     505              &                         ,  un_e   , 'U', -1._wp,   vn_e    , 'V', -1._wp   & 
     506              &                         ,  hu_e   , 'U', -1._wp,   hv_e    , 'V', -1._wp   & 
     507              &                         ,  hur_e  , 'U', -1._wp,   hvr_e   , 'V', -1._wp   & 
     508              &  , zssh_frc, 'T',  1._wp,  sshn_e , 'T',  1._wp,   khlcom = nn_hls+nn_hlts ) 
     509      END IF 
    402510      ! 
    403511      ! Initialize sums: 
     
    413521         zuwdav2 (:,:) = 0._wp  
    414522         zvwdav2 (:,:) = 0._wp    
    415       END IF  
    416  
     523      END IF 
     524 
     525      ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain (interior + regular halos + time splitting halos) 
     526      ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts 
     527      iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts 
    417528      !                                             ! ==================== ! 
    418       DO jn = 1, icycle                             !  sub-time-step loop  ! 
     529      DO jm = 1, icycle                             !  sub-time-step loop  ! 
    419530         !                                          ! ==================== ! 
    420531         ! 
    421          l_full_nf_update = jn == icycle   ! false: disable full North fold update (performances) for jn = 1 to icycle-1 
     532         l_full_nf_update = jm == icycle   ! false: disable full North fold update (performances) for jm = 1 to icycle-1 
    422533         ! 
    423534         !                    !==  Update the forcing ==! (BDY and tides) 
    424535         ! 
    425          IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, kt_offset= noffset+1 ) 
    426          IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, kt_offset= noffset   ) 
    427          ! 
    428          !                    !==  extrapolation at mid-step  ==!   (jn+1/2) 
     536         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jm, kt_offset= noffset+1 ) 
     537         IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jm, kt_offset= noffset   ) 
     538         ! 
     539         !                    !==  extrapolation at mid-step  ==!   (jm+1/2) 
    429540         ! 
    430541         !                       !* Set extrapolation coefficients for predictor step: 
    431          IF ((jn<3).AND.ll_init) THEN      ! Forward            
     542         IF( (jm<3) .AND. ll_init ) THEN      ! Forward            
    432543           za1 = 1._wp                                           
    433544           za2 = 0._wp                         
     
    439550         ENDIF 
    440551         ! 
    441          !                       !* Extrapolate barotropic velocities at mid-step (jn+1/2) 
     552         !                       !* Extrapolate barotropic velocities at mid-step (jm+1/2) 
    442553         !--        m+1/2               m                m-1           m-2       --! 
    443554         !--       u      = (3/2+beta) u   -(1/2+2beta) u      + beta u          --! 
    444555         !-------------------------------------------------------------------------! 
    445          ua_e(:,:) = za1 * un_e(:,:) + za2 * ub_e(:,:) + za3 * ubb_e(:,:) 
    446          va_e(:,:) = za1 * vn_e(:,:) + za2 * vb_e(:,:) + za3 * vbb_e(:,:) 
     556         ua_e(ibi:iei,ibj:iej) = za1 * un_e(ibi:iei,ibj:iej) + za2 * ub_e(ibi:iei,ibj:iej) + za3 * ubb_e(ibi:iei,ibj:iej) 
     557         va_e(ibi:iei,ibj:iej) = za1 * vn_e(ibi:iei,ibj:iej) + za2 * vb_e(ibi:iei,ibj:iej) + za3 * vbb_e(ibi:iei,ibj:iej) 
    447558 
    448559         IF( .NOT.ln_linssh ) THEN                        !* Update ocean depth (variable volume case only) 
    449560            !                                             !  ------------------ 
    450             ! Extrapolate Sea Level at step jit+0.5: 
     561            !                    !* Extrapolate Sea Level at mid-step (jm+1/2) 
    451562            !--         m+1/2                 m                  m-1             m-2       --! 
    452563            !--      ssh      = (3/2+beta) ssh   -(1/2+2beta) ssh      + beta ssh          --! 
    453564            !--------------------------------------------------------------------------------! 
    454             zsshp2_e(:,:) = za1 * sshn_e(:,:)  + za2 * sshb_e(:,:) + za3 * sshbb_e(:,:) 
    455              
     565            zsshp2_e(ibi:iei,ibj:iej) =  za1 * sshn_e (ibi:iei,ibj:iej)  +  za2 * sshb_e(ibi:iei,ibj:iej)   & 
     566                 &                    +  za3 * sshbb_e(ibi:iei,ibj:iej) 
    456567            ! set wetting & drying mask at tracer points for this barotropic mid-step 
    457568            IF( ln_wd_dl )   CALL wad_tmsk( zsshp2_e, ztwdmask ) 
    458569            ! 
    459570            !                          ! ocean t-depth at mid-step 
    460             zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 
     571            zhtp2_e(ibi:iei,ibj:iej) = ht_0_xtd(ibi:iei,ibj:iej) + zsshp2_e(ibi:iei,ibj:iej) 
    461572            ! 
    462             !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
    463             DO jj = 1, jpj 
    464                DO ji = 1, jpim1   ! not jpi-column 
    465                   zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    466                        &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    467                        &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    468                END DO 
    469             END DO 
    470             DO jj = 1, jpjm1        ! not jpj-row 
    471                DO ji = 1, jpi 
    472                   zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    473                        &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    474                        &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     573            !                          ! ocean u- and v-depth at mid-step 
     574            DO jj = ibj, iej-1      ! not last column, not last row 
     575               DO ji = ibi, iei-1 
     576                  zhup2_e(ji,jj) = hu_0_xtd(ji,jj) + r1_2 * r1_e1e2u_xtd(ji,jj)                 & 
     577                       &                           * (  e1e2t_xtd(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     578                       &                              + e1e2t_xtd(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask_xtd(ji,jj) 
     579                  zhvp2_e(ji,jj) = hv_0_xtd(ji,jj) + r1_2 * r1_e1e2v_xtd(ji,jj)                 & 
     580                       &                           * (  e1e2t_xtd(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     581                       &                              + e1e2t_xtd(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask_xtd(ji,jj) 
    475582               END DO 
    476583            END DO 
     
    478585         ENDIF 
    479586         ! 
    480          !                    !==  after SSH  ==!   (jn+1) 
     587         !                    !==  after SSH  ==!   (jm+1) 
    481588         ! 
    482589         !                             ! update (ua_e,va_e) to enforce volume conservation at open boundaries 
    483590         !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d 
    484          IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 
     591         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jm, ua_e, va_e, zhup2_e, zhvp2_e ) 
    485592         ! 
    486593         !                             ! resulting flux at mid-step (not over the full domain) 
    487          zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column 
    488          zhV(1:jpi  ,1:jpjm1) = e1v(1:jpi  ,1:jpjm1) * va_e(1:jpi  ,1:jpjm1) * zhvp2_e(1:jpi  ,1:jpjm1)   ! not jpj-row 
     594         zhU(ibi:iei-1,ibj:iej-1) = e2u_xtd(ibi:iei-1,ibj:iej-1) * ua_e(ibi:iei-1,ibj:iej-1) * zhup2_e(ibi:iei-1,ibj:iej-1) 
     595         zhV(ibi:iei-1,ibj:iej-1) = e1v_xtd(ibi:iei-1,ibj:iej-1) * va_e(ibi:iei-1,ibj:iej-1) * zhvp2_e(ibi:iei-1,ibj:iej-1) 
    489596         ! 
    490597#if defined key_agrif 
     
    524631            ! 
    525632         ENDIF     
    526          ! 
    527          ! 
    528          !     Compute Sea Level at step jit+1 
    529          !--           m+1        m                               m+1/2          --! 
    530          !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    531          !-------------------------------------------------------------------------! 
    532          DO jj = 2, jpjm1        ! INNER domain                              
    533             DO ji = 2, jpim1 
    534                zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    535                ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
    536             END DO 
    537          END DO 
    538          ! 
    539          CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
    540          ! 
    541          !                             ! Sum over sub-time-steps to compute advective velocities 
    542          za2 = wgtbtp2(jn)             ! zhU, zhV hold fluxes extrapolated at jn+0.5 
    543          un_adv(:,:) = un_adv(:,:) + za2 * zhU(:,:) * r1_e2u(:,:) 
    544          vn_adv(:,:) = vn_adv(:,:) + za2 * zhV(:,:) * r1_e1v(:,:) 
    545633         ! sum over sub-time-steps to decide which baroclinic velocities to set to zero (zuwdav2 is only used when ln_wd_dl_bc=True)  
    546634         IF ( ln_wd_dl_bc ) THEN 
     
    548636            zvwdav2(1:jpi  ,1:jpjm1) = zvwdav2(1:jpi  ,1:jpjm1) + za2 * zvwdmask(1:jpi  ,1:jpjm1)   ! not jpj-row 
    549637         END IF 
     638         !                              
     639         ! Sum over sub-time-steps to compute advective velocities (only correct on interior domain) 
     640         za2 = wgtbtp2(jm)             ! zhU, zhV hold fluxes extrapolated at jm+1/2 
     641         un_adv(1:jpi,1:jpj) = un_adv(1:jpi,1:jpj) + za2 * zhU(1:jpi,1:jpj) * r1_e2u(1:jpi,1:jpj) 
     642         vn_adv(1:jpi,1:jpj) = vn_adv(1:jpi,1:jpj) + za2 * zhV(1:jpi,1:jpj) * r1_e1v(1:jpi,1:jpj) 
     643         ! 
     644         ! 
     645         !     Compute Sea Level at step jit+1 
     646         !--           m+1        m                               m+1/2          --! 
     647         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
     648         !-------------------------------------------------------------------------! 
     649         ! correct domain reduction 
     650         ixtd = ixtd - 1 
     651         ibi = ibi + 1   ;   ibj = ibj + 1 
     652         iei = iei - 1   ;   iej = iej - 1 
     653         DO jj = ibj, iej 
     654            DO ji = ibi, iei 
     655               zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t_xtd(ji,jj) 
     656               ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask_xtd(ji,jj) 
     657            END DO 
     658         END DO 
     659         ! 
     660         IF( nn_hlts == 0 ) THEN 
     661            CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     662            ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain 
     663            ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts 
     664            iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts 
     665         END IF 
     666 
    550667         ! 
    551668         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
    552          IF( ln_bdy )   CALL bdy_ssh( ssha_e ) 
     669         IF( ln_bdy ) THEN 
     670            CALL swap_bdyptr   ! bdy treatment is now done on extended domain 
     671            CALL bdy_ssh( ssha_e, idbi, idei, idbj, idej, ldcomall=.true., pmask=ssmask_xtd, khlcom=nn_hls+nn_hlts ) 
     672            CALL swap_bdyptr   ! bdy treatment is now done on regular domain 
     673         END IF 
     674 
    553675#if defined key_agrif 
    554          IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jn ) 
     676         IF( .NOT.Agrif_Root() )   CALL agrif_ssh_ts( jm ) 
    555677#endif 
    556          !   
    557          ! Sea Surface Height at u-,v-points (vvl case only) 
    558          IF( .NOT.ln_linssh ) THEN                                 
    559             DO jj = 2, jpjm1   ! INNER domain, will be extended to whole domain later 
    560                DO ji = 2, jpim1      ! NO Vector Opt. 
    561                   zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    562                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    563                      &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
    564                   zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
    565                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    566                      &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
    567                END DO 
    568             END DO 
    569          ENDIF    
    570678         !          
    571679         ! Half-step back interpolation of SSH for surface pressure computation at step jit+1/2 
    572          !--            m+1/2           m+1              m               m-1              m-2     --! 
    573          !--        ssh'    =  za0 * ssh     +  za1 * ssh   +  za2 * ssh      +  za3 * ssh        --! 
    574          !------------------------------------------------------------------------------------------! 
    575          CALL ts_bck_interp( jn, ll_init, za0, za1, za2, za3 )   ! coeficients of the interpolation 
    576          zsshp2_e(:,:) = za0 *  ssha_e(:,:) + za1 *  sshn_e (:,:)   & 
    577             &          + za2 *  sshb_e(:,:) + za3 *  sshbb_e(:,:) 
     680         !--          m+1/2             m+1              m              m-1              m-2     --! 
     681         !--      ssh'      =  za0 * ssh     +  za1 * ssh   +  za2 * ssh     +  za3 * ssh        --! 
     682         !-----------------------------------------------------------------------------------------! 
     683         CALL ts_bck_interp( jm, ll_init, za0, za1, za2, za3 )   ! coeficients of the interpolation 
     684         zsshp2_e(ibi:iei,ibj:iej) =  za0 * ssha_e(ibi:iei,ibj:iej)  +  za1 * sshn_e (ibi:iei,ibj:iej)   & 
     685            &                      +  za2 * sshb_e(ibi:iei,ibj:iej)  +  za3 * sshbb_e(ibi:iei,ibj:iej) 
     686         ! 
     687         ! 
     688         ! Sea Surface Height at u-,v-points (vvl case only) 
     689         IF( .NOT.ln_linssh ) THEN 
     690            DO jj = ibj, iej-1 
     691               DO ji = ibi, iei-1 
     692                  zsshu_a(ji,jj) = r1_2 * ssumask_xtd(ji,jj) * r1_e1e2u_xtd(ji,jj)    & 
     693                     &                  * ( e1e2t_xtd(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     694                     &                  +   e1e2t_xtd(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
     695                  zsshv_a(ji,jj) = r1_2 * ssvmask_xtd(ji,jj) * r1_e1e2v_xtd(ji,jj)    & 
     696                     &                  * ( e1e2t_xtd(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     697                     &                  +   e1e2t_xtd(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
     698               END DO 
     699            END DO 
     700         ENDIF 
    578701         ! 
    579702         !                             ! Surface pressure gradient 
    580703         zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor 
    581          DO jj = 2, jpjm1                             
    582             DO ji = 2, jpim1 
    583                zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    584                zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
     704         DO jj = ibj, iej-1 
     705            DO ji = ibi, iei-1 
     706               zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u_xtd(ji,jj) 
     707               zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v_xtd(ji,jj) 
    585708            END DO 
    586709         END DO 
     
    592715         ! 
    593716         ! Add Coriolis trend: 
    594          ! zwz array below or triads normally depend on sea level with ln_linssh=F and should be updated 
     717         ! - zwz array used in dyn_cor_2d or triads normally depend on sea level with ln_linssh=F and should be updated 
    595718         ! at each time step. We however keep them constant here for optimization. 
    596          ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 
    597          CALL dyn_cor_2d( zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV,    zu_trd, zv_trd   ) 
     719         ! - Recall that zhU and zhV hold fluxes at jm+1/2 (extrapolated not backward interpolated) 
     720         ! - zu_trd_xtd and zv_trd_xtd are only correct on (ibi+1:iei-1,ibj+1:iej-1) 
     721         ! NOTE : input flux arguments have to be correct (ibi:iei,ibj:iej) -> a lbc call between input arguments computation 
     722         !        and this call without fluxes (typically after ssh at step m+1 computation) would not yield correct results  
     723         CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e,  ua_e, va_e,  zhU, zhV  , idbi, idei, idbj, idej   & 
     724              &                                           , zu_trd, zv_trd   , idbi, idei, idbj, idej   ) 
    598725         ! 
    599726         ! Add tidal astronomical forcing if defined 
     727         ! pot_astro is correct on 1:jpi,1:jpj 
    600728         IF ( ln_tide .AND. ln_tide_pot ) THEN 
    601729            DO jj = 2, jpjm1 
     
    610738!jth do implicitly instead 
    611739         IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 
    612             DO jj = 2, jpjm1 
    613                DO ji = fs_2, fs_jpim1   ! vector opt. 
     740            DO jj = ibj, iej 
     741               DO ji = ibi, iei 
    614742                  zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    615743                  zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
     
    624752         !--  u     =             u   + delta_t' * \         (1-r)*g * grad_x( ssh') -         f * k vect u      +     frc /    --! 
    625753         !--                                                                                                                    --! 
    626          !--                             FLUX FORM                                                                              --! 
     754         !--                               FLUX FORM                                                                            --! 
    627755         !--  m+1   __1__  /  m    m               /  m+1/2                             m+1/2              m+1/2    n      \ \  --! 
    628756         !-- u    =   m+1 |  h  * u   + delta_t' * \ h     * (1-r)*g * grad_x( ssh') - h     * f * k vect u      + h * frc /  | --! 
    629757         !--         h     \                                                                                                 /  --! 
    630758         !------------------------------------------------------------------------------------------------------------------------! 
     759         ! correct domain reduction 
     760         ixtd = ixtd - 1 
     761         ibi = ibi + 1   ;   ibj = ibj + 1 
     762         iei = iei - 1   ;   iej = iej - 1 
     763         ! 
    631764         IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form 
    632             DO jj = 2, jpjm1 
    633                DO ji = fs_2, fs_jpim1   ! vector opt. 
     765            DO jj = ibj, iej 
     766               DO ji = ibi, iei 
    634767                  ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
    635768                            &     + rdtbt * (                   zu_spg(ji,jj)   & 
    636769                            &                                 + zu_trd(ji,jj)   & 
    637770                            &                                 + zu_frc(ji,jj) ) &  
    638                             &   ) * ssumask(ji,jj) 
     771                            &   ) * ssumask_xtd(ji,jj) 
    639772 
    640773                  va_e(ji,jj) = (                                 vn_e(ji,jj)   & 
     
    642775                            &                                 + zv_trd(ji,jj)   & 
    643776                            &                                 + zv_frc(ji,jj) ) & 
    644                             &   ) * ssvmask(ji,jj) 
     777                            &   ) * ssvmask_xtd(ji,jj) 
    645778               END DO 
    646779            END DO 
    647780            ! 
    648781         ELSE                           !* Flux form 
    649             DO jj = 2, jpjm1 
    650                DO ji = 2, jpim1 
    651                   !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    652                   !                    ! backward interpolated depth used in spg terms at jn+1/2 
    653                   zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
    654                        &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    655                   zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    & 
    656                        &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
    657                   !                    ! inverse depth at jn+1 
    658                   z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    659                   z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     782            DO jj = ibj, iej 
     783               DO ji = ibi, iei 
     784                  !                    ! hu_e, hv_e hold depth at jm,  zhup2_e, zhvp2_e hold extrapolated depth at jm+1/2 
     785                  !                    ! backward interpolated depth used in spg terms at jm+1/2 
     786                  zhu_bck = hu_0_xtd(ji,jj) + r1_2*r1_e1e2u_xtd(ji,jj) * & 
     787                       &   ( e1e2t_xtd(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     788                       &   + e1e2t_xtd(ji+1,jj) * zsshp2_e(ji+1,jj) ) * ssumask_xtd(ji,jj) 
     789                  zhv_bck = hv_0_xtd(ji,jj) + r1_2*r1_e1e2v_xtd(ji,jj) * & 
     790                       &   ( e1e2t_xtd(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     791                       &   + e1e2t_xtd(ji,jj+1) * zsshp2_e(ji,jj+1) ) * ssvmask_xtd(ji,jj) 
     792                  !                    ! inverse depth at jm+1 
     793                  z1_hu = ssumask_xtd(ji,jj) / ( hu_0_xtd(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask_xtd(ji,jj) ) 
     794                  z1_hv = ssvmask_xtd(ji,jj) / ( hv_0_xtd(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask_xtd(ji,jj) ) 
    660795                  ! 
    661                   ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      &  
    662                        &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   ! 
    663                        &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   ! 
    664                        &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu 
     796                  ua_e(ji,jj) = (               hu_e  (ji,jj)       *    un_e (ji,jj)        &  
     797                       &            + rdtbt * (  zhu_bck            * zu_spg(ji,jj)  &   ! 
     798                       &                       + zhup2_e(ji,jj) * zu_trd(ji,jj)  &   ! 
     799                       &                       + hu_n_xtd   (ji,jj) * zu_frc(ji,jj)  )   ) * z1_hu 
    665800                  ! 
    666                   va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      & 
    667                        &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   ! 
    668                        &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   ! 
    669                        &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv 
     801                  va_e(ji,jj) = (               hv_e  (ji,jj)       *    vn_e (ji,jj)        & 
     802                       &            + rdtbt * (  zhv_bck            * zv_spg(ji,jj)  &   ! 
     803                       &                       + zhvp2_e(ji,jj) * zv_trd(ji,jj)  &   ! 
     804                       &                       + hv_n_xtd   (ji,jj) * zv_frc(ji,jj)  )   ) * z1_hv 
    670805               END DO 
    671806            END DO 
     
    681816         ENDIF 
    682817        
    683          IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) 
    684             hu_e (2:jpim1,2:jpjm1) = hu_0(2:jpim1,2:jpjm1) + zsshu_a(2:jpim1,2:jpjm1) 
    685             hur_e(2:jpim1,2:jpjm1) = ssumask(2:jpim1,2:jpjm1) / ( hu_e(2:jpim1,2:jpjm1) + 1._wp - ssumask(2:jpim1,2:jpjm1) ) 
    686             hv_e (2:jpim1,2:jpjm1) = hv_0(2:jpim1,2:jpjm1) + zsshv_a(2:jpim1,2:jpjm1) 
    687             hvr_e(2:jpim1,2:jpjm1) = ssvmask(2:jpim1,2:jpjm1) / ( hv_e(2:jpim1,2:jpjm1) + 1._wp - ssvmask(2:jpim1,2:jpjm1) ) 
    688             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  & 
    689                  &                         , hu_e , 'U', -1._wp, hv_e , 'V', -1._wp  & 
    690                  &                         , hur_e, 'U', -1._wp, hvr_e, 'V', -1._wp  ) 
    691          ELSE 
    692             CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp  ) 
    693          ENDIF 
    694          ! 
    695          ! 
    696          !                                                 ! open boundaries 
    697          IF( ln_bdy )   CALL bdy_dyn2d( jn, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e ) 
     818         IF( .NOT.ln_linssh ) THEN   !* Update ocean depth (variable volume case only) and inverse depth 
     819            hu_e (ibi:iei,ibj:iej) = hu_0_xtd(ibi:iei,ibj:iej) + zsshu_a(ibi:iei,ibj:iej) 
     820            hv_e (ibi:iei,ibj:iej) = hv_0_xtd(ibi:iei,ibj:iej) + zsshv_a(ibi:iei,ibj:iej) 
     821            hur_e(ibi:iei,ibj:iej) = ssumask_xtd(ibi:iei,ibj:iej) / ( hu_e(ibi:iei,ibj:iej) + 1._wp - ssumask_xtd(ibi:iei,ibj:iej) ) 
     822            hvr_e(ibi:iei,ibj:iej) = ssvmask_xtd(ibi:iei,ibj:iej) / ( hv_e(ibi:iei,ibj:iej) + 1._wp - ssvmask_xtd(ibi:iei,ibj:iej) ) 
     823         ENDIF 
     824          
     825         IF( ixtd == 0 ) THEN 
     826            IF( .NOT. ln_linssh ) THEN 
     827               CALL lbc_lnk_multi( 'dynspg_ts', ua_e  , 'U', -1._wp, va_e   , 'V', -1._wp      &   ! after 
     828                    &                         , un_e  , 'U', -1._wp, vn_e   , 'V', -1._wp      &   ! now 
     829                    &                         , ub_e  , 'U', -1._wp, vb_e   , 'V', -1._wp      &   ! before 
     830                    &                         , ubb_e , 'U', -1._wp, vbb_e  , 'V', -1._wp      &   ! before before 
     831                    &                         , ssha_e, 'T',  1._wp, sshn_e , 'T',  1._wp      &   ! after, now 
     832                    &                         , sshb_e, 'T',  1._wp, sshbb_e, 'T',  1._wp      &   ! before, before before 
     833                    &                         , hu_e  , 'U', -1._wp, hv_e   , 'V', -1._wp      & 
     834                    &                         , hur_e , 'U', -1._wp, hvr_e  , 'V', -1._wp      & 
     835                    &                         , khlcom = nn_hls+nn_hlts                        ) 
     836            ELSE 
     837               CALL lbc_lnk_multi( 'dynspg_ts', ua_e  , 'U', -1._wp, va_e   , 'V', -1._wp      &   ! after 
     838                    &                         , un_e  , 'U', -1._wp, vn_e   , 'V', -1._wp      &   ! now 
     839                    &                         , ub_e  , 'U', -1._wp, vb_e   , 'V', -1._wp      &   ! before 
     840                    &                         , ubb_e , 'U', -1._wp, vbb_e  , 'V', -1._wp      &   ! before before 
     841                    &                         , ssha_e, 'T',  1._wp, sshn_e , 'T',  1._wp      &   ! after, now 
     842                    &                         , sshb_e, 'T',  1._wp, sshbb_e, 'T',  1._wp      &   ! before, before before 
     843                    &                         , khlcom = nn_hls+nn_hlts                        ) 
     844            END IF 
     845            ixtd = nn_hls + nn_hlts   ! solution is now correct over the whole domain 
     846            ibi = 1   - nn_hlts   ;   ibj = 1   - nn_hlts 
     847            iei = jpi + nn_hlts   ;   iej = jpj + nn_hlts 
     848         END IF 
     849         ! 
     850         ! 
     851         !                ! open boundaries 
     852         !                ! bdy treatment is here done on regular domain (nn_hlts forced to 1 if ln_bdy or ln_tides) 
     853         IF( ln_bdy )   CALL bdy_dyn2d( jm, ua_e, va_e, un_e, vn_e, hur_e, hvr_e, ssha_e, idbi, idei, idbj, idej       & 
     854                                &     , ldcomall=.true., pumask=ssumask_xtd, pvmask=ssvmask_xtd, khlcom=nn_hls+nn_hlts ) 
    698855#if defined key_agrif                                                            
    699          IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jn )  ! Agrif 
     856         IF( .NOT.Agrif_Root() )  CALL agrif_dyn_ts( jm )  ! Agrif 
    700857#endif 
    701858         !                                             !* Swap 
     
    715872         !                                             !* Sum over whole bt loop 
    716873         !                                             !  ---------------------- 
    717          za1 = wgtbtp1(jn)                                     
     874         za1 = wgtbtp1(jm)                                     
    718875         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities 
    719             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
    720             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
     876               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj)  
     877               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj)  
    721878         ELSE                                       ! Sum transports 
    722879            IF ( .NOT.ln_wd_dl ) THEN   
    723                ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
    724                va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
     880               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj) * hu_e(1:jpi,1:jpj) 
     881               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj) * hv_e(1:jpi,1:jpj) 
    725882            ELSE  
    726                ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:) 
    727                va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:) 
     883               ua_b(1:jpi,1:jpj) = ua_b(1:jpi,1:jpj) + za1 * ua_e(1:jpi,1:jpj) * hu_e(1:jpi,1:jpj) * zuwdmask(1:jpi,1:jpj) 
     884               va_b(1:jpi,1:jpj) = va_b(1:jpi,1:jpj) + za1 * va_e(1:jpi,1:jpj) * hv_e(1:jpi,1:jpj) * zvwdmask(1:jpi,1:jpj) 
    728885            END IF  
    729886         ENDIF 
    730887         !                                          ! Sum sea level 
    731          ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 
     888         ssha(1:jpi,1:jpj) = ssha(1:jpi,1:jpj) + za1 * ssha_e(1:jpi,1:jpj) 
    732889 
    733890         !                                                 ! ==================== ! 
     
    737894      ! Phase 3. update the general trend with the barotropic trend 
    738895      ! ----------------------------------------------------------------------------- 
     896      ! Correction on regular halos 
     897      CALL lbc_lnk_multi( 'dynspg_ts',  un_adv, 'U', -1._wp,  vn_adv, 'V', -1._wp   & 
     898           &                         ,  ua_b  , 'U', -1._wp,  va_b  , 'V', -1._wp   & 
     899           &                         ,  ssha  , 'T', -1._wp                         ) 
    739900      ! 
    740901      ! Set advection velocity correction: 
     
    783944                  &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    784945            END DO 
    785          END DO 
    786          CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
     946         END DO                             ! Boundary conditions 
     947         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp, khlcom=nn_hls+nn_hlts )   ! change array used? 
    787948         ! 
    788949         DO jk=1,jpkm1 
     
    791952         END DO 
    792953         ! Save barotropic velocities not transport: 
    793          ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
    794          va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     954         ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(1:jpi,1:jpj) + 1._wp - ssumask(:,:) ) 
     955         va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(1:jpi,1:jpj) + 1._wp - ssvmask(:,:) ) 
    795956      ENDIF 
    796957 
     
    8411002      ENDIF 
    8421003      ! 
     1004 
     1005      ! deallocate temporary arrays 
     1006      DEALLOCATE( zu_trd  , zv_trd     & 
     1007         &    ,   zu_frc  , zv_frc     & 
     1008         &    ,   zu_spg  , zv_spg     & 
     1009         &    ,   zsshu_a , zsshv_a    & 
     1010         &    ,   zhup2_e , zhvp2_e    & 
     1011         &    ,   zCdU_u  , zCdU_v     & 
     1012         &    ,   zhU     , zhV        & 
     1013         &    ,   zssh_frc, zsshp2_e   & 
     1014         &    ,   zhtp2_e              & 
     1015         &    ,   hu_n_xtd, hv_n_xtd   ) 
     1016      ! 
    8431017   END SUBROUTINE dyn_spg_ts 
    8441018 
     
    8501024      !! ** Purpose : Set time-splitting weights for temporal averaging (or not) 
    8511025      !!---------------------------------------------------------------------- 
    852       LOGICAL, INTENT(in) ::   ll_av      ! temporal averaging=.true. 
    853       LOGICAL, INTENT(in) ::   ll_fw      ! forward time splitting =.true. 
    854       INTEGER, INTENT(inout) :: jpit      ! cycle length     
     1026      LOGICAL, INTENT(in   ) ::   ll_av      ! temporal averaging=.true. 
     1027      LOGICAL, INTENT(in   ) ::   ll_fw      ! forward time splitting =.true. 
     1028      INTEGER, INTENT(inout) ::   jpit       ! cycle length     
    8551029      REAL(wp), DIMENSION(3*nn_baro), INTENT(inout) ::   zwgt1, & ! Primary weights 
    8561030                                                         zwgt2    ! Secondary weights 
    8571031       
    858       INTEGER ::  jic, jn, ji                      ! temporary integers 
     1032      INTEGER ::  jic, jm, ji                      ! temporary integers 
    8591033      REAL(wp) :: za1, za2 
    8601034      !!---------------------------------------------------------------------- 
     
    8801054 
    8811055              CASE( 1 )  ! Boxcar, width = nn_baro 
    882                  DO jn = 1, 3*nn_baro 
    883                     za1 = ABS(float(jn-jic))/float(nn_baro)  
     1056                 DO jm = 1, 3*nn_baro 
     1057                    za1 = ABS(float(jm-jic))/float(nn_baro)  
    8841058                    IF (za1 < 0.5_wp) THEN 
    885                       zwgt1(jn) = 1._wp 
    886                       jpit = jn 
     1059                      zwgt1(jm) = 1._wp 
     1060                      jpit = jm 
    8871061                    ENDIF 
    8881062                 ENDDO 
    8891063 
    8901064              CASE( 2 )  ! Boxcar, width = 2 * nn_baro 
    891                  DO jn = 1, 3*nn_baro 
    892                     za1 = ABS(float(jn-jic))/float(nn_baro)  
     1065                 DO jm = 1, 3*nn_baro 
     1066                    za1 = ABS(float(jm-jic))/float(nn_baro)  
    8931067                    IF (za1 < 1._wp) THEN 
    894                       zwgt1(jn) = 1._wp 
    895                       jpit = jn 
     1068                      zwgt1(jm) = 1._wp 
     1069                      jpit = jm 
    8961070                    ENDIF 
    8971071                 ENDDO 
     
    9051079     
    9061080      ! Set secondary weights 
    907       DO jn = 1, jpit 
    908         DO ji = jn, jpit 
    909              zwgt2(jn) = zwgt2(jn) + zwgt1(ji) 
     1081      DO jm = 1, jpit 
     1082        DO ji = jm, jpit 
     1083             zwgt2(jm) = zwgt2(jm) + zwgt1(ji) 
    9101084        END DO 
    9111085      END DO 
     
    9141088      za1 = 1._wp / SUM(zwgt1(1:jpit)) 
    9151089      za2 = 1._wp / SUM(zwgt2(1:jpit)) 
    916       DO jn = 1, jpit 
    917         zwgt1(jn) = zwgt1(jn) * za1 
    918         zwgt2(jn) = zwgt2(jn) * za2 
     1090      DO jm = 1, jpit 
     1091        zwgt1(jm) = zwgt1(jm) * za1 
     1092        zwgt2(jm) = zwgt2(jm) * za2 
    9191093      END DO 
    9201094      ! 
     
    11111285      ENDIF 
    11121286      ! 
     1287      ! initialize extended scale factors 
     1288      ht_0_xtd    (1:jpi,1:jpj) = ht_0    (1:jpi,1:jpj) 
     1289      hu_0_xtd    (1:jpi,1:jpj) = hu_0    (1:jpi,1:jpj) 
     1290      hv_0_xtd    (1:jpi,1:jpj) = hv_0    (1:jpi,1:jpj) 
     1291      r1_e1e2t_xtd(1:jpi,1:jpj) = r1_e1e2t(1:jpi,1:jpj) 
     1292      r1_e1e2u_xtd(1:jpi,1:jpj) = r1_e1e2u(1:jpi,1:jpj) 
     1293      r1_e1e2v_xtd(1:jpi,1:jpj) = r1_e1e2v(1:jpi,1:jpj) 
     1294      e1e2t_xtd   (1:jpi,1:jpj) = e1e2t   (1:jpi,1:jpj) 
     1295      ssmask_xtd  (1:jpi,1:jpj) = ssmask  (1:jpi,1:jpj) 
     1296      ssumask_xtd (1:jpi,1:jpj) = ssumask (1:jpi,1:jpj) 
     1297      ssvmask_xtd (1:jpi,1:jpj) = ssvmask (1:jpi,1:jpj) 
     1298      e2u_xtd     (1:jpi,1:jpj) = e2u     (1:jpi,1:jpj) 
     1299      e1v_xtd     (1:jpi,1:jpj) = e1v     (1:jpi,1:jpj) 
     1300      r1_e1u_xtd  (1:jpi,1:jpj) = r1_e1u  (1:jpi,1:jpj) 
     1301      r1_e2v_xtd  (1:jpi,1:jpj) = r1_e2v  (1:jpi,1:jpj) 
     1302      ! 
     1303      CALL lbc_lnk_multi( 'dynspg_ts', ht_0_xtd    , 'T',  1._wp,  hu_0_xtd    , 'U', -1._wp,  hv_0_xtd    , 'V', -1._wp   & 
     1304           &                         , r1_e1e2t_xtd, 'T',  1._wp,  r1_e1e2u_xtd, 'U', -1._wp,  r1_e1e2v_xtd, 'V', -1._wp   & 
     1305           &                         , ssmask_xtd  , 'T',  1._wp,  ssumask_xtd , 'U', -1._wp,  ssvmask_xtd , 'V', -1._wp   & 
     1306           &                         , e1e2t_xtd   , 'T',  1._wp,      e2u_xtd , 'U', -1._wp,      e1v_xtd , 'V', -1._wp   & 
     1307           &                         ,                              r1_e1u_xtd , 'U', -1._wp,   r1_e2v_xtd , 'V', -1._wp   & 
     1308           &                         , khlcom = nn_hls+nn_hlts                                                             ) 
     1309      IF( ln_dynvor_enT ) THEN 
     1310         ff_t_xtd (1:jpi,1:jpj) = ff_t    (1:jpi,1:jpj) 
     1311         CALL lbc_lnk_multi( 'dynspg_ts', ff_t_xtd , 'F', -1._wp,   khlcom = nn_hls+nn_hlts  ) 
     1312      END IF 
     1313          
     1314      ! 
    11131315   END SUBROUTINE dyn_spg_ts_init 
    11141316 
    11151317    
    1116    SUBROUTINE dyn_cor_2d_init 
     1318   SUBROUTINE dyn_cor_2d_init( kdbi, kdei, kdbj, kdej ) 
    11171319