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

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

Ignore:
Timestamp:
2021-11-28T18:59:49+01:00 (3 years ago)
Author:
gsamson
Message:

update branch to the head of the trunk (r15547); ticket #2632

Location:
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
Files:
26 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/ice.F90

    r14103 r15548  
    147147   ! 
    148148   !                                     !!** ice-ridging/rafting namelist (namdyn_rdgrft) ** 
     149   LOGICAL,  PUBLIC ::   ln_str_H79       !: ice strength parameterization (Hibler79) (may be used in rheology) 
    149150   REAL(wp), PUBLIC ::   rn_crhg          !: determines changes in ice strength (also used for landfast param) 
     151   REAL(wp), PUBLIC ::   rn_pstar         !: determines ice strength, Hibler JPO79 (may be used in rheology) 
    150152   ! 
    151153   !                                     !!** ice-rheology namelist (namdyn_rhg) ** 
    … …  
    194196   !                                      !   = 0  Grenfell and Maykut 1977 (depends on cloudiness and is 0 when there is snow) 
    195197   !                                      !   = 1  Lebrun 2019 (equals 0.3 anytime with different melting/dry snw conductivities) 
     198 
     199   !                                     !!** namelist (namthd) ** 
     200   LOGICAL , PUBLIC ::   ln_icedH         ! activate ice thickness change from growing/melting (T) or not (F) 
     201   LOGICAL , PUBLIC ::   ln_icedA         ! activate lateral melting param. (T) or not (F) 
     202   LOGICAL , PUBLIC ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
     203   LOGICAL , PUBLIC ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
     204   LOGICAL , PUBLIC ::   ln_leadhfx       ! heat in the leads is used to melt sea-ice before warming the ocean 
     205   ! 
     206   !                                     !!** namelist (namthd_do) ** 
     207   REAL(wp), PUBLIC ::   rn_hinew         ! thickness for new ice formation (m) 
     208   LOGICAL , PUBLIC ::   ln_frazil        ! use of frazil ice collection as function of wind (T) or not (F) 
     209   REAL(wp), PUBLIC ::   rn_maxfraz       ! maximum portion of frazil ice collecting at the ice bottom 
     210   REAL(wp), PUBLIC ::   rn_vfraz         ! threshold drift speed for collection of bottom frazil ice 
     211   REAL(wp), PUBLIC ::   rn_Cfraz         ! squeezing coefficient for collection of bottom frazil ice 
    196212   ! 
    197213   !                                     !!** ice-vertical diffusion namelist (namthd_zdf) ** 
    … …  
    251267   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   u_oce,v_oce     !: surface ocean velocity used in ice dynamics 
    252268   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht_i_new        !: ice collection thickness accreted in leads 
     269   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraz_frac       !: fraction of frazil ice accreted at the ice bottom 
    253270   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   strength        !: ice strength 
    254271   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   stress1_i, stress2_i, stress12_i   !: 1st, 2nd & diagonal stress tensor element 
    … …  
    453470 
    454471      ii = 1 
    455       ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) , ht_i_new  (jpi,jpj) , strength(jpi,jpj) ,  & 
    456          &      stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,                      & 
    457          &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i   (jpi,jpj) ,                      & 
    458          &      aniso_11 (jpi,jpj) , aniso_12 (jpi,jpj) , rdg_conv  (jpi,jpj) , STAT=ierr(ii) ) 
     472      ALLOCATE( u_oce    (jpi,jpj) , v_oce    (jpi,jpj) , ht_i_new (jpi,jpj) , fraz_frac (jpi,jpj) ,  & 
     473         &      strength (jpi,jpj) , stress1_i(jpi,jpj) , stress2_i(jpi,jpj) , stress12_i(jpi,jpj) ,  & 
     474         &      delta_i  (jpi,jpj) , divu_i   (jpi,jpj) , shear_i  (jpi,jpj) ,                        & 
     475         &      aniso_11 (jpi,jpj) , aniso_12 (jpi,jpj) , rdg_conv (jpi,jpj) , STAT=ierr(ii) ) 
    459476 
    460477      ii = ii + 1 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icealb.F90

    r13472 r15548  
    3030   PUBLIC   ice_alb        ! called in icesbc.F90 and iceupdate.F90 
    3131 
    32    REAL(wp), PUBLIC, PARAMETER ::   rn_alb_oce = 0.066   !: ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001) 
     32   REAL(wp), PUBLIC, PARAMETER ::   rn_alb_oce = 0.066_wp   !: ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001) 
    3333   ! 
    3434   !                             !!* albedo namelist (namalb) 
    … …  
    111111      REAL(wp) ::   zalb_snw, zafrac_snw      ! snow-covered sea ice albedo & relative snow fraction 
    112112      REAL(wp) ::   zalb_cs, zalb_os          ! albedo of ice under clear/overcast sky 
     113      !! clem 
     114      REAL(wp), PARAMETER ::   zhi_albcst = 1.5_wp ! pivotal thickness (should be in the namelist) 
    113115      !!--------------------------------------------------------------------- 
    114116      ! 
    115117      IF( ln_timing )   CALL timing_start('icealb') 
    116118      ! 
    117       z1_href_pnd = 1. / 0.05 
    118       z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) )  
    119       z1_c2 = 1. / 0.05 
    120       z1_c3 = 1. / 0.02 
    121       z1_c4 = 1. / 0.03 
     119      z1_href_pnd = 1._wp / 0.05_wp 
     120      z1_c1 = 1._wp / ( LOG(zhi_albcst) - LOG(0.05_wp) )  
     121      z1_c2 = 1._wp / 0.05_wp 
     122      z1_c3 = 1._wp / 0.02_wp 
     123      z1_c4 = 1._wp / 0.03_wp 
    122124      ! 
    123125      CALL ice_var_snwfra( ph_snw, za_s_fra )   ! calculate ice fraction covered by snow 
    124126      ! 
    125127      DO jl = 1, jpl 
    126          DO_2D( 1, 1, 1, 1 ) 
     128         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )   ! palb_ice used over the full domain in icesbc 
    127129            ! 
    128130            !---------------------------------------------! 
    … …  
    148150            ENDIF 
    149151            !                       !--- Bare ice albedo (for hi < 150cm) 
    150             IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN      ! 5cm < hi < 150cm 
    151                zalb_ice = zalb_ice    + ( 0.18 - zalb_ice   ) * z1_c1 * ( LOG(1.5) - LOG(ph_ice(ji,jj,jl)) ) 
    152             ELSEIF( ph_ice(ji,jj,jl) <= 0.05 ) THEN                               ! 0cm < hi < 5cm 
    153                zalb_ice = rn_alb_oce  + ( 0.18 - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 
     152            IF( 0.05 < ph_ice(ji,jj,jl) .AND. ph_ice(ji,jj,jl) <= zhi_albcst ) THEN      ! 5cm < hi < 150cm 
     153               zalb_ice = zalb_ice    + ( 0.18_wp - zalb_ice   ) * z1_c1 * ( LOG(zhi_albcst) - LOG(ph_ice(ji,jj,jl)) ) 
     154            ELSEIF( ph_ice(ji,jj,jl) <= 0.05_wp ) THEN                               ! 0cm < hi < 5cm 
     155               zalb_ice = rn_alb_oce  + ( 0.18_wp - rn_alb_oce ) * z1_c2 * ph_ice(ji,jj,jl) 
    154156            ENDIF 
    155157            ! 
    … …  
    166168            zalb_os = ( zafrac_snw * zalb_snw + zafrac_pnd * zalb_pnd + zafrac_ice * zalb_ice ) * tmask(ji,jj,1) 
    167169            ! 
    168             zalb_cs = zalb_os - ( - 0.1010 * zalb_os * zalb_os  & 
    169                &                  + 0.1933 * zalb_os - 0.0148 ) * tmask(ji,jj,1) 
     170            zalb_cs = zalb_os - ( - 0.1010_wp * zalb_os * zalb_os  & 
     171               &                  + 0.1933_wp * zalb_os - 0.0148_wp ) * tmask(ji,jj,1) 
    170172            ! 
    171173            ! albedo depends on cloud fraction because of non-linear spectral effects 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icecor.F90

    r14433 r15548  
    5353      INTEGER, INTENT(in) ::   kn    ! 1 = after dyn ; 2 = after thermo 
    5454      ! 
    55       INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
     55      INTEGER  ::   ji, jj, jl       ! dummy loop indices 
    5656      REAL(wp) ::   zsal, zzc 
    5757      !!---------------------------------------------------------------------- 
    … …  
    9191         zzc = rhoi * r1_Dt_ice 
    9292         DO jl = 1, jpl 
    93             DO_2D( 1, 1, 1, 1 ) 
     93            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    9494               zsal = sv_i(ji,jj,jl) 
    9595               sv_i(ji,jj,jl) = MIN(  MAX( rn_simin*v_i(ji,jj,jl) , sv_i(ji,jj,jl) ) , rn_simax*v_i(ji,jj,jl)  ) 
    … …  
    9999         END DO 
    100100      ENDIF 
    101  
     101      ! 
    102102      IF( kn /= 0 ) THEN   ! no zapsmall if kn=0 (for bdy for instance) because we do not want ice-ocean exchanges (wfx,sfx,hfx) 
    103103         !                                                              otherwise conservation diags will fail 
    … …  
    105105         CALL ice_var_zapsmall      !  Zap small values                                  ! 
    106106         !                          !----------------------------------------------------- 
    107       ENDIF 
    108       !                             !----------------------------------------------------- 
    109       IF( kn == 2 ) THEN            !  Ice drift case: Corrections to avoid wrong values ! 
    110          DO_2D( 0, 0, 0, 0 )        !----------------------------------------------------- 
    111             IF ( at_i(ji,jj) == 0._wp ) THEN    ! what to do if there is no ice 
    112                IF ( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
    113                IF ( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side 
    114                IF ( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side 
    115                IF ( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side 
    116             ENDIF 
    117          END_2D 
    118          CALL lbc_lnk( 'icecor', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
    119107      ENDIF 
    120108      ! 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icectl.F90

    r14072 r15548  
    8484      REAL(wp)        , INTENT(inout) ::   pdiag_v, pdiag_s, pdiag_t, pdiag_fv, pdiag_fs, pdiag_ft 
    8585      !! 
    86       REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, & 
    87          &          zdiag_vimin, zdiag_vsmin, zdiag_vpmin, zdiag_vlmin, zdiag_aimin, zdiag_aimax, & 
    88          &          zdiag_eimin, zdiag_esmin, zdiag_simin 
    89       REAL(wp) ::   zvtrp, zetrp 
    90       REAL(wp) ::   zarea 
    91       !!------------------------------------------------------------------- 
    92       ! 
     86      REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat 
     87      REAL(wp), DIMENSION(jpi,jpj,10)     ::   ztmp3 
     88      REAL(wp), DIMENSION(jpi,jpj,jpl,8)  ::   ztmp4 
     89      REAL(wp), DIMENSION(10)             ::   zchk3          
     90      REAL(wp), DIMENSION(8)              ::   zchk4          
     91      !!------------------------------------------------------------------- 
     92      ! 
     93      ! -- quantities -- ! 
     94      ztmp3(:,:,1) = SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t        ! volume 
     95      ztmp3(:,:,2) = SUM( sv_i * rhoi, dim=3 ) * e1e2t                                             ! salt 
     96      ztmp3(:,:,3) = ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ! heat 
     97      ! 
     98      ! -- fluxes -- ! 
     99      ztmp3(:,:,4) = ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd &  ! mass 
     100         &          + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t 
     101      ztmp3(:,:,5) = ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + sfx_opw &                                ! salt 
     102         &          + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t 
     103      ztmp3(:,:,6) = ( hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw &                                ! heat 
     104         &          - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t 
     105      ! 
     106      ! -- global sum -- ! 
     107      zchk3(1:6) = glob_sum_vec( 'icectl', ztmp3(:,:,1:6) ) 
     108 
    93109      IF( icount == 0 ) THEN 
    94  
    95          pdiag_v = glob_sum( 'icectl',   SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t ) 
    96          pdiag_s = glob_sum( 'icectl',   SUM( sv_i * rhoi            , dim=3 ) * e1e2t ) 
    97          pdiag_t = glob_sum( 'icectl', ( SUM( SUM( e_i, dim=4 ), dim=3 ) + SUM( SUM( e_s, dim=4 ), dim=3 ) ) * e1e2t ) 
    98  
    99          ! mass flux 
    100          pdiag_fv = glob_sum( 'icectl',  & 
    101             &                         ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn + wfx_lam + wfx_pnd + & 
    102             &                           wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + wfx_ice_sub + wfx_spr ) * e1e2t ) 
    103          ! salt flux 
    104          pdiag_fs = glob_sum( 'icectl',  & 
    105             &                         ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni + & 
    106             &                           sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) 
    107          ! heat flux 
    108          pdiag_ft = glob_sum( 'icectl',  & 
    109             &                         (   hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw  & 
    110             &                           - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 
    111  
     110         ! 
     111         pdiag_v  = zchk3(1) 
     112         pdiag_s  = zchk3(2) 
     113         pdiag_t  = zchk3(3) 
     114         pdiag_fv = zchk3(4) 
     115         pdiag_fs = zchk3(5) 
     116         pdiag_ft = zchk3(6) 
     117         ! 
    112118      ELSEIF( icount == 1 ) THEN 
    113  
    114          ! -- mass diag -- ! 
    115          zdiag_mass = ( glob_sum( 'icectl', SUM( v_i * rhoi + v_s * rhos + ( v_ip + v_il ) * rhow, dim=3 ) * e1e2t )      & 
    116             &            - pdiag_v ) * r1_Dt_ice                                                                          & 
    117             &         + glob_sum( 'icectl', ( wfx_bog + wfx_bom + wfx_sum + wfx_sni + wfx_opw + wfx_res + wfx_dyn +       & 
    118             &                                 wfx_lam + wfx_pnd + wfx_snw_sni + wfx_snw_sum + wfx_snw_dyn + wfx_snw_sub + & 
    119             &                                 wfx_ice_sub + wfx_spr ) * e1e2t )                                           & 
    120             &         - pdiag_fv 
    121119         ! 
    122          ! -- salt diag -- ! 
    123          zdiag_salt = ( glob_sum( 'icectl', SUM( sv_i * rhoi , dim=3 ) * e1e2t ) - pdiag_s ) * r1_Dt_ice  & 
    124             &         + glob_sum( 'icectl', ( sfx_bri + sfx_bog + sfx_bom + sfx_sum + sfx_sni +           & 
    125             &                                 sfx_opw + sfx_res + sfx_dyn + sfx_sub + sfx_lam ) * e1e2t ) & 
    126             &         - pdiag_fs 
    127          ! 
    128          ! -- heat diag -- ! 
    129          zdiag_heat = ( glob_sum( 'icectl', ( SUM(SUM(e_i, dim=4), dim=3) + SUM(SUM(e_s, dim=4), dim=3) ) * e1e2t ) - pdiag_t & 
    130             &         ) * r1_Dt_ice                                                                                           & 
    131             &         + glob_sum( 'icectl', (  hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw                      & 
    132             &                                - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t )                    & 
    133             &         - pdiag_ft 
    134  
    135          ! -- min/max diag -- ! 
    136          zdiag_aimax = glob_max( 'icectl', SUM( a_i, dim=3 ) ) 
    137          zdiag_vimin = glob_min( 'icectl', v_i  ) 
    138          zdiag_vsmin = glob_min( 'icectl', v_s  ) 
    139          zdiag_vpmin = glob_min( 'icectl', v_ip ) 
    140          zdiag_vlmin = glob_min( 'icectl', v_il ) 
    141          zdiag_aimin = glob_min( 'icectl', a_i  ) 
    142          zdiag_simin = glob_min( 'icectl', sv_i ) 
    143          zdiag_eimin = glob_min( 'icectl', SUM( e_i, dim=3 ) ) 
    144          zdiag_esmin = glob_min( 'icectl', SUM( e_s, dim=3 ) ) 
     120         ! -- mass, salt and heat diags -- ! 
     121         zdiag_mass = ( zchk3(1) - pdiag_v ) * r1_Dt_ice + ( zchk3(4) - pdiag_fv ) 
     122         zdiag_salt = ( zchk3(2) - pdiag_s ) * r1_Dt_ice + ( zchk3(5) - pdiag_fs ) 
     123         zdiag_heat = ( zchk3(3) - pdiag_t ) * r1_Dt_ice + ( zchk3(6) - pdiag_ft ) 
     124 
     125         ! -- max concentration diag -- ! 
     126         ztmp3(:,:,7) = SUM( a_i, dim=3 ) 
     127         zchk3(7)     = glob_max( 'icectl', ztmp3(:,:,7) ) 
    145128 
    146129         ! -- advection scheme is conservative? -- ! 
    147          zvtrp = glob_sum( 'icectl', diag_adv_mass * e1e2t ) 
    148          zetrp = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
    149  
    150          ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
    151          zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
     130         ztmp3(:,:,8 ) = diag_adv_mass * e1e2t  
     131         ztmp3(:,:,9 ) = diag_adv_heat * e1e2t  
     132         ztmp3(:,:,10) = SUM( a_i + epsi10, dim=3 ) * e1e2t ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
     133         zchk3(8:10)   = glob_sum_vec( 'icectl', ztmp3(:,:,8:10) ) 
     134          
     135         ! -- min diags -- ! 
     136         ztmp4(:,:,:,1) = v_i 
     137         ztmp4(:,:,:,2) = v_s 
     138         ztmp4(:,:,:,3) = v_ip 
     139         ztmp4(:,:,:,4) = v_il 
     140         ztmp4(:,:,:,5) = a_i 
     141         ztmp4(:,:,:,6) = sv_i 
     142         ztmp4(:,:,:,7) = SUM( e_i, dim=3 ) 
     143         ztmp4(:,:,:,8) = SUM( e_s, dim=3 ) 
     144         zchk4(1:8)     = glob_min_vec( 'icectl', ztmp4(:,:,:,1:8) ) 
    152145 
    153146         IF( lwp ) THEN 
    154147            ! check conservation issues 
    155             IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
     148            IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zchk3(10) ) & 
    156149               &                   WRITE(numout,*)   cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice 
    157             IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
     150            IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zchk3(10) ) & 
    158151               &                   WRITE(numout,*)   cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice 
    159             IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
     152            IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zchk3(10) ) & 
    160153               &                   WRITE(numout,*)   cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
    161154            ! check negative values 
    162             IF( zdiag_vimin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_i  < 0        = ',zdiag_vimin 
    163             IF( zdiag_vsmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_s  < 0        = ',zdiag_vsmin 
    164             IF( zdiag_vpmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_ip < 0        = ',zdiag_vpmin 
    165             IF( zdiag_vlmin < 0. ) WRITE(numout,*)   cd_routine,' : violation v_il < 0        = ',zdiag_vlmin 
    166             IF( zdiag_aimin < 0. ) WRITE(numout,*)   cd_routine,' : violation a_i  < 0        = ',zdiag_aimin 
    167             IF( zdiag_simin < 0. ) WRITE(numout,*)   cd_routine,' : violation s_i  < 0        = ',zdiag_simin 
    168             IF( zdiag_eimin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_i  < 0        = ',zdiag_eimin 
    169             IF( zdiag_esmin < 0. ) WRITE(numout,*)   cd_routine,' : violation e_s  < 0        = ',zdiag_esmin 
     155            IF( zchk4(1) < 0. )   WRITE(numout,*)   cd_routine,' : violation v_i  < 0        = ',zchk4(1) 
     156            IF( zchk4(2) < 0. )   WRITE(numout,*)   cd_routine,' : violation v_s  < 0        = ',zchk4(2) 
     157            IF( zchk4(3) < 0. )   WRITE(numout,*)   cd_routine,' : violation v_ip < 0        = ',zchk4(3) 
     158            IF( zchk4(4) < 0. )   WRITE(numout,*)   cd_routine,' : violation v_il < 0        = ',zchk4(4) 
     159            IF( zchk4(5) < 0. )   WRITE(numout,*)   cd_routine,' : violation a_i  < 0        = ',zchk4(5) 
     160            IF( zchk4(6) < 0. )   WRITE(numout,*)   cd_routine,' : violation s_i  < 0        = ',zchk4(6) 
     161            IF( zchk4(7) < 0. )   WRITE(numout,*)   cd_routine,' : violation e_i  < 0        = ',zchk4(7) 
     162            IF( zchk4(8) < 0. )   WRITE(numout,*)   cd_routine,' : violation e_s  < 0        = ',zchk4(8) 
    170163            ! check maximum ice concentration 
    171             IF( zdiag_aimax>MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
    172                &                   WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zdiag_aimax 
     164            IF( zchk3(7)>MAX(rn_amax_n,rn_amax_s)+epsi10 .AND. cd_routine /= 'icedyn_adv' .AND. cd_routine /= 'icedyn_rdgrft' ) & 
     165               &                  WRITE(numout,*)   cd_routine,' : violation a_i > amax      = ',zchk3(7) 
    173166            ! check if advection scheme is conservative 
    174             IF( ABS(zvtrp) > zchk_m * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    175                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zvtrp * rDt_ice 
    176             IF( ABS(zetrp) > zchk_t * rn_icechk_glo * zarea .AND. cd_routine == 'icedyn_adv' ) & 
    177                &                   WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zetrp * rDt_ice 
     167            IF( ABS(zchk3(8)) > zchk_m * rn_icechk_glo * zchk3(10) .AND. cd_routine == 'icedyn_adv' ) & 
     168               &                  WRITE(numout,*)   cd_routine,' : violation adv scheme [kg] = ',zchk3(8) * rDt_ice 
     169            IF( ABS(zchk3(9)) > zchk_t * rn_icechk_glo * zchk3(10) .AND. cd_routine == 'icedyn_adv' ) & 
     170               &                  WRITE(numout,*)   cd_routine,' : violation adv scheme [J]  = ',zchk3(9) * rDt_ice 
    178171         ENDIF 
    179172         ! 
    … …  
    195188      !!------------------------------------------------------------------- 
    196189      CHARACTER(len=*), INTENT(in) ::   cd_routine    ! name of the routine 
    197       REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat 
    198       REAL(wp) ::   zarea 
    199       !!------------------------------------------------------------------- 
    200  
    201       ! water flux 
    202       ! -- mass diag -- ! 
    203       zdiag_mass = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr   + wfx_sub + wfx_pnd & 
    204          &                              + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ) 
    205  
    206       ! -- salt diag -- ! 
    207       zdiag_salt = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) 
    208  
    209       ! -- heat diag -- ! 
    210       zdiag_heat = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
     190      !! 
     191      REAL(wp), DIMENSION(jpi,jpj,4)     ::   ztmp 
     192      REAL(wp), DIMENSION(4)             ::   zchk          
     193      !!------------------------------------------------------------------- 
     194 
     195      ztmp(:,:,1) = ( wfx_ice + wfx_snw + wfx_spr + wfx_sub + wfx_pnd + diag_vice + diag_vsnw + diag_vpnd - diag_adv_mass ) * e1e2t ! mass diag 
     196      ztmp(:,:,2) = ( sfx + diag_sice - diag_adv_salt ) * e1e2t                                                                     ! salt 
     197      ztmp(:,:,3) = ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t                                                   ! heat 
    211198      ! equivalent to this: 
    212       !!zdiag_heat = glob_sum( 'icectl', ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
    213       !!   &                                          - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr & 
    214       !!   &                                          ) * e1e2t ) 
    215  
    216       ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
    217       zarea = glob_sum( 'icectl', SUM( a_i + epsi10, dim=3 ) * e1e2t ) 
    218  
     199      !! ( -diag_heat + hfx_sum + hfx_bom + hfx_bog + hfx_dif + hfx_opw + hfx_snw & 
     200      !!   &                                        - hfx_thd - hfx_dyn - hfx_res - hfx_sub - hfx_spr ) * e1e2t ) 
     201      ztmp(:,:,4) =  SUM( a_i + epsi10, dim=3 ) * e1e2t      ! ice area (+epsi10 to set a threshold > 0 when there is no ice) 
     202 
     203      ! global sums 
     204      zchk(1:4)   = glob_sum_vec( 'icectl', ztmp(:,:,1:4) ) 
     205       
    219206      IF( lwp ) THEN 
    220          IF( ABS(zdiag_mass) > zchk_m * rn_icechk_glo * zarea ) & 
    221             &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zdiag_mass * rDt_ice 
    222          IF( ABS(zdiag_salt) > zchk_s * rn_icechk_glo * zarea ) & 
    223             &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zdiag_salt * rDt_ice 
    224          IF( ABS(zdiag_heat) > zchk_t * rn_icechk_glo * zarea ) & 
    225             &                   WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zdiag_heat * rDt_ice 
     207         IF( ABS(zchk(1)) > zchk_m * rn_icechk_glo * zchk(4) ) & 
     208            &                   WRITE(numout,*) cd_routine,' : violation mass cons. [kg] = ',zchk(1) * rDt_ice 
     209         IF( ABS(zchk(2)) > zchk_s * rn_icechk_glo * zchk(4) ) & 
     210            &                   WRITE(numout,*) cd_routine,' : violation salt cons. [g]  = ',zchk(2) * rDt_ice 
     211         IF( ABS(zchk(3)) > zchk_t * rn_icechk_glo * zchk(4) ) & 
     212            &                   WRITE(numout,*) cd_routine,' : violation heat cons. [J]  = ',zchk(3) * rDt_ice 
    226213      ENDIF 
    227214      ! 
    … …  
    391378      cl_alname(ialert_id) = ' Very high salinity ' ! name of the alert 
    392379      DO jl = 1, jpl 
    393          DO_2D( 1, 1, 1, 1 ) 
     380         DO_2D( 0, 0, 0, 0 ) 
    394381            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    395382               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) > rn_simax ) THEN 
    … …  
    406393      cl_alname(ialert_id) = ' Very low salinity ' ! name of the alert 
    407394      DO jl = 1, jpl 
    408          DO_2D( 1, 1, 1, 1 ) 
     395         DO_2D( 0, 0, 0, 0 ) 
    409396            IF( v_i(ji,jj,jl) > epsi10  ) THEN 
    410397               IF( sv_i(ji,jj,jl) / v_i(ji,jj,jl) < rn_simin ) THEN 
    … …  
    421408      cl_alname(ialert_id) = ' Very cold ice ' ! name of the alert 
    422409      DO jl = 1, jpl 
    423          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     410         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
    424411            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    425412            IF( t_i(ji,jj,jk,jl) < -50.+rt0  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    … …  
    435422      cl_alname(ialert_id) = ' Very warm ice ' ! name of the alert 
    436423      DO jl = 1, jpl 
    437          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     424         DO_3D( 0, 0, 0, 0, 1, nlay_i ) 
    438425            ztmelts    =  -rTmlt * sz_i(ji,jj,jk,jl) + rt0 
    439426            IF( t_i(ji,jj,jk,jl) > ztmelts  .AND.  v_i(ji,jj,jl) > epsi10 ) THEN 
    … …  
    449436      cl_alname(ialert_id) = ' Very thick ice ' ! name of the alert 
    450437      jl = jpl 
    451       DO_2D( 1, 1, 1, 1 ) 
     438      DO_2D( 0, 0, 0, 0 ) 
    452439         IF( h_i(ji,jj,jl) > 50._wp ) THEN 
    453440            WRITE(numout,*) ' ALERTE :   Very thick ice ',h_i(ji,jj,jl) 
    … …  
    461448      cl_alname(ialert_id) = ' Very thin ice ' ! name of the alert 
    462449      jl = 1 
    463       DO_2D( 1, 1, 1, 1 ) 
     450      DO_2D( 0, 0, 0, 0 ) 
    464451         IF( h_i(ji,jj,jl) < rn_himin ) THEN 
    465452            WRITE(numout,*) ' ALERTE :   Very thin ice ',h_i(ji,jj,jl) 
    … …  
    472459      ialert_id = ialert_id + 1 ! reference number of this alert 
    473460      cl_alname(ialert_id) = ' Very fast ice ' ! name of the alert 
    474       DO_2D( 1, 1, 1, 1 ) 
     461      DO_2D( 0, 0, 0, 0 ) 
    475462         IF( MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) > 2. ) THEN 
    476463            WRITE(numout,*) ' ALERTE :   Very fast ice ',MAX( ABS( u_ice(ji,jj) ), ABS( v_ice(ji,jj) ) ) 
    … …  
    483470      ialert_id = ialert_id + 1 ! reference number of this alert 
    484471      cl_alname(ialert_id) = ' Ice on continents ' ! name of the alert 
    485       DO_2D( 1, 1, 1, 1 ) 
     472      DO_2D( 0, 0, 0, 0 ) 
    486473         IF( tmask(ji,jj,1) == 0._wp .AND. ( at_i(ji,jj) > 0._wp .OR. vt_i(ji,jj) > 0._wp ) ) THEN 
    487474            WRITE(numout,*) ' ALERTE :   Ice on continents ',at_i(ji,jj),vt_i(ji,jj) 
    … …  
    494481      ialert_id = ialert_id + 1 ! reference number of this alert 
    495482      cl_alname(ialert_id) = ' Incompatible ice conc and vol ' ! name of the alert 
    496       DO_2D( 1, 1, 1, 1 ) 
     483      DO_2D( 0, 0, 0, 0 ) 
    497484         IF(  ( vt_i(ji,jj) == 0._wp .AND. at_i(ji,jj) >  0._wp ) .OR. & 
    498485            & ( vt_i(ji,jj) >  0._wp .AND. at_i(ji,jj) == 0._wp ) ) THEN 
    … …  
    762749      INTEGER, INTENT(in) ::   kt   ! ice time-step index 
    763750      ! 
    764       INTEGER  ::   ji, jj 
    765       REAL(wp) ::   zdiag_mass, zdiag_salt, zdiag_heat, zdiag_adv_mass, zdiag_adv_salt, zdiag_adv_heat 
    766       REAL(wp), DIMENSION(jpi,jpj) ::   zdiag_mass2D, zdiag_salt2D, zdiag_heat2D 
     751      REAL(wp), DIMENSION(jpi,jpj,6) ::   ztmp 
     752      REAL(wp), DIMENSION(6)         ::   zchk 
    767753      !!------------------------------------------------------------------- 
    768754      ! 
    … …  
    773759      ENDIF 
    774760      ! 
    775       ! 2D budgets (must be close to 0) 
    776       IF( iom_use('icedrift_mass') .OR. iom_use('icedrift_salt') .OR. iom_use('icedrift_heat') ) THEN 
    777          DO_2D( 1, 1, 1, 1 ) 
    778             zdiag_mass2D(ji,jj) =   wfx_ice(ji,jj)   + wfx_snw(ji,jj)   + wfx_spr(ji,jj) + wfx_sub(ji,jj) & 
    779                &                  + diag_vice(ji,jj) + diag_vsnw(ji,jj) - diag_adv_mass(ji,jj) 
    780             zdiag_salt2D(ji,jj) = sfx(ji,jj) + diag_sice(ji,jj) - diag_adv_salt(ji,jj) 
    781             zdiag_heat2D(ji,jj) = qt_oce_ai(ji,jj) - qt_atm_oi(ji,jj) + diag_heat(ji,jj) - diag_adv_heat(ji,jj) 
    782          END_2D 
    783          ! 
    784          ! write outputs 
    785          CALL iom_put( 'icedrift_mass', zdiag_mass2D ) 
    786          CALL iom_put( 'icedrift_salt', zdiag_salt2D ) 
    787          CALL iom_put( 'icedrift_heat', zdiag_heat2D ) 
    788       ENDIF 
    789  
    790       ! -- mass diag -- ! 
    791       zdiag_mass     = glob_sum( 'icectl', (  wfx_ice   + wfx_snw   + wfx_spr + wfx_sub & 
    792          &                                  + diag_vice + diag_vsnw - diag_adv_mass ) * e1e2t ) * rDt_ice 
    793       zdiag_adv_mass = glob_sum( 'icectl', diag_adv_mass * e1e2t ) * rDt_ice 
    794  
    795       ! -- salt diag -- ! 
    796       zdiag_salt     = glob_sum( 'icectl', ( sfx + diag_sice - diag_adv_salt ) * e1e2t ) * rDt_ice * 1.e-3 
    797       zdiag_adv_salt = glob_sum( 'icectl', diag_adv_salt * e1e2t ) * rDt_ice * 1.e-3 
    798  
    799       ! -- heat diag -- ! 
    800       zdiag_heat     = glob_sum( 'icectl', ( qt_oce_ai - qt_atm_oi + diag_heat - diag_adv_heat ) * e1e2t ) 
    801       zdiag_adv_heat = glob_sum( 'icectl', diag_adv_heat * e1e2t ) 
    802  
     761      ! -- 2D budgets (must be close to 0) -- ! 
     762      ztmp(:,:,1) =  wfx_ice  (:,:) + wfx_snw  (:,:) + wfx_spr  (:,:) + wfx_sub(:,:) + wfx_pnd(:,:) & 
     763         &         + diag_vice(:,:) + diag_vsnw(:,:) + diag_vpnd(:,:) - diag_adv_mass(:,:) 
     764      ztmp(:,:,2) = sfx(:,:) + diag_sice(:,:) - diag_adv_salt(:,:) 
     765      ztmp(:,:,3) = qt_oce_ai(:,:) - qt_atm_oi(:,:) + diag_heat(:,:) - diag_adv_heat(:,:) 
     766 
     767      ! write outputs 
     768      CALL iom_put( 'icedrift_mass', ztmp(:,:,1) ) 
     769      CALL iom_put( 'icedrift_salt', ztmp(:,:,2) ) 
     770      CALL iom_put( 'icedrift_heat', ztmp(:,:,3) ) 
     771 
     772      ! -- 1D budgets -- ! 
     773      ztmp(:,:,1) = ztmp(:,:,1) * e1e2t * rDt_ice         ! mass 
     774      ztmp(:,:,2) = ztmp(:,:,2) * e1e2t * rDt_ice * 1.e-3 ! salt 
     775      ztmp(:,:,3) = ztmp(:,:,3) * e1e2t                   ! heat 
     776 
     777      ztmp(:,:,4) = diag_adv_mass * e1e2t * rDt_ice 
     778      ztmp(:,:,5) = diag_adv_salt * e1e2t * rDt_ice * 1.e-3 
     779      ztmp(:,:,6) = diag_adv_heat * e1e2t 
     780 
     781      ! global sums 
     782      zchk(1:6) = glob_sum_vec( 'icectl', ztmp(:,:,1:6) ) 
     783       
    803784      !                    ! write out to file 
    804785      IF( lwp ) THEN 
    805786         ! check global drift (must be close to 0) 
    806          WRITE(numicedrift,FMT='(2x,i6,3x,a19,4x,f25.5)') kt, 'mass drift     [kg]', zdiag_mass 
    807          WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift     [kg]', zdiag_salt 
    808          WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift     [W] ', zdiag_heat 
     787         WRITE(numicedrift,FMT='(2x,i6,3x,a19,4x,f25.5)') kt, 'mass drift     [kg]', zchk(1) 
     788         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift     [kg]', zchk(2) 
     789         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift     [W] ', zchk(3) 
    809790         ! check drift from advection scheme (can be /=0 with bdy but not sure why) 
    810          WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'mass drift adv [kg]', zdiag_adv_mass 
    811          WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift adv [kg]', zdiag_adv_salt 
    812          WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift adv [W] ', zdiag_adv_heat 
     791         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'mass drift adv [kg]', zchk(4) 
     792         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'salt drift adv [kg]', zchk(5) 
     793         WRITE(numicedrift,FMT='(11x,     a19,4x,f25.5)')     'heat drift adv [W] ', zchk(6) 
    813794      ENDIF 
    814795      !                    ! drifts 
    815       rdiag_icemass = rdiag_icemass + zdiag_mass 
    816       rdiag_icesalt = rdiag_icesalt + zdiag_salt 
    817       rdiag_iceheat = rdiag_iceheat + zdiag_heat 
    818       rdiag_adv_icemass = rdiag_adv_icemass + zdiag_adv_mass 
    819       rdiag_adv_icesalt = rdiag_adv_icesalt + zdiag_adv_salt 
    820       rdiag_adv_iceheat = rdiag_adv_iceheat + zdiag_adv_heat 
     796      rdiag_icemass = rdiag_icemass + zchk(1) 
     797      rdiag_icesalt = rdiag_icesalt + zchk(2) 
     798      rdiag_iceheat = rdiag_iceheat + zchk(3) 
     799      rdiag_adv_icemass = rdiag_adv_icemass + zchk(4) 
     800      rdiag_adv_icesalt = rdiag_adv_icesalt + zchk(5) 
     801      rdiag_adv_iceheat = rdiag_adv_iceheat + zchk(6) 
    821802      ! 
    822803      !                    ! output drifts and close ascii file 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedia.F90

    r14072 r15548  
    6565      INTEGER, INTENT(in) ::   kt   ! ocean time step 
    6666      !! 
    67       REAL(wp)   ::   zbg_ivol, zbg_item, zbg_area, zbg_isal 
    68       REAL(wp)   ::   zbg_svol, zbg_stem 
    69       REAL(wp)   ::   z_frc_voltop, z_frc_temtop, z_frc_sal 
    70       REAL(wp)   ::   z_frc_volbot, z_frc_tembot 
    71       REAL(wp)   ::   zdiff_vol, zdiff_sal, zdiff_tem 
     67      REAL(wp), DIMENSION(jpi,jpj,16) ::   ztmp 
     68      REAL(wp), DIMENSION(16)         ::   zbg           
    7269      !!--------------------------------------------------------------------------- 
    7370      IF( ln_timing )   CALL timing_start('ice_dia') 
    … …  
    8380      ENDIF 
    8481 
    85       ! ----------------------- ! 
    86       ! 1 -  Contents           ! 
    87       ! ----------------------- ! 
    88       IF(  iom_use('ibgvol_tot' ) .OR. iom_use('sbgvol_tot' ) .OR. iom_use('ibgarea_tot') .OR. & 
    89          & iom_use('ibgsalt_tot') .OR. iom_use('ibgheat_tot') .OR. iom_use('sbgheat_tot') ) THEN 
    90  
    91          zbg_ivol = glob_sum( 'icedia', vt_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! ice volume (km3) 
    92          zbg_svol = glob_sum( 'icedia', vt_s(:,:) * e1e2t(:,:) ) * 1.e-9  ! snow volume (km3) 
    93          zbg_area = glob_sum( 'icedia', at_i(:,:) * e1e2t(:,:) ) * 1.e-6  ! area (km2) 
    94          zbg_isal = glob_sum( 'icedia', st_i(:,:) * e1e2t(:,:) ) * 1.e-9  ! salt content (pss*km3) 
    95          zbg_item = glob_sum( 'icedia', et_i(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
    96          zbg_stem = glob_sum( 'icedia', et_s(:,:) * e1e2t(:,:) ) * 1.e-20 ! heat content (1.e20 J) 
    97  
    98          CALL iom_put( 'ibgvol_tot'  , zbg_ivol ) 
    99          CALL iom_put( 'sbgvol_tot'  , zbg_svol ) 
    100          CALL iom_put( 'ibgarea_tot' , zbg_area ) 
    101          CALL iom_put( 'ibgsalt_tot' , zbg_isal ) 
    102          CALL iom_put( 'ibgheat_tot' , zbg_item ) 
    103          CALL iom_put( 'sbgheat_tot' , zbg_stem ) 
    104  
    105       ENDIF 
    106  
     82      ztmp(:,:,:) = 0._wp ! should be better coded 
     83       
    10784      ! ---------------------------! 
    108       ! 2 - Trends due to forcing  ! 
     85      ! 1 - Trends due to forcing  ! 
    10986      ! ---------------------------! 
    11087      ! they must be kept outside an IF(iom_use) because of the call to dia_rst below 
    111       z_frc_volbot = r1_rho0 * glob_sum( 'icedia', -( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-ocean 
    112       z_frc_voltop = r1_rho0 * glob_sum( 'icedia', -( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ) * 1.e-9   ! freshwater flux ice/snow-atm 
    113       z_frc_sal    = r1_rho0 * glob_sum( 'icedia', -      sfx(:,:)                                     * e1e2t(:,:) ) * 1.e-9   ! salt fluxes ice/snow-ocean 
    114       z_frc_tembot =           glob_sum( 'icedia',  qt_oce_ai(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ocean (and below ice) 
    115       z_frc_temtop =           glob_sum( 'icedia',  qt_atm_oi(:,:)                                     * e1e2t(:,:) ) * 1.e-20  ! heat on top of ice-coean 
    116       ! 
    117       frc_voltop  = frc_voltop  + z_frc_voltop  * rDt_ice ! km3 
    118       frc_volbot  = frc_volbot  + z_frc_volbot  * rDt_ice ! km3 
    119       frc_sal     = frc_sal     + z_frc_sal     * rDt_ice ! km3*pss 
    120       frc_temtop  = frc_temtop  + z_frc_temtop  * rDt_ice ! 1.e20 J 
    121       frc_tembot  = frc_tembot  + z_frc_tembot  * rDt_ice ! 1.e20 J 
    122  
    123       CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
    124       CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
    125       CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal - forcing                     (psu*km3 equivalent ocean water) 
    126       CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J) 
    127       CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J) 
    128  
    129       IF(  iom_use('ibgfrchfxtop') .OR. iom_use('ibgfrchfxbot') ) THEN 
    130          CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ice/snw/ocean      (W/m2) 
    131          CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice)   (W/m2) 
    132       ENDIF 
     88      ztmp(:,:,1) = - ( wfx_ice(:,:) + wfx_snw(:,:) + wfx_err_sub(:,:) ) * e1e2t(:,:) ! freshwater flux ice/snow-ocean 
     89      ztmp(:,:,2) = - ( wfx_sub(:,:) + wfx_spr(:,:) )                    * e1e2t(:,:) ! freshwater flux ice/snow-atm 
     90      ztmp(:,:,3) = -   sfx    (:,:)                                     * e1e2t(:,:) ! salt fluxes ice/snow-ocean 
     91      ztmp(:,:,4) =   qt_atm_oi(:,:)                                     * e1e2t(:,:) ! heat on top of ice-ocean 
     92      ztmp(:,:,5) =   qt_oce_ai(:,:)                                     * e1e2t(:,:) ! heat on top of ocean (and below ice) 
     93       
     94      ! ----------------------- ! 
     95      ! 2 -  Contents           ! 
     96      ! ----------------------- ! 
     97      IF( iom_use('ibgvol_tot' ) )   ztmp(:,:,6 ) = vt_i (:,:) * e1e2t(:,:) ! ice volume 
     98      IF( iom_use('sbgvol_tot' ) )   ztmp(:,:,7 ) = vt_s (:,:) * e1e2t(:,:) ! snow volume 
     99      IF( iom_use('ibgarea_tot') )   ztmp(:,:,8 ) = at_i (:,:) * e1e2t(:,:) ! area 
     100      IF( iom_use('ibgsalt_tot') )   ztmp(:,:,9 ) = st_i (:,:) * e1e2t(:,:) ! salt content 
     101      IF( iom_use('ibgheat_tot') )   ztmp(:,:,10) = et_i (:,:) * e1e2t(:,:) ! heat content 
     102      IF( iom_use('sbgheat_tot') )   ztmp(:,:,11) = et_s (:,:) * e1e2t(:,:) ! heat content 
     103      IF( iom_use('ipbgvol_tot') )   ztmp(:,:,12) = vt_ip(:,:) * e1e2t(:,:) ! ice pond volume 
     104      IF( iom_use('ilbgvol_tot') )   ztmp(:,:,13) = vt_il(:,:) * e1e2t(:,:) ! ice pond lid volume 
    133105 
    134106      ! ---------------------------------- ! 
    135107      ! 3 -  Content variations and drifts ! 
    136108      ! ---------------------------------- ! 
    137       IF(  iom_use('ibgvolume') .OR. iom_use('ibgsaltco') .OR. iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) THEN 
    138  
    139          zdiff_vol = r1_rho0 * glob_sum( 'icedia', ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! freshwater trend (km3) 
    140          zdiff_sal = r1_rho0 * glob_sum( 'icedia', ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-9   ! salt content trend (km3*pss) 
    141          zdiff_tem =           glob_sum( 'icedia', ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ) * 1.e-20  ! heat content trend (1.e20 J) 
    142          !                               + SUM( qevap_ice * a_i_b, dim=3 )       !! clem: I think this term should not be there (but needs a check) 
    143  
    144          zdiff_vol = zdiff_vol - ( frc_voltop + frc_volbot ) 
    145          zdiff_sal = zdiff_sal - frc_sal 
    146          zdiff_tem = zdiff_tem - ( frc_tembot - frc_temtop ) 
    147  
    148          CALL iom_put( 'ibgvolume' , zdiff_vol )   ! ice/snow volume  drift            (km3 equivalent ocean water) 
    149          CALL iom_put( 'ibgsaltco' , zdiff_sal )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
    150          CALL iom_put( 'ibgheatco' , zdiff_tem )   ! ice/snow heat content drift       (1.e20 J) 
    151          ! 
    152       ENDIF 
    153  
     109      IF( iom_use('ibgvolume') ) ztmp(:,:,14) = ( rhoi*vt_i(:,:) + rhos*vt_s(:,:) - vol_loc_ini(:,:) ) * e1e2t(:,:) ! freshwater trend 
     110      IF( iom_use('ibgsaltco') ) ztmp(:,:,15) = ( rhoi*st_i(:,:)                  - sal_loc_ini(:,:) ) * e1e2t(:,:) ! salt content trend 
     111      IF( iom_use('ibgheatco') .OR. iom_use('ibgheatfx') ) & 
     112         &                       ztmp(:,:,16) = ( et_i(:,:) + et_s(:,:)           - tem_loc_ini(:,:) ) * e1e2t(:,:) ! heat content trend 
     113       
     114      ! global sum 
     115      zbg(1:16) = glob_sum_vec( 'icedia', ztmp(:,:,1:16) ) 
     116 
     117      ! change units for trends 
     118      zbg(1) = zbg(1) * r1_rho0 * 1.e-9  * rDt_ice ! freshwater flux ice/snow-ocean (km3) 
     119      zbg(2) = zbg(2) * r1_rho0 * 1.e-9  * rDt_ice ! freshwater flux ice/snow-atm (km3) 
     120      zbg(3) = zbg(3) * r1_rho0 * 1.e-9  * rDt_ice ! salt fluxes ice/snow-ocean (km3*pss) 
     121      zbg(4) = zbg(4)           * 1.e-20 * rDt_ice ! heat on top of ice-ocean (1.e20 J) 
     122      zbg(5) = zbg(5)           * 1.e-20 * rDt_ice ! heat on top of ocean (and below ice) (1.e20 J) 
     123      ! cumulative sum 
     124      frc_voltop  = frc_voltop  + zbg(1) 
     125      frc_volbot  = frc_volbot  + zbg(2) 
     126      frc_sal     = frc_sal     + zbg(3) 
     127      frc_temtop  = frc_temtop  + zbg(4) 
     128      frc_tembot  = frc_tembot  + zbg(5) 
     129 
     130      ! change units for contents 
     131      zbg(6)  = zbg(6)  * 1.e-9  ! ice volume (km3) 
     132      zbg(7)  = zbg(7)  * 1.e-9  ! snw volume (km3) 
     133      zbg(8)  = zbg(8)  * 1.e-6  ! ice area (km2) 
     134      zbg(9)  = zbg(9)  * 1.e-9  ! salt content (km3*pss) 
     135      zbg(10) = zbg(10) * 1.e-20 ! ice heat content (1.e20 J) 
     136      zbg(11) = zbg(11) * 1.e-20 ! snw heat content (1.e20 J) 
     137      zbg(12) = zbg(12) * 1.e-9  ! pnd volume (km3) 
     138      zbg(13) = zbg(13) * 1.e-9  ! pnd lid volume (km3) 
     139 
     140      ! change units for trends 
     141      zbg(14) = zbg(14) * r1_rho0 * 1.e-9  ! freshwater trend (km3) 
     142      zbg(15) = zbg(15) * r1_rho0 * 1.e-9  ! salt content trend (km3*pss) 
     143      zbg(16) = zbg(16)           * 1.e-20 ! heat content trend (1.e20 J) 
     144      ! difference 
     145      zbg(14) = zbg(14) - ( frc_voltop + frc_volbot ) 
     146      zbg(15) = zbg(15) -   frc_sal 
     147      zbg(16) = zbg(16) - ( frc_tembot - frc_temtop ) 
     148 
     149      ! outputs 
     150      CALL iom_put( 'ibgfrcvoltop' , frc_voltop )   ! vol  forcing ice/snw-atm          (km3 equivalent ocean water) 
     151      CALL iom_put( 'ibgfrcvolbot' , frc_volbot )   ! vol  forcing ice/snw-ocean        (km3 equivalent ocean water) 
     152      CALL iom_put( 'ibgfrcsal'    , frc_sal    )   ! sal  forcing                      (psu*km3 equivalent ocean water) 
     153      CALL iom_put( 'ibgfrctemtop' , frc_temtop )   ! heat on top of ice/snw/ocean      (1.e20 J) 
     154      CALL iom_put( 'ibgfrctembot' , frc_tembot )   ! heat on top of ocean(below ice)   (1.e20 J) 
     155      CALL iom_put( 'ibgfrchfxtop' , frc_temtop * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ice/snw/ocean      (W/m2) 
     156      CALL iom_put( 'ibgfrchfxbot' , frc_tembot * z1_e1e2 * 1.e-20 * kt*rn_Dt ) ! heat on top of ocean(below ice)   (W/m2) 
     157 
     158      CALL iom_put( 'ibgvol_tot'  , zbg(6)  ) 
     159      CALL iom_put( 'sbgvol_tot'  , zbg(7)  ) 
     160      CALL iom_put( 'ibgarea_tot' , zbg(8)  ) 
     161      CALL iom_put( 'ibgsalt_tot' , zbg(9)  ) 
     162      CALL iom_put( 'ibgheat_tot' , zbg(10) ) 
     163      CALL iom_put( 'sbgheat_tot' , zbg(11) ) 
     164      CALL iom_put( 'ipbgvol_tot' , zbg(12) ) 
     165      CALL iom_put( 'ilbgvol_tot' , zbg(13) ) 
     166      
     167      CALL iom_put( 'ibgvolume' , zbg(14) )   ! ice/snow volume  drift            (km3 equivalent ocean water) 
     168      CALL iom_put( 'ibgsaltco' , zbg(15) )   ! ice salt content drift            (psu*km3 equivalent ocean water) 
     169      CALL iom_put( 'ibgheatco' , zbg(16) )   ! ice/snow heat content drift       (1.e20 J) 
     170      ! 
     171      ! restarts 
    154172      IF( lrst_ice )   CALL ice_dia_rst( 'WRITE', kt_ice ) 
    155173      ! 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn.F90

    r14072 r15548  
    135135         ! CFL = 0.5 at a distance from the bound of 1/6 of the basin length 
    136136         ! Then for dx = 2m and dt = 1s => rn_uice = u (1/6th) = 1m/s 
    137          DO_2D( 1, 1, 1, 1 ) 
     137         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    138138            zcoefu = ( REAL(jpiglo+1)*0.5_wp - REAL(ji+nimpp-1) ) / ( REAL(jpiglo+1)*0.5_wp - 1._wp ) 
    139139            zcoefv = ( REAL(jpjglo+1)*0.5_wp - REAL(jj+njmpp-1) ) / ( REAL(jpjglo+1)*0.5_wp - 1._wp ) 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_adv_pra.F90

    r14433 r15548  
    268268            &                          , sxxice, 'T', 1._wp, syyice, 'T',  1._wp, sxyice, 'T',  1._wp  & 
    269269            &                          , z0snw , 'T', 1._wp, sxsn  , 'T', -1._wp, sysn  , 'T', -1._wp  & ! snw volume 
    270             &                          , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  ) 
    271          CALL lbc_lnk( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
     270            &                          , sxxsn , 'T', 1._wp, syysn , 'T',  1._wp, sxysn , 'T',  1._wp  & 
     271            &                          , z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp  & ! ice salinity 
    272272            &                          , sxxsal, 'T', 1._wp, syysal, 'T',  1._wp, sxysal, 'T',  1._wp  & 
    273273            &                          , z0ai  , 'T', 1._wp, sxa   , 'T', -1._wp, sya   , 'T', -1._wp  & ! ice concentration 
    274             &                          , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  ) 
    275          CALL lbc_lnk( 'icedyn_adv_pra', z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
     274            &                          , sxxa  , 'T', 1._wp, syya  , 'T',  1._wp, sxya  , 'T',  1._wp  & 
     275            &                          , z0oi  , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp  & ! ice age 
    276276            &                          , sxxage, 'T', 1._wp, syyage, 'T',  1._wp, sxyage, 'T',  1._wp  ) 
    277277         CALL lbc_lnk( 'icedyn_adv_pra', z0es  , 'T', 1._wp, sxc0  , 'T', -1._wp, syc0  , 'T', -1._wp  & ! snw enthalpy 
    … …  
    280280            &                          , sxxe  , 'T', 1._wp, syye  , 'T',  1._wp, sxye  , 'T',  1._wp  ) 
    281281         IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 
    282             CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
    283                &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
    284                &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
    285                &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    286             IF ( ln_pnd_lids ) THEN 
    287                CALL lbc_lnk( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp  & ! melt pond lid volume 
    288                   &                          , sxxvl,'T', 1._wp, syyvl,'T',  1._wp, sxyvl,'T',  1._wp  ) 
     282            IF( ln_pnd_lids ) THEN 
     283               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     284                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     285                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     286                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  & 
     287                  &                          , z0vl , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp  & ! melt pond lid volume 
     288                  &                          , sxxvl, 'T', 1._wp, syyvl, 'T',  1._wp, sxyvl, 'T',  1._wp  ) 
     289            ELSE 
     290               CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp  & ! melt pond fraction 
     291                  &                          , sxxap, 'T', 1._wp, syyap, 'T',  1._wp, sxyap, 'T',  1._wp  & 
     292                  &                          , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp  & ! melt pond volume 
     293                  &                          , sxxvp, 'T', 1._wp, syyvp, 'T',  1._wp, sxyvp, 'T',  1._wp  ) 
    289294            ENDIF 
    290295         ENDIF 
    … …  
    766771      ! 
    767772      DO jl = 1, jpl 
    768          DO_2D( 1, 1, 1, 1 ) 
     773         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    769774            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    770775               ! 
    … …  
    813818      !                                           ! -- check e_i/v_i -- ! 
    814819      DO jl = 1, jpl 
    815          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     820         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    816821            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    817822               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    827832      !                                           ! -- check e_s/v_s -- ! 
    828833      DO jl = 1, jpl 
    829          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     834         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    830835            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    831836               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    870875      ! -- check snow load -- ! 
    871876      DO jl = 1, jpl 
    872          DO_2D( 1, 1, 1, 1 ) 
     877         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    873878            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    874879               ! 
    … …  
    11681173      !! ** Purpose :  compute the max of the 9 points around 
    11691174      !!---------------------------------------------------------------------- 
    1170       REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input 
    1171       REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output 
    1172       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1175      REAL(wp), DIMENSION(:,:,:), INTENT(in ) ::   pice   ! input 
     1176      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pmax   ! output 
     1177      ! 
     1178      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1179      REAL(wp)                       ::   zmax3 
    11731180      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    11741181      !!---------------------------------------------------------------------- 
     1182      ! basic version: get the max of epsi20 + 9 neighbours 
     1183!!$      DO jl = 1, jpl 
     1184!!$         DO_2D( 0, 0, 0, 0 ) 
     1185!!$            pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl),   & 
     1186!!$               &                          pice(ji-1,jj  ,jl), pice(ji,jj  ,jl), pice(ji+1,jj  ,jl),   & 
     1187!!$               &                          pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1188!!$         END_2D 
     1189!!$      END DO 
     1190      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
    11751191      DO jl = 1, jpl 
    1176          DO jj = Njs0-1, Nje0+1 
    1177             DO ji = Nis0, Nie0 
    1178                zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
    1179             END DO 
     1192         DO ji = Nis0, Nie0 
     1193            zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jl), pice(ji-1,Njs0-1,jl), pice(ji+1,Njs0-1,jl) ) 
     1194            zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jl), pice(ji-1,Njs0  ,jl), pice(ji+1,Njs0  ,jl) ) 
    11801195         END DO 
    1181          DO jj = Njs0, Nje0 
    1182             DO ji = Nis0, Nie0 
    1183                pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1184             END DO 
    1185          END DO 
     1196         DO_2D( 0, 0, 0, 0 ) 
     1197            zmax3 = MAX( epsi20, pice(ji,jj+1,jl), pice(ji-1,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1198            pmax(ji,jj,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1199            zmax1(ji) = zmax2(ji) 
     1200            zmax2(ji) = zmax3 
     1201         END_2D 
    11861202      END DO 
    11871203   END SUBROUTINE icemax3D 
    … …  
    11921208      !! ** Purpose :  compute the max of the 9 points around 
    11931209      !!---------------------------------------------------------------------- 
    1194       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input 
    1195       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output 
    1196       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1210      REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) ::   pice   ! input 
     1211      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) ::   pmax   ! output 
     1212      ! 
     1213      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1214      REAL(wp)                       ::   zmax3 
    11971215      INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices 
    11981216      !!---------------------------------------------------------------------- 
    11991217      jlay = SIZE( pice , 3 )   ! size of input arrays 
     1218      ! basic version: get the max of epsi20 + 9 neighbours 
     1219!!$      DO jl = 1, jpl 
     1220!!$         DO jk = 1, jlay 
     1221!!$            DO_2D( 0, 0, 0, 0 ) 
     1222!!$               pmax(ji,jj,jk,jl) = MAX( epsi20, pice(ji-1,jj-1,jk,jl), pice(ji,jj-1,jk,jl), pice(ji+1,jj-1,jk,jl),   & 
     1223!!$                  &                             pice(ji-1,jj  ,jk,jl), pice(ji,jj  ,jk,jl), pice(ji+1,jj  ,jk,jl),   & 
     1224!!$                  &                             pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1225!!$            END_2D 
     1226!!$         END DO 
     1227!!$      END DO 
     1228      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
    12001229      DO jl = 1, jpl 
    12011230         DO jk = 1, jlay 
    1202             DO jj = Njs0-1, Nje0+1 
    1203                DO ji = Nis0, Nie0 
    1204                   zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
    1205                END DO 
    1206             END DO 
    1207             DO jj = Njs0, Nje0 
    1208                DO ji = Nis0, Nie0 
    1209                   pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1210                END DO 
    1211             END DO 
     1231            DO ji = Nis0, Nie0 
     1232               zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jk,jl), pice(ji-1,Njs0-1,jk,jl), pice(ji+1,Njs0-1,jk,jl) ) 
     1233               zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jk,jl), pice(ji-1,Njs0  ,jk,jl), pice(ji+1,Njs0  ,jk,jl) ) 
     1234            END DO 
     1235            DO_2D( 0, 0, 0, 0 ) 
     1236               zmax3 = MAX( epsi20, pice(ji,jj+1,jk,jl), pice(ji-1,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1237               pmax(ji,jj,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1238               zmax1(ji) = zmax2(ji) 
     1239               zmax2(ji) = zmax3 
     1240            END_2D 
    12121241         END DO 
    12131242      END DO 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_adv_umx.F90

    r14433 r15548  
    164164      ! 
    165165      ! --- define velocity for advection: u*grad(H) --- ! 
    166       DO_2D( 0, 0, 0, 0 ) 
     166      DO_2D( nn_hls-1, nn_hls, nn_hls, nn_hls ) 
    167167         IF    ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN   ;   zcu_box(ji,jj) = 0._wp 
    168168         ELSEIF( pu_ice(ji,jj)                   >  0._wp ) THEN   ;   zcu_box(ji,jj) = pu_ice(ji-1,jj) 
    169169         ELSE                                                      ;   zcu_box(ji,jj) = pu_ice(ji  ,jj) 
    170170         ENDIF 
    171  
     171      END_2D 
     172      DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls ) 
    172173         IF    ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN   ;   zcv_box(ji,jj) = 0._wp 
    173174         ELSEIF( pv_ice(ji,jj)                   >  0._wp ) THEN   ;   zcv_box(ji,jj) = pv_ice(ji,jj-1) 
    … …  
    204205            IF( .NOT. ALLOCATED(jmsk_small) )   ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 
    205206            DO jl = 1, jpl 
    206                DO_2D( 1, 0, 1, 0 ) 
     207               DO_2D( 1, 0, nn_hls, nn_hls ) 
    207208                  zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 
    208209                  IF( zvi_cen < epsi06) THEN   ;   imsk_small(ji,jj,jl) = 0 
    209210                  ELSE                         ;   imsk_small(ji,jj,jl) = 1   ;   ENDIF 
     211               END_2D 
     212               DO_2D( nn_hls, nn_hls, 1, 0 ) 
    210213                  zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 
    211214                  IF( zvi_cen < epsi06) THEN   ;   jmsk_small(ji,jj,jl) = 0 
    … …  
    583586         ! 
    584587         DO jl = 1, jpl 
    585             DO_2D( 1, 0, 1, 0 ) 
     588            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    586589               pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    587590               pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    … …  
    594597            ! 
    595598            DO jl = 1, jpl              !-- flux in x-direction 
    596                DO_2D( 1, 0, 1, 1 ) 
     599               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    597600                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
    598601               END_2D 
    … …  
    600603            ! 
    601604            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    602                DO_2D( 0, 0, 1, 1 ) 
     605               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 
    603606                  ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) )              & 
    604607                     &   + ( pu     (ji,jj   ) - pu     (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    609612            ! 
    610613            DO jl = 1, jpl              !-- flux in y-direction 
    611                DO_2D( 0, 0, 1, 0 ) 
     614               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
    612615                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 
    613616               END_2D 
    … …  
    617620            ! 
    618621            DO jl = 1, jpl              !-- flux in y-direction 
    619                DO_2D( 1, 1, 1, 0 ) 
     622               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    620623                  pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
    621624               END_2D 
    … …  
    623626            ! 
    624627            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    625                DO_2D( 1, 1, 0, 0 ) 
     628               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 
    626629                  ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) )  & 
    627630                     &   + ( pv     (ji,jj   ) - pv     (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    632635            ! 
    633636            DO jl = 1, jpl              !-- flux in x-direction 
    634                DO_2D( 1, 0, 0, 0 ) 
     637               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    635638                  pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 
    636639               END_2D 
    … …  
    642645      ! 
    643646      DO jl = 1, jpl                    !-- after tracer with upstream scheme 
    644          DO_2D( 0, 0, 0, 0 ) 
     647         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    645648            ztra = - (   pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj  ,jl)   & 
    646649               &       + pfv_ups(ji,jj,jl) - pfv_ups(ji  ,jj-1,jl) ) & 
    … …  
    651654         END_2D 
    652655      END DO 
    653       CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
     656      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 
    654657 
    655658   END SUBROUTINE upstream 
    … …  
    681684         ! 
    682685         DO jl = 1, jpl 
    683             DO_2D( 1, 0, 1, 1 ) 
     686            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    684687               pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj  ,jl) ) 
    685688            END_2D 
    686             DO_2D( 1, 1, 1, 0 ) 
     689            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    687690               pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji  ,jj+1,jl) ) 
    688691            END_2D 
    … …  
    701704            ! 
    702705            DO jl = 1, jpl              !-- flux in x-direction 
    703                DO_2D( 1, 0, 1, 1 ) 
     706               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 
    704707                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 
    705708               END_2D 
    … …  
    708711 
    709712            DO jl = 1, jpl              !-- first guess of tracer from u-flux 
    710                DO_2D( 0, 0, 1, 1 ) 
     713               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 
    711714                  ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) )              & 
    712715                     &   + ( pu    (ji,jj   ) - pu    (ji-1,jj   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    717720 
    718721            DO jl = 1, jpl              !-- flux in y-direction 
    719                DO_2D( 0, 0, 1, 0 ) 
     722               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 
    720723                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 
    721724               END_2D 
    … …  
    726729            ! 
    727730            DO jl = 1, jpl              !-- flux in y-direction 
    728                DO_2D( 1, 1, 1, 0 ) 
     731               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 
    729732                  pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 
    730733               END_2D 
    … …  
    733736            ! 
    734737            DO jl = 1, jpl              !-- first guess of tracer from v-flux 
    735                DO_2D( 1, 1, 0, 0 ) 
     738               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 
    736739                  ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) )  & 
    737740                     &   + ( pv    (ji,jj   ) - pv    (ji,jj-1   ) ) * pt(ji,jj,jl) * (1.-pamsk) 
    … …  
    742745            ! 
    743746            DO jl = 1, jpl              !-- flux in x-direction 
    744                DO_2D( 1, 0, 0, 0 ) 
     747               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    745748                  pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 
    746749               END_2D 
    … …  
    785788         ! 
    786789         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    787          CALL ultimate_x( pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 
     790         CALL ultimate_x( nn_hls, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 
    788791         !                                                        !--  limiter in x --! 
    789792         IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 
    790793         !                                                        !--  advective form update in zpt  --! 
    791794         DO jl = 1, jpl 
    792             DO_2D( 0, 0, 0, 0 ) 
     795            DO_2D( 0, 0, nn_hls, nn_hls ) 
    793796               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pubox(ji,jj   ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t  (ji,jj) & 
    794797                  &                              + pt   (ji,jj,jl) * ( pu  (ji,jj   ) - pu  (ji-1,jj   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    797800            END_2D 
    798801         END DO 
    799          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    800802         ! 
    801803         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    802804         IF( ll_hoxy ) THEN 
    803             CALL ultimate_y( pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 
     805            CALL ultimate_y( 0, pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 
    804806         ELSE 
    805             CALL ultimate_y( pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 
     807            CALL ultimate_y( 0, pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 
    806808         ENDIF 
    807809         !                                                        !--  limiter in y --! 
    … …  
    812814         ! 
    813815         !                                                        !--  ultimate interpolation of pt at v-point  --! 
    814          CALL ultimate_y( pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 
     816         CALL ultimate_y( nn_hls, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 
    815817         !                                                        !--  limiter in y --! 
    816818         IF( np_limiter == 2 .OR. np_limiter == 3 )   CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 
    817819         !                                                        !--  advective form update in zpt  --! 
    818820         DO jl = 1, jpl 
    819             DO_2D( 0, 0, 0, 0 ) 
     821            DO_2D( nn_hls, nn_hls, 0, 0 ) 
    820822               zpt(ji,jj,jl) = ( pt(ji,jj,jl) - (  pvbox(ji,jj   ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t  (ji,jj) & 
    821823                  &                              + pt   (ji,jj,jl) * ( pv  (ji,jj   ) - pv  (ji,jj-1   ) ) * r1_e1e2t(ji,jj) & 
    … …  
    824826            END_2D 
    825827         END DO 
    826          CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp ) 
    827828         ! 
    828829         !                                                        !--  ultimate interpolation of pt at u-point  --! 
    829830         IF( ll_hoxy ) THEN 
    830             CALL ultimate_x( pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 
     831            CALL ultimate_x( 0, pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 
    831832         ELSE 
    832             CALL ultimate_x( pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 
     833            CALL ultimate_x( 0, pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 
    833834         ENDIF 
    834835         !                                                        !--  limiter in x --! 
    … …  
    842843 
    843844 
    844    SUBROUTINE ultimate_x( pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 
     845   SUBROUTINE ultimate_x( kloop, pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 
    845846      !!--------------------------------------------------------------------- 
    846847      !!                    ***  ROUTINE ultimate_x  *** 
    … …  
    852853      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    853854      !!---------------------------------------------------------------------- 
     855      INTEGER                         , INTENT(in   ) ::   kloop     ! either 0 or nn_hls depending on the order of the call 
    854856      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    855857      INTEGER                         , INTENT(in   ) ::   kn_umx    ! order of the scheme (1-5=UM or 20=CEN2) 
    … …  
    867869      !                                                     !--  Laplacian in i-direction  --! 
    868870      DO jl = 1, jpl 
    869          DO jj = 2, jpjm1         ! First derivative (gradient) 
    870             DO ji = 1, jpim1 
    871                ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
    872             END DO 
    873             !                     ! Second derivative (Laplacian) 
    874             DO ji = 2, jpim1 
    875                ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
    876             END DO 
    877          END DO 
    878       END DO 
    879       CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
     871         DO_2D( nn_hls, nn_hls-1, kloop, kloop )      ! First derivative (gradient) 
     872            ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     873         END_2D 
     874         DO_2D( nn_hls-1, nn_hls-1, kloop, kloop )    ! Second derivative (Laplacian) 
     875            ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     876         END_2D 
     877!!$         DO jj = 2, jpjm1         ! First derivative (gradient) 
     878!!$            DO ji = 1, jpim1 
     879!!$               ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     880!!$            END DO 
     881!!$            !                     ! Second derivative (Laplacian) 
     882!!$            DO ji = 2, jpim1 
     883!!$               ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     884!!$            END DO 
     885!!$         END DO 
     886      END DO 
     887      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 
    880888      ! 
    881889      !                                                     !--  BiLaplacian in i-direction  --! 
    882890      DO jl = 1, jpl 
    883          DO jj = 2, jpjm1         ! Third derivative 
    884             DO ji = 1, jpim1 
    885                ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
    886             END DO 
    887             !                     ! Fourth derivative 
    888             DO ji = 2, jpim1 
    889                ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
    890             END DO 
    891          END DO 
    892       END DO 
    893       CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
     891         DO_2D( 1, 0, kloop, kloop )                  ! Third derivative 
     892            ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     893         END_2D 
     894         DO_2D( 0, 0, kloop, kloop )                  ! Fourth derivative 
     895            ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     896         END_2D 
     897!!$         DO jj = 2, jpjm1         ! Third derivative 
     898!!$            DO ji = 1, jpim1 
     899!!$               ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 
     900!!$            END DO 
     901!!$            !                     ! Fourth derivative 
     902!!$            DO ji = 2, jpim1 
     903!!$               ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 
     904!!$            END DO 
     905!!$         END DO 
     906      END DO 
    894907      ! 
    895908      ! 
    … …  
    899912         ! 
    900913         DO jl = 1, jpl 
    901             DO_2D( 1, 0, 0, 0 ) 
     914            DO_2D( 1, 0, kloop, kloop ) 
    902915               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    903916                  &                                         - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) 
    … …  
    908921         ! 
    909922         DO jl = 1, jpl 
    910             DO_2D( 1, 0, 0, 0 ) 
     923            DO_2D( 1, 0, kloop, kloop ) 
    911924               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    912925               pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    918931         ! 
    919932         DO jl = 1, jpl 
    920             DO_2D( 1, 0, 0, 0 ) 
     933            DO_2D( 1, 0, kloop, kloop ) 
    921934               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    922935               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    932945         ! 
    933946         DO jl = 1, jpl 
    934             DO_2D( 1, 0, 0, 0 ) 
     947            DO_2D( 1, 0, kloop, kloop ) 
    935948               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    936949               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    945958      CASE( 5 )                                                   !==  5th order central TIM  ==! (Eq. 29) 
    946959         ! 
    947          DO jl = 1, jpl 
    948             DO_2D( 1, 0, 0, 0 ) 
     960         CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 
     961         ! 
     962         DO jl = 1, jpl 
     963            DO_2D( 1, 0, kloop, kloop ) 
    949964               zcu  = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 
    950965               zdx2 = e1u(ji,jj) * e1u(ji,jj) 
    … …  
    967982      IF( ll_neg ) THEN 
    968983         DO jl = 1, jpl 
    969             DO_2D( 1, 0, 0, 0 ) 
     984            DO_2D( 1, 0, kloop, kloop ) 
    970985               IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    971986                  pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * (                                pt(ji+1,jj,jl) + pt(ji,jj,jl)   & 
    … …  
    9851000 
    9861001 
    987    SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 
     1002   SUBROUTINE ultimate_y( kloop, pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 
    9881003      !!--------------------------------------------------------------------- 
    9891004      !!                    ***  ROUTINE ultimate_y  *** 
    … …  
    9951010      !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 
    9961011      !!---------------------------------------------------------------------- 
     1012      INTEGER                         , INTENT(in   ) ::   kloop     ! either 0 or nn_hls depending on the order of the call 
    9971013      REAL(wp)                        , INTENT(in   ) ::   pamsk     ! advection of concentration (1) or other tracers (0) 
    9981014      INTEGER                         , INTENT(in   ) ::   kn_umx    ! order of the scheme (1-5=UM or 20=CEN2) 
    … …  
    10101026      !                                                     !--  Laplacian in j-direction  --! 
    10111027      DO jl = 1, jpl 
    1012          DO_2D( 0, 0, 1, 0 )         ! First derivative (gradient) 
     1028         DO_2D( kloop, kloop, nn_hls, nn_hls-1 )      ! First derivative (gradient) 
    10131029            ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10141030         END_2D 
    1015          DO_2D( 0, 0, 0, 0 )         ! Second derivative (Laplacian) 
     1031         DO_2D( kloop, kloop, nn_hls-1, nn_hls-1 )    ! Second derivative (Laplacian) 
    10161032            ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10171033         END_2D 
    10181034      END DO 
    1019       CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
     1035      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 
    10201036      ! 
    10211037      !                                                     !--  BiLaplacian in j-direction  --! 
    10221038      DO jl = 1, jpl 
    1023          DO_2D( 0, 0, 1, 0 )         ! First derivative 
     1039         DO_2D( kloop, kloop, 1, 0 )                  ! Third derivative 
    10241040            ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 
    10251041         END_2D 
    1026          DO_2D( 0, 0, 0, 0 )         ! Second derivative 
     1042         DO_2D( kloop, kloop, 0, 0 )                  ! Fourth derivative 
    10271043            ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 
    10281044         END_2D 
    10291045      END DO 
    1030       CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
    10311046      ! 
    10321047      ! 
    … …  
    10351050      CASE( 1 )                                                !==  1st order central TIM  ==! (Eq. 21) 
    10361051         DO jl = 1, jpl 
    1037             DO_2D( 0, 0, 1, 0 ) 
     1052            DO_2D( kloop, kloop, 1, 0 ) 
    10381053               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    10391054                  &                                         - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) 
    … …  
    10431058      CASE( 2 )                                                !==  2nd order central TIM  ==! (Eq. 23) 
    10441059         DO jl = 1, jpl 
    1045             DO_2D( 0, 0, 1, 0 ) 
     1060            DO_2D( kloop, kloop, 1, 0 ) 
    10461061               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10471062               pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                                pt(ji,jj+1,jl) + pt(ji,jj,jl)   & 
    … …  
    10521067      CASE( 3 )                                                !==  3rd order central TIM  ==! (Eq. 24) 
    10531068         DO jl = 1, jpl 
    1054             DO_2D( 0, 0, 1, 0 ) 
     1069            DO_2D( kloop, kloop, 1, 0 ) 
    10551070               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10561071               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10651080      CASE( 4 )                                                !==  4th order central TIM  ==! (Eq. 27) 
    10661081         DO jl = 1, jpl 
    1067             DO_2D( 0, 0, 1, 0 ) 
     1082            DO_2D( kloop, kloop, 1, 0 ) 
    10681083               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10691084               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10771092         ! 
    10781093      CASE( 5 )                                                !==  5th order central TIM  ==! (Eq. 29) 
    1079          DO jl = 1, jpl 
    1080             DO_2D( 0, 0, 1, 0 ) 
     1094         ! 
     1095         CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 
     1096         ! 
     1097         DO jl = 1, jpl 
     1098            DO_2D( kloop, kloop, 1, 0 ) 
    10811099               zcv  = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 
    10821100               zdy2 = e2v(ji,jj) * e2v(ji,jj) 
    … …  
    10991117      IF( ll_neg ) THEN 
    11001118         DO jl = 1, jpl 
    1101             DO_2D( 0, 0, 1, 0 ) 
     1119            DO_2D( kloop, kloop, 1, 0 ) 
    11021120               IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 
    11031121                  pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * (                              ( pt(ji,jj+1,jl) + pt(ji,jj,jl) )  & 
    … …  
    12991317      ! 
    13001318      DO jl = 1, jpl 
    1301          DO_2D( 0, 0, 0, 0 ) 
     1319         DO_2D( nn_hls, nn_hls-1, 0, 0 ) 
    13021320            zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 
    13031321         END_2D 
    13041322      END DO 
    1305       CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
    1306  
    1307       DO jl = 1, jpl 
    1308          DO_2D( 0, 0, 0, 0 ) 
     1323      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp)   ! lateral boundary cond. 
     1324 
     1325      DO jl = 1, jpl 
     1326         DO_2D( nn_hls-1, 0, 0, 0 ) 
    13091327            uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 
    13101328 
    … …  
    13671385         END_2D 
    13681386      END DO 
    1369       CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
     1387      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp)   ! lateral boundary cond. 
    13701388      ! 
    13711389   END SUBROUTINE limiter_x 
    … …  
    13901408      ! 
    13911409      DO jl = 1, jpl 
    1392          DO_2D( 0, 0, 0, 0 ) 
     1410         DO_2D( 0, 0, nn_hls, nn_hls-1 ) 
    13931411            zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 
    13941412         END_2D 
    13951413      END DO 
    1396       CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
    1397  
    1398       DO jl = 1, jpl 
    1399          DO_2D( 0, 0, 0, 0 ) 
     1414      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp)   ! lateral boundary cond. 
     1415 
     1416      DO jl = 1, jpl 
     1417         DO_2D( 0, 0, nn_hls-1, 0 ) 
    14001418            vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 
    14011419 
    … …  
    14591477         END_2D 
    14601478      END DO 
    1461       CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
     1479      IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp)   ! lateral boundary cond. 
    14621480      ! 
    14631481   END SUBROUTINE limiter_y 
    … …  
    14941512      ! 
    14951513      DO jl = 1, jpl 
    1496          DO_2D( 1, 1, 1, 1 ) 
     1514         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    14971515            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    14981516               ! 
    … …  
    15411559      !                                           ! -- check e_i/v_i -- ! 
    15421560      DO jl = 1, jpl 
    1543          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     1561         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    15441562            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    15451563               ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15551573      !                                           ! -- check e_s/v_s -- ! 
    15561574      DO jl = 1, jpl 
    1557          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     1575         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    15581576            IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 
    15591577               ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean 
    … …  
    15981616      ! -- check snow load -- ! 
    15991617      DO jl = 1, jpl 
    1600          DO_2D( 1, 1, 1, 1 ) 
     1618         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    16011619            IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 
    16021620               ! 
    … …  
    16271645      !! ** Purpose :  compute the max of the 9 points around 
    16281646      !!---------------------------------------------------------------------- 
    1629       REAL(wp), DIMENSION(:,:,:)      , INTENT(in ) ::   pice   ! input 
    1630       REAL(wp), DIMENSION(:,:,:)      , INTENT(out) ::   pmax   ! output 
    1631       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1647      REAL(wp), DIMENSION(:,:,:), INTENT(in ) ::   pice   ! input 
     1648      REAL(wp), DIMENSION(:,:,:), INTENT(out) ::   pmax   ! output 
     1649      ! 
     1650      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1651      REAL(wp)                       ::   zmax3 
    16321652      INTEGER  ::   ji, jj, jl   ! dummy loop indices 
    16331653      !!---------------------------------------------------------------------- 
    1634       DO jl = 1, jpl 
    1635          DO jj = Njs0-1, Nje0+1 
    1636             DO ji = Nis0, Nie0 
    1637                zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jl), pice(ji-1,jj,jl), pice(ji+1,jj,jl) ) 
    1638             END DO 
    1639          END DO 
    1640          DO jj = Njs0, Nje0 
    1641             DO ji = Nis0, Nie0 
    1642                pmax(ji,jj,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1643             END DO 
    1644          END DO 
     1654      ! basic version: get the max of epsi20 + 9 neighbours 
     1655!!$      DO jl = 1, jpl 
     1656!!$         DO_2D( 0, 0, 0, 0 ) 
     1657!!$            pmax(ji,jj,jl) = MAX( epsi20, pice(ji-1,jj-1,jl), pice(ji,jj-1,jl), pice(ji+1,jj-1,jl),   & 
     1658!!$               &                          pice(ji-1,jj  ,jl), pice(ji,jj  ,jl), pice(ji+1,jj  ,jl),   & 
     1659!!$               &                          pice(ji-1,jj+1,jl), pice(ji,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1660!!$         END_2D 
     1661!!$      END DO 
     1662      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
     1663      DO jl = 1, jpl 
     1664         DO ji = Nis0, Nie0 
     1665            zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jl), pice(ji-1,Njs0-1,jl), pice(ji+1,Njs0-1,jl) ) 
     1666            zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jl), pice(ji-1,Njs0  ,jl), pice(ji+1,Njs0  ,jl) ) 
     1667         END DO 
     1668         DO_2D( 0, 0, 0, 0 ) 
     1669            zmax3 = MAX( epsi20, pice(ji,jj+1,jl), pice(ji-1,jj+1,jl), pice(ji+1,jj+1,jl) ) 
     1670            pmax(ji,jj,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1671            zmax1(ji) = zmax2(ji) 
     1672            zmax2(ji) = zmax3 
     1673         END_2D 
    16451674      END DO 
    16461675   END SUBROUTINE icemax3D 
    … …  
    16511680      !! ** Purpose :  compute the max of the 9 points around 
    16521681      !!---------------------------------------------------------------------- 
    1653       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(in ) ::   pice   ! input 
    1654       REAL(wp), DIMENSION(:,:,:,:)    , INTENT(out) ::   pmax   ! output 
    1655       REAL(wp), DIMENSION(2:jpim1,jpj)              ::   zmax   ! temporary array 
     1682      REAL(wp), DIMENSION(:,:,:,:), INTENT(in ) ::   pice   ! input 
     1683      REAL(wp), DIMENSION(:,:,:,:), INTENT(out) ::   pmax   ! output 
     1684      ! 
     1685      REAL(wp), DIMENSION(Nis0:Nie0) ::   zmax1, zmax2 
     1686      REAL(wp)                       ::   zmax3 
    16561687      INTEGER  ::   jlay, ji, jj, jk, jl   ! dummy loop indices 
    16571688      !!---------------------------------------------------------------------- 
    16581689      jlay = SIZE( pice , 3 )   ! size of input arrays 
     1690      ! basic version: get the max of epsi20 + 9 neighbours 
     1691!!$      DO jl = 1, jpl 
     1692!!$         DO jk = 1, jlay 
     1693!!$            DO_2D( 0, 0, 0, 0 ) 
     1694!!$               pmax(ji,jj,jk,jl) = MAX( epsi20, pice(ji-1,jj-1,jk,jl), pice(ji,jj-1,jk,jl), pice(ji+1,jj-1,jk,jl),   & 
     1695!!$                  &                             pice(ji-1,jj  ,jk,jl), pice(ji,jj  ,jk,jl), pice(ji+1,jj  ,jk,jl),   & 
     1696!!$                  &                             pice(ji-1,jj+1,jk,jl), pice(ji,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1697!!$            END_2D 
     1698!!$         END DO 
     1699!!$      END DO 
     1700      ! optimized version : does a little bit more than 2 max of epsi20 + 3 neighbours 
    16591701      DO jl = 1, jpl 
    16601702         DO jk = 1, jlay 
    1661             DO jj = Njs0-1, Nje0+1 
    1662                DO ji = Nis0, Nie0 
    1663                   zmax(ji,jj) = MAX( epsi20, pice(ji,jj,jk,jl), pice(ji-1,jj,jk,jl), pice(ji+1,jj,jk,jl) ) 
    1664                END DO 
    1665             END DO 
    1666             DO jj = Njs0, Nje0 
    1667                DO ji = Nis0, Nie0 
    1668                   pmax(ji,jj,jk,jl) = MAX( epsi20, zmax(ji,jj), zmax(ji,jj-1), zmax(ji,jj+1) ) 
    1669                END DO 
    1670             END DO 
     1703            DO ji = Nis0, Nie0 
     1704               zmax1(ji) = MAX( epsi20, pice(ji,Njs0-1,jk,jl), pice(ji-1,Njs0-1,jk,jl), pice(ji+1,Njs0-1,jk,jl) ) 
     1705               zmax2(ji) = MAX( epsi20, pice(ji,Njs0  ,jk,jl), pice(ji-1,Njs0  ,jk,jl), pice(ji+1,Njs0  ,jk,jl) ) 
     1706            END DO 
     1707            DO_2D( 0, 0, 0, 0 ) 
     1708               zmax3 = MAX( epsi20, pice(ji,jj+1,jk,jl), pice(ji-1,jj+1,jk,jl), pice(ji+1,jj+1,jk,jl) ) 
     1709               pmax(ji,jj,jk,jl) = MAX( epsi20, zmax1(ji), zmax2(ji), zmax3 ) 
     1710               zmax1(ji) = zmax2(ji) 
     1711               zmax2(ji) = zmax3 
     1712            END_2D 
    16711713         END DO 
    16721714      END DO 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rdgrft.F90

    r14072 r15548  
    5757   ! 
    5858   ! ** namelist (namdyn_rdgrft) ** 
    59    LOGICAL  ::   ln_str_H79       ! ice strength parameterization (Hibler79) 
    60    REAL(wp) ::   rn_pstar         ! determines ice strength, Hibler JPO79 
    6159   REAL(wp) ::   rn_csrdg         ! fraction of shearing energy contributing to ridging 
    6260   LOGICAL  ::   ln_partf_lin     ! participation function linear (Thorndike et al. (1975)) 
    … …  
    162160      npti = 0   ;   nptidx(:) = 0 
    163161      ipti = 0   ;   iptidx(:) = 0 
    164       DO_2D( 1, 1, 1, 1 ) 
     162      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    165163         IF ( at_i(ji,jj) > epsi10 ) THEN 
    166164            npti           = npti + 1 
    … …  
    272270 
    273271      ! controls 
    274       IF( sn_cfctl%l_prtctl )   CALL ice_prt3D   ('icedyn_rdgrft')                                                        ! prints 
     272      IF( sn_cfctl%l_prtctl )   CALL ice_prt3D('icedyn_rdgrft')                                                           ! prints 
    275273      IF( ln_icectl    )   CALL ice_prt     (kt, iiceprt, jiceprt,-1, ' - ice dyn rdgrft - ')                             ! prints 
    276274      IF( ln_icediachk )   CALL ice_cons_hsm(1, 'icedyn_rdgrft', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) ! conservation 
    … …  
    520518      ! 
    521519      INTEGER , DIMENSION(jpij) ::   itest_rdg, itest_rft   ! test for conservation 
     520      LOGICAL , DIMENSION(jpij) ::   ll_shift         ! logical for doing calculation or not 
    522521      !!------------------------------------------------------------------- 
    523522      ! 
    … …  
    540539         DO ji = 1, npti 
    541540 
    542             IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN   ! only if ice is ridging 
     541            ! set logical to true when ridging 
     542            IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN   ;   ll_shift(ji) = .TRUE. 
     543            ELSE                                                                ;   ll_shift(ji) = .FALSE. 
     544            ENDIF 
     545             
     546            IF( ll_shift(ji) ) THEN   ! only if ice is ridging 
    543547 
    544548               IF( a_i_2d(ji,jl1) > epsi10 ) THEN   ;   z1_ai(ji) = 1._wp / a_i_2d(ji,jl1) 
    … …  
    630634         DO jk = 1, nlay_s 
    631635            DO ji = 1, npti 
    632                IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN 
     636               IF( ll_shift(ji) ) THEN 
    633637                  ! Compute ridging /rafting fractions 
    634638                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji) 
    … …  
    651655         DO jk = 1, nlay_i 
    652656            DO ji = 1, npti 
    653                IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN 
     657               IF( ll_shift(ji) ) THEN 
    654658                  ! Compute ridging /rafting fractions 
    655659                  afrdg = aridge(ji,jl1) * closing_gross(ji) * rDt_ice * z1_ai(ji) 
    … …  
    674678            DO ji = 1, npti 
    675679 
    676                IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp ) THEN 
     680               IF( ll_shift(ji) ) THEN 
    677681 
    678682                  ! Compute the fraction of ridged ice area and volume going to thickness category jl2 
    … …  
    731735            DO jk = 1, nlay_s 
    732736               DO ji = 1, npti 
    733                   IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp )   & 
     737                  IF( ll_shift(ji) )   & 
    734738                     &   ze_s_2d(ji,jk,jl2) = ze_s_2d(ji,jk,jl2) + ( esrdg(ji,jk) * rn_fsnwrdg * fvol(ji)  +  & 
    735739                     &                                               esrft(ji,jk) * rn_fsnwrft * zswitch(ji) ) 
    … …  
    740744            DO jk = 1, nlay_i 
    741745               DO ji = 1, npti 
    742                   IF( apartf(ji,jl1) > 0._wp .AND. closing_gross(ji) > 0._wp )   & 
     746                  IF( ll_shift(ji) )   & 
    743747                     &   ze_i_2d(ji,jk,jl2) = ze_i_2d(ji,jk,jl2) + eirdg(ji,jk) * fvol(ji) + eirft(ji,jk) * zswitch(ji) 
    744748               END DO 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rhg_eap.F90

    r14433 r15548  
    5858 
    5959   REAL(wp), DIMENSION(nx_yield, ny_yield, na_yield) ::   s11r, s12r, s22r, s11s, s12s, s22s 
     60   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
     61 
     62   !! for convergence tests 
     63   INTEGER ::   ncvgid   ! netcdf file id 
     64   INTEGER ::   nvarid   ! netcdf variable id 
    6065 
    6166   !! * Substitutions 
    6267#  include "do_loop_substitute.h90" 
    6368#  include "domzgr_substitute.h90" 
    64  
    65    !! for convergence tests 
    66    INTEGER ::   ncvgid   ! netcdf file id 
    67    INTEGER ::   nvarid   ! netcdf variable id 
    68    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   aimsk00 
    69    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   eap_res  , aimsk15 
    7069   !!---------------------------------------------------------------------- 
    7170   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    180179      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    181180      ! 
     181      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    182182      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    183183      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    184       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    185184 
    186185      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
    … …  
    203202      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_eap: EAP sea-ice rheology' 
    204203      ! 
    205       IF( kt == nit000 )  THEN  
    206          ! 
    207          ! for diagnostics  
    208          ALLOCATE( aimsk00(jpi,jpj) ) 
    209          ! for convergence tests 
    210          IF( nn_rhg_chkcvg > 0 ) ALLOCATE( eap_res(jpi,jpj), aimsk15(jpi,jpj) ) 
    211       ENDIF 
    212       ! 
     204      ! for diagnostics and convergence tests 
    213205      DO_2D( 1, 1, 1, 1 ) 
    214          aimsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     206         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    215207      END_2D 
    216208      IF( nn_rhg_chkcvg > 0 ) THEN 
    217209         DO_2D( 1, 1, 1, 1 ) 
    218             aimsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     210            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    219211         END_2D 
    220212      ENDIF 
    221213      ! 
    222 !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
    223214      !------------------------------------------------------------------------------! 
    224215      ! 0) mask at F points for the ice 
    225216      !------------------------------------------------------------------------------! 
    226       ! ocean/land mask 
    227       DO_2D( 1, 0, 1, 0 ) 
    228          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    229       END_2D 
    230       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1._wp ) 
    231  
    232       ! Lateral boundary conditions on velocity (modify zfmask) 
    233       DO_2D( 0, 0, 0, 0 ) 
    234          IF( zfmask(ji,jj) == 0._wp ) THEN 
    235             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    236                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     217      IF( kt == nit000 ) THEN 
     218         ! ocean/land mask 
     219         ALLOCATE( fimask(jpi,jpj) ) 
     220         IF( rn_ishlat == 0._wp ) THEN 
     221            DO_2D( 0, 0, 0, 0 ) 
     222               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     223            END_2D 
     224         ELSE 
     225            DO_2D( 0, 0, 0, 0 ) 
     226               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     227               ! Lateral boundary conditions on velocity (modify fimask) 
     228               IF( fimask(ji,jj) == 0._wp ) THEN 
     229                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     230                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     231               ENDIF 
     232            END_2D 
    237233         ENDIF 
    238       END_2D 
    239       DO jj = 2, jpjm1 
    240          IF( zfmask(1,jj) == 0._wp ) THEN 
    241             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    242          ENDIF 
    243          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    244             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    245          ENDIF 
    246       END DO 
    247       DO ji = 2, jpim1 
    248          IF( zfmask(ji,1) == 0._wp ) THEN 
    249             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    250          ENDIF 
    251          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    252             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    253          ENDIF 
    254       END DO 
    255       CALL lbc_lnk( 'icedyn_rhg_eap', zfmask, 'F', 1.0_wp ) 
     234         CALL lbc_lnk( 'icedyn_rhg_eap', fimask, 'F', 1.0_wp ) 
     235      ENDIF 
    256236 
    257237      !------------------------------------------------------------------------------! 
    … …  
    401381            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    402382               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    403                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     383               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    404384 
    405385         END_2D 
    … …  
    760740 
    761741         ! convergence test 
    762          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
     742         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg_eap( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
    763743         ! 
    764744         !                                                ! ==================== ! 
    … …  
    777757         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    778758            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    779             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     759            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    780760 
    781761      END_2D 
    … …  
    830810            &                            ztauy_ai, 'V', -1.0_wp, ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 
    831811         ! 
    832          CALL iom_put( 'utau_oi' , ztaux_oi * aimsk00 ) 
    833          CALL iom_put( 'vtau_oi' , ztauy_oi * aimsk00 ) 
    834          CALL iom_put( 'utau_ai' , ztaux_ai * aimsk00 ) 
    835          CALL iom_put( 'vtau_ai' , ztauy_ai * aimsk00 ) 
    836          CALL iom_put( 'utau_bi' , ztaux_bi * aimsk00 ) 
    837          CALL iom_put( 'vtau_bi' , ztauy_bi * aimsk00 ) 
     812         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
     813         CALL iom_put( 'vtau_oi' , ztauy_oi * zmsk00 ) 
     814         CALL iom_put( 'utau_ai' , ztaux_ai * zmsk00 ) 
     815         CALL iom_put( 'vtau_ai' , ztauy_ai * zmsk00 ) 
     816         CALL iom_put( 'utau_bi' , ztaux_bi * zmsk00 ) 
     817         CALL iom_put( 'vtau_bi' , ztauy_bi * zmsk00 ) 
    838818      ENDIF 
    839819 
    840820      ! --- divergence, shear and strength --- ! 
    841       IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * aimsk00 )   ! divergence 
    842       IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * aimsk00 )   ! shear 
    843       IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * aimsk00 )   ! delta 
    844       IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * aimsk00 )   ! strength 
     821      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
     822      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
     823      IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * zmsk00 )   ! delta 
     824      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    845825 
    846826      ! --- Stress tensor invariants (SIMIP diags) --- ! 
    … …  
    861841 
    862842            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008) 
    863             zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure 
    864             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress 
     843            zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                      ! 1st stress invariant, aka average normal stress, aka negative pressure 
     844            zsig_II(ji,jj)   =   SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 )  ! 2nd  ''       ''    , aka maximum shear stress 
    865845 
    866846         END_2D 
    867847         ! 
    868848         ! Stress tensor invariants (normal and shear stress N/m) - SIMIP diags - definitions following Coon (1974) and Feltham (2008) 
    869          IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * aimsk00(:,:) ) ! Normal stress 
    870          IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * aimsk00(:,:) ) ! Maximum shear stress 
     849         IF( iom_use('normstr') )   CALL iom_put( 'normstr', zsig_I (:,:) * zmsk00(:,:) ) ! Normal stress 
     850         IF( iom_use('sheastr') )   CALL iom_put( 'sheastr', zsig_II(:,:) * zmsk00(:,:) ) ! Maximum shear stress 
    871851 
    872852         DEALLOCATE ( zsig_I, zsig_II ) 
    … …  
    893873 
    894874            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point 
    895             zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure 
    896             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress 
     875            zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                      ! 1st stress invariant, aka average normal stress, aka negative pressure 
     876            zsig_II(ji,jj)   =   SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 )  ! 2nd  ''       ''    , aka maximum shear stress 
    897877 
    898878            ! Normalized  principal stresses (used to display the ellipse) 
    … …  
    914894         CALL lbc_lnk( 'icedyn_rhg_eap', zyield11, 'T', 1.0_wp, zyield22, 'T', 1.0_wp, zyield12, 'T', 1.0_wp ) 
    915895 
    916          CALL iom_put( 'yield11', zyield11 * aimsk00 ) 
    917          CALL iom_put( 'yield22', zyield22 * aimsk00 ) 
    918          CALL iom_put( 'yield12', zyield12 * aimsk00 ) 
     896         CALL iom_put( 'yield11', zyield11 * zmsk00 ) 
     897         CALL iom_put( 'yield22', zyield22 * zmsk00 ) 
     898         CALL iom_put( 'yield12', zyield12 * zmsk00 ) 
    919899      ENDIF 
    920900 
    … …  
    922902      IF( iom_use('aniso') ) THEN 
    923903         CALL lbc_lnk( 'icedyn_rhg_eap', paniso_11, 'T', 1.0_wp ) 
    924          CALL iom_put( 'aniso' , paniso_11 * aimsk00 ) 
     904         CALL iom_put( 'aniso' , paniso_11 * zmsk00 ) 
    925905      ENDIF 
    926906 
    … …  
    933913            &                              zfU, 'U', -1.0_wp,   zfV, 'V', -1.0_wp ) 
    934914 
    935          CALL iom_put( 'dssh_dx' , zspgU * aimsk00 )   ! Sea-surface tilt term in force balance (x) 
    936          CALL iom_put( 'dssh_dy' , zspgV * aimsk00 )   ! Sea-surface tilt term in force balance (y) 
    937          CALL iom_put( 'corstrx' , zCorU * aimsk00 )   ! Coriolis force term in force balance (x) 
    938          CALL iom_put( 'corstry' , zCorV * aimsk00 )   ! Coriolis force term in force balance (y) 
    939          CALL iom_put( 'intstrx' , zfU   * aimsk00 )   ! Internal force term in force balance (x) 
    940          CALL iom_put( 'intstry' , zfV   * aimsk00 )   ! Internal force term in force balance (y) 
     915         CALL iom_put( 'dssh_dx' , zspgU * zmsk00 )   ! Sea-surface tilt term in force balance (x) 
     916         CALL iom_put( 'dssh_dy' , zspgV * zmsk00 )   ! Sea-surface tilt term in force balance (y) 
     917         CALL iom_put( 'corstrx' , zCorU * zmsk00 )   ! Coriolis force term in force balance (x) 
     918         CALL iom_put( 'corstry' , zCorV * zmsk00 )   ! Coriolis force term in force balance (y) 
     919         CALL iom_put( 'intstrx' , zfU   * zmsk00 )   ! Internal force term in force balance (x) 
     920         CALL iom_put( 'intstry' , zfV   * zmsk00 )   ! Internal force term in force balance (y) 
    941921      ENDIF 
    942922 
    … …  
    949929         DO_2D( 0, 0, 0, 0 ) 
    950930            ! 2D ice mass, snow mass, area transport arrays (X, Y) 
    951             zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * aimsk00(ji,jj) 
    952             zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * aimsk00(ji,jj) 
     931            zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
     932            zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    953933 
    954934            zdiag_xmtrp_ice(ji,jj) = rhoi * zfac_x * ( vt_i(ji+1,jj) + vt_i(ji,jj) ) ! ice mass transport, X-component 
    … …  
    984964            IF( ln_aEVP ) THEN   ! output: beta * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    985965               CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * zbeta(:,:) * umask(:,:,1) , & 
    986                   &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     966                  &                           ABS( v_ice(:,:) - zv_ice(:,:) ) * zbeta(:,:) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    987967            ELSE                 ! output: nn_nevp * ( u(t=nn_nevp) - u(t=nn_nevp-1) ) 
    988968               CALL iom_put( 'uice_cvg', REAL( nn_nevp ) * MAX( ABS( u_ice(:,:) - zu_ice(:,:) ) * umask(:,:,1) , & 
    989                   &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * aimsk15(:,:) ) 
     969                  &                                             ABS( v_ice(:,:) - zv_ice(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    990970            ENDIF 
    991971         ENDIF 
    … …  
    995975 
    996976 
    997    SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     977   SUBROUTINE rhg_cvg_eap( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    998978      !!---------------------------------------------------------------------- 
    999979      !!                    ***  ROUTINE rhg_cvg_eap  *** 
    … …  
    1010990      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    1011991      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     992      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    1012993      !! 
    1013994      INTEGER           ::   it, idtime, istatus 
    … …  
    10381019 
    10391020      ! time 
    1040       it = ( kt - 1 ) * kitermax + kiter 
     1021      it = ( kt - nit000 ) * kitermax + kiter 
    10411022 
    10421023      ! convergence 
    … …  
    10441025         zresm = 0._wp 
    10451026      ELSE 
    1046          DO_2D( 1, 1, 1, 1 ) 
    1047             eap_res(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    1048                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * aimsk15(ji,jj) 
     1027         zresm = 0._wp 
     1028         DO_2D( 0, 0, 0, 0 ) 
     1029            zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1030               &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
    10491031         END_2D 
    1050  
    1051          zresm = MAXVAL( eap_res ) 
    10521032         CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
    10531033      ENDIF 
    … …  
    10571037         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
    10581038         ! close file 
    1059          IF( kt == nitend )   istatus = NF90_CLOSE(ncvgid) 
     1039         IF( kt == nitend - nn_fsbc + 1 .AND. kiter == kitermax )   istatus = NF90_CLOSE(ncvgid) 
    10601040      ENDIF 
    10611041 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rhg_evp.F90

    r14433 r15548  
    4848   PUBLIC   rhg_evp_rst       ! called by icedyn_rhg.F90 
    4949 
     50   !! for convergence tests 
     51   INTEGER ::   ncvgid   ! netcdf file id 
     52   INTEGER ::   nvarid   ! netcdf variable id 
     53   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
     54    
    5055   !! * Substitutions 
    5156#  include "do_loop_substitute.h90" 
    5257#  include "domzgr_substitute.h90" 
    53  
    54    !! for convergence tests 
    55    INTEGER ::   ncvgid   ! netcdf file id 
    56    INTEGER ::   nvarid   ! netcdf variable id 
    57    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    5858   !!---------------------------------------------------------------------- 
    5959   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    134134      REAL(wp) ::   zvCr                                                ! critical ice volume above which ice is landfast 
    135135      ! 
    136       REAL(wp) ::   zintb, zintn                                        ! dummy argument 
    137136      REAL(wp) ::   zfac_x, zfac_y 
    138       REAL(wp) ::   zshear, zdum1, zdum2 
    139137      ! 
    140138      REAL(wp), DIMENSION(jpi,jpj) ::   zdelta, zp_delt                 ! delta and P/delta at T points 
    … …  
    161159      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    162160      ! 
     161      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00, zmsk15 
    163162      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! dummy arrays 
    164163      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence 
    165       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    166164 
    167165      REAL(wp), PARAMETER          ::   zepsi  = 1.0e-20_wp             ! tolerance parameter 
    … …  
    180178      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xatrp     ! X-component of area transport (m2/s) 
    181179      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_yatrp     ! Y-component of area transport (m2/s) 
     180      !! -- advect fields at the rheology time step for the calculation of strength 
     181      !!    it seems that convergence is worse when ll_advups=true. So it not really a good idea 
     182      LOGICAL  ::   ll_advups = .FALSE. 
     183      REAL(wp) ::   zdt_ups 
     184      REAL(wp), ALLOCATABLE, DIMENSION(:,:)   ::   ztmp 
     185      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   za_i_ups, zv_i_ups   ! tracers advected upstream 
    182186      !!------------------------------------------------------------------- 
    183187 
    … …  
    185189      ! 
    186190      ! for diagnostics and convergence tests 
    187       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    188       DO_2D( 1, 1, 1, 1 ) 
     191      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    189192         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    190          zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    191193      END_2D 
    192       ! 
    193       !!gm for Clem:  OPTIMIZATION:  I think zfmask can be computed one for all at the initialization.... 
     194      IF( nn_rhg_chkcvg > 0 ) THEN 
     195         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     196            zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
     197         END_2D 
     198      ENDIF 
     199      ! 
    194200      !------------------------------------------------------------------------------! 
    195201      ! 0) mask at F points for the ice 
    196202      !------------------------------------------------------------------------------! 
    197       ! ocean/land mask 
    198       DO_2D( 1, 0, 1, 0 ) 
    199          zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    200       END_2D 
    201       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 
    202  
    203       ! Lateral boundary conditions on velocity (modify zfmask) 
    204       DO_2D( 0, 0, 0, 0 ) 
    205          IF( zfmask(ji,jj) == 0._wp ) THEN 
    206             zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    207                &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     203      IF( kt == nit000 ) THEN 
     204         ! ocean/land mask 
     205         ALLOCATE( fimask(jpi,jpj) ) 
     206         IF( rn_ishlat == 0._wp ) THEN 
     207            DO_2D( 0, 0, 0, 0 ) 
     208               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     209            END_2D 
     210         ELSE 
     211            DO_2D( 0, 0, 0, 0 ) 
     212               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     213               ! Lateral boundary conditions on velocity (modify fimask) 
     214               IF( fimask(ji,jj) == 0._wp ) THEN 
     215                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     216                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     217               ENDIF 
     218            END_2D 
    208219         ENDIF 
    209       END_2D 
    210       DO jj = 2, jpjm1 
    211          IF( zfmask(1,jj) == 0._wp ) THEN 
    212             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
    213          ENDIF 
    214          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    215             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpim1,jj,1), umask(jpi,jj-1,1) ) ) 
    216         ENDIF 
    217       END DO 
    218       DO ji = 2, jpim1 
    219          IF( zfmask(ji,1) == 0._wp ) THEN 
    220             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    221          ENDIF 
    222          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    223             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpjm1,1) ) ) 
    224          ENDIF 
    225       END DO 
    226       CALL lbc_lnk( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 
    227  
     220         CALL lbc_lnk( 'icedyn_rhg_evp', fimask, 'F', 1._wp ) 
     221      ENDIF 
    228222      !------------------------------------------------------------------------------! 
    229223      ! 1) define some variables and initialize arrays 
    … …  
    244238         z1_alph2 = 1._wp / ( zalph2 + 1._wp ) 
    245239      ELSE 
    246          zdtevp   = rdt_ice 
     240         zdtevp   = rDt_ice 
    247241         ! zalpha parameters set later on adaptatively 
    248242      ENDIF 
    … …  
    270264      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    271265 
    272       DO_2D( 0, 0, 0, 0 ) 
     266      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     267         zm1          = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) )  ! Ice/snow mass at U-V points 
     268         zmf  (ji,jj) = zm1 * ff_t(ji,jj)                            ! Coriolis at T points (m*f) 
     269         zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin )                   ! dt/m at T points (for alpha and beta coefficients) 
     270      END_2D 
     271       
     272      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    273273 
    274274         ! ice fraction at U-V points 
    … …  
    284284 
    285285         ! Ocean currents at U-V points 
    286          v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
    287          u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
    288  
    289          ! Coriolis at T points (m*f) 
    290          zmf(ji,jj)      = zm1 * ff_t(ji,jj) 
    291  
    292          ! dt/m at T points (for alpha and beta coefficients) 
    293          zdt_m(ji,jj)    = zdtevp / MAX( zm1, zmmin ) 
     286         ! (brackets added to fix the order of floating point operations for halo 1 - halo 2 compatibility) 
     287         v_oceU(ji,jj)   = 0.25_wp * ( (v_oce(ji,jj) + v_oce(ji,jj-1)) + (v_oce(ji+1,jj) + v_oce(ji+1,jj-1)) ) * umask(ji,jj,1) 
     288         u_oceV(ji,jj)   = 0.25_wp * ( (u_oce(ji,jj) + u_oce(ji-1,jj)) + (u_oce(ji,jj+1) + u_oce(ji-1,jj+1)) ) * vmask(ji,jj,1) 
    294289 
    295290         ! m/dt 
    … …  
    316311 
    317312      END_2D 
    318       CALL lbc_lnk( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 
    319313      ! 
    320314      !                                  !== Landfast ice parameterization ==! 
    321315      ! 
    322316      IF( ln_landfast_L16 ) THEN         !-- Lemieux 2016 
    323          DO_2D( 0, 0, 0, 0 ) 
     317         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    324318            ! ice thickness at U-V points 
    325319            zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    … …  
    338332         ! 
    339333      ELSE                               !-- no landfast 
    340          DO_2D( 0, 0, 0, 0 ) 
     334         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    341335            ztaux_base(ji,jj) = 0._wp 
    342336            ztauy_base(ji,jj) = 0._wp 
    … …  
    362356 
    363357         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    364          DO_2D( 1, 0, 1, 0 ) 
     358         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    365359 
    366360            ! shear at F points 
    367361            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    368362               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    369                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     363               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    370364 
    371365         END_2D 
    … …  
    393387            zdelta(ji,jj) = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 
    394388 
     389            ! P/delta at T points 
     390            zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
     391 
    395392         END_2D 
    396          CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp ) 
    397  
    398          ! P/delta at T points 
    399          DO_2D( 1, 1, 1, 1 ) 
    400             zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 
    401          END_2D 
    402  
    403          DO_2D( 0, 1, 0, 1 )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
     393         CALL lbc_lnk( 'icedyn_rhg_evp', zdelta, 'T', 1.0_wp, zp_delt, 'T', 1.0_wp ) 
     394 
     395         ! 
     396         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls )   ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 
    404397 
    405398            ! divergence at T points (duplication to avoid communications) 
    406             zdiv  = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj)   & 
    407                &    + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
     399            ! (brackets added to fix the order of floating point operations for halo 1 - halo 2 compatibility) 
     400            zdiv  = ( (e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj))   & 
     401               &    + (e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1))   & 
    408402               &    ) * r1_e1e2t(ji,jj) 
    409403 
    … …  
    436430         ! Save beta at T-points for further computations 
    437431         IF( ln_aEVP ) THEN 
    438             DO_2D( 1, 1, 1, 1 ) 
     432            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    439433               zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 
    440434            END_2D 
    441435         ENDIF 
    442436 
    443          DO_2D( 1, 0, 1, 0 ) 
     437         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    444438 
    445439            ! alpha for aEVP 
    … …  
    453447 
    454448            ! P/delta at F points 
    455             zp_delf = 0.25_wp * ( zp_delt(ji,jj) + zp_delt(ji+1,jj) + zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1) ) 
     449            ! (brackets added to fix the order of floating point operations for halo 1 - halo 2 compatibility) 
     450            zp_delf = 0.25_wp * ( (zp_delt(ji,jj) + zp_delt(ji+1,jj)) + (zp_delt(ji,jj+1) + zp_delt(ji+1,jj+1)) ) 
    456451 
    457452            ! stress at F points (zkt/=0 if landfast) 
    … …  
    461456 
    462457         ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 
    463          DO_2D( 0, 0, 0, 0 ) 
     458         ! (brackets added to fix the order of floating point operations for halo 1 - halo 2 compatibility) 
     459         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    464460            !                   !--- U points 
    465             zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
     461            zfU(ji,jj) = 0.5_wp * ( (( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    466462               &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    & 
    467                &                    ) * r1_e2u(ji,jj)                                                                      & 
     463               &                    ) * r1_e2u(ji,jj))                                                                      & 
    468464               &                  + ( zs12(ji,jj) * e1f(ji,jj) * e1f(ji,jj) - zs12(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1)  & 
    469465               &                    ) * 2._wp * r1_e1u(ji,jj)                                                              & 
    … …  
    471467            ! 
    472468            !                !--- V points 
    473             zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
     469            zfV(ji,jj) = 0.5_wp * ( (( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
    474470               &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    & 
    475                &                    ) * r1_e1v(ji,jj)                                                                      & 
     471               &                    ) * r1_e1v(ji,jj))                                                                      & 
    476472               &                  + ( zs12(ji,jj) * e2f(ji,jj) * e2f(ji,jj) - zs12(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj)  & 
    477473               &                    ) * 2._wp * r1_e2v(ji,jj)                                                              & 
    … …  
    479475            ! 
    480476            !                !--- ice currents at U-V point 
    481             v_iceU(ji,jj) = 0.25_wp * ( v_ice(ji,jj) + v_ice(ji,jj-1) + v_ice(ji+1,jj) + v_ice(ji+1,jj-1) ) * umask(ji,jj,1) 
    482             u_iceV(ji,jj) = 0.25_wp * ( u_ice(ji,jj) + u_ice(ji-1,jj) + u_ice(ji,jj+1) + u_ice(ji-1,jj+1) ) * vmask(ji,jj,1) 
     477            v_iceU(ji,jj) = 0.25_wp * ( (v_ice(ji,jj) + v_ice(ji,jj-1)) + (v_ice(ji+1,jj) + v_ice(ji+1,jj-1)) ) * umask(ji,jj,1) 
     478            u_iceV(ji,jj) = 0.25_wp * ( (u_ice(ji,jj) + u_ice(ji-1,jj)) + (u_ice(ji,jj+1) + u_ice(ji-1,jj+1)) ) * vmask(ji,jj,1) 
    483479            ! 
    484480         END_2D 
    … …  
    489485         IF( MOD(jter,2) == 0 ) THEN ! even iterations 
    490486            ! 
    491             DO_2D( 0, 0, 0, 0 ) 
     487            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    492488               !                 !--- tau_io/(v_oce - v_ice) 
    493489               zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) )  & 
    … …  
    533529               ENDIF 
    534530            END_2D 
    535             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    536             ! 
    537 #if defined key_agrif 
    538 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    539             CALL agrif_interp_ice( 'V' ) 
    540 #endif 
    541             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
     531            IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    542532            ! 
    543533            DO_2D( 0, 0, 0, 0 ) 
    … …  
    585575               ENDIF 
    586576            END_2D 
    587             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    588             ! 
    589 #if defined key_agrif 
    590 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    591             CALL agrif_interp_ice( 'U' ) 
    592 #endif 
    593             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     577            IF( nn_hls == 1 ) THEN   ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
     578            ELSE                     ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
     579            ENDIF 
    594580            ! 
    595581         ELSE ! odd iterations 
    596582            ! 
    597             DO_2D( 0, 0, 0, 0 ) 
     583            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
    598584               !                 !--- tau_io/(u_oce - u_ice) 
    599585               zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) )  & 
    … …  
    639625               ENDIF 
    640626            END_2D 
    641             CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    642             ! 
    643 #if defined key_agrif 
    644 !!            CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
    645             CALL agrif_interp_ice( 'U' ) 
    646 #endif 
    647             IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     627            IF( nn_hls == 1 )   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 
    648628            ! 
    649629            DO_2D( 0, 0, 0, 0 ) 
    … …  
    691671               ENDIF 
    692672            END_2D 
    693             CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
    694             ! 
     673            IF( nn_hls == 1 ) THEN   ;   CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 
     674            ELSE                     ;   CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
     675            ENDIF 
     676            ! 
     677         ENDIF 
     678         ! 
    695679#if defined key_agrif 
    696 !!            CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
    697             CALL agrif_interp_ice( 'V' ) 
     680!!       CALL agrif_interp_ice( 'U', jter, nn_nevp ) 
     681!!       CALL agrif_interp_ice( 'V', jter, nn_nevp ) 
     682         CALL agrif_interp_ice( 'U' ) 
     683         CALL agrif_interp_ice( 'V' ) 
    698684#endif 
    699             IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
    700             ! 
     685         IF( ln_bdy )   CALL bdy_ice_dyn( 'U' ) 
     686         IF( ln_bdy )   CALL bdy_ice_dyn( 'V' ) 
     687         ! 
     688         ! convergence test 
     689         IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) 
     690         ! 
     691         ! 
     692         ! --- change strength according to advected a_i and v_i (upstream for now) --- ! 
     693         IF( ll_advups .AND. ln_str_H79 ) THEN 
     694            ! 
     695            IF( jter == 1 ) THEN                               ! init 
     696               ALLOCATE( za_i_ups(jpi,jpj,jpl), zv_i_ups(jpi,jpj,jpl) ) 
     697               ALLOCATE( ztmp(jpi,jpj) ) 
     698               zdt_ups = rDt_ice / REAL( nn_nevp ) 
     699               za_i_ups(:,:,:) = a_i(:,:,:) 
     700               zv_i_ups(:,:,:) = v_i(:,:,:) 
     701            ELSE 
     702               CALL lbc_lnk( 'icedyn_rhg_evp', za_i_ups, 'T', 1.0_wp, zv_i_ups, 'T', 1.0_wp )                
     703            ENDIF 
     704            ! 
     705            CALL rhg_upstream( jter, zdt_ups, u_ice, v_ice, za_i_ups )   ! upstream advection: a_i 
     706            CALL rhg_upstream( jter, zdt_ups, u_ice, v_ice, zv_i_ups )   ! upstream advection: v_i 
     707            ! 
     708            DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 )    ! strength 
     709               strength(ji,jj) = rn_pstar * SUM( zv_i_ups(ji,jj,:) ) * EXP( -rn_crhg * ( 1._wp - SUM( za_i_ups(ji,jj,:) ) ) ) 
     710            END_2D 
     711            IF( nn_hls == 1 )  CALL lbc_lnk( 'icedyn_rhg_evp', strength, 'T', 1.0_wp ) 
     712            ! 
     713            DO_2D( 0, 0, 0, 0 )                                ! strength smoothing 
     714               IF( SUM( za_i_ups(ji,jj,:) ) > 0._wp ) THEN 
     715                  ztmp(ji,jj) = ( 4._wp * strength(ji,jj) + strength(ji-1,jj  ) + strength(ji+1,jj  ) & 
     716                     &                                    + strength(ji  ,jj-1) + strength(ji  ,jj+1) & 
     717                     &          ) / ( 4._wp + tmask(ji-1,jj,1) + tmask(ji+1,jj,1) + tmask(ji,jj-1,1) + tmask(ji,jj+1,1) ) 
     718               ELSE 
     719                  ztmp(ji,jj) = 0._wp 
     720               ENDIF 
     721            END_2D 
     722            DO_2D( 0, 0, 0, 0 ) 
     723               strength(ji,jj) = ztmp(ji,jj) 
     724            END_2D 
     725            ! 
     726            IF( jter == nn_nevp ) THEN 
     727               DEALLOCATE( za_i_ups, zv_i_ups ) 
     728               DEALLOCATE( ztmp ) 
     729            ENDIF 
    701730         ENDIF 
    702  
    703          ! convergence test 
    704          IF( nn_rhg_chkcvg == 2 )   CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice ) 
    705          ! 
    706731         !                                                ! ==================== ! 
    707732      END DO                                              !  end loop over jter  ! 
    … …  
    709734      IF( ln_aEVP )   CALL iom_put( 'beta_evp' , zbeta ) 
    710735      ! 
     736      IF( ll_advups .AND. ln_str_H79 )   CALL lbc_lnk( 'icedyn_rhg_evp', strength, 'T', 1.0_wp ) 
     737      ! 
    711738      !------------------------------------------------------------------------------! 
    712739      ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 
    713740      !------------------------------------------------------------------------------! 
    714       DO_2D( 1, 0, 1, 0 ) 
     741      DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
    715742 
    716743         ! shear at F points 
    717744         zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    718745            &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    719             &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
     746            &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
    720747 
    721748      END_2D 
    … …  
    782809      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
    783810      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
     811      IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * zmsk00 )   ! delta 
    784812 
    785813      ! --- Stress tensor invariants (SIMIP diags) --- ! 
    … …  
    788816         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    789817         ! 
    790          DO_2D( 1, 1, 1, 1 ) 
     818         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    791819 
    792820            ! Ice stresses 
    … …  
    800828 
    801829            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008) 
    802             zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                           ! 1st stress invariant, aka average normal stress, aka negative pressure 
    803             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )  ! 2nd  ''       '', aka maximum shear stress 
     830            zsig_I (ji,jj)   =   zsig1 * 0.5_wp                                      ! 1st stress invariant, aka average normal stress, aka negative pressure 
     831            zsig_II(ji,jj)   =   SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 )  ! 2nd  ''       ''    , aka maximum shear stress 
    804832 
    805833         END_2D 
    … …  
    821849         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    822850         ! 
    823          DO_2D( 1, 1, 1, 1 ) 
     851         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    824852 
    825853            ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates 
    … …  
    832860 
    833861            ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point 
    834             zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                            ! 1st stress invariant, aka average normal stress, aka negative pressure 
    835             zsig_II(ji,jj)   =   SQRT ( MAX( 0._wp, zsig2 * zsig2 * 0.25_wp + zsig12 ) )   ! 2nd  ''       '', aka maximum shear stress 
     862            zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                       ! 1st stress invariant, aka average normal stress, aka negative pressure 
     863            zsig_II(ji,jj)   =   SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 * zsig12 )   ! 2nd  ''       ''    , aka maximum shear stress 
    836864 
    837865            ! Normalized  principal stresses (used to display the ellipse) 
    … …  
    914942      ENDIF 
    915943      ! 
    916       DEALLOCATE( zmsk00, zmsk15 ) 
    917       ! 
    918944   END SUBROUTINE ice_dyn_rhg_evp 
    919945 
    920946 
    921    SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb ) 
     947   SUBROUTINE rhg_cvg( kt, kiter, kitermax, pu, pv, pub, pvb, pmsk15 ) 
    922948      !!---------------------------------------------------------------------- 
    923949      !!                    ***  ROUTINE rhg_cvg  *** 
    … …  
    934960      INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax       ! ocean time-step index 
    935961      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb          ! now and before velocities 
     962      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmsk15 
    936963      !! 
    937964      INTEGER           ::   it, idtime, istatus 
    … …  
    939966      REAL(wp)          ::   zresm           ! local real 
    940967      CHARACTER(len=20) ::   clname 
    941       REAL(wp), DIMENSION(jpi,jpj) ::   zres           ! check convergence 
     968      LOGICAL           ::   ll_maxcvg 
     969      REAL(wp), DIMENSION(jpi,jpj,2) ::   zres 
     970      REAL(wp), DIMENSION(2)         ::   ztmp 
    942971      !!---------------------------------------------------------------------- 
    943  
     972      ll_maxcvg = .FALSE. 
     973      ! 
    944974      ! create file 
    945975      IF( kt == nit000 .AND. kiter == 1 ) THEN 
    … …  
    956986            istatus = NF90_CREATE( TRIM(clname), NF90_CLOBBER, ncvgid ) 
    957987            istatus = NF90_DEF_DIM( ncvgid, 'time'  , NF90_UNLIMITED, idtime ) 
    958             istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE   , (/ idtime /), nvarid ) 
     988            istatus = NF90_DEF_VAR( ncvgid, 'uice_cvg', NF90_DOUBLE , (/ idtime /), nvarid ) 
    959989            istatus = NF90_ENDDEF(ncvgid) 
    960990         ENDIF 
    … …  
    963993 
    964994      ! time 
    965       it = ( kt - 1 ) * kitermax + kiter 
     995      it = ( kt - nit000 ) * kitermax + kiter 
    966996 
    967997      ! convergence 
    … …  
    969999         zresm = 0._wp 
    9701000      ELSE 
    971          DO_2D( 1, 1, 1, 1 ) 
    972             zres(ji,jj) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
    973                &               ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * zmsk15(ji,jj) 
    974          END_2D 
    975          zresm = MAXVAL( zres ) 
    976          CALL mpp_max( 'icedyn_rhg_evp', zresm )   ! max over the global domain 
     1001         zresm = 0._wp 
     1002         IF( ll_maxcvg ) THEN   ! error max over the domain 
     1003            DO_2D( 0, 0, 0, 0 ) 
     1004               zresm = MAX( zresm, MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1005                  &                     ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) ) 
     1006            END_2D 
     1007            CALL mpp_max( 'icedyn_rhg_evp', zresm ) 
     1008         ELSE                   ! error averaged over the domain 
     1009            DO_2D( 0, 0, 0, 0 ) 
     1010               zres(ji,jj,1) = MAX( ABS( pu(ji,jj) - pub(ji,jj) ) * umask(ji,jj,1), & 
     1011                  &                 ABS( pv(ji,jj) - pvb(ji,jj) ) * vmask(ji,jj,1) ) * pmsk15(ji,jj) 
     1012               zres(ji,jj,2) = pmsk15(ji,jj) 
     1013            END_2D 
     1014            ztmp(:) = glob_sum_vec( 'icedyn_rhg_evp', zres ) 
     1015            IF( ztmp(2) /= 0._wp )   zresm = ztmp(1) / ztmp(2) 
     1016         ENDIF 
    9771017      ENDIF 
    9781018 
    … …  
    9811021         istatus = NF90_PUT_VAR( ncvgid, nvarid, (/zresm/), (/it/), (/1/) ) 
    9821022         ! close file 
    983          IF( kt == nitend - nn_fsbc + 1 )   istatus = NF90_CLOSE(ncvgid) 
     1023         IF( kt == nitend - nn_fsbc + 1 .AND. kiter == kitermax )   istatus = NF90_CLOSE(ncvgid) 
    9841024      ENDIF 
    9851025 
    … …  
    10421082   END SUBROUTINE rhg_evp_rst 
    10431083 
     1084   SUBROUTINE rhg_upstream( jter, pdt, pu, pv, pt ) 
     1085      !!--------------------------------------------------------------------- 
     1086      !!                    ***  ROUTINE rhg_upstream  *** 
     1087      !! 
     1088      !! **  Purpose :   compute the upstream fluxes and upstream guess of tracer 
     1089      !!---------------------------------------------------------------------- 
     1090      INTEGER                    , INTENT(in   ) ::   jter 
     1091      REAL(wp)                   , INTENT(in   ) ::   pdt              ! tracer time-step 
     1092      REAL(wp), DIMENSION(:,:  ) , INTENT(in   ) ::   pu, pv           ! 2 ice velocity components 
     1093      REAL(wp), DIMENSION(:,:,:) , INTENT(inout) ::   pt               ! tracer fields 
     1094      ! 
     1095      INTEGER  ::   ji, jj, jl    ! dummy loop indices 
     1096      REAL(wp) ::   ztra          ! local scalar 
     1097      LOGICAL  ::   ll_upsxy = .TRUE. 
     1098      REAL(wp), DIMENSION(jpi,jpj) ::   zfu_ups, zfv_ups, zpt   ! upstream fluxes and tracer guess 
     1099      !!---------------------------------------------------------------------- 
     1100      DO jl = 1, jpl 
     1101         IF( .NOT. ll_upsxy ) THEN         !** no alternate directions **! 
     1102            ! 
     1103            DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 
     1104               zfu_ups(ji,jj) = MAX(pu(ji,jj)*e2u(ji,jj), 0._wp) * pt(ji,jj,jl) + MIN(pu(ji,jj)*e2u(ji,jj), 0._wp) * pt(ji+1,jj,jl) 
     1105               zfv_ups(ji,jj) = MAX(pv(ji,jj)*e1v(ji,jj), 0._wp) * pt(ji,jj,jl) + MIN(pv(ji,jj)*e1v(ji,jj), 0._wp) * pt(ji,jj+1,jl) 
     1106            END_2D 
     1107            ! 
     1108         ELSE                              !** alternate directions **! 
     1109            ! 
     1110            IF( MOD(jter,2) == 1 ) THEN   !==  odd ice time step:  adv_x then adv_y  ==! 
     1111               ! 
     1112               DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls )       !-- flux in x-direction 
     1113                  zfu_ups(ji,jj) = MAX( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji  ,jj,jl) + & 
     1114                     &             MIN( pu(ji,jj)*e2u(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 
     1115               END_2D 
     1116               ! 
     1117               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls )     !-- first guess of tracer from u-flux 
     1118                  ztra       = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) ) 
     1119                  zpt(ji,jj) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1120               END_2D 
     1121               ! 
     1122               DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 )   !-- flux in y-direction 
     1123                  zfv_ups(ji,jj) = MAX( pv(ji,jj)*e1v(ji,jj), 0._wp ) * zpt(ji,jj  ) + & 
     1124                     &             MIN( pv(ji,jj)*e1v(ji,jj), 0._wp ) * zpt(ji,jj+1) 
     1125               END_2D 
     1126               ! 
     1127            ELSE                          !==  even ice time step:  adv_y then adv_x  ==! 
     1128               ! 
     1129               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 )       !-- flux in y-direction 
     1130                  zfv_ups(ji,jj) = MAX( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji,jj  ,jl) + & 
     1131                     &             MIN( pv(ji,jj)*e1v(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 
     1132               END_2D 
     1133               ! 
     1134               DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 )     !-- first guess of tracer from v-flux 
     1135                  ztra       = - ( zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) 
     1136                  zpt(ji,jj) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1137               END_2D 
     1138               ! 
     1139               DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 )   !-- flux in x-direction 
     1140                  zfu_ups(ji,jj) = MAX( pu(ji,jj)*e2u(ji,jj), 0._wp ) * zpt(ji  ,jj) + & 
     1141                     &             MIN( pu(ji,jj)*e2u(ji,jj), 0._wp ) * zpt(ji+1,jj) 
     1142               END_2D 
     1143               ! 
     1144            ENDIF 
     1145            ! 
     1146         ENDIF 
     1147         ! 
     1148         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 
     1149            ztra         = - ( zfu_ups(ji,jj) - zfu_ups(ji-1,jj) + zfv_ups(ji,jj) - zfv_ups(ji,jj-1) ) 
     1150            pt(ji,jj,jl) =   ( pt(ji,jj,jl) + ztra * pdt * r1_e1e2t(ji,jj) ) * tmask(ji,jj,1) 
     1151         END_2D 
     1152      END DO 
     1153      ! 
     1154   END SUBROUTINE rhg_upstream 
    10441155 
    10451156#else 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icedyn_rhg_vp.F90

    r14433 r15548  
    4141   PUBLIC   ice_dyn_rhg_vp   ! called by icedyn_rhg.F90 
    4242 
    43  
    44    LOGICAL  ::   lp_zebra_vp =.TRUE.      ! activate zebra (solve the linear system problem every odd j-band, then one every even one) 
     43   INTEGER  ::   nn_nvp              ! total number of VP iterations (n_out_vp*n_inn_vp) 
     44   LOGICAL  ::   lp_zebra_vp =.TRUE. ! activate zebra (solve the linear system problem every odd j-band, then one every even one) 
    4545   REAL(wp) ::   zrelaxu_vp=0.95     ! U-relaxation factor (MV: can probably be merged with V-factor once ok) 
    4646   REAL(wp) ::   zrelaxv_vp=0.95     ! V-relaxation factor  
    4747   REAL(wp) ::   zuerr_max_vp=0.80   ! maximum velocity error, above which a forcing error is considered and solver is stopped 
    48    REAL(wp) ::   zuerr_min_vp=1.e-04   ! minimum velocity error, beyond which convergence is assumed 
     48   REAL(wp) ::   zuerr_min_vp=1.e-04 ! minimum velocity error, beyond which convergence is assumed 
    4949 
    5050   !! for convergence tests 
    5151   INTEGER ::   ncvgid        ! netcdf file id 
    52    INTEGER ::   nvarid_ures 
    53    INTEGER ::   nvarid_vres 
    54    INTEGER ::   nvarid_velres 
    55    INTEGER ::   nvarid_udif 
    56    INTEGER ::   nvarid_vdif 
    57    INTEGER ::   nvarid_veldif 
     52   INTEGER ::   nvarid_ures, nvarid_vres, nvarid_velres 
     53   INTEGER ::   nvarid_uerr_max, nvarid_verr_max, nvarid_velerr_max 
     54   INTEGER ::   nvarid_umad, nvarid_vmad, nvarid_velmad 
     55   INTEGER ::   nvarid_umad_outer, nvarid_vmad_outer, nvarid_velmad_outer 
    5856   INTEGER ::   nvarid_mke 
    59    INTEGER ::   nvarid_ures_xy, nvarid_vres_xy 
    60  
    61    REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zmsk00, zmsk15 
    62  
     57 
     58   REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   fimask   ! mask at F points for the ice 
     59    
     60   !! * Substitutions 
     61#  include "do_loop_substitute.h90" 
    6362   !!---------------------------------------------------------------------- 
    6463   !! NEMO/ICE 4.0 , NEMO Consortium (2018) 
    … …  
    8685      !! 
    8786      !!  f1(u) = g1(v) 
    88       !!  f2(v) = g2(v) 
     87      !!  f2(v) = g2(u) 
    8988      !! 
    9089      !!  The right-hand side (RHS) is explicit 
    … …  
    139138      ! 
    140139      INTEGER ::   ji, ji2, jj, jj2, jn          ! dummy loop indices 
    141       INTEGER ::   jter, i_out, i_inn  !  
     140      INTEGER ::   i_out, i_inn, i_inn_tot  !  
    142141      INTEGER ::   ji_min, jj_min      ! 
    143142      INTEGER ::   nn_zebra_vp         ! number of zebra steps 
    144143 
    145       INTEGER ::   nn_nvp              ! total number of VP iterations (n_out_vp*n_inn_vp)       
    146144      ! 
    147145      REAL(wp) ::   zrhoco                                              ! rho0 * rn_cio 
    … …  
    150148      REAL(wp) ::   zkt                                                 ! isotropic tensile strength for landfast ice 
    151149      REAL(wp) ::   zm1, zm2, zm3, zmassU, zmassV                       ! ice/snow mass and volume 
    152       REAL(wp) ::   zdeltat, zds2, zdt, zdt2, zdiv, zdiv2               ! temporary scalars 
    153       REAL(wp) ::   zp_deltastar_f                                      !  
     150      REAL(wp) ::   zds2, zdt, zdt2, zdiv, zdiv2                        ! temporary scalars 
     151      REAL(wp) ::   zp_delstar_f                                        !  
    154152      REAL(wp) ::   zu_cV, zv_cU                                        !  
    155153      REAL(wp) ::   zfac, zfac1, zfac2, zfac3 
    … …  
    158156      REAL(wp) ::   zAA3, zw, ztau, zuerr_max, zverr_max 
    159157      ! 
    160       REAL(wp), DIMENSION(jpi,jpj) ::   zfmask                          ! mask at F points for the ice 
    161158      REAL(wp), DIMENSION(jpi,jpj) ::   za_iU  , za_iV                      ! ice fraction on U/V points 
    162159      REAL(wp), DIMENSION(jpi,jpj) ::   zmU_t, zmV_t                    ! Acceleration term contribution to RHS 
    163160      REAL(wp), DIMENSION(jpi,jpj) ::   zmassU_t, zmassV_t              ! Mass per unit area divided by time step 
    164161      ! 
    165       REAL(wp), DIMENSION(jpi,jpj) ::   zdeltastar_t                    ! Delta* at T-points 
    166       REAL(wp), DIMENSION(jpi,jpj) ::   zten_i                          ! Tension 
    167       REAL(wp), DIMENSION(jpi,jpj) ::   zp_deltastar_t                  ! P/delta* at T points 
     162      REAL(wp), DIMENSION(jpi,jpj) ::   zdeltat, zdelstar_t             ! Delta & Delta* at T-points 
     163      REAL(wp), DIMENSION(jpi,jpj) ::   ztens, zshear                   ! Tension, shear 
     164      REAL(wp), DIMENSION(jpi,jpj) ::   zp_delstar_t                    ! P/delta* at T points 
    168165      REAL(wp), DIMENSION(jpi,jpj) ::   zzt, zet                        ! Viscosity pre-factors at T points 
    169166      REAL(wp), DIMENSION(jpi,jpj) ::   zef                             ! Viscosity pre-factor at F point 
    … …  
    193190      REAL(wp), DIMENSION(jpi,jpj) ::   zFU, zFU_prime, zBU_prime       ! Rearranged linear system coefficients, U equation 
    194191      REAL(wp), DIMENSION(jpi,jpj) ::   zFV, zFV_prime, zBV_prime       ! Rearranged linear system coefficients, V equation 
    195       REAL(wp), DIMENSION(jpi,jpj) ::   zCU_prime, zCV_prime            ! Rearranged linear system coefficients, V equation 
    196192!!!      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_bi, ztauy_bi              ! ice-OceanBottom stress at U-V points (landfast) 
    197193!!!      REAL(wp), DIMENSION(jpi,jpj) ::   ztaux_base, ztauy_base          ! ice-bottom stress at U-V points (landfast) 
    198194     ! 
     195      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00 
    199196      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk01x, zmsk01y                ! mask for lots of ice (1), little ice (0) 
    200197      REAL(wp), DIMENSION(jpi,jpj) ::   zmsk00x, zmsk00y                ! mask for ice presence (1), no ice (0) 
    … …  
    204201      REAL(wp), PARAMETER          ::   zamin  = 0.001_wp               ! ice concentration below which ice velocity becomes very small 
    205202      !! --- diags 
    206       REAL(wp) ::   zsig1, zsig2, zsig12, zdelta, z1_strength, zfac_x, zfac_y 
     203      REAL(wp)                     ::   zsig1, zsig2, zsig12, zdelta, z1_strength, zfac_x, zfac_y 
    207204      REAL(wp), DIMENSION(jpi,jpj) ::   zs1, zs2, zs12, zs12f           ! stress tensor components 
    208205      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zsig_I, zsig_II, zsig1_p, zsig2_p 
    … …  
    212209      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zdiag_xatrp, zdiag_yatrp         ! X/Y-component of area transport (m2/s, SIMIP) 
    213210 
    214  
    215       CALL ctl_stop( 'STOP', 'icedyn_rhg_vp: stop because vp rheology is an ongoing work and should not be used' ) 
     211      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zvel_res                         ! Residual of the linear system at last iteration 
     212      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   zvel_diff                        ! Absolute velocity difference @last outer iteration 
     213                         
    216214       
    217215      !!---------------------------------------------------------------------------------------------------------------------- 
    218       ! DEBUG put all forcing terms to zero 
    219          ! air-ice drag 
    220          utau_ice(:,:) = 0._wp 
    221          vtau_ice(:,:) = 0._wp 
    222          ! coriolis 
    223          ff_t(:,:) = 0._wp 
    224          ! ice-ocean drag 
    225          rn_cio = 0._wp 
    226          ! ssh  
    227          ! done line 330 !!! dont forget to act there 
    228       ! END DEBUG 
    229216 
    230217      IF( kt == nit000 .AND. lwp )   WRITE(numout,*) '-- ice_dyn_rhg_vp: VP sea-ice rheology (LSR solver)' 
    … …  
    238225       
    239226      ! for diagnostics and convergence tests 
    240       ALLOCATE( zmsk00(jpi,jpj), zmsk15(jpi,jpj) ) 
    241       DO jj = 1, jpj 
    242          DO ji = 1, jpi 
    243             zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    244             zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 
    245          END DO 
    246       END DO 
     227      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     228         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
     229      END_2D 
    247230       
    248231      IF ( lp_zebra_vp ) THEN; nn_zebra_vp = 2 
    … …  
    264247      IF( nn_rhg_chkcvg /= 0 ) THEN 
    265248       
    266          ! ice area for global mean kinetic energy 
    267          zglob_area = glob_sum( 'ice_rhg_vp', at_i(:,:) * e1e2t(:,:) ) ! global ice area (km2) 
     249         ! ice area for global mean kinetic energy (m2) 
     250         zglob_area = glob_sum( 'ice_rhg_vp', at_i(:,:) * e1e2t(:,:) * tmask(:,:,1) ) 
    268251          
    269252      ENDIF 
    … …  
    276259 
    277260      zs1_rhsu(:,:) = 0._wp; zs2_rhsu(:,:) = 0._wp; zs1_rhsv(:,:) = 0._wp; zs2_rhsv(:,:) = 0._wp 
    278       zAU(:,:) = 0._wp; zBU(:,:) = 0._wp; zCU(:,:) = 0._wp; zDU(:,:) = 0._wp; zEU(:,:) = 0._wp; 
    279       zAV(:,:) = 0._wp; zBV(:,:) = 0._wp; zCV(:,:) = 0._wp; zDV(:,:) = 0._wp; zEV(:,:) = 0._wp; 
    280       zrhsu(:,:) = 0._wp; zrhsv(:,:) = 0._wp 
    281       zf_rhsu(:,:) = 0._wp; zf_rhsv(:,:) = 0._wp 
     261      zrhsu  (:,:)  = 0._wp; zrhsv  (:,:)  = 0._wp; zf_rhsu(:,:)  = 0._wp; zf_rhsv(:,:)  = 0._wp 
     262      zAU(:,:) = 0._wp; zBU(:,:) = 0._wp; zCU(:,:) = 0._wp; zDU(:,:) = 0._wp; zEU(:,:) = 0._wp 
     263      zAV(:,:) = 0._wp; zBV(:,:) = 0._wp; zCV(:,:) = 0._wp; zDV(:,:) = 0._wp; zEV(:,:) = 0._wp 
    282264 
    283265      !------------------------------------------------------------------------------! 
    … …  
    289271      CALL ice_strength ! strength at T points 
    290272       
    291       !------------------------------ 
    292       ! -- F-mask       (code from EVP) 
    293       !------------------------------ 
    294       ! MartinV:  
    295       ! In EVP routine, zfmask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 
    296       ! I am not sure the same recipe applies here 
    297        
    298       ! - ocean/land mask 
    299       DO jj = 1, jpj - 1 
    300          DO ji = 1, jpi - 1 
    301             zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
    302          END DO 
    303       END DO 
    304  
    305       ! Lateral boundary conditions on velocity (modify zfmask) 
    306       ! Can be computed once for all, at first time step, for all rheologies 
    307       DO jj = 2, jpj - 1 
    308          DO ji = 2, jpi - 1   ! vector opt. 
    309             IF( zfmask(ji,jj) == 0._wp ) THEN 
    310                zfmask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
    311                   &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
    312             ENDIF 
    313          END DO 
    314       END DO 
    315       DO jj = 2, jpj - 1 
    316          IF( zfmask(1,jj) == 0._wp ) THEN 
    317             zfmask(1  ,jj) = rn_ishlat * MIN( 1._wp , MAX( vmask(2,jj,1), umask(1,jj+1,1), umask(1,jj,1) ) ) 
     273      !--------------------------- 
     274      ! -- F-mask (code from EVP) 
     275      !--------------------------- 
     276      IF( kt == nit000 ) THEN 
     277         ! MartinV:  
     278         ! In EVP routine, fimask is applied on shear at F-points, in order to enforce the lateral boundary condition (no-slip, ..., free-slip) 
     279         ! I am not sure the same recipe applies here 
     280          
     281         ! - ocean/land mask 
     282         ALLOCATE( fimask(jpi,jpj) ) 
     283         IF( rn_ishlat == 0._wp ) THEN 
     284            DO_2D( 0, 0, 0, 0 ) 
     285               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     286            END_2D 
     287         ELSE 
     288            DO_2D( 0, 0, 0, 0 ) 
     289               fimask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 
     290               ! Lateral boundary conditions on velocity (modify fimask) 
     291               IF( fimask(ji,jj) == 0._wp ) THEN 
     292                  fimask(ji,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(ji,jj,1), umask(ji,jj+1,1), & 
     293                     &                                          vmask(ji,jj,1), vmask(ji+1,jj,1) ) ) 
     294               ENDIF 
     295            END_2D 
    318296         ENDIF 
    319          IF( zfmask(jpi,jj) == 0._wp ) THEN 
    320             zfmask(jpi,jj) = rn_ishlat * MIN( 1._wp , MAX( umask(jpi,jj+1,1), vmask(jpi - 1,jj,1), umask(jpi,jj-1,1) ) ) 
    321         ENDIF 
    322       END DO 
    323       DO ji = 2, jpi - 1 
    324          IF( zfmask(ji,1) == 0._wp ) THEN 
    325             zfmask(ji, 1 ) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,1,1), umask(ji,2,1), vmask(ji,1,1) ) ) 
    326          ENDIF 
    327          IF( zfmask(ji,jpj) == 0._wp ) THEN 
    328             zfmask(ji,jpj) = rn_ishlat * MIN( 1._wp , MAX( vmask(ji+1,jpj,1), vmask(ji-1,jpj,1), umask(ji,jpj - 1,1) ) ) 
    329          ENDIF 
    330       END DO 
    331        
    332       CALL lbc_lnk( 'icedyn_rhg_vp', zfmask, 'F', 1._wp ) 
     297          
     298         CALL lbc_lnk( 'icedyn_rhg_vp', fimask, 'F', 1._wp ) 
     299      ENDIF 
    333300       
    334301      !---------------------------------------------------------------------------------------------------------- 
    … …  
    340307      !    embedded sea ice: compute representative ice top surface 
    341308      !    non-embedded sea ice: use ocean surface for slope calculation 
    342       zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 
    343       zsshdyn(:,:) = 0._wp ! DEBUG CAREFUL !!! 
    344  
    345       zmt(:,:) = rhos * vt_s(:,:) + rhoi * vt_i(:,:)       ! Snow and ice mass at T-point 
    346       zmf(:,:) = zmt(:,:) * ff_t(:,:)                      ! Coriolis factor at T points (m*f) 
    347        
    348       DO jj = 2, jpj - 1 
    349          DO ji = 2, jpi - 1 
    350  
    351             ! Ice fraction at U-V points 
    352             za_iU(ji,jj)    = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    353             za_iV(ji,jj)    = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    354  
    355             ! Snow and ice mass at U-V points 
    356             zm1             = zmt(ji,jj) 
    357             zm2             = zmt(ji+1,jj) 
    358             zm3             = zmt(ji,jj+1) 
    359              
    360             zmassU          = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
    361             zmassV          = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    362                            
    363             ! Mass per unit area divided by time step 
    364             zmassU_t(ji,jj) = zmassU * r1_Dt_ice 
    365             zmassV_t(ji,jj) = zmassV * r1_Dt_ice 
    366  
    367             ! Acceleration term contribution to RHS (depends on velocity at previous time step)             
    368             zmU_t(ji,jj)    = zmassU_t(ji,jj) * u_ice(ji,jj) 
    369             zmV_t(ji,jj)    = zmassV_t(ji,jj) * v_ice(ji,jj) 
    370              
    371             ! Ocean currents at U-V points 
    372             v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
    373             u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
    374              
    375             ! Wind stress 
    376             ztaux_ai(ji,jj) = za_iU(ji,jj) * utau_ice(ji,jj) 
    377             ztauy_ai(ji,jj) = za_iV(ji,jj) * vtau_ice(ji,jj) 
    378  
    379             ! Force due to sea surface tilt(- m*g*GRAD(ssh)) 
    380             zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 
    381             zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 
    382  
    383             ! Mask for ice presence (1) or absence (0) 
    384             zmsk00x(ji,jj)  = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
    385             zmsk00y(ji,jj)  = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
    386  
    387             ! Mask for lots of ice (1) or little ice (0) 
    388             IF ( zmassU <= zmmin .AND. za_iU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
    389             ELSE                                                      ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
    390             IF ( zmassV <= zmmin .AND. za_iV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
    391             ELSE                                                      ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF               
    392  
    393 ! MV TEST DEBUG 
    394             IF ( ( zmt(ji,jj)   <= zmmin .OR. zmt(ji+1,jj)  <= zmmin )     .AND.  & 
    395                & ( at_i(ji,jj)  <= zamin .OR. at_i(ji+1,jj) <= zamin ) )    THEN   ;   zmsk01x(ji,jj) = 0._wp 
    396             ELSE                                                                   ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
    397  
    398             IF ( ( zmt(ji,jj)   <= zmmin .OR. zmt(ji,jj+1)  <= zmmin )     .AND.  & 
    399                & ( at_i(ji,jj)  <= zamin .OR. at_i(ji,jj+1) <= zamin ) )    THEN   ;   zmsk01y(ji,jj) = 0._wp 
    400             ELSE                                                                   ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF               
    401 ! END MV TEST DEBUG 
    402  
    403          END DO 
    404       END DO    
    405  
    406       CALL iom_put( 'zmsk00x'    , zmsk00x  )   ! MV DEBUG 
    407       CALL iom_put( 'zmsk00y'    , zmsk00y  )   ! MV DEBUG 
    408       CALL iom_put( 'zmsk01x'    , zmsk01x  )   ! MV DEBUG 
    409       CALL iom_put( 'zmsk01y'    , zmsk01y  )   ! MV DEBUG 
    410       CALL iom_put( 'ztaux_ai'   , ztaux_ai )   ! MV DEBUG 
    411       CALL iom_put( 'ztauy_ai'   , ztauy_ai )   ! MV DEBUG 
    412       CALL iom_put( 'zspgU'      , zspgU    )   ! MV DEBUG 
    413       CALL iom_put( 'zspgV'      , zspgV    )   ! MV DEBUG 
     309      zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b)     
     310 
     311      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     312         zmt(ji,jj) = rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj)       ! Snow and ice mass at T-point 
     313         zmf(ji,jj) = zmt(ji,jj) * ff_t(ji,jj)                      ! Coriolis factor at T points (m*f) 
     314      END_2D 
     315       
     316      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     317 
     318         ! Ice fraction at U-V points 
     319         za_iU(ji,jj)    = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     320         za_iV(ji,jj)    = 0.5_wp * ( at_i(ji,jj) * e1e2t(ji,jj) + at_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     321 
     322         ! Snow and ice mass at U-V points 
     323         zm1             = zmt(ji,jj) 
     324         zm2             = zmt(ji+1,jj) 
     325         zm3             = zmt(ji,jj+1) 
     326         zmassU          = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm2 * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) 
     327         zmassV          = 0.5_wp * ( zm1 * e1e2t(ji,jj) + zm3 * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
     328          
     329         ! Mass per unit area divided by time step 
     330         zmassU_t(ji,jj) = zmassU * r1_Dt_ice 
     331         zmassV_t(ji,jj) = zmassV * r1_Dt_ice 
     332          
     333         ! Acceleration term contribution to RHS (depends on velocity at previous time step)             
     334         zmU_t(ji,jj)    = zmassU_t(ji,jj) * u_ice(ji,jj) 
     335         zmV_t(ji,jj)    = zmassV_t(ji,jj) * v_ice(ji,jj) 
     336          
     337         ! Ocean currents at U-V points 
     338         v_oceU(ji,jj)   = 0.25_wp * ( v_oce(ji,jj) + v_oce(ji,jj-1) + v_oce(ji+1,jj) + v_oce(ji+1,jj-1) ) * umask(ji,jj,1) 
     339         u_oceV(ji,jj)   = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 
     340          
     341         ! Wind stress 
     342         ztaux_ai(ji,jj) = za_iU(ji,jj) * utau_ice(ji,jj) 
     343         ztauy_ai(ji,jj) = za_iV(ji,jj) * vtau_ice(ji,jj) 
     344          
     345         ! Force due to sea surface tilt(- m*g*GRAD(ssh)) 
     346         zspgU(ji,jj)    = - zmassU * grav * ( zsshdyn(ji+1,jj) - zsshdyn(ji,jj) ) * r1_e1u(ji,jj) 
     347         zspgV(ji,jj)    = - zmassV * grav * ( zsshdyn(ji,jj+1) - zsshdyn(ji,jj) ) * r1_e2v(ji,jj) 
     348          
     349         ! Mask for ice presence (1) or absence (0) 
     350         zmsk00x(ji,jj)  = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassU ) )  ! 0 if no ice 
     351         zmsk00y(ji,jj)  = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zmassV ) )  ! 0 if no ice 
     352          
     353         ! Mask for lots of ice (1) or little ice (0) 
     354         IF ( zmassU <= zmmin .AND. za_iU(ji,jj) <= zamin ) THEN   ;   zmsk01x(ji,jj) = 0._wp 
     355         ELSE                                                      ;   zmsk01x(ji,jj) = 1._wp   ;   ENDIF 
     356         IF ( zmassV <= zmmin .AND. za_iV(ji,jj) <= zamin ) THEN   ;   zmsk01y(ji,jj) = 0._wp 
     357         ELSE                                                      ;   zmsk01y(ji,jj) = 1._wp   ;   ENDIF               
     358 
     359      END_2D   
    414360             
    415361      !------------------------------------------------------------------------------! 
    … …  
    422368      zv_c(:,:) = v_ice(:,:) 
    423369       
    424       jter = 0 
     370      i_inn_tot = 0 
    425371 
    426372      DO i_out = 1, nn_vp_nout 
    427373 
    428          IF( lwp )   WRITE(numout,*) ' outer loop  i_out : ', i_out 
    429                 
    430374         ! Velocities used in the non linear terms are the average of the past two iterates 
    431          ! u_it = 0.5 * ( u_{it-1} + u_{it-2}) 
     375         ! u_it = 0.5 * ( u_{it-1} + u_{it-2} ) 
    432376         ! Also used in Hibler and Ackley (1983); Zhang and Hibler (1997); Lemieux and Tremblay (2009) 
    433377         zu_c(:,:) = 0.5_wp * ( u_ice(:,:) + zu_c(:,:) ) 
    … …  
    441385         ! In the outer loop, one needs to update all RHS terms 
    442386         ! with explicit velocity dependencies (viscosities, coriolis, ocean stress) 
    443          ! as a function of uc 
    444          ! 
     387         ! as a function of "current" velocities (uc, vc) 
    445388       
    446389         !------------------------------------------ 
    … …  
    449392 
    450393         ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 
    451          DO jj = 1, jpj - 1         ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
    452             DO ji = 1, jpi - 1 
    453  
    454                ! shear at F points 
    455                zds(ji,jj) = ( ( zu_c(ji,jj+1) * r1_e1u(ji,jj+1) - zu_c(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    456                   &         + ( zv_c(ji+1,jj) * r1_e2v(ji+1,jj) - zv_c(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    457                   &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
    458  
    459             END DO 
    460          END DO 
    461  
    462          CALL lbc_lnk( 'icedyn_rhg_vp', zds, 'F', 1. ) ! MV TEST could be un-necessary according to Gurvan 
    463          CALL iom_put( 'zds'          , zds      )   ! MV DEBUG 
    464  
    465          IF( lwp )   WRITE(numout,*) ' outer loop  1a i_out : ', i_out 
    466  
    467          !DO jj = 2, jpj - 1    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
    468          !   DO ji = 2, jpi - 1 !  
    469  
    470 ! MV DEBUG 
    471          DO jj = 2, jpj        ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
    472             DO ji = 2, jpi     !  
    473 ! END MV DEBUG 
    474  
    475                ! shear**2 at T points (doc eq. A16) 
    476                zds2 = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
    477                   &   + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
    478                   &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
     394         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! 1->jpi-1 
     395          
     396            ! loops start at 1 since there is no boundary condition (lbc_lnk) at i=1 and j=1 for F points 
     397            ! shear at F points 
     398            zds(ji,jj) = ( ( zu_c(ji,jj+1) * r1_e1u(ji,jj+1) - zu_c(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
     399               &         + ( zv_c(ji+1,jj) * r1_e2v(ji+1,jj) - zv_c(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
     400               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
     401 
     402         END_2D 
     403 
     404         CALL lbc_lnk( 'icedyn_rhg_vp', zds, 'F', 1. ) ! necessary, zds2 uses jpi/jpj values for zds  
     405 
     406         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! 2 -> jpj; 2,jpi !!! CHECK !!! 
     407            ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
     408 
     409            ! shear**2 at T points (doc eq. A16) 
     410            zds2  = ( zds(ji,jj  ) * zds(ji,jj  ) * e1e2f(ji,jj  ) + zds(ji-1,jj  ) * zds(ji-1,jj  ) * e1e2f(ji-1,jj  )  & 
     411               &    + zds(ji,jj-1) * zds(ji,jj-1) * e1e2f(ji,jj-1) + zds(ji-1,jj-1) * zds(ji-1,jj-1) * e1e2f(ji-1,jj-1)  & 
     412               &    ) * 0.25_wp * r1_e1e2t(ji,jj) 
    479413               
    480                ! divergence at T points 
    481                zdiv  = ( e2u(ji,jj) * zu_c(ji,jj) - e2u(ji-1,jj) * zu_c(ji-1,jj)   & 
    482                   &    + e1v(ji,jj) * zv_c(ji,jj) - e1v(ji,jj-1) * zv_c(ji,jj-1)   & 
    483                   &    ) * r1_e1e2t(ji,jj) 
    484                zdiv2 = zdiv * zdiv 
     414            ! divergence at T points 
     415            zdiv  = ( e2u(ji,jj) * zu_c(ji,jj) - e2u(ji-1,jj) * zu_c(ji-1,jj)   & 
     416               &    + e1v(ji,jj) * zv_c(ji,jj) - e1v(ji,jj-1) * zv_c(ji,jj-1)   & 
     417               &    ) * r1_e1e2t(ji,jj) 
     418            zdiv2 = zdiv * zdiv 
    485419                
    486                ! tension at T points 
    487                zdt  = ( ( zu_c(ji,jj) * r1_e2u(ji,jj) - zu_c(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
    488                   &   - ( zv_c(ji,jj) * r1_e1v(ji,jj) - zv_c(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
    489                   &   ) * r1_e1e2t(ji,jj) 
    490                zdt2 = zdt * zdt 
     420            ! tension at T points 
     421            zdt   = ( ( zu_c(ji,jj) * r1_e2u(ji,jj) - zu_c(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj)   & 
     422               &    - ( zv_c(ji,jj) * r1_e1v(ji,jj) - zv_c(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)   & 
     423               &    ) * r1_e1e2t(ji,jj) 
     424            zdt2 = zdt * zdt 
    491425                
    492                ! delta at T points 
    493                zdeltat = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
     426            ! delta at T points 
     427            zdeltat(ji,jj)        = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 )   
    494428                
    495                ! delta* at T points (following Lemieux and Dupont, GMD 2020) 
    496                zdeltastar_t(ji,jj) = zdeltat + rn_creepl 
     429            ! delta* at T points (following Lemieux and Dupont, GMD 2020) 
     430            zdelstar_t(ji,jj)     = zdeltat(ji,jj) + rn_creepl ! OPT zdelstar_t can be totally removed and put into next line directly. Could change results 
    497431               
    498                ! P/delta at T-points 
    499                zp_deltastar_t(ji,jj) = strength(ji,jj) / zdeltastar_t(ji,jj) 
     432            ! P/delta* at T-points 
     433            zp_delstar_t(ji,jj)   = strength(ji,jj) / zdelstar_t(ji,jj) 
    500434                
    501                ! Temporary zzt and zet factors at T-points 
    502                zzt(ji,jj)     = zp_deltastar_t(ji,jj) * r1_e1e2t(ji,jj) 
    503                zet(ji,jj)     = zzt(ji,jj)     * z1_ecc2  
     435            ! Temporary zzt and zet factors at T-points 
     436            zzt(ji,jj)            = zp_delstar_t(ji,jj) * r1_e1e2t(ji,jj) 
     437            zet(ji,jj)            = zzt(ji,jj)     * z1_ecc2  
    504438                           
    505             END DO 
    506          END DO 
    507           
    508          CALL lbc_lnk( 'icedyn_rhg_vp', zp_deltastar_t , 'T', 1. , zzt , 'T', 1., zet, 'T', 1. ) 
    509  
    510          CALL iom_put( 'zzt'        , zzt      )   ! MV DEBUG 
    511          CALL iom_put( 'zet'        , zet      )   ! MV DEBUG 
    512          CALL iom_put( 'zp_deltastar_t', zp_deltastar_t ) ! MV DEBUG 
    513  
    514          IF( lwp )   WRITE(numout,*) ' outer loop  1b i_out : ', i_out 
    515  
    516          DO jj = 1, jpj - 1 
    517             DO ji = 1, jpi - 1 
    518                 
     439         END_2D 
     440          
     441         CALL lbc_lnk( 'icedyn_rhg_vp', zp_delstar_t , 'T', 1. ) ! necessary, used for ji = 1 and jj = 1 
     442 
     443         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )! 1-> jpj-1; 1->jpi-1 
     444          
    519445               ! P/delta* at F points 
    520                zp_deltastar_f = 0.25_wp * ( zp_deltastar_t(ji,jj) + zp_deltastar_t(ji+1,jj) + zp_deltastar_t(ji,jj+1) + zp_deltastar_t(ji+1,jj+1) ) 
     446               zp_delstar_f = 0.25_wp * ( zp_delstar_t(ji,jj) + zp_delstar_t(ji+1,jj) + zp_delstar_t(ji,jj+1) + zp_delstar_t(ji+1,jj+1) ) 
    521447                
    522448               ! Temporary zef factor at F-point 
    523                zef(ji,jj)      = zp_deltastar_f * r1_e1e2f(ji,jj) * z1_ecc2 * zfmask(ji,jj) 
    524  
    525             END DO 
    526          END DO 
    527           
    528          CALL lbc_lnk( 'icedyn_rhg_vp', zef, 'F', 1. ) 
    529          CALL iom_put( 'zef'          , zef            ) ! MV DEBUG 
    530          IF( lwp )   WRITE(numout,*) ' outer loop  1c i_out : ', i_out 
    531  
     449               zef(ji,jj)      = zp_delstar_f * r1_e1e2f(ji,jj) * z1_ecc2 * fimask(ji,jj) * 0.5_wp 
     450                
     451         END_2D 
     452          
    532453         !--------------------------------------------------- 
    533454         ! -- Ocean-ice drag and Coriolis RHS contributions 
    534455         !--------------------------------------------------- 
    535456 
    536          DO jj = 2, jpj - 1 
    537              DO ji = 2, jpi - 1 
     457         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     458          
     459            !--- ice u-velocity @V points, v-velocity @U points (for non-linear drag computation) 
     460            zu_cV            = 0.25_wp * ( zu_c(ji,jj) + zu_c(ji-1,jj) + zu_c(ji,jj+1) + zu_c(ji-1,jj+1) ) * vmask(ji,jj,1) 
     461            zv_cU            = 0.25_wp * ( zv_c(ji,jj) + zv_c(ji,jj-1) + zv_c(ji+1,jj) + zv_c(ji+1,jj-1) ) * umask(ji,jj,1) 
    538462                 
    539                 !--- ice u-velocity @V points, v-velocity @U points (for non-linear drag computation) 
    540                 zu_cV            = 0.25_wp * ( zu_c(ji,jj) + zu_c(ji-1,jj) + zu_c(ji,jj+1) + zu_c(ji-1,jj+1) ) * vmask(ji,jj,1) 
    541                 zv_cU            = 0.25_wp * ( zv_c(ji,jj) + zv_c(ji,jj-1) + zv_c(ji+1,jj) + zv_c(ji+1,jj-1) ) * umask(ji,jj,1) 
     463            !--- non-linear drag coefficients (need to be updated at each outer loop, see Lemieux and Tremblay JGR09, p.3, beginning of Section 3) 
     464            zCwU(ji,jj)          = za_iU(ji,jj) * zrhoco * SQRT( ( zu_c (ji,jj) - u_oce (ji,jj) ) * ( zu_c (ji,jj) - u_oce (ji,jj) )  & 
     465              &                                                + ( zv_cU - v_oceU(ji,jj) ) * ( zv_cU - v_oceU(ji,jj) ) ) 
     466            zCwV(ji,jj)          = za_iV(ji,jj) * zrhoco * SQRT( ( zv_c (ji,jj) - v_oce (ji,jj) ) * ( zv_c (ji,jj) - v_oce (ji,jj) )  & 
     467              &                                                + ( zu_cV - u_oceV(ji,jj) ) * ( zu_cV - u_oceV(ji,jj) ) ) 
     468                  
     469            !--- Ocean-ice drag contributions to RHS  
     470            ztaux_oi_rhsu(ji,jj) = zCwU(ji,jj) * u_oce(ji,jj) 
     471            ztauy_oi_rhsv(ji,jj) = zCwV(ji,jj) * v_oce(ji,jj) 
    542472                 
    543                 !--- non-linear drag coefficients (need to be updated at each outer loop, see Lemieux and Tremblay JGR09, p.3, beginning of Section 3) 
    544                 zCwU(ji,jj)          = za_iU(ji,jj) * zrhoco * SQRT( ( zu_c (ji,jj) - u_oce (ji,jj) ) * ( zu_c (ji,jj) - u_oce (ji,jj) )  & 
    545                   &                                                + ( zv_cU - v_oceU(ji,jj) ) * ( zv_cU - v_oceU(ji,jj) ) ) 
    546                 zCwV(ji,jj)          = za_iV(ji,jj) * zrhoco * SQRT( ( zv_c (ji,jj) - v_oce (ji,jj) ) * ( zv_c (ji,jj) - v_oce (ji,jj) )  & 
    547                   &                                                + ( zu_cV - u_oceV(ji,jj) ) * ( zu_cV - u_oceV(ji,jj) ) ) 
    548                   
    549                 !--- Ocean-ice drag contributions to RHS  
    550                 ztaux_oi_rhsu(ji,jj) = zCwU(ji,jj) * u_oce(ji,jj) 
    551                 ztauy_oi_rhsv(ji,jj) = zCwV(ji,jj) * v_oce(ji,jj) 
    552                  
    553                 ! --- U-component of Coriolis Force (energy conserving formulation) 
    554                 ! Note Lemieux et al 2008 recommend to do that implicitly, but I don't really see how this could be done 
    555                 zCorU(ji,jj)         =   0.25_wp * r1_e1u(ji,jj) *  & 
    556                            &             ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * zv_c(ji  ,jj) + e1v(ji  ,jj-1) * zv_c(ji  ,jj-1) )  & 
    557                            &             + zmf(ji+1,jj) * ( e1v(ji+1,jj) * zv_c(ji+1,jj) + e1v(ji+1,jj-1) * zv_c(ji+1,jj-1) ) ) 
     473            !--- U-component of Coriolis Force (energy conserving formulation) 
     474            zCorU(ji,jj)         =   0.25_wp * r1_e1u(ji,jj) *  & 
     475                       &             ( zmf(ji  ,jj) * ( e1v(ji  ,jj) * zv_c(ji  ,jj) + e1v(ji  ,jj-1) * zv_c(ji  ,jj-1) )  & 
     476                       &             + zmf(ji+1,jj) * ( e1v(ji+1,jj) * zv_c(ji+1,jj) + e1v(ji+1,jj-1) * zv_c(ji+1,jj-1) ) ) 
    558477                            
    559                 ! --- V-component of Coriolis Force (energy conserving formulation) 
    560                 zCorV(ji,jj)         = - 0.25_wp * r1_e2v(ji,jj) *  & 
    561                            &             ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * zu_c(ji,jj  ) + e2u(ji-1,jj  ) * zu_c(ji-1,jj  ) )  & 
    562                            &             + zmf(ji,jj+1) * ( e2u(ji,jj+1) * zu_c(ji,jj+1) + e2u(ji-1,jj+1) * zu_c(ji-1,jj+1) ) ) 
    563           
    564              END DO 
    565          END DO 
    566  
    567          IF( lwp )   WRITE(numout,*) ' outer loop  1d i_out : ', i_out 
    568           
    569          CALL lbc_lnk( 'icedyn_rhg_vp', zCwU ,  'U', -1., zCwV, 'V', -1. ) 
    570          CALL lbc_lnk( 'icedyn_rhg_vp', zCorU,  'U', -1., zCorV, 'V', -1. ) 
    571  
    572          CALL iom_put( 'zCwU'          , zCwU           ) ! MV DEBUG 
    573          CALL iom_put( 'zCwV'          , zCwV           ) ! MV DEBUG 
    574          CALL iom_put( 'zCorU'         , zCorU          ) ! MV DEBUG 
    575          CALL iom_put( 'zCorV'         , zCorV          ) ! MV DEBUG 
    576  
    577          IF( lwp )   WRITE(numout,*) ' outer loop  1f i_out : ', i_out 
    578           
    579          ! a priori, Coriolis and drag terms only affect diagonal or independent term of the linear system,  
    580          ! so there is no need for lbclnk on drag and coriolis 
    581  
     478            !--- V-component of Coriolis Force (energy conserving formulation) 
     479            zCorV(ji,jj)         = - 0.25_wp * r1_e2v(ji,jj) *  & 
     480                       &             ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * zu_c(ji,jj  ) + e2u(ji-1,jj  ) * zu_c(ji-1,jj  ) )  & 
     481                       &             + zmf(ji,jj+1) * ( e2u(ji,jj+1) * zu_c(ji,jj+1) + e2u(ji-1,jj+1) * zu_c(ji-1,jj+1) ) ) 
     482 
     483         END_2D 
     484          
    582485         !------------------------------------- 
    583486         ! -- Internal stress RHS contribution 
    584487         !------------------------------------- 
    585488 
    586          ! --- Stress contributions at T-points          
    587          DO jj = 2, jpj    ! loop to jpi,jpj to avoid making a communication for zs1,zs2,zs12 
    588             DO ji = 2, jpi !  
     489         ! --- Stress contributions at T-points 
     490         DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! 2 -> jpj; 2,jpi !!! CHECK !!! 
     491          
     492         ! loop to jpi,jpj to avoid making a communication for zs1 & zs2 
    589493             
    590                ! sig1 contribution to RHS of U-equation at T-points 
    591                zs1_rhsu(ji,jj) =   zzt(ji,jj) * ( e1v(ji,jj)    * zv_c(ji,jj) - e1v(ji,jj-1)    * zv_c(ji,jj-1) - 1.0_wp ) 
     494            ! sig1 contribution to RHS of U-equation at T-points 
     495            zs1_rhsu(ji,jj) =   zzt(ji,jj) * ( e1v(ji,jj)    * zv_c(ji,jj) - e1v(ji,jj-1)    * zv_c(ji,jj-1) )   & 
     496                            &                - zp_delstar_t(ji,jj) * zdeltat(ji,jj) 
    592497                                             
    593                ! sig2 contribution to RHS of U-equation at T-points             
    594                zs2_rhsu(ji,jj) = - zet(ji,jj) * ( r1_e1v(ji,jj) * zv_c(ji,jj) - r1_e1v(ji,jj-1) * zv_c(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  
    595  
    596                ! sig1 contribution to RHS of V-equation at T-points 
    597                zs1_rhsv(ji,jj) =   zzt(ji,jj) * ( e2u(ji,jj)    * zu_c(ji,jj) - e2u(ji-1,jj)    * zu_c(ji-1,jj) - 1.0_wp ) 
    598  
    599                ! sig2 contribution to RHS of V-equation  at T-points 
    600                zs2_rhsv(ji,jj) =   zet(ji,jj) * ( r1_e2u(ji,jj) * zu_c(ji,jj) - r1_e2u(ji-1,jj) * zu_c(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) 
    601  
    602             END DO 
    603          END DO 
    604  
    605          CALL iom_put( 'zs1_rhsu'      , zs1_rhsu       ) ! MV DEBUG 
    606          CALL iom_put( 'zs2_rhsu'      , zs2_rhsu       ) ! MV DEBUG 
    607          CALL iom_put( 'zs1_rhsv'      , zs1_rhsv       ) ! MV DEBUG 
    608          CALL iom_put( 'zs2_rhsv'      , zs2_rhsv       ) ! MV DEBUG 
    609           
    610          ! a priori, no lbclnk, because rhsu is only used in the inner domain 
    611           
    612          ! --- Stress contributions at f-points          
    613          ! MV NOTE: I applied zfmask on zds, by mimetism on EVP, but without deep understanding of what I was doing 
     498            ! sig2 contribution to RHS of U-equation at T-points             
     499            zs2_rhsu(ji,jj) = - zet(ji,jj) * ( r1_e1v(ji,jj) * zv_c(ji,jj) - r1_e1v(ji,jj-1) * zv_c(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj)  
     500 
     501            ! sig1 contribution to RHS of V-equation at T-points 
     502            zs1_rhsv(ji,jj) =   zzt(ji,jj) * ( e2u(ji,jj)    * zu_c(ji,jj) - e2u(ji-1,jj)    * zu_c(ji-1,jj) )   &  
     503                            &                - zp_delstar_t(ji,jj) * zdeltat(ji,jj) 
     504 
     505            ! sig2 contribution to RHS of V-equation  at T-points 
     506            zs2_rhsv(ji,jj) =   zet(ji,jj) * ( r1_e2u(ji,jj) * zu_c(ji,jj) - r1_e2u(ji-1,jj) * zu_c(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) 
     507 
     508         END_2D 
     509                   
     510         ! --- Stress contributions at F-points          
     511         ! MV NOTE: I applied fimask on zds, by mimetism on EVP, but without deep understanding of what I was doing 
    614512         ! My guess is that this is the way to enforce boundary conditions on strain rate tensor 
    615513 
    616          IF( lwp )   WRITE(numout,*) ' outer loop 2 i_out : ', i_out 
    617  
    618          DO jj = 1, jpj - 1 
    619             DO ji = 1, jpi - 1 
    620                 
    621                ! sig12 contribution to RHS of U equation at F-points  
    622                zs12_rhsu(ji,jj) = - zef(ji,jj)  * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) - r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * zfmask(ji,jj) 
    623                 
    624                ! sig12 contribution to RHS of V equation at F-points 
    625                zs12_rhsv(ji,jj) =   zef(ji,jj)  * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) - r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * zfmask(ji,jj) 
    626  
    627             END DO 
    628          END DO 
    629  
    630          CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsu, 'F', 1. ) 
    631          CALL lbc_lnk( 'icedyn_rhg_vp', zs12_rhsv, 'F', 1. ) 
    632  
    633          CALL iom_put( 'zs12_rhsu'     , zs12_rhsu      ) ! MV DEBUG 
    634          CALL iom_put( 'zs12_rhsv'     , zs12_rhsv      ) ! MV DEBUG 
    635  
    636          ! a priori, no lbclnk, because rhsu are only used in the inner domain 
    637  
     514         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) ! 1->jpi-1 
     515          
     516            ! sig12 contribution to RHS of U equation at F-points  
     517            zs12_rhsu(ji,jj) =   zef(ji,jj)  * ( r1_e2v(ji+1,jj) * zv_c(ji+1,jj) + r1_e2v(ji,jj) * zv_c(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) * fimask(ji,jj) 
     518 
     519            ! sig12 contribution to RHS of V equation at F-points 
     520            zs12_rhsv(ji,jj) =   zef(ji,jj)  * ( r1_e1u(ji,jj+1) * zu_c(ji,jj+1) + r1_e1u(ji,jj) * zu_c(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) * fimask(ji,jj) 
     521 
     522         END_2D 
     523          
    638524         ! --- Internal force contributions to RHS, taken as divergence of stresses (Appendix C of Hunke and Dukowicz, 2002) 
    639525         ! OPT: merge with next loop and use intermediate scalars for zf_rhsu 
    640           
    641          DO jj = 2, jpj - 1 
    642             DO ji = 2, jpi - 1                
     526         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     527          
    643528               ! --- U component of internal force contribution to RHS at U points 
    644529               zf_rhsu(ji,jj) = 0.5_wp * r1_e1e2u(ji,jj) * &  
    … …  
    650535               zf_rhsv(ji,jj) = 0.5_wp * r1_e1e2v(ji,jj) * & 
    651536                  &           (    e1v(ji,jj)    * ( zs1_rhsv(ji,jj+1) - zs1_rhsv(ji,jj) )                                                                 & 
    652                   &      +         r1_e1v(ji,jj) * ( e1t(ji,jj+1) * e1t(ji,jj+1) * zs2_rhsv(ji,jj+1) - e1t(ji,jj) * e1t(ji,jj)     * zs2_rhsv(ji,jj) )     & 
     537                  &      -         r1_e1v(ji,jj) * ( e1t(ji,jj+1) * e1t(ji,jj+1) * zs2_rhsv(ji,jj+1) - e1t(ji,jj)   * e1t(ji,jj)   * zs2_rhsv(ji,jj) )     & 
    653538                  &      + 2._wp * r1_e2v(ji,jj) * ( e2f(ji,jj)   * e2f(ji,jj)   * zs12_rhsv(ji,jj)  - e2f(ji-1,jj) * e2f(ji-1,jj) * zs12_rhsv(ji-1,jj) ) ) 
    654                    
    655             END DO 
    656          END DO 
    657  
    658          CALL iom_put( 'zf_rhsu'       , zf_rhsu        ) ! MV DEBUG 
    659          CALL iom_put( 'zf_rhsv'       , zf_rhsv        ) ! MV DEBUG 
     539 
     540         END_2D 
    660541          
    661542         !--------------------------- 
    … …  
    664545         ! 
    665546         ! OPT: could use intermediate scalars to reduce memory access 
    666          DO jj = 2, jpj - 1 
    667             DO ji = 2, jpi - 1 
    668              
    669                ! still miss ice ocean stress and acceleration contribution 
    670                zrhsu(ji,jj) = zmU_t(ji,jj) + ztaux_ai(ji,jj) + ztaux_oi_rhsu(ji,jj) + zspgU(ji,jj) + zCorU(ji,jj) + zf_rhsu(ji,jj) 
    671                zrhsv(ji,jj) = zmV_t(ji,jj) + ztauy_ai(ji,jj) + ztauy_oi_rhsv(ji,jj) + zspgV(ji,jj) + zCorV(ji,jj) + zf_rhsu(ji,jj) 
    672  
    673             END DO 
    674          END DO 
    675           
    676          CALL lbc_lnk( 'icedyn_rhg_vp', zrhsu, 'U', -1., zrhsv, 'V',  -1.) 
    677          CALL lbc_lnk( 'icedyn_rhg_vp', zmU_t, 'U', -1., zmV_t, 'V',  -1.) 
    678          CALL lbc_lnk( 'icedyn_rhg_vp', ztaux_oi_rhsu, 'U', -1., ztauy_oi_rhsv, 'V',  -1.) 
    679  
    680          CALL iom_put( 'zmU_t'         , zmU_t          ) ! MV DEBUG 
    681          CALL iom_put( 'zmV_t'         , zmV_t          ) ! MV DEBUG 
    682          CALL iom_put( 'ztaux_oi_rhsu' , ztaux_oi_rhsu  ) ! MV DEBUG 
    683          CALL iom_put( 'ztauy_oi_rhsv' , ztauy_oi_rhsv  ) ! MV DEBUG 
    684          CALL iom_put( 'zrhsu'         , zrhsu          ) ! MV DEBUG 
    685          CALL iom_put( 'zrhsv'         , zrhsv          ) ! MV DEBUG 
    686           
    687          ! inner domain calculations -> no lbclnk 
    688  
    689          IF( lwp )   WRITE(numout,*) ' outer loop 4 i_out : ', i_out 
    690       
     547         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     548                      
     549            zrhsu(ji,jj) = zmU_t(ji,jj) + ztaux_ai(ji,jj) + ztaux_oi_rhsu(ji,jj) + zspgU(ji,jj) + zCorU(ji,jj) + zf_rhsu(ji,jj) 
     550            zrhsv(ji,jj) = zmV_t(ji,jj) + ztauy_ai(ji,jj) + ztauy_oi_rhsv(ji,jj) + zspgV(ji,jj) + zCorV(ji,jj) + zf_rhsv(ji,jj) 
     551 
     552         END_2D 
     553          
    691554         !---------------------------------------------------------------------------------------! 
    692555         ! 
    … …  
    706569         !         only zzt and zet are iteration-dependent, other only depend on scale factors 
    707570                   
    708          DO ji = 2, jpi - 1 ! internal domain do loop 
    709             DO jj = 2, jpj - 1 
    710  
    711                !------------------------------------- 
    712                ! -- Internal forces LHS contribution 
    713                !------------------------------------- 
    714                ! 
    715                ! --- U-component 
    716                ! 
    717                ! "T" factors (intermediate results) 
    718                ! 
    719                zfac       = 0.5_wp * r1_e1e2u(ji,jj) 
    720                zfac1      =         zfac * e2u(ji,jj) 
    721                zfac2      =         zfac * r1_e2u(ji,jj) 
    722                zfac3      = 2._wp * zfac * r1_e1u(ji,jj) 
    723  
    724                zt12U      = - zfac1 * zzt(ji+1,jj) 
    725                zt11U      =   zfac1 * zzt(ji,jj) 
    726           
    727                zt22U      = - zfac2 * zet(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) 
    728                zt21U      =   zfac2 * zet(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj) 
    729           
    730                zt122U     = - zfac3 * zef(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj) 
    731                zt121U     =   zfac3 * zef(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) 
     571         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     572          
     573            !------------------------------------- 
     574            ! -- Internal forces LHS contribution 
     575            !------------------------------------- 
     576            ! 
     577            ! --- U-component 
     578            ! 
     579            ! "T" factors (intermediate results) 
     580            ! 
     581            zfac       = 0.5_wp * r1_e1e2u(ji,jj) 
     582            zfac1      =         zfac * e2u(ji,jj) 
     583            zfac2      =         zfac * r1_e2u(ji,jj) 
     584            zfac3      = 2._wp * zfac * r1_e1u(ji,jj) 
     585 
     586            zt11U      =   zfac1 * zzt(ji,jj) 
     587            zt12U      =   zfac1 * zzt(ji+1,jj) 
     588          
     589            zt21U      =   zfac2 * zet(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj)   * e2t(ji,jj) 
     590            zt22U      =   zfac2 * zet(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) 
     591          
     592            zt121U     =   zfac3 * zef(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) * e1f(ji,jj-1) 
     593            zt122U     =   zfac3 * zef(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj)   * e1f(ji,jj) 
    732594                
    733                ! 
    734                ! Linear system coefficients 
    735                ! 
    736                zAU(ji,jj) = - zt11U * e2u(ji-1,jj) - zt21U * r1_e2u(ji-1,jj) 
    737                zBU(ji,jj) = ( zt12U + zt11U ) * e2u(ji,jj) + ( zt22U + zt21U ) * r1_e2u(ji,jj) + ( zt122U + zt121U ) * r1_e1u(ji,jj) 
    738                zCU(ji,jj) = - zt12U * e2u(ji+1,jj) - zt22U * r1_e2u(ji+1,jj) 
    739           
    740                zDU(ji,jj) =   zt121U * r1_e1u(ji,jj-1) 
    741                zEU(ji,jj) =   zt122U * r1_e1u(ji,jj+1) 
     595            ! 
     596            ! Linear system coefficients 
     597            ! 
     598            zAU(ji,jj) = -   zt11U           * e2u(ji-1,jj) -   zt21U          * r1_e2u(ji-1,jj) 
     599            zBU(ji,jj) =   ( zt11U + zt12U ) * e2u(ji,jj)   + ( zt21U + zt22U ) * r1_e2u(ji,jj)   + ( zt121U + zt122U ) * r1_e1u(ji,jj) 
     600            zCU(ji,jj) = -   zt12U           * e2u(ji+1,jj) -   zt22U          * r1_e2u(ji+1,jj) 
     601          
     602            zDU(ji,jj) =     zt121U * r1_e1u(ji,jj-1) 
     603            zEU(ji,jj) =     zt122U * r1_e1u(ji,jj+1) 
    742604               
    743                ! 
    744                ! --- V-component 
    745                ! 
    746                ! "T" factors (intermediate results) 
    747                ! 
    748                zfac       = 0.5_wp * r1_e1e2v(ji,jj) 
    749                zfac1      =         zfac * e2v(ji,jj) 
    750                zfac2      =         zfac * r1_e1v(ji,jj) 
    751                zfac3      = 2._wp * zfac * r1_e2v(ji,jj) 
    752           
    753                zt12V      = - zfac1 * zzt(ji,jj+1) 
    754                zt11V      =   zfac1 * zzt(ji,jj) 
    755           
    756                zt22V      =   zfac2 * zet(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) 
    757                zt21V      = - zfac2 * zet(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj) 
    758           
    759                zt122V     =   zfac3 * zef(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj) 
    760                zt121V     = - zfac3 * zef(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) 
    761           
    762                ! 
    763                ! Linear system coefficients 
    764                ! 
    765                zAV(ji,jj) = - zt11V * e1v(ji,jj-1) + zt21V * r1_e1v(ji,jj-1) 
    766                zBV(ji,jj) =  ( zt12V + zt11V ) * e1v(ji,jj) - ( zt22V + zt21V ) * r1_e1v(ji,jj) - ( zt122V + zt121V ) * r1_e2v(ji,jj) 
    767                zCV(ji,jj) = - zt12V * e1v(ji,jj+1) + zt22V * r1_e1v(ji,jj+1) 
    768           
    769                zDV(ji,jj) = - zt121V * r1_e2v(ji-1,jj) ! mistake is in the pdf notes not here 
    770                zEV(ji,jj) = - zt122V * r1_e2v(ji+1,jj) 
     605            ! 
     606            ! --- V-component 
     607            ! 
     608            ! "T" factors (intermediate results) 
     609            ! 
     610            zfac       = 0.5_wp * r1_e1e2v(ji,jj) 
     611            zfac1      =         zfac * e1v(ji,jj) 
     612            zfac2      =         zfac * r1_e1v(ji,jj) 
     613            zfac3      = 2._wp * zfac * r1_e2v(ji,jj) 
     614 
     615            zt11V      =   zfac1 * zzt(ji,jj) 
     616            zt12V      =   zfac1 * zzt(ji,jj+1) 
     617 
     618            zt21V      =   zfac2 * zet(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj)   * e1t(ji,jj) 
     619            zt22V      =   zfac2 * zet(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) 
     620          
     621            zt121V     =   zfac3 * zef(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) * e2f(ji-1,jj) 
     622            zt122V     =   zfac3 * zef(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj)   * e2f(ji,jj) 
     623 
     624            ! 
     625            ! Linear system coefficients 
     626            ! 
     627            zAV(ji,jj) = -   zt11V           * e1v(ji,jj-1) -   zt21V          * r1_e1v(ji,jj-1) 
     628            zBV(ji,jj) =   ( zt11V + zt12V ) * e1v(ji,jj)   + ( zt21V + zt22V ) * r1_e1v(ji,jj)   + ( zt122V + zt121V ) * r1_e2v(ji,jj) 
     629            zCV(ji,jj) = -   zt12V           * e1v(ji,jj+1) -   zt22V          * r1_e1v(ji,jj+1) 
     630 
     631            zDV(ji,jj) =     zt121V * r1_e2v(ji-1,jj) 
     632            zEV(ji,jj) =    zt122V * r1_e2v(ji+1,jj) 
    771633                   
    772                !----------------------------------------------------- 
    773                ! -- Ocean-ice drag and acceleration LHS contribution 
    774                !----------------------------------------------------- 
    775                zBU(ji,jj) = zBU(ji,jj) + zCwU(ji,jj) + zmassU_t(ji,jj) 
    776                zBV(ji,jj) = ZBV(ji,jj) + zCwV(ji,jj) + zmassV_t(ji,jj) 
    777           
    778             END DO 
    779          END DO 
    780  
    781          CALL lbc_lnk( 'icedyn_rhg_vp', zAU  , 'U', 1., zAV  , 'V',  1. ) 
    782          CALL lbc_lnk( 'icedyn_rhg_vp', zBU  , 'U', 1., zBV  , 'V',  1. ) 
    783          CALL lbc_lnk( 'icedyn_rhg_vp', zCU  , 'U', 1., zCV  , 'V',  1. ) 
    784          CALL lbc_lnk( 'icedyn_rhg_vp', zDU  , 'U', 1., zDV  , 'V',  1. ) 
    785          CALL lbc_lnk( 'icedyn_rhg_vp', zEU  , 'U', 1., zEV  , 'V',  1. ) 
    786                 
    787          CALL iom_put( 'zAU'           , zAU            ) ! MV DEBUG 
    788          CALL iom_put( 'zBU'           , zBU            ) ! MV DEBUG 
    789          CALL iom_put( 'zCU'           , zCU            ) ! MV DEBUG 
    790          CALL iom_put( 'zDU'           , zDU            ) ! MV DEBUG 
    791          CALL iom_put( 'zEU'           , zEU            ) ! MV DEBUG 
    792          CALL iom_put( 'zAV'           , zAV            ) ! MV DEBUG 
    793          CALL iom_put( 'zBV'           , zBV            ) ! MV DEBUG 
    794          CALL iom_put( 'zCV'           , zCV            ) ! MV DEBUG 
    795          CALL iom_put( 'zDV'           , zDV            ) ! MV DEBUG 
    796          CALL iom_put( 'zEV'           , zEV            ) ! MV DEBUG 
    797  
     634            !----------------------------------------------------- 
     635            ! -- Ocean-ice drag and acceleration LHS contribution 
     636            !----------------------------------------------------- 
     637            zBU(ji,jj) = zBU(ji,jj) + zCwU(ji,jj) + zmassU_t(ji,jj) 
     638            zBV(ji,jj) = zBV(ji,jj) + zCwV(ji,jj) + zmassV_t(ji,jj) 
     639          
     640         END_2D 
     641          
    798642      !------------------------------------------------------------------------------! 
    799643      ! 
    … …  
    808652         DO i_inn = 1, nn_vp_ninn ! inner loop iterations 
    809653 
    810             IF( lwp )   WRITE(numout,*) ' inner loop 1 i_inn : ', i_inn 
    811           
    812654            !--- mitgcm computes initial value of residual here... 
    813655 
    814             jter             = jter + 1 
    815             ! l_full_nf_update = jter == nn_nvp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
    816  
    817             zu_b(:,:)      = u_ice(:,:) ! velocity at previous sub-iterate 
    818             zv_b(:,:)      = v_ice(:,:) 
    819  
    820 !           zAU(:,:) = 0._wp; zBU(:,:) = 0._wp; zCU(:,:) = 0._wp; zDU(:,:) = 0._wp; zEU(:,:) = 0._wp 
    821 !           zAV(:,:) = 0._wp; zBV(:,:) = 0._wp; zCV(:,:) = 0._wp; zDV(:,:) = 0._wp; zEV(:,:) = 0._wp 
     656            i_inn_tot             = i_inn_tot + 1 
     657            ! l_full_nf_update = i_inn_tot == nn_nvp   ! false: disable full North fold update (performances) for iter = 1 to nn_nevp-1 
     658 
     659            zu_b(:,:)       = u_ice(:,:) ! velocity at previous inner-iterate 
     660            zv_b(:,:)       = v_ice(:,:) 
    822661 
    823662            IF ( ll_u_iterate .OR. ll_v_iterate )   THEN 
    … …  
    832671                  ! A*u(i-1,j)+B*u(i,j)+C*u(i+1,j) = F 
    833672 
    834                   zFU(:,:)       = 0._wp ; zFU_prime(:,:) = 0._wp ; zBU_prime(:,:) = 0._wp; zCU_prime(:,:) = 0._wp 
     673                  zFU(:,:)       = 0._wp ; zFU_prime(:,:) = 0._wp ; zBU_prime(:,:) = 0._wp;  
    835674                   
    836675                  DO jn = 1, nn_zebra_vp ! "zebra" loop (! red-black-sor!!! ) 
    … …  
    841680                     ELSE                  ;   jj_min = 3 
    842681                     ENDIF 
    843  
    844                      IF ( lwp ) WRITE(numout,*) ' Into the U-zebra loop at step jn = ', jn, ', with jj_min = ', jj_min 
    845682 
    846683                     DO jj = jj_min, jpj - 1, nn_zebra_vp 
    … …  
    850687                        !------------------------ 
    851688                        DO ji = 2, jpi - 1     
    852  
    853                            ! boundary condition substitution 
     689                           ! note: these are key lines linking information between processors 
     690                           ! u_ice/v_ice need to be lbc_linked 
     691 
     692                           ! sub-domain boundary condition substitution 
    854693                           ! see Zhang and Hibler, 1997, Appendix B 
    855694                           zAA3 = 0._wp 
    … …  
    867706                     END DO 
    868707                      
    869                      CALL lbc_lnk( 'icedyn_rhg_vp', zFU, 'U',  1. ) 
    870                       
    871708                     !--------------- 
    872709                     ! Forward sweep 
    … …  
    874711                     DO jj = jj_min, jpj - 1, nn_zebra_vp 
    875712       
     713                        zBU_prime(2,jj)     = zBU(2,jj) 
     714                        zFU_prime(2,jj)     = zFU(2,jj) 
     715 
    876716                        DO ji = 3, jpi - 1 
    877717 
    … …  
    884724 
    885725                     END DO 
    886  
    887                      CALL lbc_lnk( 'icedyn_rhg_vp', zFU_prime, 'U',  1., zBU_prime, 'U', 1. ) 
    888   
     726                                                                                                      
    889727                     !----------------------------- 
    890728                     ! Backward sweep & relaxation 
    … …  
    894732                     
    895733                        ! --- Backward sweep  
     734 
    896735                        ! last row  
    897736                        zfac = SIGN( 1._wp , zBU_prime(jpi-1,jj) ) * MAX( 0._wp , SIGN( 1._wp , ABS( zBU_prime(jpi-1,jj) ) - epsi20 ) ) 
    898737                        u_ice(jpi-1,jj)    = zfac * zFU_prime(jpi-1,jj) / MAX( ABS ( zBU_prime(jpi-1,jj) ) , epsi20 ) &  
    899738                                           &            * umask(jpi-1,jj,1) 
    900                         DO ji = jpi-2 , 2, -1 ! all other rows    !  ---> original backward loop 
     739 
     740                        DO ji = jpi - 2 , 2, -1 ! all other rows    !  ---> original backward loop 
    901741                           zfac = SIGN( 1._wp , zBU_prime(ji,jj) ) * MAX( 0._wp , SIGN( 1._wp , ABS( zBU_prime(ji,jj) ) - epsi20 ) ) 
    902742                           u_ice(ji,jj)    = zfac * ( zFU_prime(ji,jj) - zCU(ji,jj) * u_ice(ji+1,jj) ) * umask(ji,jj,1)   &  
    … …  
    904744                        END DO 
    905745 
    906                         !--- Relaxation 
    907                         ! and velocity masking for little-ice and no-ice cases 
     746                        !--- Relaxation and masking (for low-ice/no-ice cases) 
    908747                        DO ji = 2, jpi - 1     
    909748                         
    … …  
    917756 
    918757                     END DO ! jj 
     758 
     759                     CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1. ) 
    919760                      
    920761                  END DO ! zebra loop 
    … …  
    932773                  !!! ZH97 explain it is critical for convergence speed 
    933774 
    934                   zFV(:,:)       = 0._wp ; zFV_prime(:,:) = 0._wp ; zBV_prime(:,:) = 0._wp; zCV_prime(:,:) = 0._wp 
     775                  zFV(:,:)       = 0._wp ; zFV_prime(:,:) = 0._wp ; zBV_prime(:,:) = 0._wp;  
    935776 
    936777                  DO jn = 1, nn_zebra_vp ! "zebra" loop 
    … …  
    940781                     ENDIF 
    941782 
    942                      IF ( lwp ) WRITE(numout,*) ' Into the V-zebra loop at step jn = ', jn, ', with ji_min = ', ji_min 
    943           
    944783                     DO ji = ji_min, jpi - 1, nn_zebra_vp  
    945784                      
    … …  
    949788                        DO jj = 2, jpj - 1 
    950789 
    951                            ! boundary condition substitution (check it is correctly applied !!!) 
     790                           ! subdomain boundary condition substitution (check it is correctly applied !!!) 
    952791                           ! see Zhang and Hibler, 1997, Appendix B 
    953792                           zAA3 = 0._wp 
    … …  
    965804                     END DO 
    966805 
    967                      CALL lbc_lnk( 'icedyn_rhg_vp', zFV, 'V',  1.) 
    968                       
    969806                     !--------------- 
    970807                     ! Forward sweep 
    … …  
    972809                     DO ji = ji_min, jpi - 1, nn_zebra_vp  
    973810                      
    974                         DO jj = 3, jpj - 1 
     811                        zBV_prime(ji,2)     = zBV(ji,2) 
     812                        zFV_prime(ji,2)     = zFV(ji,2) 
     813 
     814                        DO jj = 3, jpj - 1  
    975815 
    976816                           zfac             = SIGN( 1._wp , zBV(ji,jj-1) ) * MAX( 0._wp , SIGN( 1._wp , ABS( zBV(ji,jj-1) ) - epsi20 ) ) 
    … …  
    983823                     END DO 
    984824 
    985                      CALL lbc_lnk( 'icedyn_rhg_vp', zFV_prime, 'V',  1., zBV_prime, 'V', 1. ) 
    986                       
    987825                     !----------------------------- 
    988826                     ! Backward sweep & relaxation 
    … …  
    1003841                        END DO             
    1004842                                                    
    1005                         ! --- Relaxation  & masking (should it be now or later) 
     843                        ! --- Relaxation & masking  
    1006844                        DO jj = 2, jpj - 1 
    1007845                         
    … …  
    1015853                         
    1016854                     END DO ! ji 
     855 
     856                     CALL lbc_lnk( 'icedyn_rhg_vp', v_ice, 'V', -1. ) 
    1017857                      
    1018858                  END DO ! zebra loop 
    … …  
    1020860               ENDIF !   ll_v_iterate 
    1021861 
    1022                CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
     862               ! I suspect the communication should go into the zebra loop if we want reproducibility 
    1023863                               
    1024864               !-------------------------------------------------------------------------------------- 
    … …  
    1031871               ! MV OPT: if the number of iterations to convergence is really variable, and keep the convergence check 
    1032872               ! then we must optimize the use of the mpp_max, which is prohibitive                             
    1033                zuerr_max = 0._wp 
     873               zuerr_max  = 0._wp 
    1034874                                
    1035875               IF ( ll_u_iterate .AND. MOD ( i_inn, nn_vp_chkcvg ) == 0 ) THEN 
    … …  
    1037877                  ! - Maximum U-velocity difference                
    1038878                  zuerr(:,:) = 0._wp 
    1039                   DO jj = 2, jpj - 1 
    1040                      DO ji = 2, jpi - 1 
    1041                         zuerr(ji,jj) = ABS ( ( u_ice(ji,jj) - zu_b(ji,jj) ) ) * umask(ji,jj,1) 
    1042                      END DO 
    1043                   END DO 
     879                  DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     880                   
     881                     zuerr(ji,jj) = ABS ( ( u_ice(ji,jj) - zu_b(ji,jj) ) ) * umask(ji,jj,1)  
     882                   
     883                  END_2D 
     884          
    1044885                  zuerr_max = MAXVAL( zuerr ) 
    1045886                  CALL mpp_max( 'icedyn_rhg_evp', zuerr_max )   ! max over the global domain - damned! 
    1046                    
    1047                   ! - Stop if error is too large ("safeguard against bad forcing" of original Zhang routine) 
     887 
     888                  ! - Stop if max error is too large ("safeguard against bad forcing" of original Zhang routine) 
    1048889                  IF ( i_inn > 1 .AND. zuerr_max > zuerr_max_vp ) THEN 
    1049890                      IF ( lwp ) WRITE(numout,*) " VP rheology error was too large : ", zuerr_max, " in outer U-iteration ", i_out, " after ", i_inn, " iterations, we stopped " 
    … …  
    1068909                  ! - Maximum V-velocity difference 
    1069910                  zverr(:,:)   = 0._wp    
    1070                   DO jj = 2, jpj - 1 
    1071                      DO ji = 2, jpi - 1 
     911                  DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     912                   
    1072913                        zverr(ji,jj) = ABS ( ( v_ice(ji,jj) - zv_b(ji,jj) ) ) * vmask(ji,jj,1) 
    1073                      END DO 
    1074                   END DO 
    1075914                   
     915                  END_2D 
     916                            
    1076917                  zverr_max = MAXVAL( zverr ) 
    1077918                  CALL mpp_max( 'icedyn_rhg_evp', zverr_max )   ! max over the global domain - damned! 
    … …  
    1098939            ! 
    1099940            !--------------------------------------------------------------------------------------- 
    1100  
    1101             IF( nn_rhg_chkcvg/=0 .AND. MOD ( i_inn - 1, nn_vp_chkcvg ) == 0 ) CALL rhg_cvg_vp( kt, jter, nn_nvp, u_ice, v_ice, zmt, zuerr_max, zverr_max, zglob_area, & 
    1102                       &                         zrhsu, zAU, zBU, zCU, zDU, zEU, zrhsv, zAV, zBV, zCV, zDV, zEV ) 
    1103  
    1104             IF ( lwp ) WRITE(numout,*) ' Done convergence tests ' 
     941            IF( nn_rhg_chkcvg/=0 .AND. MOD ( i_inn - 1, nn_vp_chkcvg ) == 0 ) THEN 
     942 
     943               CALL rhg_cvg_vp( kt, i_out, i_inn, i_inn_tot, nn_vp_nout, nn_vp_ninn, nn_nvp,        & 
     944                      &         u_ice, v_ice, zu_b, zv_b, zu_c, zv_c,                               & 
     945                      &         zmt, za_iU, za_iV, zuerr_max, zverr_max, zglob_area,                & 
     946                      &         zrhsu, zAU, zBU, zCU, zDU, zEU, zFU,                                & 
     947                      &         zrhsv, zAV, zBV, zCV, zDV, zEV, zFV,                                & 
     948                                zvel_res, zvel_diff ) 
     949 
     950            ENDIF 
    1105951 
    1106952         END DO ! i_inn, end of inner loop 
    … …  
    1108954      END DO ! End of outer loop (i_out) ============================================================================================= 
    1109955 
    1110       IF ( lwp ) WRITE(numout,*) ' We are out of outer loop ' 
    1111  
    1112       CALL lbc_lnk( 'icedyn_rhg_vp', zFU  , 'U',  1., zFV  , 'V',  1. ) 
    1113       CALL lbc_lnk( 'icedyn_rhg_vp', zBU_prime  , 'U',  1., zBV_prime  , 'V',  1. ) 
    1114       CALL lbc_lnk( 'icedyn_rhg_vp', zFU_prime  , 'U',  1., zFV_prime  , 'V',  1. ) 
    1115       CALL lbc_lnk( 'icedyn_rhg_vp', zCU_prime  , 'U',  1., zCV_prime  , 'V',  1. ) 
    1116  
    1117       CALL iom_put( 'zFU'           , zFU            ) ! MV DEBUG 
    1118       CALL iom_put( 'zBU_prime'     , zBU_prime      ) ! MV DEBUG 
    1119       CALL iom_put( 'zCU_prime'     , zCU_prime      ) ! MV DEBUG 
    1120       CALL iom_put( 'zFU_prime'     , zFU_prime      ) ! MV DEBUG 
    1121  
    1122       CALL iom_put( 'zFV'           , zFV            ) ! MV DEBUG 
    1123       CALL iom_put( 'zBV_prime'     , zBV_prime      ) ! MV DEBUG 
    1124       CALL iom_put( 'zCV_prime'     , zCV_prime      ) ! MV DEBUG 
    1125       CALL iom_put( 'zFV_prime'     , zFV_prime      ) ! MV DEBUG 
    1126  
    1127       CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    1128  
    1129       IF ( lwp ) WRITE(numout,*) ' We are about to output uice_dbg ' 
    1130       IF( iom_use('uice_dbg' ) )   CALL iom_put( 'uice_dbg'   , u_ice    )                              ! ice velocity u after solver 
    1131       IF( iom_use('vice_dbg' ) )   CALL iom_put( 'vice_dbg'   , v_ice    )                              ! ice velocity v after solver 
    1132              
     956      IF( nn_rhg_chkcvg/=0  ) THEN 
     957           
     958         IF( iom_use('velo_res') )   CALL iom_put( 'velo_res', zvel_res  )   ! linear system residual  @last inner&outer iteration 
     959         IF( iom_use('velo_ero') )   CALL iom_put( 'velo_ero', zvel_diff )   ! abs velocity difference @last outer iteration 
     960         IF( iom_use('uice_eri') )   CALL iom_put( 'uice_eri', zuerr     )   ! abs velocity difference @last inner iteration 
     961         IF( iom_use('vice_eri') )   CALL iom_put( 'vice_eri', zverr     )   ! abs velocity difference @last inner iteration 
     962 
     963         DEALLOCATE( zvel_res , zvel_diff ) 
     964         
     965      ENDIF ! nn_rhg_chkcvg 
     966 
    1133967      !------------------------------------------------------------------------------! 
    1134968      ! 
    1135       ! --- Convergence diagnostics  
     969      ! --- Recompute delta, shear and div (inputs for mechanical redistribution)  
    1136970      ! 
    1137971      !------------------------------------------------------------------------------! 
    1138  
    1139       IF( nn_rhg_chkcvg /= 0 ) THEN 
    1140            
    1141          IF( iom_use('uice_cvg')  ) THEN 
    1142             CALL iom_put( 'uice_cvg', MAX( ABS( u_ice(:,:) - zu_b(:,:) ) * umask(:,:,1) , &                ! ice velocity difference at last iteration 
    1143                   &                        ABS( v_ice(:,:) - zv_b(:,:) ) * vmask(:,:,1) ) * zmsk15(:,:) ) 
    1144          ENDIF    
    1145          
    1146       ENDIF 
    1147  
    1148       ! MV DEBUG test - replace ice velocity by ocean current to give the model the means to go ahead 
    1149       DO jj = 2, jpj - 1 
    1150          DO ji = 2, jpi - 1    
    1151  
    1152              u_ice(ji,jj) =   zmsk00x(ji,jj)                               &  
    1153       &         * (           zmsk01x(ji,jj)   * u_oce(ji,jj) * 0.01_wp    & 
    1154                   + ( 1._wp - zmsk01x(ji,jj) ) * u_oce(ji,jj) * 0.01_wp    ) 
    1155  
    1156              v_ice(ji,jj) =   zmsk00y(ji,jj)                               &  
    1157       &         * (           zmsk01y(ji,jj)   * v_oce(ji,jj) * 0.01_wp    & 
    1158                   + ( 1._wp - zmsk01y(ji,jj) ) * v_oce(ji,jj) * 0.01_wp    ) 
    1159  
    1160          END DO 
    1161       END DO 
    1162  
    1163       CALL lbc_lnk( 'icedyn_rhg_vp', u_ice, 'U', -1., v_ice, 'V', -1. ) 
    1164  
    1165       IF ( lwp ) WRITE(numout,*) ' Velocity replaced ' 
    1166  
    1167       ! END DEBUG 
    1168  
    1169       !------------------------------------------------------------------------------! 
    1170       ! 
    1171       ! --- Recompute delta, shear and div (inputs for mechanical redistribution)  
    1172       ! 
    1173       !------------------------------------------------------------------------------! 
    1174972      ! 
    1175973      ! MV OPT: subroutinize ? 
    1176  
    1177       DO jj = 1, jpj - 1 
    1178          DO ji = 1, jpi - 1 
     974      DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) ! 1->jpj-1; 1->jpi-1 
    1179975 
    1180976            ! shear at F points 
    1181977            zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj)   & 
    1182978               &         + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj)   & 
    1183                &         ) * r1_e1e2f(ji,jj) * zfmask(ji,jj) 
    1184  
    1185          END DO 
    1186       END DO            
    1187        
    1188       DO jj = 2, jpj - 1 
    1189          DO ji = 2, jpi - 1 !  
     979               &         ) * r1_e1e2f(ji,jj) * fimask(ji,jj) 
     980 
     981      END_2D       
     982       
     983      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
    1190984             
    1191985            ! tension**2 at T points 
    … …  
    1195989            zdt2 = zdt * zdt 
    1196990             
    1197             zten_i(ji,jj) = zdt 
     991            ztens(ji,jj)    = zdt 
    1198992             
    1199993            ! shear**2 at T points (doc eq. A16) 
    … …  
    1202996               &   ) * 0.25_wp * r1_e1e2t(ji,jj) 
    1203997             
    1204             ! shear at T points 
    1205             pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) 
     998            ! maximum shear rate at T points (includees tension, output only) 
     999            pshear_i(ji,jj) = SQRT( zdt2 + zds2 ) ! i think this is maximum shear rate and not actual shear --- i'm not totally sure here 
     1000 
     1001            ! shear at T-points 
     1002            zshear(ji,jj)   = SQRT( zds2 ) 
    12061003 
    12071004            ! divergence at T points 
    … …  
    12091006               &             + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1)   & 
    12101007               &             ) * r1_e1e2t(ji,jj) 
     1008 
     1009            zdiv2          =  pdivu_i(ji,jj) *  pdivu_i(ji,jj) 
    12111010             
    12121011            ! delta at T points 
    1213             zdelta         = SQRT( pdivu_i(ji,jj) * pdivu_i(ji,jj) + ( zdt2 + zds2 ) * z1_ecc2 )   
     1012            zdelta         = SQRT( zdiv2 + ( zdt2 + zds2 ) * z1_ecc2 ) 
    12141013            rswitch        = 1._wp - MAX( 0._wp, SIGN( 1._wp, -zdelta ) ) ! 0 if delta=0 
    1215              
    1216             !pdelta_i(ji,jj) = zdelta + rn_creepl * rswitch 
    1217             pdelta_i(ji,jj) = zdelta + rn_creepl 
    1218  
    1219          END DO 
    1220       END DO 
    1221  
    1222       IF ( lwp ) WRITE(numout,*) ' Deformation recalculated ' 
     1014 
     1015            pdelta_i(ji,jj) = zdelta + rn_creepl ! * rswitch 
     1016 
     1017      END_2D 
    12231018       
    12241019      CALL lbc_lnk( 'icedyn_rhg_vp', pshear_i, 'T', 1., pdivu_i, 'T', 1., pdelta_i, 'T', 1. ) 
    … …  
    12371032      ! 
    12381033      ! ---- Sea ice stresses at T-points 
    1239       IF ( iom_use('normstr') .OR. iom_use('sheastr') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    1240        
    1241          DO jj = 2, jpj - 1 
    1242             DO ji = 2, jpi - 1 
    1243                zp_deltastar_t(ji,jj)   =   strength(ji,jj) / pdelta_i(ji,jj)  
    1244                zfac                    =   zp_deltastar_t(ji,jj)  
     1034      IF ( iom_use('normstr')    .OR. iom_use('sheastr')    .OR. & 
     1035     &     iom_use('intstrx')    .OR. iom_use('intstry')    .OR. & 
     1036     &     iom_use('sig1_pnorm') .OR. iom_use('sig2_pnorm') ) THEN 
     1037       
     1038         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1039          
     1040               zp_delstar_t(ji,jj)     =   strength(ji,jj) / pdelta_i(ji,jj)  
     1041               zfac                    =   zp_delstar_t(ji,jj)  
    12451042               zs1(ji,jj)              =   zfac * ( pdivu_i(ji,jj) - pdelta_i(ji,jj) ) 
    1246                zs2(ji,jj)              =   zfac * z1_ecc2 * zten_i(ji,jj) 
    1247                zs12(ji,jj)             =   zfac * z1_ecc2 * pshear_i(ji,jj) 
    1248             END DO 
    1249          END DO 
     1043               zs2(ji,jj)              =   zfac * z1_ecc2 * ztens(ji,jj) 
     1044               zs12(ji,jj)             =   zfac * z1_ecc2 * zshear(ji,jj) * 0.5_wp ! Bug 12 nov 
     1045 
     1046         END_2D 
    12501047 
    12511048         CALL lbc_lnk( 'icedyn_rhg_vp', zs1, 'T', 1., zs2, 'T', 1., zs12, 'T', 1. ) 
    … …  
    12561053      IF ( iom_use('intstrx') .OR. iom_use('intstry') ) THEN 
    12571054 
    1258          DO jj = 1, jpj - 1 
    1259             DO ji = 1, jpi - 1 
     1055         DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) ! 1->jpj-1; 1->jpi-1 
    12601056             
    12611057               ! P/delta* at F points 
    1262                zp_deltastar_f = 0.25_wp * ( zp_deltastar_t(ji,jj) + zp_deltastar_t(ji+1,jj) + zp_deltastar_t(ji,jj+1) + zp_deltastar_t(ji+1,jj+1) ) 
     1058               zp_delstar_f = 0.25_wp * ( zp_delstar_t(ji,jj) + zp_delstar_t(ji+1,jj) + zp_delstar_t(ji,jj+1) + zp_delstar_t(ji+1,jj+1) ) 
    12631059                
    12641060               ! s12 at F-points  
    1265                zs12f(ji,jj) = zp_deltastar_f * z1_ecc2 * zds(ji,jj) 
     1061               zs12f(ji,jj) = zp_delstar_f * z1_ecc2 * zds(ji,jj) 
    12661062                
    1267             END DO 
    1268          END DO 
     1063         END_2D 
    12691064 
    12701065         CALL lbc_lnk( 'icedyn_rhg_vp', zs12f, 'F', 1. ) 
    12711066          
    12721067      ENDIF 
    1273  
    1274       IF ( lwp ) WRITE(numout,*) ' zs12f recalculated ' 
    12751068 
    12761069      ! 
    … …  
    12861079 
    12871080         !--- Recalculate oceanic stress at last inner iteration 
    1288          DO jj = 2, jpj - 1 
    1289             DO ji = 2, jpi - 1 
     1081         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
    12901082 
    12911083                !--- ice u-velocity @V points, v-velocity @U points (for non-linear drag computation) 
    … …  
    13031095                ztauy_oi(ji,jj) = zCwV(ji,jj) * ( v_oce(ji,jj) - v_ice(ji,jj) ) 
    13041096                 
    1305             END DO 
    1306          END DO 
     1097         END_2D 
    13071098          
    13081099         ! 
    13091100         CALL lbc_lnk( 'icedyn_rhg_vp', ztaux_oi, 'U', -1., ztauy_oi, 'V', -1., ztaux_ai, 'U', -1., ztauy_ai, 'V', -1. ) !, & 
    1310 !            &                           ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
     1101!            &                          ztaux_bi, 'U', -1., ztauy_bi, 'V', -1. ) 
    13111102         ! 
    13121103         CALL iom_put( 'utau_oi' , ztaux_oi * zmsk00 ) 
    … …  
    13231114      ! --- Divergence, shear and strength --- ! 
    13241115      IF( iom_use('icediv') )   CALL iom_put( 'icediv' , pdivu_i  * zmsk00 )   ! divergence 
    1325       IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! shear 
     1116      IF( iom_use('iceshe') )   CALL iom_put( 'iceshe' , pshear_i * zmsk00 )   ! maximum shear rate 
    13261117      IF( iom_use('icedlt') )   CALL iom_put( 'icedlt' , pdelta_i * zmsk00 )   ! delta 
    13271118      IF( iom_use('icestr') )   CALL iom_put( 'icestr' , strength * zmsk00 )   ! strength 
    13281119 
    1329       IF ( lwp ) WRITE(numout,*) 'Some terms recalculated ' 
    1330  
    13311120      ! --- Stress tensor invariants (SIMIP diags) --- ! 
    13321121      IF( iom_use('normstr') .OR. iom_use('sheastr') ) THEN 
    … …  
    13401129         ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    13411130         !          
    1342          DO jj = 2, jpj - 1 
    1343             DO ji = 2, jpi - 1 
     1131         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
    13441132               ! Stress invariants 
    1345                zsig_I(ji,jj)    =   zs1(ji,jj) * 0.5_wp                                        ! 1st invariant, aka average normal stress aka negative pressure 
    1346                zsig_II(ji,jj)   =   SQRT ( zs2(ji,jj) * zs2(ji,jj) * 0.25_wp + zs12(ji,jj) )  ! 2nd invariant, aka maximum shear stress                
    1347             END DO 
    1348          END DO 
     1133               zsig_I(ji,jj)    =   zs1(ji,jj) * 0.5_wp   ! 1st invariant, aka average normal stress aka negative pressure 
     1134               zsig_II(ji,jj)   =   0.5_wp * SQRT ( zs2(ji,jj) * zs2(ji,jj) + 4. * zs12(ji,jj) * zs12(ji,jj) )   ! 2nd invariant, aka maximum shear stress                
     1135         END_2D 
    13491136 
    13501137         CALL lbc_lnk( 'icedyn_rhg_vp', zsig_I, 'T', 1., zsig_II, 'T', 1.) 
    … …  
    13561143          
    13571144      ENDIF 
    1358  
    1359       IF ( lwp ) WRITE(numout,*) 'SIMIP work done' 
    13601145 
    13611146      ! --- Normalized stress tensor principal components --- ! 
    … …  
    13701155         ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 
    13711156         !          
    1372          DO jj = 2, jpj - 1 
    1373             DO ji = 2, jpi - 1 
     1157         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1158          
    13741159               ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates  
    13751160               !                        and **deformations** at current iterates 
    13761161               !                        following Lemieux & Dupont (2020) 
    1377                zfac             =   zp_deltastar_t(ji,jj) 
    1378                zsig1            =   zfac * ( pdivu_i(ji,jj) - zdeltastar_t(ji,jj) ) 
    1379                zsig1            = 0._wp !!! FUCKING DEBUG TEST !!! 
    1380                zsig2            =   zfac * z1_ecc2 * zten_i(ji,jj) 
    1381                zsig12           =   zfac * z1_ecc2 * pshear_i(ji,jj) 
     1162               zfac             =   zp_delstar_t(ji,jj) 
     1163               zsig1            =   zfac * ( pdivu_i(ji,jj) - zdeltat(ji,jj) ) 
     1164               zsig2            =   zfac * z1_ecc2 * ztens(ji,jj) 
     1165               zsig12           =   zfac * z1_ecc2 * zshear(ji,jj) * 0.5_wp ! Bugfix 12 Nov 
    13821166                
    13831167               ! Stress invariants (sigma_I, sigma_II, Coon 1974, Feltham 2008), T-point 
    1384                zsig_I(ji,jj)    =   zsig1 * 0.5_wp                              ! 1st invariant 
    1385                zsig_II(ji,jj)   =   SQRT ( zsig2 * zsig2 * 0.25_wp + zsig12 )   ! 2nd invariant 
     1168               zsig_I(ji,jj)    =   zsig1 * 0.5_wp                                       ! 1st invariant 
     1169               zsig_II(ji,jj)   =   0.5_wp * SQRT ( zsig2 * zsig2 + 4. *zsig12 * zsig12 )   ! 2nd invariant 
    13861170 
    13871171               ! Normalized  principal stresses (used to display the ellipse) 
    … …  
    13891173               zsig1_p(ji,jj)   =   ( zsig_I(ji,jj) + zsig_II(ji,jj) ) * z1_strength 
    13901174               zsig2_p(ji,jj)   =   ( zsig_I(ji,jj) - zsig_II(ji,jj) ) * z1_strength 
    1391             END DO 
    1392          END DO 
    1393          IF ( lwp ) WRITE(numout,*) 'Some shitty stress work done' 
     1175                
     1176         END_2D 
    13941177         ! 
    13951178         CALL lbc_lnk( 'icedyn_rhg_vp', zsig1_p, 'T', 1., zsig2_p, 'T', 1.) 
    1396          !       
    1397          IF ( lwp ) WRITE(numout,*) ' Beauaaaarflblbllll ' 
    13981179         ! 
    13991180         CALL iom_put( 'sig1_pnorm' , zsig1_p )  
    … …  
    14011182 
    14021183         DEALLOCATE( zsig1_p , zsig2_p , zsig_I , zsig_II ) 
    1403  
    1404          IF ( lwp ) WRITE(numout,*) ' So what ??? ' 
    14051184          
    14061185      ENDIF 
    … …  
    14111190 
    14121191         ! --- Recalculate Coriolis stress at last inner iteration 
    1413          DO jj = 2, jpj - 1 
    1414             DO ji = 2, jpi - 1 
     1192         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
    14151193                ! --- U-component  
    14161194                zCorU(ji,jj)         =   0.25_wp * r1_e1u(ji,jj) *  & 
    … …  
    14201198                           &             ( zmf(ji,jj  ) * ( e2u(ji,jj  ) * u_ice(ji,jj  ) + e2u(ji-1,jj  ) * u_ice(ji-1,jj  ) )  & 
    14211199                           &             + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 
    1422             END DO 
    1423          END DO 
     1200         END_2D 
    14241201         ! 
    14251202         CALL lbc_lnk( 'icedyn_rhg_vp', zspgU, 'U', -1., zspgV, 'V', -1., & 
    … …  
    14361213 
    14371214         ! Recalculate internal forces (divergence of stress tensor) at last inner iteration 
    1438          DO jj = 2, jpj - 1 
    1439             DO ji = 2, jpi - 1 
     1215         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1216 
    14401217               zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj)                                             & 
    14411218                  &                  + ( zs2(ji+1,jj) * e2t(ji+1,jj) * e2t(ji+1,jj) - zs2(ji,jj) * e2t(ji,jj) * e2t(ji,jj)    & 
    … …  
    14441221                  &                    ) * 2._wp * r1_e1u(ji,jj)                                                              & 
    14451222                  &                  ) * r1_e1e2u(ji,jj) 
     1223 
    14461224               zfV(ji,jj) = 0.5_wp * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj)                                             & 
    14471225                  &                  - ( zs2(ji,jj+1) * e1t(ji,jj+1) * e1t(ji,jj+1) - zs2(ji,jj) * e1t(ji,jj) * e1t(ji,jj)    & 
    … …  
    14501228                  &                    ) * 2._wp * r1_e2v(ji,jj)                                                              & 
    14511229                  &                  ) * r1_e1e2v(ji,jj) 
    1452             END DO 
    1453          END DO 
     1230 
     1231         END_2D 
    14541232             
    14551233         CALL lbc_lnk( 'icedyn_rhg_vp', zfU, 'U', -1., zfV, 'V', -1. ) 
    … …  
    14671245            &      zdiag_xmtrp_snw(jpi,jpj) , zdiag_ymtrp_snw(jpi,jpj) , zdiag_xatrp(jpi,jpj) , zdiag_yatrp(jpi,jpj) ) 
    14681246         ! 
    1469          DO jj = 2, jpj - 1 
    1470             DO ji = 2, jpi - 1 
    1471                ! 2D ice mass, snow mass, area transport arrays (X, Y) 
     1247         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1               ! 2D ice mass, snow mass, area transport arrays (X, Y) 
     1248 
    14721249               zfac_x = 0.5 * u_ice(ji,jj) * e2u(ji,jj) * zmsk00(ji,jj) 
    14731250               zfac_y = 0.5 * v_ice(ji,jj) * e1v(ji,jj) * zmsk00(ji,jj) 
    … …  
    14821259               zdiag_yatrp(ji,jj)     = zfac_y * ( at_i(ji,jj+1) + at_i(ji,jj) )        !        ''            Y-   '' 
    14831260 
    1484             END DO 
    1485          END DO 
    1486  
     1261         END_2D 
     1262          
    14871263         CALL lbc_lnk( 'icedyn_rhg_vp', zdiag_xmtrp_ice, 'U', -1., zdiag_ymtrp_ice, 'V', -1., & 
    14881264            &                           zdiag_xmtrp_snw, 'U', -1., zdiag_ymtrp_snw, 'V', -1., & 
    … …  
    15011277      ENDIF 
    15021278 
    1503       DEALLOCATE( zmsk00, zmsk15 ) 
    1504  
    15051279   END SUBROUTINE ice_dyn_rhg_vp 
    15061280    
    15071281    
    1508     
    1509    SUBROUTINE rhg_cvg_vp( kt, kiter, kitermax, pu, pv, pmt, puerr_max, pverr_max, pglob_area, & 
    1510                   &       prhsu, pAU, pBU, pCU, pDU, pEU, prhsv, pAV, pBV, pCV, pDV, pEV ) 
    1511     
     1282   SUBROUTINE rhg_cvg_vp( kt, kitout, kitinn, kitinntot, kitoutmax, kitinnmax, kitinntotmax , & 
     1283                  &       pu, pv, pub, pvb, pub_outer, pvb_outer                     , & 
     1284                  &       pmt, pat_iu, pat_iv, puerr_max, pverr_max, pglob_area      , & 
     1285                  &       prhsu, pAU, pBU, pCU, pDU, pEU, pFU                        , & 
     1286                  &       prhsv, pAV, pBV, pCV, pDV, pEV, pFV                        , &    
     1287                  &       pvel_res, pvel_diff                                            ) 
     1288      !! 
    15121289      !!---------------------------------------------------------------------- 
    15131290      !!                    ***  ROUTINE rhg_cvg_vp  *** 
    … …  
    15241301      !! 
    15251302      !! ** Note    :   for the first sub-iteration, uice_cvg is set to 0 (too large otherwise)    
     1303      !! 
    15261304      !!---------------------------------------------------------------------- 
    1527       INTEGER ,                 INTENT(in) ::   kt, kiter, kitermax      ! ocean time-step index 
    1528       REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pmt              ! now velocity and mass per unit area  
    1529       REAL(wp),                 INTENT(in) ::   puerr_max, pverr_max     ! absolute mean velocity difference 
    1530       REAL(wp),                 INTENT(in) ::   pglob_area               ! global ice area 
    1531       REAL(wp), DIMENSION(:,:), INTENT(in) ::   prhsu, pAU, pBU, pCU, pDU, pEU ! linear system coefficients  
    1532       REAL(wp), DIMENSION(:,:), INTENT(in) ::   prhsv, pAV, pBV, pCV, pDV, pEV 
    1533       !! 
    1534       INTEGER           ::   it, idtime, istatus, ix_dim, iy_dim 
     1305      !! 
     1306      INTEGER ,                 INTENT(in) ::   kt, kitout, kitinn, kitinntot    ! ocean model iterate, outer, inner and total n-iterations 
     1307      INTEGER ,                 INTENT(in) ::   kitoutmax, kitinnmax             ! max number of outer & inner iterations 
     1308      INTEGER ,                 INTENT(in) ::   kitinntotmax                     ! max number of total sub-iterations 
     1309      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pu, pv, pub, pvb                 ! now & sub-iter-before velocities 
     1310      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pub_outer, pvb_outer             ! velocities @before outer iterations 
     1311      REAL(wp), DIMENSION(:,:), INTENT(in) ::   pmt, pat_iu, pat_iv              ! mass at T-point, ice concentration at U&V 
     1312      REAL(wp),                 INTENT(in) ::   puerr_max, pverr_max             ! absolute mean velocity difference 
     1313      REAL(wp),                 INTENT(in) ::   pglob_area                       ! global ice area 
     1314      REAL(wp), DIMENSION(:,:), INTENT(in) ::   prhsu, pAU, pBU, pCU, pDU, pEU, pFU ! linear system coefficients  
     1315      REAL(wp), DIMENSION(:,:), INTENT(in) ::   prhsv, pAV, pBV, pCV, pDV, pEV, pFV 
     1316      REAL(wp), DIMENSION(:,:), INTENT(inout) ::  pvel_res                       ! velocity residual @last inner iteration 
     1317      REAL(wp), DIMENSION(:,:), INTENT(inout) ::  pvel_diff                      ! velocity difference @last outer iteration 
     1318      !! 
     1319 
     1320      INTEGER           ::   idtime, istatus, ix_dim, iy_dim 
    15351321      INTEGER           ::   ji, jj          ! dummy loop indices 
    1536       REAL(wp)          ::   zveldif, zu_res_mean, zv_res_mean, zvelres, zmke, zu, zv ! local scalars 
    1537       REAL(wp)          ::   z1_pglob_area 
     1322      INTEGER           ::   it_inn_file, it_out_file 
     1323      REAL(wp)          ::   zu_res_mean, zv_res_mean, zvel_res_mean                  ! mean residuals of the linear system 
     1324      REAL(wp)          ::   zu_mad, zv_mad, zvel_mad                                 ! mean absolute deviation, sub-iterates 
     1325      REAL(wp)          ::   zu_mad_outer, zv_mad_outer, zvel_mad_outer               ! mean absolute deviation, outer-iterates 
     1326      REAL(wp)          ::   zvel_err_max, zmke, zu, zv                               ! local scalars 
     1327      REAL(wp)          ::   z1_pglob_area                                            ! inverse global ice area 
     1328 
    15381329      REAL(wp), DIMENSION(jpi,jpj) ::   zu_res, zv_res, zvel2                         ! local arrays 
     1330      REAL(wp), DIMENSION(jpi,jpj) ::   zu_diff, zv_diff                              ! local arrays 
    15391331                                                                              
    15401332      CHARACTER(len=20) ::   clname 
    15411333      !!---------------------------------------------------------------------- 
    15421334 
     1335 
    15431336      IF( lwp ) THEN 
     1337 
    15441338         WRITE(numout,*) 
    15451339         WRITE(numout,*) 'rhg_cvg_vp : ice rheology convergence control' 
    15461340         WRITE(numout,*) '~~~~~~~~~~~' 
    1547          WRITE(numout,*) ' kiter    =  : ', kiter 
    1548          WRITE(numout,*) ' kitermax =  : ', kitermax 
     1341         WRITE(numout,*) ' kt          =  : ', kt 
     1342         WRITE(numout,*) ' kitout      =  : ', kitout 
     1343         WRITE(numout,*) ' kitinn      =  : ', kitinn 
     1344         WRITE(numout,*) ' kitinntot   =  : ', kitinntot 
     1345         WRITE(numout,*) ' kitoutmax (nn_vp_nout) =  ', kitoutmax 
     1346         WRITE(numout,*) ' kitinnmax (nn_vp_ninn) =  ', kitinnmax 
     1347         WRITE(numout,*) ' kitinntotmax (nn_nvp)  =  ', kitinntotmax 
     1348         WRITE(numout,*) 
     1349 
    15491350      ENDIF 
    15501351 
     1352      z1_pglob_area = 1._wp / pglob_area      ! inverse global ice area 
     1353 
    15511354      ! create file 
    1552       IF( kt == nit000 .AND. kiter == 1 ) THEN 
     1355      IF( kt == nit000 .AND. kitinntot == 1 ) THEN 
    15531356         ! 
    15541357         IF( lwm ) THEN 
    … …  
    15621365            istatus = NF90_DEF_DIM( ncvgid, 'y'     , jpj, iy_dim ) 
    15631366 
    1564             ! i suggest vel_dif instead 
    1565             istatus = NF90_DEF_VAR( ncvgid, 'u_res'  , NF90_DOUBLE  , (/ idtime /), nvarid_ures ) 
    1566             istatus = NF90_DEF_VAR( ncvgid, 'v_res'  , NF90_DOUBLE  , (/ idtime /), nvarid_vres ) 
    1567             istatus = NF90_DEF_VAR( ncvgid, 'vel_res', NF90_DOUBLE  , (/ idtime /), nvarid_velres ) 
    1568             istatus = NF90_DEF_VAR( ncvgid, 'u_dif'  , NF90_DOUBLE  , (/ idtime /), nvarid_udif ) 
    1569             istatus = NF90_DEF_VAR( ncvgid, 'v_dif'  , NF90_DOUBLE  , (/ idtime /), nvarid_vdif ) 
    1570             istatus = NF90_DEF_VAR( ncvgid, 'vel_dif', NF90_DOUBLE  , (/ idtime /), nvarid_veldif ) 
     1367            istatus = NF90_DEF_VAR( ncvgid, 'u_res'         , NF90_DOUBLE  , (/ idtime /), nvarid_ures ) 
     1368            istatus = NF90_DEF_VAR( ncvgid, 'v_res'         , NF90_DOUBLE  , (/ idtime /), nvarid_vres ) 
     1369            istatus = NF90_DEF_VAR( ncvgid, 'vel_res'       , NF90_DOUBLE  , (/ idtime /), nvarid_velres ) 
     1370 
     1371            istatus = NF90_DEF_VAR( ncvgid, 'uerr_max_sub'  , NF90_DOUBLE  , (/ idtime /), nvarid_uerr_max ) 
     1372            istatus = NF90_DEF_VAR( ncvgid, 'verr_max_sub'  , NF90_DOUBLE  , (/ idtime /), nvarid_verr_max ) 
     1373            istatus = NF90_DEF_VAR( ncvgid, 'velerr_max_sub', NF90_DOUBLE  , (/ idtime /), nvarid_velerr_max ) 
     1374 
     1375            istatus = NF90_DEF_VAR( ncvgid, 'umad_sub'      , NF90_DOUBLE  , (/ idtime /), nvarid_umad ) 
     1376            istatus = NF90_DEF_VAR( ncvgid, 'vmad_sub'      , NF90_DOUBLE  , (/ idtime /), nvarid_vmad ) 
     1377            istatus = NF90_DEF_VAR( ncvgid, 'velmad_sub'    , NF90_DOUBLE  , (/ idtime /), nvarid_velmad ) 
     1378             
     1379            istatus = NF90_DEF_VAR( ncvgid, 'umad_outer'    , NF90_DOUBLE  , (/ idtime /), nvarid_umad_outer   ) 
     1380            istatus = NF90_DEF_VAR( ncvgid, 'vmad_outer'    , NF90_DOUBLE  , (/ idtime /), nvarid_vmad_outer   ) 
     1381            istatus = NF90_DEF_VAR( ncvgid, 'velmad_outer'  , NF90_DOUBLE  , (/ idtime /), nvarid_velmad_outer ) 
     1382 
    15711383            istatus = NF90_DEF_VAR( ncvgid, 'mke_ice', NF90_DOUBLE  , (/ idtime /), nvarid_mke ) 
    15721384 
    1573             istatus = NF90_DEF_VAR( ncvgid, 'u_res_xy', NF90_DOUBLE, (/ ix_dim, iy_dim /), nvarid_ures_xy) 
    1574             istatus = NF90_DEF_VAR( ncvgid, 'v_res_xy', NF90_DOUBLE, (/ ix_dim, iy_dim /), nvarid_vres_xy) 
    1575  
    15761385            istatus = NF90_ENDDEF(ncvgid) 
    15771386 
    … …  
    15801389      ENDIF 
    15811390 
    1582       IF ( lwp ) WRITE(numout,*) ' File created ' 
    1583  
    1584       ! --- Max absolute velocity difference with previous iterate (zveldif) 
    1585       zveldif = MAX( puerr_max, pverr_max ) ! velocity difference with previous iterate, should nearly be equivalent to evp code  
    1586                                             ! if puerrmask and pverrmax are masked at 15% (TEST) 
    1587  
    1588       ! ---  Mean residual and kinetic energy 
    1589       IF ( kiter == 1 ) THEN 
    1590  
    1591          zu_res_mean = 0._wp 
    1592          zv_res_mean = 0._wp 
    1593          zvelres     = 0._wp 
    1594          zmke        = 0._wp 
     1391      !------------------------------------------------------------ 
     1392      ! 
     1393      ! Max absolute velocity difference with previous sub-iterate 
     1394      ! ( zvel_err_max ) 
     1395      ! 
     1396      !------------------------------------------------------------ 
     1397      ! 
     1398      ! This comes from the criterion used to stop the iterative procedure 
     1399      zvel_err_max   = 0.5_wp * ( puerr_max + pverr_max ) ! average of U- and V- maximum error over the whole domain 
     1400 
     1401      !---------------------------------------------- 
     1402      ! 
     1403      ! Mean-absolute-deviation (sub-iterates) 
     1404      ! ( zu_mad, zv_mad, zvel_mad) 
     1405      ! 
     1406      !---------------------------------------------- 
     1407      ! 
     1408      ! U 
     1409      zu_diff(:,:) = 0._wp 
     1410       
     1411      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1412       
     1413         zu_diff(ji,jj) = ABS ( ( pu(ji,jj) - pub(ji,jj) ) ) * e1e2u(ji,jj) * pat_iu(ji,jj) * umask(ji,jj,1) * z1_pglob_area 
     1414       
     1415      END_2D 
     1416       
     1417      ! V 
     1418      zv_diff(:,:)   = 0._wp 
     1419       
     1420      DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1421       
     1422         zv_diff(ji,jj) = ABS ( ( pv(ji,jj) - pvb(ji,jj) ) ) * e1e2v(ji,jj) * pat_iv(ji,jj) * vmask(ji,jj,1) * z1_pglob_area 
     1423       
     1424      END_2D 
     1425 
     1426      ! global sum & U-V average 
     1427      CALL lbc_lnk( 'icedyn_rhg_cvg_vp', zu_diff,  'U',  1., zv_diff , 'V',  1. ) 
     1428      zu_mad   = glob_sum( 'icedyn_rhg_vp : ', zu_diff ) 
     1429      zv_mad   = glob_sum( 'icedyn_rhg_vp : ', zv_diff ) 
     1430 
     1431      zvel_mad = 0.5_wp * ( zu_mad + zv_mad ) 
     1432 
     1433      !----------------------------------------------- 
     1434      ! 
     1435      ! Mean-absolute-deviation (outer-iterates) 
     1436      ! ( zu_mad_outer, zv_mad_outer, zvel_mad_outer) 
     1437      ! 
     1438      !----------------------------------------------- 
     1439      ! 
     1440      IF ( kitinn == kitinnmax ) THEN ! only work at the end of outer iterates  
     1441 
     1442         ! * U 
     1443         zu_diff(:,:) = 0._wp 
     1444          
     1445         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1446          
     1447            zu_diff(ji,jj) = ABS ( ( pu(ji,jj) - pub_outer(ji,jj) ) ) * e1e2u(ji,jj) * pat_iu(ji,jj) * umask(ji,jj,1) * & 
     1448                              &    z1_pglob_area 
     1449                               
     1450         END_2D 
     1451          
     1452         ! * V 
     1453         zv_diff(:,:)   = 0._wp 
     1454          
     1455         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1456          
     1457            zv_diff(ji,jj) = ABS ( ( pv(ji,jj) - pvb_outer(ji,jj) ) ) * e1e2v(ji,jj) * pat_iv(ji,jj) * vmask(ji,jj,1) * & 
     1458                              &    z1_pglob_area 
     1459          
     1460         END_2D 
     1461          
     1462         ! Global ice-concentration, grid-cell-area weighted mean 
     1463         CALL lbc_lnk( 'icedyn_rhg_cvg_vp', zu_diff,  'U',  1., zv_diff , 'V',  1. ) ! abs behaves as a scalar no ? 
     1464 
     1465         zu_mad_outer   = glob_sum( 'icedyn_rhg_vp : ', zu_diff ) 
     1466         zv_mad_outer   = glob_sum( 'icedyn_rhg_vp : ', zv_diff ) 
     1467    
     1468         ! Average of both U & V 
     1469         zvel_mad_outer = 0.5_wp * ( zu_mad_outer + zv_mad_outer ) 
     1470                   
     1471      ENDIF 
     1472 
     1473      ! --- Spatially-resolved absolute difference to send back to main routine  
     1474      ! (last iteration only, T-point) 
     1475 
     1476      IF ( kitinntot == kitinntotmax) THEN 
     1477 
     1478         zu_diff(:,:) = 0._wp 
     1479         zv_diff(:,:) = 0._wp 
     1480 
     1481         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1482 
     1483               zu_diff(ji,jj) = ( ABS ( ( pu(ji-1,jj) - pub_outer(ji-1,jj) ) ) * umask(ji-1,jj,1) & 
     1484    &                           + ABS ( ( pu(ji,jj  ) - pub_outer(ji,jj)   ) ) * umask(ji,jj,1) ) & 
     1485    &                           / ( umask(ji-1,jj,1) + umask(ji,jj,1) ) 
     1486 
     1487               zv_diff(ji,jj) = ( ABS ( ( pv(ji,jj-1)   - pvb_outer(ji,jj-1) ) ) * vmask(ji,jj-1,1) & 
     1488    &                           + ABS ( ( pv(ji,jj  ) - pvb_outer(ji,jj)     ) ) * vmask(ji,jj,1)   & 
     1489    &                           / ( vmask(ji,jj-1,1) + vmask(ji,jj,1) ) ) 
     1490      
     1491    
     1492         END_2D 
     1493          
     1494         CALL lbc_lnk( 'icedyn_rhg_cvg_vp', zu_diff,  'T',  1., zv_diff , 'T',  1. ) 
     1495         pvel_diff(:,:) = 0.5_wp * ( zu_diff(:,:) + zv_diff(:,:) ) 
    15951496 
    15961497      ELSE 
    15971498 
    1598       ! -- Mean residual (N/m^2), zu_res_mean 
    1599       ! Here we take the residual of the linear system (N/m^2),  
    1600       ! We define it as in mitgcm: square-root of area-weighted mean square residual 
    1601       ! Local residual r = Ax - B expresses to which extent the momentum balance is verified  
    1602       ! i.e., how close we are to a solution 
    1603  
    1604       IF ( lwp ) WRITE(numout,*) ' TEST 1 '  
    1605  
    1606       z1_pglob_area = 1._wp / pglob_area 
    1607  
    1608       zu_res(:,:) = 0._wp; zv_res(:,:) = 0._wp 
    1609  
    1610       DO jj = 2, jpj - 1 
    1611          DO ji = 2, jpi - 1                                       
    1612             zu_res(ji,jj)  = ( prhsu(ji,jj) + pDU(ji,jj) * pu(ji,jj-1) + pEU(ji,jj) * pu(ji,jj+1)               & 
    1613                &             - pAU(ji,jj) * pu(ji-1,jj) - pBU(ji,jj) * pu(ji,jj) - pCU(ji,jj) * pu(ji+1,jj) ) 
    1614                             
    1615             zv_res(ji,jj)  = ( prhsv(ji,jj) + pDV(ji,jj) * pv(ji-1,jj) + pEV(ji,jj) * pv(ji+1,jj)               & 
    1616                &             - pAV(ji,jj) * pv(ji,jj-1) - pBV(ji,jj) * pv(ji,jj) - pCV(ji,jj) * pv(ji,jj+1) ) 
    1617  
    1618             zu_res(ji,jj)  = SQRT( zu_res(ji,jj) * zu_res(ji,jj) ) * umask(ji,jj,1) * e1e2u(ji,jj) * z1_pglob_area 
    1619             zv_res(ji,jj)  = SQRT( zv_res(ji,jj) * zv_res(ji,jj) ) * vmask(ji,jj,1) * e1e2v(ji,jj) * z1_pglob_area 
    1620  
    1621          END DO 
    1622       END DO                   
    1623  
    1624       IF ( lwp ) WRITE(numout,*) ' TEST 2 '  
    1625       zu_res_mean = glob_sum( 'ice_rhg_vp', zu_res(:,:) ) 
    1626       zv_res_mean = glob_sum( 'ice_rhg_vp', zv_res(:,:) ) 
    1627       IF ( lwp ) WRITE(numout,*) ' TEST 3 '  
    1628       zvelres     = 0.5_wp * ( zu_res_mean + zv_res_mean ) 
    1629  
    1630       IF ( lwp ) WRITE(numout,*) ' TEST 4 '  
    1631                                            
    1632       ! -- Global mean kinetic energy per unit area (J/m2) 
    1633       zvel2(:,:) = 0._wp 
    1634       DO jj = 2, jpj - 1 
    1635          DO ji = 2, jpi - 1                    
    1636             zu     = 0.5_wp * ( pu(ji-1,jj) + pu(ji,jj) ) ! u-vel at T-point 
    1637             zv     = 0.5_wp * ( pv(ji,jj-1) + pv(ji,jj) ) 
    1638             zvel2(ji,jj)  = zu*zu + zv*zv              ! square of ice velocity at T-point   
    1639          END DO 
    1640       END DO 
    1641         
    1642       IF ( lwp ) WRITE(numout,*) ' TEST 5 '  
    1643  
    1644       zmke = 0.5_wp * glob_sum( 'ice_rhg_vp', pmt(:,:) * e1e2t(:,:) * zvel2(:,:) ) / pglob_area 
    1645  
    1646       IF ( lwp ) WRITE(numout,*) ' TEST 6 ' 
    1647  
    1648       ENDIF ! kiter 
     1499         pvel_diff(:,:) = 0._wp 
     1500 
     1501      ENDIF 
     1502 
     1503      !--------------------------------------- 
     1504      ! 
     1505      ! ---  Mean residual & kinetic energy 
     1506      ! 
     1507      !--------------------------------------- 
     1508 
     1509      IF ( kitinntot == 1 ) THEN 
     1510 
     1511         zu_res_mean   = 0._wp 
     1512         zv_res_mean   = 0._wp 
     1513         zvel_res_mean = 0._wp 
     1514         zmke          = 0._wp 
     1515 
     1516      ELSE 
     1517 
     1518         ! * Mean residual (N/m2) 
     1519         ! Here we take the residual of the linear system (N/m2),  
     1520         ! We define it as in mitgcm: global area-weighted mean of square-root residual 
     1521         ! Local residual r = Ax - B expresses to which extent the momentum balance is verified  
     1522         ! i.e., how close we are to a solution 
     1523         zu_res(:,:) = 0._wp; zv_res(:,:) = 0._wp 
     1524          
     1525         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1526 
     1527               zu_res(ji,jj)  = ( prhsu(ji,jj) + pDU(ji,jj) * pu(ji,jj-1) + pEU(ji,jj) * pu(ji,jj+1)               & 
     1528                  &             - pAU(ji,jj) * pu(ji-1,jj) - pBU(ji,jj) * pu(ji,jj) - pCU(ji,jj) * pu(ji+1,jj) ) 
     1529               zv_res(ji,jj)  = ( prhsv(ji,jj) + pDV(ji,jj) * pv(ji-1,jj) + pEV(ji,jj) * pv(ji+1,jj)               & 
     1530                  &             - pAV(ji,jj) * pv(ji,jj-1) - pBV(ji,jj) * pv(ji,jj) - pCV(ji,jj) * pv(ji,jj+1) ) 
     1531 
     1532!              zu_res(ji,jj)  = pFU(ji,jj) - pAU(ji,jj) * pu(ji-1,jj) - pBU(ji,jj) * pu(ji,jj) - pCU(ji,jj) * pu(ji+1,jj) 
     1533!              zv_res(ji,jj)  = pFV(ji,jj) - pAV(ji,jj) * pv(ji,jj-1) - pBV(ji,jj) * pv(ji,jj) - pCV(ji,jj) * pv(ji,jj+1) 
     1534    
     1535               zu_res(ji,jj)  = SQRT( zu_res(ji,jj) * zu_res(ji,jj) ) * umask(ji,jj,1) * pat_iu(ji,jj) * e1e2u(ji,jj) * z1_pglob_area 
     1536               zv_res(ji,jj)  = SQRT( zv_res(ji,jj) * zv_res(ji,jj) ) * vmask(ji,jj,1) * pat_iv(ji,jj) * e1e2v(ji,jj) * z1_pglob_area 
     1537    
     1538         END_2D 
     1539          
     1540         ! Global ice-concentration, grid-cell-area weighted mean 
     1541         CALL lbc_lnk( 'icedyn_rhg_cvg_vp', zu_res,  'U', 1., zv_res , 'V', 1. ) 
     1542    
     1543         zu_res_mean   = glob_sum( 'ice_rhg_vp', zu_res(:,:) ) 
     1544         zv_res_mean   = glob_sum( 'ice_rhg_vp', zv_res(:,:) ) 
     1545         zvel_res_mean = 0.5_wp * ( zu_res_mean + zv_res_mean ) 
     1546    
     1547         ! --- Global mean kinetic energy per unit area (J/m2) 
     1548         zvel2(:,:) = 0._wp 
     1549 
     1550         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
    16491551                   
    1650          !                                                ! ==================== ! 
    1651  
    1652       ! time 
    1653       it = ( kt - 1 ) * kitermax + kiter 
    1654  
    1655  
     1552               zu     = 0.5_wp * ( pu(ji-1,jj) + pu(ji,jj) ) ! u-vel at T-point 
     1553               zv     = 0.5_wp * ( pv(ji,jj-1) + pv(ji,jj) ) 
     1554               zvel2(ji,jj)  = zu*zu + zv*zv              ! square of ice velocity at T-point   
     1555 
     1556         END_2D 
     1557                    
     1558         zmke = 0.5_wp * glob_sum( 'ice_rhg_vp', pmt(:,:) * e1e2t(:,:) * zvel2(:,:) ) / pglob_area 
     1559    
     1560      ENDIF ! kitinntot 
     1561 
     1562      !--- Spatially-resolved residual at last iteration to send back to main routine (last iteration only) 
     1563      !--- Calculation @T-point 
     1564 
     1565      IF ( kitinntot == kitinntotmax) THEN 
     1566 
     1567         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1568 
     1569               zu_res(ji,jj)  = ( prhsu(ji,jj) + pDU(ji,jj) * pu(ji,jj-1) + pEU(ji,jj) * pu(ji,jj+1)               & 
     1570                  &             - pAU(ji,jj) * pu(ji-1,jj) - pBU(ji,jj) * pu(ji,jj) - pCU(ji,jj) * pu(ji+1,jj) ) 
     1571               zv_res(ji,jj)  = ( prhsv(ji,jj) + pDV(ji,jj) * pv(ji-1,jj) + pEV(ji,jj) * pv(ji+1,jj)               & 
     1572                  &             - pAV(ji,jj) * pv(ji,jj-1) - pBV(ji,jj) * pv(ji,jj) - pCV(ji,jj) * pv(ji,jj+1) ) 
     1573 
     1574               zu_res(ji,jj)  = SQRT( zu_res(ji,jj) * zu_res(ji,jj) ) * umask(ji,jj,1)  
     1575               zv_res(ji,jj)  = SQRT( zv_res(ji,jj) * zv_res(ji,jj) ) * vmask(ji,jj,1)  
     1576 
     1577         END_2D 
     1578          
     1579         CALL lbc_lnk( 'icedyn_rhg_cvg_vp', zu_res,  'U',  1., zv_res , 'V',  1. ) 
     1580 
     1581         DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2->jpj-1; 2->jpi-1 
     1582          
     1583               pvel_res(ji,jj) = 0.25_wp * ( zu_res(ji-1,jj) + zu_res(ji,jj) + zv_res(ji,jj-1) + zv_res(ji,jj) ) 
     1584          
     1585         END_2D 
     1586         CALL lbc_lnk( 'icedyn_rhg_cvg_vp', pvel_res, 'T', 1. ) 
     1587 
     1588      ELSE 
     1589 
     1590         pvel_res(:,:) = 0._wp 
     1591 
     1592      ENDIF 
     1593                   
     1594      !                                                ! ==================== ! 
     1595 
     1596      it_inn_file =  ( kt - nit000 ) * kitinntotmax + kitinntot ! time step in the file 
     1597      it_out_file =  ( kt - nit000 ) * kitoutmax    + kitout 
     1598 
     1599      ! write variables 
    16561600      IF( lwm ) THEN 
    1657          ! write variables 
    1658          istatus = NF90_PUT_VAR( ncvgid, nvarid_ures, (/zu_res_mean/), (/it/), (/1/) ) ! U-residual of the linear system 
    1659          istatus = NF90_PUT_VAR( ncvgid, nvarid_vres, (/zv_res_mean/), (/it/), (/1/) ) ! V-residual of the linear system 
    1660          istatus = NF90_PUT_VAR( ncvgid, nvarid_velres, (/zvelres/), (/it/), (/1/) )   ! average of u- and v- residuals 
    1661          istatus = NF90_PUT_VAR( ncvgid, nvarid_udif, (/puerr_max/), (/it/), (/1/) )   ! max U velocity difference, inner iterations 
    1662          istatus = NF90_PUT_VAR( ncvgid, nvarid_vdif, (/pverr_max/), (/it/), (/1/) )   ! max V velocity difference, inner iterations 
    1663          istatus = NF90_PUT_VAR( ncvgid, nvarid_veldif, (/zveldif/), (/it/), (/1/) )   ! max U or V velocity diff between subiterations 
    1664          istatus = NF90_PUT_VAR( ncvgid, nvarid_mke, (/zmke/), (/it/), (/1/) )         ! mean kinetic energy 
    1665  
    1666          ! 
    1667          IF ( kiter == kitermax ) THEN 
    1668             WRITE(numout,*) ' Should plot the spatially dependent residual ' 
    1669             istatus = NF90_PUT_VAR( ncvgid, nvarid_ures_xy, (/zu_res/) )          ! U-residual, spatially dependent 
    1670             istatus = NF90_PUT_VAR( ncvgid, nvarid_vres_xy, (/zv_res/) )          ! V-residual, spatially dependent 
     1601 
     1602         istatus = NF90_PUT_VAR( ncvgid, nvarid_ures  , (/zu_res_mean/), (/it_inn_file/), (/1/) )        ! Residuals of the linear system, area weighted mean 
     1603         istatus = NF90_PUT_VAR( ncvgid, nvarid_vres  , (/zv_res_mean/), (/it_inn_file/), (/1/) )        ! 
     1604         istatus = NF90_PUT_VAR( ncvgid, nvarid_velres, (/zvel_res_mean/), (/it_inn_file/), (/1/) )      ! 
     1605 
     1606         istatus = NF90_PUT_VAR( ncvgid, nvarid_uerr_max  , (/puerr_max/), (/it_inn_file/), (/1/) )      ! Max velocit_inn_filey error, sub-it_inn_fileerates 
     1607         istatus = NF90_PUT_VAR( ncvgid, nvarid_verr_max  , (/pverr_max/), (/it_inn_file/), (/1/) )      !  
     1608         istatus = NF90_PUT_VAR( ncvgid, nvarid_velerr_max, (/zvel_err_max/), (/it_inn_file/), (/1/) )   !  
     1609 
     1610         istatus = NF90_PUT_VAR( ncvgid, nvarid_umad    , (/zu_mad/)  , (/it_inn_file/), (/1/) )         ! velocit_inn_filey MAD, area/sic-weighted, sub-it_inn_fileerates 
     1611         istatus = NF90_PUT_VAR( ncvgid, nvarid_vmad    , (/zv_mad/)  , (/it_inn_file/), (/1/) )         !  
     1612         istatus = NF90_PUT_VAR( ncvgid, nvarid_velmad  , (/zvel_mad/), (/it_inn_file/), (/1/) )         !  
     1613 
     1614         istatus = NF90_PUT_VAR( ncvgid, nvarid_mke, (/zmke/), (/kitinntot/), (/1/) )                    ! mean kinetic energy 
     1615 
     1616         IF ( kitinn == kitinnmax ) THEN ! only print outer mad at the end of inner loop 
     1617 
     1618            istatus = NF90_PUT_VAR( ncvgid, nvarid_umad_outer    , (/zu_mad_outer/)  , (/it_out_file/), (/1/) )   ! velocity MAD, area/sic-weighted, outer-iterates 
     1619            istatus = NF90_PUT_VAR( ncvgid, nvarid_vmad_outer    , (/zv_mad_outer/)  , (/it_out_file/), (/1/) )   ! 
     1620            istatus = NF90_PUT_VAR( ncvgid, nvarid_velmad_outer  , (/zvel_mad_outer/), (/it_out_file/), (/1/) )   ! 
     1621 
    16711622         ENDIF 
    16721623 
    1673          ! close file 
    1674          IF( kt == nitend )   istatus = NF90_CLOSE( ncvgid ) 
     1624         IF( kt == nitend - nn_fsbc + 1 .AND. kitinntot == kitinntotmax )    istatus = NF90_CLOSE( ncvgid ) 
    16751625      ENDIF 
    16761626       

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/iceistate.F90

    r14143 r15548  
    7575   INTEGER , PARAMETER ::   jp_hld = 10          ! index of pnd lid depth    (m) 
    7676   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   si  ! structure of input fields (file informations, fields read) 
    77  
     77   ! 
     78#if defined key_agrif 
     79   REAL(wp), PUBLIC ::   rsshadj   !: initial mean ssh adjustment due to initial ice+snow mass 
     80#endif 
     81   ! 
    7882   !! * Substitutions 
    7983#  include "do_loop_substitute.h90" 
    … …  
    108112      ! 
    109113      INTEGER  ::   ji, jj, jk, jl         ! dummy loop indices 
    110       REAL(wp) ::   ztmelts 
     114      REAL(wp) ::   ztmelts, zsshadj, area 
    111115      INTEGER , DIMENSION(4)           ::   itest 
    112116      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d 
    … …  
    308312            ! select ice covered grid points 
    309313            npti = 0 ; nptidx(:) = 0 
    310             DO_2D( 1, 1, 1, 1 ) 
     314            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    311315               IF ( zht_i_ini(ji,jj) > 0._wp ) THEN 
    312316                  npti         = npti  + 1 
    … …  
    363367            CALL ice_var_salprof ! for sz_i 
    364368            DO jl = 1, jpl 
    365                DO_2D( 1, 1, 1, 1 ) 
     369               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    366370                  v_i (ji,jj,jl) = h_i(ji,jj,jl) * a_i(ji,jj,jl) 
    367371                  v_s (ji,jj,jl) = h_s(ji,jj,jl) * a_i(ji,jj,jl) 
    … …  
    371375            ! 
    372376            DO jl = 1, jpl 
    373                DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     377               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    374378                  t_s(ji,jj,jk,jl) = zts_3d(ji,jj,jl) 
    375379                  e_s(ji,jj,jk,jl) = zswitch(ji,jj) * v_s(ji,jj,jl) * r1_nlay_s * & 
    … …  
    379383            ! 
    380384            DO jl = 1, jpl 
    381                DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     385               DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    382386                  t_i (ji,jj,jk,jl) = zti_3d(ji,jj,jl)  
    383387                  ztmelts          = - rTmlt * sz_i(ji,jj,jk,jl) + rt0 ! melting temperature in K 
    … …  
    414418      ENDIF ! ln_iceini 
    415419      ! 
    416       !---------------------------------------------- 
    417       ! 4) Snow-ice mass (case ice is fully embedded) 
    418       !---------------------------------------------- 
     420      !---------------------------------------------------------- 
     421      ! 4) Adjust ssh and vertical scale factors to snow-ice mass 
     422      !---------------------------------------------------------- 
    419423      snwice_mass  (:,:) = tmask(:,:,1) * SUM( rhos * v_s + rhoi * v_i + rhow * ( v_ip + v_il ), dim=3  )   ! snow+ice mass 
    420424      snwice_mass_b(:,:) = snwice_mass(:,:) 
    421425      ! 
    422426      IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    423          ! 
     427         !                              ! ---------------- 
    424428         ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rho0 
    425429         ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rho0 
    426430         ! 
     431      ELSE                              ! levitating sea-ice: deplete the initial ssh over the whole domain 
     432         !                              ! ------------------ 
     433         area    = glob_sum( 'iceistate', e1e2t(:,:) * ssmask(:,:) ) 
     434         zsshadj = glob_sum( 'iceistate', snwice_mass(:,:) * r1_rho0 * e1e2t(:,:) ) / area 
     435#if defined key_agrif 
     436         ! Override ssh adjustment in nested domains by the root-domain ssh adjustment; 
     437         ! store the adjustment value in a global module variable to make it retrievable in nested domains 
     438         IF( .NOT.Agrif_Root() ) THEN 
     439            IF  (.NOT.ln_init_chfrpar ) THEN   ! child is not initialized from the parent 
     440               zsshadj = Agrif_Parent(rsshadj) 
     441            ELSE                               ! child is     initialized from the parent 
     442               zsshadj = 0._wp                 ! => 0 since ssh adjustement is already done 
     443            ENDIF 
     444         ELSE 
     445            rsshadj = zsshadj 
     446         ENDIF 
     447#endif 
     448         IF(lwp) WRITE(numout,'(A23,F10.6,A20)') ' sea level adjusted by ', -zsshadj, ' m to compensate for' 
     449         IF(lwp) WRITE(numout,*) ' the initial snow+ice mass' 
     450         ! 
     451         WHERE( ssmask(:,:) == 1._wp ) 
     452            ssh(:,:,Kmm) = ssh(:,:,Kmm) - zsshadj 
     453            ssh(:,:,Kbb) = ssh(:,:,Kbb) - zsshadj 
     454         ENDWHERE 
     455         ! 
     456      ENDIF 
     457      ! 
     458      IF( .NOT.ln_linssh ) THEN 
    427459#if defined key_qco 
    428          IF( .NOT.ln_linssh )   CALL dom_qco_zgr( Kbb, Kmm )        ! upadte of r3=ssh/h0 ratios 
     460         CALL dom_qco_zgr( Kbb, Kmm )        ! upadte of r3=ssh/h0 ratios 
    429461#elif defined key_linssh 
    430          !                                                          ! fix in time coord. : no update of vertical coord. 
     462         !                                   ! Fix in time : key_linssh case, set through domzgr_substitute.h90 
    431463#else 
    432          IF( .NOT.ln_linssh )   CALL dom_vvl_zgr( Kbb, Kmm, Kaa )   ! interpolation scale factor, depth and water column 
     464         DO jk = 1, jpk 
     465            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls) 
     466               IF( snwice_mass(ji,jj) /= 0._wp ) THEN 
     467                  e3t(ji,jj,jk,Kmm) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kmm) * r1_ht_0(ji,jj) * tmask(ji,jj,jk) ) 
     468                  e3t(ji,jj,jk,Kbb) = e3t_0(ji,jj,jk) * ( 1._wp + ssh(ji,jj,Kbb) * r1_ht_0(ji,jj) * tmask(ji,jj,jk) ) 
     469               ENDIF 
     470            END_2D 
     471         END DO 
     472         ! 
     473         CALL dom_vvl_zgr( Kbb, Kmm, Kaa )   ! interpolation of scale factor, depth and water column 
    433474#endif 
    434  
    435475      ENDIF 
    436  
     476      ! 
    437477      !!clem: output of initial state should be written here but it is impossible because 
    438478      !!      the ocean and ice are in the same file 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/iceitd.F90

    r14072 r15548  
    101101      ! 
    102102      npti = 0   ;   nptidx(:) = 0 
    103       DO_2D( 1, 1, 1, 1 ) 
     103      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    104104         IF ( at_i(ji,jj) > epsi10 ) THEN 
    105105            npti = npti + 1 
    … …  
    378378            ! 
    379379            ! Compute coefficients of g(eta) = g0 + g1*eta 
    380             zdhr = 1._wp / (phR(ji) - phL(ji)) 
     380            IF( phR(ji) > phL(ji) ) THEN   ;   zdhr = 1._wp / (phR(ji) - phL(ji)) 
     381            ELSE                           ;   zdhr = 0._wp ! if hR=hL=hice => no remapping 
     382            ENDIF 
     383            !!zdhr = 1._wp / (phR(ji) - phL(ji)) 
    381384            zwk1 = 6._wp * paice(ji) * zdhr 
    382385            zwk2 = ( phice(ji) - phL(ji) ) * zdhr 
    … …  
    624627         !                    !--------------------------------------- 
    625628         npti = 0   ;   nptidx(:) = 0 
    626          DO_2D( 1, 1, 1, 1 ) 
     629         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    627630            IF( a_i(ji,jj,jl) > 0._wp .AND. v_i(ji,jj,jl) > (a_i(ji,jj,jl) * hi_max(jl)) ) THEN 
    628631               npti = npti + 1 
    … …  
    660663         !                    !----------------------------------------- 
    661664         npti = 0 ; nptidx(:) = 0 
    662          DO_2D( 1, 1, 1, 1 ) 
     665         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    663666            IF( a_i(ji,jj,jl+1) > 0._wp .AND. v_i(ji,jj,jl+1) <= (a_i(ji,jj,jl+1) * hi_max(jl)) ) THEN 
    664667               npti = npti + 1 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icesbc.F90

    r14433 r15548  
    109109      !!                dqns_ice                                 = non solar  heat sensistivity                  [W/m2] 
    110110      !!                qemp_oce, qemp_ice, qprec_ice, qevap_ice = sensible heat (associated with evap & precip) [W/m2] 
     111      !!            + these fields 
     112      !!                qsb_ice_bot                              = sensible heat at the ice bottom               [W/m2] 
     113      !!                fhld, qlead                              = heat budget in the leads                      [W/m2] 
    111114      !!            + some fields that are not used outside this module: 
    112115      !!                qla_ice                                  = latent heat flux over ice                     [W/m2] 
    … …  
    117120      INTEGER, INTENT(in) ::   kt     ! ocean time step 
    118121      INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk or Pure Coupled) 
    119       ! 
    120       INTEGER  ::   ji, jj, jl      ! dummy loop index 
    121       REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
    122       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zalb, zmsk00      ! 2D workspace 
    123122      !!-------------------------------------------------------------------- 
    124123      ! 
    … …  
    130129         WRITE(numout,*)'~~~~~~~~~~~~~~~' 
    131130      ENDIF 
    132  
    133       ! get missing value from xml 
    134       CALL iom_miss_val( "icetemp", zmiss_val ) 
    135  
    136       ! --- ice albedo --- ! 
     131      !                     !== ice albedo ==! 
    137132      CALL ice_alb( t_su, h_i, h_s, ln_pnd_alb, a_ip_eff, h_ip, cloud_fra, alb_ice ) 
    138  
    139133      ! 
    140134      SELECT CASE( ksbc )   !== fluxes over sea ice ==! 
    … …  
    142136      CASE( jp_usr )              !--- user defined formulation 
    143137                                  CALL usrdef_sbc_ice_flx( kt, h_s, h_i ) 
    144       CASE( jp_blk, jp_abl )  !--- bulk formulation & ABL formulation 
     138      CASE( jp_blk, jp_abl )      !--- bulk formulation & ABL formulation 
    145139                                  CALL blk_ice_2    ( t_su, h_s, h_i, alb_ice, & 
    146140            &                                         theta_air_zt(:,:), q_air_zt(:,:),    &   ! #LB: known from "sbc_oce" module... 
    147141            &                                         sf(jp_slp)%fnow(:,:,1), sf(jp_qlw)%fnow(:,:,1), & 
    148142            &                                         sf(jp_prec)%fnow(:,:,1), sf(jp_snow)%fnow(:,:,1) ) 
    149          IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
     143         IF( ln_mixcpl        )   CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    150144         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
    151145         !                        !    compute conduction flux and surface temperature (as in Jules surface module) 
    … …  
    153147            &                     CALL blk_ice_qcn    ( ln_virtual_itd, t_su, t_bo, h_s, h_i ) 
    154148      CASE ( jp_purecpl )         !--- coupled formulation 
    155                                   CALL sbc_cpl_ice_flx( picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
     149                                  CALL sbc_cpl_ice_flx( kt, picefr=at_i_b, palbi=alb_ice, psst=sst_m, pist=t_su, phs=h_s, phi=h_i ) 
    156150         IF( nn_flxdist /= -1 )   CALL ice_flx_dist   ( t_su, alb_ice, qns_ice, qsr_ice, dqns_ice, evap_ice, devap_ice, nn_flxdist ) 
    157151      END SELECT 
    158  
    159       !--- output ice albedo and surface albedo ---! 
    160       IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN 
    161  
    162          ALLOCATE( zalb(jpi,jpj), zmsk00(jpi,jpj) ) 
    163  
    164          WHERE( at_i_b < 1.e-03 ) 
    165             zmsk00(:,:) = 0._wp 
    166             zalb  (:,:) = rn_alb_oce 
    167          ELSEWHERE 
    168             zmsk00(:,:) = 1._wp 
    169             zalb  (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
    170          END WHERE 
    171          ! ice albedo 
    172          CALL iom_put( 'icealb' , zalb * zmsk00 + zmiss_val * ( 1._wp - zmsk00 ) ) 
    173          ! ice+ocean albedo 
    174          zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 
    175          CALL iom_put( 'albedo' , zalb ) 
    176  
    177          DEALLOCATE( zalb, zmsk00 ) 
    178  
    179       ENDIF 
     152      !                     !== some fluxes at the ice-ocean interface and in the leads 
     153      CALL ice_flx_other 
    180154      ! 
    181155      IF( ln_timing )   CALL timing_stop('icesbc') 
    … …  
    270244 
    271245 
     246   SUBROUTINE ice_flx_other 
     247      !!----------------------------------------------------------------------- 
     248      !!                   ***  ROUTINE ice_flx_other *** 
     249      !! 
     250      !! ** Purpose :   prepare necessary fields for thermo calculations 
     251      !! 
     252      !! ** Inputs  :   u_ice, v_ice, ssu_m, ssv_m, utau, vtau 
     253      !!                frq_m, qsr_oce, qns_oce, qemp_oce, e3t_m, sst_m 
     254      !! ** Outputs :   qsb_ice_bot, fhld, qlead 
     255      !!----------------------------------------------------------------------- 
     256      INTEGER  ::   ji, jj             ! dummy loop indices 
     257      REAL(wp) ::   zfric_u, zqld, zqfr, zqfr_neg, zqfr_pos, zu_io, zv_io, zu_iom1, zv_iom1 
     258      REAL(wp), PARAMETER ::   zfric_umin = 0._wp       ! lower bound for the friction velocity (cice value=5.e-04) 
     259      REAL(wp), PARAMETER ::   zch        = 0.0057_wp   ! heat transfer coefficient 
     260      REAL(wp), DIMENSION(jpi,jpj) ::  zfric, zvel      ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
     261      !!----------------------------------------------------------------------- 
     262      ! 
     263      ! computation of friction velocity at T points 
     264      IF( ln_icedyn ) THEN 
     265         DO_2D( 0, 0, 0, 0 ) 
     266            zu_io   = u_ice(ji  ,jj  ) - ssu_m(ji  ,jj  ) 
     267            zu_iom1 = u_ice(ji-1,jj  ) - ssu_m(ji-1,jj  ) 
     268            zv_io   = v_ice(ji  ,jj  ) - ssv_m(ji  ,jj  ) 
     269            zv_iom1 = v_ice(ji  ,jj-1) - ssv_m(ji  ,jj-1) 
     270            ! 
     271            zfric(ji,jj) = rn_cio * ( 0.5_wp * ( zu_io*zu_io + zu_iom1*zu_iom1 + zv_io*zv_io + zv_iom1*zv_iom1 ) ) * tmask(ji,jj,1) 
     272            zvel (ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj  ) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj  ) + u_ice(ji,jj) ) + & 
     273               &                          ( v_ice(ji  ,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji  ,jj-1) + v_ice(ji,jj) ) ) 
     274         END_2D 
     275      ELSE      !  if no ice dynamics => transfer directly the atmospheric stress to the ocean 
     276         DO_2D( 0, 0, 0, 0 ) 
     277            zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp *  & 
     278               &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
     279               &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
     280            zvel(ji,jj) = 0._wp 
     281         END_2D 
     282      ENDIF 
     283      CALL lbc_lnk( 'icesbc', zfric, 'T',  1.0_wp, zvel, 'T', 1.0_wp ) 
     284      ! 
     285      !--------------------------------------------------------------------! 
     286      ! Partial computation of forcing for the thermodynamic sea ice model 
     287      !--------------------------------------------------------------------! 
     288      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )   ! needed for qlead 
     289         rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
     290         ! 
     291         ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
     292         zqld =  tmask(ji,jj,1) * rDt_ice *  & 
     293            &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
     294            &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
     295 
     296         ! --- Energy needed to bring ocean surface layer until its freezing, zqfr is defined everywhere (J.m-2) --- ! 
     297         !     (mostly<0 but >0 if supercooling) 
     298         zqfr     = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
     299         zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
     300         zqfr_pos = MAX( zqfr , 0._wp )                                                                    ! only > 0 
     301 
     302         ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 
     303         !     (mostly>0 but <0 if supercooling) 
     304         zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
     305         qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 
     306 
     307         ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
     308         !                              the freezing point, so that we do not have SST < T_freeze 
     309         !                              This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg 
     310         !                              The following formulation is ok for both normal conditions and supercooling 
     311         qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
     312 
     313         ! If conditions are always supercooled (such as at the mouth of ice-shelves), then ice grows continuously 
     314         ! ==> stop ice formation by artificially setting up the turbulent fluxes to 0 when volume > 20m (arbitrary) 
     315         IF( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) > 0._wp .AND. vt_i(ji,jj) >= 20._wp ) THEN 
     316            zqfr               = 0._wp 
     317            zqfr_pos           = 0._wp 
     318            qsb_ice_bot(ji,jj) = 0._wp 
     319         ENDIF 
     320         ! 
     321         ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 
     322         !     qlead is the energy received from the atm. in the leads. 
     323         !     If warming (zqld >= 0), then the energy in the leads is used to melt ice (bottom melting) => fhld  (W/m2) 
     324         !     If cooling (zqld <  0), then the energy in the leads is used to grow ice in open water    => qlead (J.m-2) 
     325         IF( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
     326            ! upper bound for fhld: fhld should be equal to zqld 
     327            !                        but we have to make sure that this heat will not make the sst drop below the freezing point 
     328            !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr_pos 
     329            !                        The following formulation is ok for both normal conditions and supercooling 
     330            fhld (ji,jj) = rswitch * MAX( 0._wp, ( zqld - zqfr_pos ) * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) &  ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
     331               &                                 - qsb_ice_bot(ji,jj) ) 
     332            qlead(ji,jj) = 0._wp 
     333         ELSE 
     334            fhld (ji,jj) = 0._wp 
     335            ! upper bound for qlead: qlead should be equal to zqld 
     336            !                        but before using this heat for ice formation, we suppose that the ocean cools down till the freezing point. 
     337            !                        The energy for this cooling down is zqfr. Also some heat will be removed from the ocean from turbulent fluxes (qsb) 
     338            !                        and freezing point is reached if zqfr = zqld - qsb*a/dt 
     339            !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr 
     340            !                        The following formulation is ok for both normal conditions and supercooling 
     341            qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rDt_ice ) - zqfr ) 
     342         ENDIF 
     343         ! 
     344         ! If ice is landfast and ice concentration reaches its max 
     345         ! => stop ice formation in open water 
     346         IF(  zvel(ji,jj) <= 5.e-04_wp .AND. at_i(ji,jj) >= rn_amax_2d(ji,jj)-epsi06 )   qlead(ji,jj) = 0._wp 
     347         ! 
     348         ! If the grid cell is almost fully covered by ice (no leads) 
     349         ! => stop ice formation in open water 
     350         IF( at_i(ji,jj) >= (1._wp - epsi10) )   qlead(ji,jj) = 0._wp 
     351         ! 
     352         ! If ln_leadhfx is false 
     353         ! => do not use energy of the leads to melt sea-ice 
     354         IF( .NOT.ln_leadhfx )   fhld(ji,jj) = 0._wp 
     355         ! 
     356      END_2D 
     357 
     358      ! In case we bypass open-water ice formation 
     359      IF( .NOT. ln_icedO )  qlead(:,:) = 0._wp 
     360      ! In case we bypass growing/melting from top and bottom 
     361      IF( .NOT. ln_icedH ) THEN 
     362         qsb_ice_bot(:,:) = 0._wp 
     363         fhld       (:,:) = 0._wp 
     364      ENDIF 
     365       
     366   END SUBROUTINE ice_flx_other 
     367    
     368    
    272369   SUBROUTINE ice_sbc_init 
    273370      !!------------------------------------------------------------------- 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icestp.F90

    r14072 r15548  
    159159                                        CALL ice_rst_opn( kt )        ! Open Ice restart file (if necessary) 
    160160         ! 
    161          IF( ln_icedyn .AND. .NOT.lk_c1d )   & 
     161         IF( ln_icedyn .AND. .NOT.ln_c1d )   & 
    162162            &                           CALL ice_dyn( kt, Kmm )       ! -- Ice dynamics 
    163163         ! 
    … …  
    404404      !!---------------------------------------------------------------------- 
    405405 
    406       DO_2D( 1, 1, 1, 1 ) 
     406      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls )   ! needed for (at least) diag_adv_mass -> to be removed  
    407407         sfx    (ji,jj) = 0._wp   ; 
    408408         sfx_bri(ji,jj) = 0._wp   ;   sfx_lam(ji,jj) = 0._wp 
    … …  
    452452 
    453453      DO jl = 1, jpl 
    454          DO_2D( 1, 1, 1, 1 ) 
     454         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    455455            ! SIMIP diagnostics 
    456456            t_si       (ji,jj,jl) = rt0     ! temp at the ice-snow interface 
    … …  
    460460            qcn_ice    (ji,jj,jl) = 0._wp   ! conductive flux (ln_cndflx=T & ln_cndemule=T) 
    461461            qtr_ice_bot(ji,jj,jl) = 0._wp   ! part of solar radiation transmitted through the ice needed at least for outputs 
     462            qml_ice    (ji,jj,jl) = 0._wp   ! surface melt heat flux 
    462463            ! Melt pond surface melt diagnostics (mv - more efficient: grouped into one water volume flux) 
    463464            dh_i_sum_2d(ji,jj,jl) = 0._wp 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd.F90

    r14433 r15548  
    4848   PUBLIC   ice_thd_init    ! called by ice_init 
    4949 
    50    !!** namelist (namthd) ** 
    51    LOGICAL ::   ln_icedH         ! activate ice thickness change from growing/melting (T) or not (F) 
    52    LOGICAL ::   ln_icedA         ! activate lateral melting param. (T) or not (F) 
    53    LOGICAL ::   ln_icedO         ! activate ice growth in open-water (T) or not (F) 
    54    LOGICAL ::   ln_icedS         ! activate gravity drainage and flushing (T) or not (F) 
    55    LOGICAL ::   ln_leadhfx       ! heat in the leads is used to melt sea-ice before warming the ocean 
    56  
    5750   !! for convergence tests 
    5851   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztice_cvgerr, ztice_cvgstp 
    … …  
    9285      ! 
    9386      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    94       REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg, zqfr_pos 
    95       REAL(wp), PARAMETER :: zfric_umin = 0._wp       ! lower bound for the friction velocity (cice value=5.e-04) 
    96       REAL(wp), PARAMETER :: zch        = 0.0057_wp   ! heat transfer coefficient 
    97       REAL(wp), DIMENSION(jpi,jpj) ::   zu_io, zv_io, zfric, zvel   ! ice-ocean velocity (m/s) and frictional velocity (m2/s2) 
    98       ! 
    9987      !!------------------------------------------------------------------- 
    10088      ! controls 
    … …  
    114102         ztice_cvgerr = 0._wp ; ztice_cvgstp = 0._wp 
    115103      ENDIF 
    116  
    117       !---------------------------------------------! 
    118       ! computation of friction velocity at T points 
    119       !---------------------------------------------! 
    120       IF( ln_icedyn ) THEN 
    121          zu_io(:,:) = u_ice(:,:) - ssu_m(:,:) 
    122          zv_io(:,:) = v_ice(:,:) - ssv_m(:,:) 
    123          DO_2D( 0, 0, 0, 0 ) 
    124             zfric(ji,jj) = rn_cio * ( 0.5_wp *  & 
    125                &                    (  zu_io(ji,jj) * zu_io(ji,jj) + zu_io(ji-1,jj) * zu_io(ji-1,jj)   & 
    126                &                     + zv_io(ji,jj) * zv_io(ji,jj) + zv_io(ji,jj-1) * zv_io(ji,jj-1) ) ) * tmask(ji,jj,1) 
    127             zvel(ji,jj) = 0.5_wp * SQRT( ( u_ice(ji-1,jj) + u_ice(ji,jj) ) * ( u_ice(ji-1,jj) + u_ice(ji,jj) ) + & 
    128                &                         ( v_ice(ji,jj-1) + v_ice(ji,jj) ) * ( v_ice(ji,jj-1) + v_ice(ji,jj) ) ) 
    129          END_2D 
    130       ELSE      !  if no ice dynamics => transmit directly the atmospheric stress to the ocean 
    131          DO_2D( 0, 0, 0, 0 ) 
    132             zfric(ji,jj) = r1_rho0 * SQRT( 0.5_wp *  & 
    133                &                         (  utau(ji,jj) * utau(ji,jj) + utau(ji-1,jj) * utau(ji-1,jj)   & 
    134                &                          + vtau(ji,jj) * vtau(ji,jj) + vtau(ji,jj-1) * vtau(ji,jj-1) ) ) * tmask(ji,jj,1) 
    135             zvel(ji,jj) = 0._wp 
    136          END_2D 
    137       ENDIF 
    138       CALL lbc_lnk( 'icethd', zfric, 'T',  1.0_wp, zvel, 'T', 1.0_wp ) 
    139       ! 
    140       !--------------------------------------------------------------------! 
    141       ! Partial computation of forcing for the thermodynamic sea ice model 
    142       !--------------------------------------------------------------------! 
    143       DO_2D( 1, 1, 1, 1 ) 
    144          rswitch  = tmask(ji,jj,1) * MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) ! 0 if no ice 
    145          ! 
    146          ! --- Energy received in the lead from atm-oce exchanges, zqld is defined everywhere (J.m-2) --- ! 
    147          zqld =  tmask(ji,jj,1) * rDt_ice *  & 
    148             &    ( ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) * frq_m(ji,jj) +  & 
    149             &      ( 1._wp - at_i_b(ji,jj) ) * qns_oce(ji,jj) + qemp_oce(ji,jj) ) 
    150  
    151          ! --- Energy needed to bring ocean surface layer until its freezing, zqfr is defined everywhere (J.m-2) --- ! 
    152          !     (mostly<0 but >0 if supercooling) 
    153          zqfr     = rho0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) * tmask(ji,jj,1)  ! both < 0 (t_bo < sst) and > 0 (t_bo > sst) 
    154          zqfr_neg = MIN( zqfr , 0._wp )                                                                    ! only < 0 
    155          zqfr_pos = MAX( zqfr , 0._wp )                                                                    ! only > 0 
    156  
    157          ! --- Sensible ocean-to-ice heat flux (W/m2) --- ! 
    158          !     (mostly>0 but <0 if supercooling) 
    159          zfric_u            = MAX( SQRT( zfric(ji,jj) ), zfric_umin ) 
    160          qsb_ice_bot(ji,jj) = rswitch * rho0 * rcp * zch * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) 
    161  
    162          ! upper bound for qsb_ice_bot: the heat retrieved from the ocean must be smaller than the heat necessary to reach 
    163          !                              the freezing point, so that we do not have SST < T_freeze 
    164          !                              This implies: qsb_ice_bot(ji,jj) * at_i(ji,jj) * rtdice <= - zqfr_neg 
    165          !                              The following formulation is ok for both normal conditions and supercooling 
    166          qsb_ice_bot(ji,jj) = rswitch * MIN( qsb_ice_bot(ji,jj), - zqfr_neg * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) ) 
    167  
    168          ! If conditions are always supercooled (such as at the mouth of ice-shelves), then ice grows continuously 
    169          ! ==> stop ice formation by artificially setting up the turbulent fluxes to 0 when volume > 20m (arbitrary) 
    170          IF( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) > 0._wp .AND. vt_i(ji,jj) >= 20._wp ) THEN 
    171             zqfr               = 0._wp 
    172             zqfr_pos           = 0._wp 
    173             qsb_ice_bot(ji,jj) = 0._wp 
    174          ENDIF 
    175          ! 
    176          ! --- Energy Budget of the leads (qlead, J.m-2) --- ! 
    177          !     qlead is the energy received from the atm. in the leads. 
    178          !     If warming (zqld >= 0), then the energy in the leads is used to melt ice (bottom melting) => fhld  (W/m2) 
    179          !     If cooling (zqld <  0), then the energy in the leads is used to grow ice in open water    => qlead (J.m-2) 
    180          IF( zqld >= 0._wp .AND. at_i(ji,jj) > 0._wp ) THEN 
    181             ! upper bound for fhld: fhld should be equal to zqld 
    182             !                        but we have to make sure that this heat will not make the sst drop below the freezing point 
    183             !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr_pos 
    184             !                        The following formulation is ok for both normal conditions and supercooling 
    185             fhld (ji,jj) = rswitch * MAX( 0._wp, ( zqld - zqfr_pos ) * r1_Dt_ice / MAX( at_i(ji,jj), epsi10 ) &  ! divided by at_i since this is (re)multiplied by a_i in icethd_dh.F90 
    186                &                                 - qsb_ice_bot(ji,jj) ) 
    187             qlead(ji,jj) = 0._wp 
    188          ELSE 
    189             fhld (ji,jj) = 0._wp 
    190             ! upper bound for qlead: qlead should be equal to zqld 
    191             !                        but before using this heat for ice formation, we suppose that the ocean cools down till the freezing point. 
    192             !                        The energy for this cooling down is zqfr. Also some heat will be removed from the ocean from turbulent fluxes (qsb) 
    193             !                        and freezing point is reached if zqfr = zqld - qsb*a/dt 
    194             !                        so the max heat that can be pulled out of the ocean is zqld - qsb - zqfr 
    195             !                        The following formulation is ok for both normal conditions and supercooling 
    196             qlead(ji,jj) = MIN( 0._wp , zqld - ( qsb_ice_bot(ji,jj) * at_i(ji,jj) * rDt_ice ) - zqfr ) 
    197          ENDIF 
    198          ! 
    199          ! If ice is landfast and ice concentration reaches its max 
    200          ! => stop ice formation in open water 
    201          IF(  zvel(ji,jj) <= 5.e-04_wp .AND. at_i(ji,jj) >= rn_amax_2d(ji,jj)-epsi06 )   qlead(ji,jj) = 0._wp 
    202          ! 
    203          ! If the grid cell is almost fully covered by ice (no leads) 
    204          ! => stop ice formation in open water 
    205          IF( at_i(ji,jj) >= (1._wp - epsi10) )   qlead(ji,jj) = 0._wp 
    206          ! 
    207          ! If ln_leadhfx is false 
    208          ! => do not use energy of the leads to melt sea-ice 
    209          IF( .NOT.ln_leadhfx )   fhld(ji,jj) = 0._wp 
    210          ! 
    211       END_2D 
    212  
    213       ! In case we bypass open-water ice formation 
    214       IF( .NOT. ln_icedO )  qlead(:,:) = 0._wp 
    215       ! In case we bypass growing/melting from top and bottom 
    216       IF( .NOT. ln_icedH ) THEN 
    217          qsb_ice_bot(:,:) = 0._wp 
    218          fhld       (:,:) = 0._wp 
    219       ENDIF 
    220  
     104      ! 
     105      CALL ice_thd_frazil             !--- frazil ice: collection thickness (ht_i_new) & fraction of frazil (fraz_frac) 
     106      ! 
    221107      !-------------------------------------------------------------------------------------------! 
    222108      ! Thermodynamic computation (only on grid points covered by ice) => loop over ice categories 
    … …  
    226112         ! select ice covered grid points 
    227113         npti = 0 ; nptidx(:) = 0 
    228          DO_2D( 1, 1, 1, 1 ) 
     114         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    229115            IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
    230116               npti         = npti  + 1 
    … …  
    268154      ! 
    269155      IF ( ln_pnd .AND. ln_icedH ) & 
    270          &                    CALL ice_thd_pnd                      ! --- Melt ponds 
     156         &                    CALL ice_thd_pnd                      ! --- Melt ponds --- ! 
    271157      ! 
    272158      IF( jpl > 1  )          CALL ice_itd_rem( kt )                ! --- Transport ice between thickness categories --- ! 
    … …  
    276162                              CALL ice_cor( kt , 2 )                ! --- Corrections --- ! 
    277163      ! 
    278       oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! ice natural aging incrementation 
     164      oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rDt_ice              ! --- Ice natural aging incrementation 
     165      ! 
     166      DO_2D( 0, 0, 0, 0 )                                           ! --- Ice velocity corrections 
     167         IF( at_i(ji,jj) == 0._wp ) THEN   ! if ice has melted 
     168            IF( at_i(ji+1,jj) == 0._wp )   u_ice(ji  ,jj) = 0._wp   ! right side 
     169            IF( at_i(ji-1,jj) == 0._wp )   u_ice(ji-1,jj) = 0._wp   ! left side 
     170            IF( at_i(ji,jj+1) == 0._wp )   v_ice(ji,jj  ) = 0._wp   ! upper side 
     171            IF( at_i(ji,jj-1) == 0._wp )   v_ice(ji,jj-1) = 0._wp   ! bottom side 
     172         ENDIF 
     173      END_2D 
     174      CALL lbc_lnk( 'icethd', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 
    279175      ! 
    280176      ! convergence tests 
    … …  
    355251   END SUBROUTINE ice_thd_mono 
    356252 
    357  
    358253   SUBROUTINE ice_thd_1d2d( kl, kn ) 
    359254      !!----------------------------------------------------------------------- 
    … …  
    536431         CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_bot_1d(1:npti), qcn_ice_bot(:,:,kl) ) 
    537432         CALL tab_1d_2d( npti, nptidx(1:npti), qcn_ice_top_1d(1:npti), qcn_ice_top(:,:,kl) ) 
     433         CALL tab_1d_2d( npti, nptidx(1:npti), qml_ice_1d    (1:npti), qml_ice    (:,:,kl) ) 
    538434         ! extensive variables 
    539435         CALL tab_1d_2d( npti, nptidx(1:npti), v_i_1d (1:npti), v_i (:,:,kl) ) 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd_da.F90

    r12489 r15548  
    109109      !!--------------------------------------------------------------------- 
    110110      INTEGER  ::   ji     ! dummy loop indices 
    111       REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda 
     111      REAL(wp)            ::   zastar, zdfloe, zperi, zwlat, zda, zda_tot 
    112112      REAL(wp), PARAMETER ::   zdmax = 300._wp 
    113113      REAL(wp), PARAMETER ::   zcs   = 0.66_wp 
    114114      REAL(wp), PARAMETER ::   zm1   = 3.e-6_wp 
    115115      REAL(wp), PARAMETER ::   zm2   = 1.36_wp 
    116       ! 
    117       REAL(wp), DIMENSION(jpij) ::   zda_tot 
    118116      !!--------------------------------------------------------------------- 
    119117      ! 
    … …  
    128126         zwlat  = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2  ! Melt speed rate [m/s] 
    129127         ! 
    130          zda_tot(ji) = MIN( zwlat * zperi * rDt_ice, at_i_1d(ji) )                 ! sea ice concentration decrease (>0) 
     128         zda_tot = MIN( zwlat * zperi * rDt_ice, at_i_1d(ji) )                     ! sea ice concentration decrease (>0) 
    131129       
    132130         ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- ! 
    … …  
    134132            ! decrease of concentration for the category jl 
    135133            !    each category contributes to melting in proportion to its concentration 
    136             zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) ) 
     134            zda = MIN( a_i_1d(ji), zda_tot * a_i_1d(ji) / at_i_1d(ji) ) 
    137135             
    138136            ! Contribution to salt flux 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd_dh.F90

    r14072 r15548  
    224224      zevap_rema(1:npti) = 0._wp 
    225225      DO ji = 1, npti 
    226          IF( evap_ice_1d(ji) > 0._wp ) THEN 
    227             zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0 
    228             zevap_rema(ji) = MAX( 0._wp, evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos ) ! remaining evap in kg.m-2 (used for ice sublimation later on) 
    229          ENDIF 
     226         zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0 
     227         zevap_rema(ji) = evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos               ! remaining evap in kg.m-2 (used for ice sublimation later on) 
    230228      END DO 
    231229 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd_do.F90

    r14433 r15548  
    3535 
    3636   PUBLIC   ice_thd_do        ! called by ice_thd 
     37   PUBLIC   ice_thd_frazil    ! called by ice_thd 
    3738   PUBLIC   ice_thd_do_init   ! called by ice_stp 
    38  
    39    !                          !!** namelist (namthd_do) ** 
    40    REAL(wp) ::   rn_hinew      ! thickness for new ice formation (m) 
    41    LOGICAL  ::   ln_frazil     ! use of frazil ice collection as function of wind (T) or not (F) 
    42    REAL(wp) ::   rn_maxfraz    ! maximum portion of frazil ice collecting at the ice bottom 
    43    REAL(wp) ::   rn_vfraz      ! threshold drift speed for collection of bottom frazil ice 
    44    REAL(wp) ::   rn_Cfraz      ! squeezing coefficient for collection of bottom frazil ice 
    4539 
    4640   !! * Substitutions 
    … …  
    7872      !!------------------------------------------------------------------------ 
    7973      INTEGER  ::   ji, jj, jk, jl   ! dummy loop indices 
    80       INTEGER  ::   iter             !   -       - 
    81       REAL(wp) ::   ztmelts, zfrazb, zweight, zde                               ! local scalars 
    82       REAL(wp) ::   zgamafr, zvfrx, zvgx, ztaux, ztwogp, zf                     !   -      - 
    83       REAL(wp) ::   ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, zsqcd , zhicrit   !   -      - 
    84       ! 
     74      ! 
     75      REAL(wp) ::   ztmelts 
     76      REAL(wp) ::   zdE 
    8577      REAL(wp) ::   zQm          ! enthalpy exchanged with the ocean (J/m2, >0 towards ocean) 
    8678      REAL(wp) ::   zEi          ! sea ice specific enthalpy (J/kg) 
    … …  
    10294      REAL(wp), DIMENSION(jpij) ::   zda_res     ! residual area in case of excessive heat budget 
    10395      REAL(wp), DIMENSION(jpij) ::   zv_frazb    ! accretion of frazil ice at the ice bottom 
    104       REAL(wp), DIMENSION(jpij) ::   zvrel_1d    ! relative ice / frazil velocity (1D vector) 
     96      REAL(wp), DIMENSION(jpij) ::   zfraz_frac_1d ! relative ice / frazil velocity (1D vector) 
    10597      ! 
    10698      REAL(wp), DIMENSION(jpij,jpl) ::   zv_b    ! old volume of ice in category jl 
    … …  
    109101      REAL(wp), DIMENSION(jpij,nlay_i,jpl) ::   ze_i_2d !: 1-D version of e_i 
    110102      ! 
    111       REAL(wp), DIMENSION(jpi,jpj) ::   zvrel    ! relative ice / frazil velocity 
    112       ! 
    113       REAL(wp) :: zcai = 1.4e-3_wp               ! ice-air drag (clem: should be dependent on coupling/forcing used) 
    114103      !!-----------------------------------------------------------------------! 
    115104 
    … …  
    119108      at_i(:,:) = SUM( a_i, dim=3 ) 
    120109      !------------------------------------------------------------------------------! 
    121       ! 1) Collection thickness of ice formed in leads and polynyas 
    122       !------------------------------------------------------------------------------!     
    123       ! ht_i_new is the thickness of new ice formed in open water 
    124       ! ht_i_new can be either prescribed (ln_frazil=F) or computed (ln_frazil=T) 
    125       ! Frazil ice forms in open water, is transported by wind 
    126       ! accumulates at the edge of the consolidated ice edge 
    127       ! where it forms aggregates of a specific thickness called 
    128       ! collection thickness. 
    129  
    130       zvrel(:,:) = 0._wp 
    131  
    132       ! Default new ice thickness 
    133       WHERE( qlead(:,:) < 0._wp ) ! cooling 
    134          ht_i_new(:,:) = rn_hinew 
    135       ELSEWHERE 
    136          ht_i_new(:,:) = 0._wp 
    137       END WHERE 
    138  
    139       IF( ln_frazil ) THEN 
    140          ! 
    141          ht_i_new(:,:) = 0._wp 
    142          ! 
    143          ! Physical constants 
    144          zhicrit = 0.04                                          ! frazil ice thickness 
    145          ztwogp  = 2. * rho0 / ( grav * 0.3 * ( rho0 - rhoi ) )  ! reduced grav 
    146          zsqcd   = 1.0 / SQRT( 1.3 * zcai )                      ! 1/SQRT(airdensity*drag) 
    147          zgamafr = 0.03 
    148          ! 
    149          DO_2D( 0, 0, 0, 0 ) 
    150             IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling 
    151                ! -- Wind stress -- ! 
    152                ztaux         = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)   & 
    153                   &          +   utau_ice(ji  ,jj  ) * umask(ji  ,jj  ,1) ) * 0.5_wp 
    154                ztauy         = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)   & 
    155                   &          +   vtau_ice(ji  ,jj  ) * vmask(ji  ,jj  ,1) ) * 0.5_wp 
    156                ! Square root of wind stress 
    157                ztenagm       =  SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
    158  
    159                ! -- Frazil ice velocity -- ! 
    160                rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
    161                zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
    162                zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
    163  
    164                ! -- Pack ice velocity -- ! 
    165                zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
    166                zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
    167  
    168                ! -- Relative frazil/pack ice velocity -- ! 
    169                rswitch      = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
    170                zvrel2       = MAX(  ( zvfrx - zvgx ) * ( zvfrx - zvgx )   & 
    171                   &               + ( zvfry - zvgy ) * ( zvfry - zvgy ) , 0.15 * 0.15 ) * rswitch 
    172                zvrel(ji,jj) = SQRT( zvrel2 ) 
    173  
    174                ! -- new ice thickness (iterative loop) -- ! 
    175                ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1 )    & 
    176                   &                   / ( ( zhicrit + 0.1 ) * ( zhicrit + 0.1 ) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
    177  
    178                iter = 1 
    179                DO WHILE ( iter < 20 )  
    180                   zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   & 
    181                      &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2 
    182                   zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0 * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
    183  
    184                   ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 ) 
    185                   iter = iter + 1 
    186                END DO 
    187                ! 
    188                ! bound ht_i_new (though I don't see why it should be necessary) 
    189                ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 
    190                ! 
    191             ENDIF 
    192             ! 
    193          END_2D 
    194          !  
    195          CALL lbc_lnk( 'icethd_do', zvrel, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
    196  
    197       ENDIF 
    198  
    199       !------------------------------------------------------------------------------! 
    200       ! 2) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
     110      ! 1) Compute thickness, salinity, enthalpy, age, area and volume of new ice 
    201111      !------------------------------------------------------------------------------! 
    202112      ! it occurs if cooling 
    … …  
    204114      ! Identify grid points where new ice forms 
    205115      npti = 0   ;   nptidx(:) = 0 
    206       DO_2D( 1, 1, 1, 1 ) 
     116      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    207117         IF ( qlead(ji,jj)  <  0._wp ) THEN 
    208118            npti = npti + 1 
    … …  
    223133            END DO 
    224134         END DO 
    225          CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d  (1:npti) , qlead      ) 
    226          CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d   (1:npti) , t_bo       ) 
    227          CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d(1:npti) , sfx_opw    ) 
    228          CALL tab_2d_1d( npti, nptidx(1:npti), wfx_opw_1d(1:npti) , wfx_opw    ) 
    229          CALL tab_2d_1d( npti, nptidx(1:npti), zh_newice (1:npti) , ht_i_new   ) 
    230          CALL tab_2d_1d( npti, nptidx(1:npti), zvrel_1d  (1:npti) , zvrel      ) 
     135         CALL tab_2d_1d( npti, nptidx(1:npti), qlead_1d     (1:npti) , qlead      ) 
     136         CALL tab_2d_1d( npti, nptidx(1:npti), t_bo_1d      (1:npti) , t_bo       ) 
     137         CALL tab_2d_1d( npti, nptidx(1:npti), sfx_opw_1d   (1:npti) , sfx_opw    ) 
     138         CALL tab_2d_1d( npti, nptidx(1:npti), wfx_opw_1d   (1:npti) , wfx_opw    ) 
     139         CALL tab_2d_1d( npti, nptidx(1:npti), zh_newice    (1:npti) , ht_i_new   ) 
     140         CALL tab_2d_1d( npti, nptidx(1:npti), zfraz_frac_1d(1:npti) , fraz_frac  ) 
    231141 
    232142         CALL tab_2d_1d( npti, nptidx(1:npti), hfx_thd_1d(1:npti) , hfx_thd    ) 
    … …  
    300210         END DO 
    301211          
    302          zv_frazb(1:npti) = 0._wp 
    303          IF( ln_frazil ) THEN 
    304             ! A fraction zfrazb of frazil ice is accreted at the ice bottom 
    305             DO ji = 1, npti 
    306                rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - at_i_1d(ji) ) ) 
    307                zfrazb        = rswitch * ( TANH( rn_Cfraz * ( zvrel_1d(ji) - rn_vfraz ) ) + 1.0 ) * 0.5 * rn_maxfraz 
    308                zv_frazb(ji)  =         zfrazb   * zv_newice(ji) 
    309                zv_newice(ji) = ( 1.0 - zfrazb ) * zv_newice(ji) 
    310             END DO 
    311          END IF 
     212         ! A fraction fraz_frac of frazil ice is accreted at the ice bottom 
     213         DO ji = 1, npti 
     214            rswitch       = 1._wp - MAX( 0._wp, SIGN( 1._wp , - at_i_1d(ji) ) ) 
     215            zv_frazb(ji)  =           zfraz_frac_1d(ji) * rswitch   * zv_newice(ji) 
     216            zv_newice(ji) = ( 1._wp - zfraz_frac_1d(ji) * rswitch ) * zv_newice(ji) 
     217         END DO 
    312218          
    313219         ! --- Area of new ice --- ! 
    … …  
    317223 
    318224         !------------------------------------------------------------------------------! 
    319          ! 3) Redistribute new ice area and volume into ice categories                  ! 
     225         ! 2) Redistribute new ice area and volume into ice categories                  ! 
    320226         !------------------------------------------------------------------------------! 
    321227 
    … …  
    426332 
    427333 
     334   SUBROUTINE ice_thd_frazil 
     335      !!----------------------------------------------------------------------- 
     336      !!                   ***  ROUTINE ice_thd_frazil *** 
     337      !! 
     338      !! ** Purpose :   frazil ice collection thickness and fraction 
     339      !! 
     340      !! ** Inputs  :   u_ice, v_ice, utau_ice, vtau_ice 
     341      !! ** Ouputs  :   ht_i_new, fraz_frac 
     342      !!----------------------------------------------------------------------- 
     343      INTEGER  ::   ji, jj             ! dummy loop indices 
     344      INTEGER  ::   iter 
     345      REAL(wp) ::   zvfrx, zvgx, ztaux, zf, ztenagm, zvfry, zvgy, ztauy, zvrel2, zfp, ztwogp 
     346      REAL(wp), PARAMETER ::   zcai    = 1.4e-3_wp                       ! ice-air drag (clem: should be dependent on coupling/forcing used) 
     347      REAL(wp), PARAMETER ::   zhicrit = 0.04_wp                         ! frazil ice thickness 
     348      REAL(wp), PARAMETER ::   zsqcd   = 1.0_wp / SQRT( 1.3_wp * zcai )  ! 1/SQRT(airdensity*drag) 
     349      REAL(wp), PARAMETER ::   zgamafr = 0.03_wp 
     350      !!----------------------------------------------------------------------- 
     351      ! 
     352      !---------------------------------------------------------! 
     353      ! Collection thickness of ice formed in leads and polynyas 
     354      !---------------------------------------------------------!     
     355      ! ht_i_new is the thickness of new ice formed in open water 
     356      ! ht_i_new can be either prescribed (ln_frazil=F) or computed (ln_frazil=T) 
     357      ! Frazil ice forms in open water, is transported by wind, accumulates at the edge of the consolidated ice edge 
     358      ! where it forms aggregates of a specific thickness called collection thickness. 
     359      ! 
     360      fraz_frac(:,:) = 0._wp 
     361      ! 
     362      ! Default new ice thickness 
     363      WHERE( qlead(:,:) < 0._wp ) ! cooling 
     364         ht_i_new(:,:) = rn_hinew 
     365      ELSEWHERE 
     366         ht_i_new(:,:) = 0._wp 
     367      END WHERE 
     368 
     369      IF( ln_frazil ) THEN 
     370         ztwogp  = 2._wp * rho0 / ( grav * 0.3_wp * ( rho0 - rhoi ) )  ! reduced grav 
     371         ! 
     372         DO_2D( 0, 0, 0, 0 ) 
     373            IF ( qlead(ji,jj) < 0._wp ) THEN ! cooling 
     374               ! -- Wind stress -- ! 
     375               ztaux = ( utau_ice(ji-1,jj  ) * umask(ji-1,jj  ,1) + utau_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
     376               ztauy = ( vtau_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1) + vtau_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
     377               ! Square root of wind stress 
     378               ztenagm = SQRT( SQRT( ztaux * ztaux + ztauy * ztauy ) ) 
     379 
     380               ! -- Frazil ice velocity -- ! 
     381               rswitch = MAX( 0._wp, SIGN( 1._wp , ztenagm - epsi10 ) ) 
     382               zvfrx   = rswitch * zgamafr * zsqcd * ztaux / MAX( ztenagm, epsi10 ) 
     383               zvfry   = rswitch * zgamafr * zsqcd * ztauy / MAX( ztenagm, epsi10 ) 
     384 
     385               ! -- Pack ice velocity -- ! 
     386               zvgx    = ( u_ice(ji-1,jj  ) * umask(ji-1,jj  ,1)  + u_ice(ji,jj) * umask(ji,jj,1) ) * 0.5_wp 
     387               zvgy    = ( v_ice(ji  ,jj-1) * vmask(ji  ,jj-1,1)  + v_ice(ji,jj) * vmask(ji,jj,1) ) * 0.5_wp 
     388 
     389               ! -- Relative frazil/pack ice velocity -- ! 
     390               rswitch = MAX( 0._wp, SIGN( 1._wp , at_i(ji,jj) - epsi10 ) ) 
     391               zvrel2  = MAX( (zvfrx - zvgx)*(zvfrx - zvgx) + (zvfry - zvgy)*(zvfry - zvgy), 0.15_wp*0.15_wp ) * rswitch 
     392 
     393               ! -- fraction of frazil ice -- ! 
     394               fraz_frac(ji,jj) = rswitch * ( TANH( rn_Cfraz * ( SQRT(zvrel2) - rn_vfraz ) ) + 1._wp ) * 0.5_wp * rn_maxfraz 
     395                
     396               ! -- new ice thickness (iterative loop) -- ! 
     397               ht_i_new(ji,jj) = zhicrit +   ( zhicrit + 0.1_wp )    & 
     398                  &                      / ( ( zhicrit + 0.1_wp ) * ( zhicrit + 0.1_wp ) -  zhicrit * zhicrit ) * ztwogp * zvrel2 
     399               iter = 1 
     400               DO WHILE ( iter < 20 )  
     401                  zf  = ( ht_i_new(ji,jj) - zhicrit ) * ( ht_i_new(ji,jj) * ht_i_new(ji,jj) - zhicrit * zhicrit ) -   & 
     402                     &    ht_i_new(ji,jj) * zhicrit * ztwogp * zvrel2 
     403                  zfp = ( ht_i_new(ji,jj) - zhicrit ) * ( 3.0_wp * ht_i_new(ji,jj) + zhicrit ) - zhicrit * ztwogp * zvrel2 
     404 
     405                  ht_i_new(ji,jj) = ht_i_new(ji,jj) - zf / MAX( zfp, epsi20 ) 
     406                  iter = iter + 1 
     407               END DO 
     408               ! 
     409               ! bound ht_i_new (though I don't see why it should be necessary) 
     410               ht_i_new(ji,jj) = MAX( 0.01_wp, MIN( ht_i_new(ji,jj), hi_max(jpl) ) ) 
     411               ! 
     412            ELSE 
     413               ht_i_new(ji,jj) = 0._wp 
     414            ENDIF 
     415            ! 
     416         END_2D 
     417         !  
     418         CALL lbc_lnk( 'icethd_frazil', fraz_frac, 'T', 1.0_wp, ht_i_new, 'T', 1.0_wp  ) 
     419 
     420      ENDIF 
     421   END SUBROUTINE ice_thd_frazil 
     422 
     423    
    428424   SUBROUTINE ice_thd_do_init 
    429425      !!----------------------------------------------------------------------- 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd_ent.F90

    r13547 r15548  
    121121         DO ji = 1, npti 
    122122            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )  
    123             qnew(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) 
     123            qnew(ji,jk1) = rswitch * MAX( 0._wp, zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 ) ! max for roundoff error 
    124124         END DO 
    125125      END DO 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icethd_pnd.F90

    r14252 r15548  
    9999      ! 
    100100      DO jl = 1, jpl 
    101          DO_2D( 1, 1, 1, 1 ) 
     101         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    102102            IF( v_i(ji,jj,jl) < epsi10 .OR. at_i(ji,jj) < epsi10 ) THEN 
    103103               wfx_pnd  (ji,jj)    = wfx_pnd(ji,jj) + ( v_ip(ji,jj,jl) + v_il(ji,jj,jl) ) * rhow * r1_Dt_ice 
    … …  
    116116      !------------------------------ 
    117117      npti = 0   ;   nptidx(:) = 0 
    118       DO_2D( 1, 1, 1, 1 ) 
     118      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    119119         IF( at_i(ji,jj) >= epsi10 ) THEN 
    120120            npti = npti + 1 
    … …  
    590590 
    591591      DO jl = 1, jpl 
    592          DO_2D( 1, 1, 1, 1 ) 
     592         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    593593 
    594594               IF ( a_i(ji,jj,jl) > epsi10 ) THEN 
    … …  
    638638      IF( ln_pnd_lids ) THEN 
    639639 
    640          DO_2D( 1, 1, 1, 1 ) 
     640         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    641641 
    642642            IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp_ini(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 
    … …  
    662662                     IF ( t_su(ji,jj,jl) > zTp ) THEN 
    663663 
    664                         zdvice = MIN( dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) ) 
     664                        zdvice = MIN( -dh_i_sum_2d(ji,jj,jl)*a_ip(ji,jj,jl), v_il(ji,jj,jl) ) 
    665665 
    666666                        IF ( zdvice > epsi10 ) THEN 
    … …  
    765765      DO jl = 1, jpl 
    766766 
    767          DO_2D( 1, 1, 1, 1 ) 
     767         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    768768 
    769769!              ! zap lids on small ponds 
    … …  
    775775               ! recalculate equivalent pond variables 
    776776               IF ( a_ip(ji,jj,jl) > epsi10) THEN 
    777                   h_ip(ji,jj,jl)      = v_ip(ji,jj,jl) / a_i(ji,jj,jl) 
     777                  h_ip(ji,jj,jl)      = v_ip(ji,jj,jl) / a_ip(ji,jj,jl) 
    778778                  a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i(ji,jj,jl) ! MV in principle, useless as computed in icevar 
    779779                  h_il(ji,jj,jl) = v_il(ji,jj,jl) / a_ip(ji,jj,jl) ! MV in principle, useless as computed in icevar 
    … …  
    869869       h_ip(:,:,:) = 0._wp 
    870870 
    871        DO_2D( 1, 1, 1, 1 ) 
     871       DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    872872 
    873873             IF ( at_i(ji,jj) > 0.01 .AND. hm_i(ji,jj) > rn_himin .AND. zvolp(ji,jj) > zvp_min * at_i(ji,jj) ) THEN 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/iceupdate.F90

    r14581 r15548  
    9292      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices 
    9393      REAL(wp) ::   zqsr             ! New solar flux received by the ocean 
    94       REAL(wp), DIMENSION(jpi,jpj) ::   z2d                  ! 2D workspace 
     94      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z2d                  ! 2D workspace 
    9595      !!--------------------------------------------------------------------- 
    9696      IF( ln_timing )   CALL timing_start('iceupdate') 
    … …  
    104104      ! Net heat flux on top of the ice-ocean (W.m-2) 
    105105      !---------------------------------------------- 
    106       qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:) 
     106      IF( ln_cndflx ) THEN   ! ice-atm interface = conduction (and melting) fluxes 
     107         qt_atm_oi(:,:) = ( 1._wp - at_i_b(:,:) ) * ( qns_oce(:,:) + qsr_oce(:,:) ) + qemp_oce(:,:) + & 
     108            &             SUM( a_i_b * ( qcn_ice + qml_ice + qtr_ice_top ), dim=3 ) + qemp_ice(:,:) 
     109      ELSE                   ! ice-atm interface = solar and non-solar fluxes 
     110         qt_atm_oi(:,:) = qns_tot(:,:) + qsr_tot(:,:)  
     111      ENDIF 
    107112 
    108113      ! --- case we bypass ice thermodynamics --- ! 
    … …  
    115120      ENDIF 
    116121 
    117       DO_2D( 1, 1, 1, 1 ) 
     122      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    118123 
    119124         ! Solar heat flux reaching the ocean (max) = zqsr (W.m-2) 
    120125         !--------------------------------------------------- 
    121          zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
     126         IF( ln_cndflx ) THEN   ! ice-atm interface = conduction (and melting) fluxes 
     127            zqsr = ( 1._wp - at_i_b(ji,jj) ) * qsr_oce(ji,jj) + SUM( a_i_b (ji,jj,:) * qtr_ice_bot(ji,jj,:) ) 
     128         ELSE                   ! ice-atm interface = solar and non-solar fluxes 
     129            zqsr = qsr_tot(ji,jj) - SUM( a_i_b(ji,jj,:) * ( qsr_ice(ji,jj,:) - qtr_ice_bot(ji,jj,:) ) ) 
     130         ENDIF 
    122131 
    123132         ! Total heat flux reaching the ocean = qt_oce_ai (W.m-2) 
    124133         !--------------------------------------------------- 
    125          qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 
    126             &                                - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 
    127             &                                + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 
    128             &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 
    129  
     134         IF( ln_icethd ) THEN 
     135            qt_oce_ai(ji,jj) = qt_atm_oi(ji,jj) - hfx_sum(ji,jj) - hfx_bom(ji,jj) - hfx_bog(ji,jj) & 
     136               &                                - hfx_dif(ji,jj) - hfx_opw(ji,jj) - hfx_snw(ji,jj) & 
     137               &                                + hfx_thd(ji,jj) + hfx_dyn(ji,jj) + hfx_res(ji,jj) & 
     138               &                                + hfx_sub(ji,jj) - SUM( qevap_ice(ji,jj,:) * a_i_b(ji,jj,:) ) + hfx_spr(ji,jj) 
     139         ENDIF 
     140          
    130141         ! New qsr and qns used to compute the oceanic heat flux at the next time step 
    131142         !---------------------------------------------------------------------------- 
    … …  
    228239 
    229240      IF ( iom_use( 'vfxthin' ) ) THEN   ! mass flux from ice growth in open water + thin ice (<20cm) => comparable to observations 
     241         ALLOCATE( z2d(jpi,jpj) ) 
    230242         WHERE( hm_i(:,:) < 0.2 .AND. hm_i(:,:) > 0. ) ; z2d = wfx_bog 
    231243         ELSEWHERE                                     ; z2d = 0._wp 
    232244         END WHERE 
    233245         CALL iom_put( 'vfxthin', wfx_opw + z2d ) 
     246         DEALLOCATE( z2d ) 
    234247      ENDIF 
    235248 
    … …  
    278291      IF( iom_use('hfxcndbot'  ) )   CALL iom_put( 'hfxcndbot'  , SUM( qcn_ice_bot * a_i_b, dim=3 ) )   ! Bottom conduction flux 
    279292      IF( iom_use('hfxcndtop'  ) )   CALL iom_put( 'hfxcndtop'  , SUM( qcn_ice_top * a_i_b, dim=3 ) )   ! Surface conduction flux 
    280 !!    IF( iom_use('hfxmelt'    ) )   CALL iom_put( 'hfxmelt'    , SUM( qml_ice     * a_i_b, dim=3 ) )   ! Surface melt flux 
    281 !!    IF( iom_use('hfxldmelt'  ) )   CALL iom_put( 'hfxldmelt'  ,      fhld        * at_i_b         )   ! Heat in lead for ice melting  
    282 !!    IF( iom_use('hfxldgrow'  ) )   CALL iom_put( 'hfxldgrow'  ,      qlead       * r1_Dt_ice      )   ! Heat in lead for ice growth 
     293      IF( iom_use('hfxmelt'    ) )   CALL iom_put( 'hfxmelt'    , SUM( qml_ice     * a_i_b, dim=3 ) )   ! Surface melt flux 
     294      IF( iom_use('hfxldmelt'  ) )   CALL iom_put( 'hfxldmelt'  ,      fhld        * at_i_b         )   ! Heat in lead for ice melting  
     295      IF( iom_use('hfxldgrow'  ) )   CALL iom_put( 'hfxldgrow'  ,      qlead       * r1_Dt_ice      )   ! Heat in lead for ice growth 
    283296 
    284297      ! controls 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icevar.F90

    r14072 r15548  
    271271      zlay_i   = REAL( nlay_i , wp )    ! number of layers 
    272272      DO jl = 1, jpl 
    273          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     273         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    274274            IF ( v_i(ji,jj,jl) > epsi20 ) THEN     !--- icy area 
    275275               ! 
    … …  
    341341      !!------------------------------------------------------------------- 
    342342      INTEGER  ::   ji, jj, jk, jl   ! dummy loop index 
    343       REAL(wp) ::   zsal, z1_dS 
    344       REAL(wp) ::   zargtemp , zs0, zs 
    345       REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   z_slope_s, zalpha    ! case 2 only 
     343      REAL(wp) ::   z1_dS 
     344      REAL(wp) ::   ztmp1, ztmp2, zs0, zs 
     345      REAL(wp), ALLOCATABLE, DIMENSION(:,:) ::   z_slope_s, zalpha    ! case 2 only 
    346346      REAL(wp), PARAMETER :: zsi0 = 3.5_wp 
    347347      REAL(wp), PARAMETER :: zsi1 = 4.5_wp 
    … …  
    361361      CASE( 2 )       !  time varying salinity with linear profile  ! 
    362362         !            !---------------------------------------------! 
    363          ! 
    364          ALLOCATE( z_slope_s(jpi,jpj,jpl) , zalpha(jpi,jpj,jpl) ) 
     363         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
     364         ! 
     365         ALLOCATE( z_slope_s(jpi,jpj) , zalpha(jpi,jpj) ) 
    365366         ! 
    366367         DO jl = 1, jpl 
    367             DO jk = 1, nlay_i 
    368                sz_i(:,:,jk,jl)  = s_i(:,:,jl) 
    369             END DO 
    370          END DO 
    371          !                                      ! Slope of the linear profile 
    372          WHERE( h_i(:,:,:) > epsi20 )   ;   z_slope_s(:,:,:) = 2._wp * s_i(:,:,:) / h_i(:,:,:) 
    373          ELSEWHERE                      ;   z_slope_s(:,:,:) = 0._wp 
    374          END WHERE 
    375          ! 
    376          z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    377          DO jl = 1, jpl 
    378             DO_2D( 1, 1, 1, 1 ) 
    379                zalpha(ji,jj,jl) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
     368 
     369            DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     370               !                                      ! Slope of the linear profile 
     371               IF( h_i(ji,jj,jl) > epsi20 ) THEN 
     372                  z_slope_s(ji,jj) = 2._wp * s_i(ji,jj,jl) / h_i(ji,jj,jl) 
     373               ELSE 
     374                  z_slope_s(ji,jj) = 0._wp 
     375               ENDIF 
     376               ! 
     377               zalpha(ji,jj) = MAX(  0._wp , MIN( ( zsi1 - s_i(ji,jj,jl) ) * z1_dS , 1._wp )  ) 
    380378               !                             ! force a constant profile when SSS too low (Baltic Sea) 
    381                IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj,jl) = 0._wp 
     379               IF( 2._wp * s_i(ji,jj,jl) >= sss_m(ji,jj) )   zalpha(ji,jj) = 0._wp 
    382380            END_2D 
    383          END DO 
    384          ! 
    385          ! Computation of the profile 
    386          DO jl = 1, jpl 
    387             DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     381            ! 
     382            ! Computation of the profile 
     383            DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    388384               !                          ! linear profile with 0 surface value 
    389                zs0 = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
    390                zs  = zalpha(ji,jj,jl) * zs0 + ( 1._wp - zalpha(ji,jj,jl) ) * s_i(ji,jj,jl)     ! weighting the profile 
     385               zs0 = z_slope_s(ji,jj) * ( REAL(jk,wp) - 0.5_wp ) * h_i(ji,jj,jl) * r1_nlay_i 
     386               zs  = zalpha(ji,jj) * zs0 + ( 1._wp - zalpha(ji,jj) ) * s_i(ji,jj,jl)     ! weighting the profile 
    391387               sz_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( zs, rn_simin ) ) 
    392388            END_3D 
    … …  
    409405         DO jl = 1, jpl 
    410406            DO jk = 1, nlay_i 
    411                zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    412                sz_i(:,:,jk,jl) =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) )  ) 
     407               ztmp1 = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
     408               ztmp2 = 1.6_wp * (  1._wp - COS( rpi * ztmp1**(0.407_wp/(0.573_wp+ztmp1)) ) ) 
     409               DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     410                  sz_i(ji,jj,jk,jl) =  ztmp2 
     411               END_2D 
    413412            END DO 
    414413         END DO 
    … …  
    427426      !!------------------------------------------------------------------- 
    428427      INTEGER  ::   ji, jk    ! dummy loop indices 
    429       REAL(wp) ::   zargtemp, zsal, z1_dS   ! local scalars 
     428      REAL(wp) ::   ztmp1, ztmp2, z1_dS   ! local scalars 
    430429      REAL(wp) ::   zs, zs0              !   -      - 
    431430      ! 
    … …  
    445444      CASE( 2 )       !  time varying salinity with linear profile  ! 
    446445         !            !---------------------------------------------! 
     446         z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    447447         ! 
    448448         ALLOCATE( z_slope_s(jpij), zalpha(jpij) ) 
    449449         ! 
    450          !                                      ! Slope of the linear profile 
    451          WHERE( h_i_1d(1:npti) > epsi20 )   ;   z_slope_s(1:npti) = 2._wp * s_i_1d(1:npti) / h_i_1d(1:npti) 
    452          ELSEWHERE                          ;   z_slope_s(1:npti) = 0._wp 
    453          END WHERE 
    454  
    455          z1_dS = 1._wp / ( zsi1 - zsi0 ) 
    456450         DO ji = 1, npti 
     451            !                                      ! Slope of the linear profile 
     452            IF( h_i_1d(ji) > epsi20 ) THEN 
     453               z_slope_s(ji) = 2._wp * s_i_1d(ji) / h_i_1d(ji) 
     454            ELSE 
     455               z_slope_s(ji) = 0._wp 
     456            ENDIF 
     457            ! 
    457458            zalpha(ji) = MAX(  0._wp , MIN(  ( zsi1 - s_i_1d(ji) ) * z1_dS , 1._wp  )  ) 
    458459            !                             ! force a constant profile when SSS too low (Baltic Sea) 
    459460            IF( 2._wp * s_i_1d(ji) >= sss_1d(ji) )   zalpha(ji) = 0._wp 
     461            ! 
    460462         END DO 
    461463         ! 
    … …  
    480482!!gm cf remark in ice_var_salprof routine, CASE( 3 ) 
    481483         DO jk = 1, nlay_i 
    482             zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    483             zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) ) 
     484            ztmp1  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
     485            ztmp2 =  1.6_wp * ( 1._wp - COS( rpi * ztmp1**( 0.407_wp / ( 0.573_wp + ztmp1 ) ) ) ) 
    484486            DO ji = 1, npti 
    485                sz_i_1d(ji,jk) = zsal 
     487               sz_i_1d(ji,jk) = ztmp2 
    486488            END DO 
    487489         END DO 
    … …  
    515517         ! Zap ice energy and use ocean heat to melt ice 
    516518         !----------------------------------------------------------------- 
    517          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     519         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    518520            ! update exchanges with ocean 
    519521            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_i(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    … …  
    522524         END_3D 
    523525         ! 
    524          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     526         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    525527            ! update exchanges with ocean 
    526528            hfx_res(ji,jj)   = hfx_res(ji,jj) - (1._wp - zswitch(ji,jj) ) * e_s(ji,jj,jk,jl) * r1_Dt_ice ! W.m-2 <0 
    … …  
    532534         ! zap ice and snow volume, add water and salt to ocean 
    533535         !----------------------------------------------------------------- 
    534          DO_2D( 1, 1, 1, 1 ) 
     536         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    535537            ! update exchanges with ocean 
    536538            sfx_res(ji,jj)  = sfx_res(ji,jj) + ( 1._wp - zswitch(ji,jj) ) * sv_i(ji,jj,jl)   * rhoi * r1_Dt_ice 
    … …  
    608610         ! zap ice energy and send it to the ocean 
    609611         !---------------------------------------- 
    610          DO_3D( 1, 1, 1, 1, 1, nlay_i ) 
     612         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
    611613            IF( pe_i(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    612614               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_i(ji,jj,jk,jl) * z1_dt ! W.m-2 >0 
    … …  
    615617         END_3D 
    616618         ! 
    617          DO_3D( 1, 1, 1, 1, 1, nlay_s ) 
     619         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 
    618620            IF( pe_s(ji,jj,jk,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    619621               hfx_res(ji,jj)   = hfx_res(ji,jj) - pe_s(ji,jj,jk,jl) * z1_dt ! W.m-2 <0 
    … …  
    625627         ! zap ice and snow volume, add water and salt to ocean 
    626628         !----------------------------------------------------- 
    627          DO_2D( 1, 1, 1, 1 ) 
     629         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    628630            IF( pv_i(ji,jj,jl) < 0._wp .OR. pa_i(ji,jj,jl) <= 0._wp ) THEN 
    629631               wfx_res(ji,jj)    = wfx_res(ji,jj) + pv_i (ji,jj,jl) * rhoi * z1_dt 
    … …  
    712714      bv_i (:,:,:) = 0._wp 
    713715      DO jl = 1, jpl 
    714          DO jk = 1, nlay_i 
    715             WHERE( t_i(:,:,jk,jl) < rt0 - epsi10 ) 
    716                bv_i(:,:,jl) = bv_i(:,:,jl) - rTmlt * sz_i(:,:,jk,jl) * r1_nlay_i / ( t_i(:,:,jk,jl) - rt0 ) 
    717             END WHERE 
    718          END DO 
     716         DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 
     717            IF( t_i(ji,jj,jk,jl) < rt0 - epsi10 ) THEN 
     718               bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rTmlt * sz_i(ji,jj,jk,jl) * r1_nlay_i / ( t_i(ji,jj,jk,jl) - rt0 ) 
     719            ENDIF 
     720         END_3D 
    719721      END DO 
    720722      WHERE( vt_i(:,:) > epsi20 )   ;   bvm_i(:,:) = SUM( bv_i(:,:,:) * v_i(:,:,:) , dim=3 ) / vt_i(:,:) 
    … …  
    779781      ! temporary 
    780782      REAL(wp) :: zintn, zintb                     ! time interpolation weights [] 
    781       REAL(wp), DIMENSION(jpi,jpj) :: zsnwiceload  ! snow and ice load [m] 
    782783      ! 
    783784      ! compute ice load used to define the equivalent ssh in lead 
    … …  
    792793         zintb = REAL( nn_fsbc + 1 ) / REAL( nn_fsbc ) * 0.5_wp 
    793794         ! 
    794          zsnwiceload(:,:) = ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rho0 
     795         ! compute equivalent ssh in lead 
     796         ice_var_sshdyn(:,:) = pssh(:,:) + ( zintn * psnwice_mass(:,:) + zintb * psnwice_mass_b(:,:) ) * r1_rho0 
    795797         ! 
    796798      ELSE 
    797          zsnwiceload(:,:) = 0.0_wp 
     799         ! compute equivalent ssh in lead 
     800         ice_var_sshdyn(:,:) = pssh(:,:) 
    798801      ENDIF 
    799       ! compute equivalent ssh in lead 
    800       ice_var_sshdyn(:,:) = pssh(:,:) + zsnwiceload(:,:) 
    801802      ! 
    802803   END FUNCTION ice_var_sshdyn 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/ICE/icewri.F90

    r14072 r15548  
    2020   USE ice            ! sea-ice: variables 
    2121   USE icevar         ! sea-ice: operations 
     22   USE icealb , ONLY : rn_alb_oce 
    2223   ! 
    2324   USE ioipsl         ! 
    … …  
    5354      REAL(wp) ::   z2da, z2db, zrho1, zrho2 
    5455      REAL(wp) ::   zmiss_val       ! missing value retrieved from xios 
    55       REAL(wp), DIMENSION(jpi,jpj)     ::   z2d, zfast                     ! 2D workspace 
     56      REAL(wp), DIMENSION(jpi,jpj)     ::   z2d                            ! 2D workspace 
    5657      REAL(wp), DIMENSION(jpi,jpj)     ::   zmsk00, zmsk05, zmsk15, zmsksn ! O%, 5% and 15% concentration mask and snow mask 
    5758      REAL(wp), DIMENSION(jpi,jpj,jpl) ::   zmsk00l, zmsksnl               ! cat masks 
     59      REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   zfast, zalb, zmskalb      ! 2D workspace 
    5860      ! 
    5961      ! Global ice diagnostics (SIMIP) 
    … …  
    7173 
    7274      ! tresholds for outputs 
    73       DO_2D( 1, 1, 1, 1 ) 
     75      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    7476         zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06  ) ) ! 1 if ice    , 0 if no ice 
    7577         zmsk05(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.05_wp ) ) ! 1 if 5% ice , 0 if less 
    … …  
    7880      END_2D 
    7981      DO jl = 1, jpl 
    80          DO_2D( 1, 1, 1, 1 ) 
     82         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
    8183            zmsk00l(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , a_i(ji,jj,jl) - epsi06 ) ) 
    8284            zmsksnl(ji,jj,jl)  = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi06 ) ) 
    … …  
    131133      IF( iom_use('vice'    ) )   CALL iom_put( 'vice'   , v_ice    )                                                       ! ice velocity v 
    132134      ! 
    133       IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity 
     135      IF( iom_use('icevel') .OR. iom_use('fasticepres') ) THEN                                                              ! module of ice velocity & fast ice 
     136         ALLOCATE( zfast(jpi,jpj) ) 
    134137         DO_2D( 0, 0, 0, 0 ) 
    135138            z2da  = u_ice(ji,jj) + u_ice(ji-1,jj) 
    … …  
    144147         END WHERE 
    145148         CALL iom_put( 'fasticepres', zfast ) 
    146       ENDIF 
    147  
     149         DEALLOCATE( zfast ) 
     150      ENDIF 
     151      ! 
     152      IF( iom_use('icealb') .OR. iom_use('albedo') ) THEN                                                                   ! ice albedo and surface albedo 
     153         ALLOCATE( zalb(jpi,jpj), zmskalb(jpi,jpj) ) 
     154         ! ice albedo 
     155         WHERE( at_i_b < 1.e-03 ) 
     156            zmskalb(:,:) = 0._wp 
     157            zalb   (:,:) = rn_alb_oce 
     158         ELSEWHERE 
     159            zmskalb(:,:) = 1._wp 
     160            zalb   (:,:) = SUM( alb_ice * a_i_b, dim=3 ) / at_i_b 
     161         END WHERE 
     162         CALL iom_put( 'icealb' , zalb * zmskalb + zmiss_val * ( 1._wp - zmskalb ) ) 
     163         ! ice+ocean albedo 
     164         zalb(:,:) = SUM( alb_ice * a_i_b, dim=3 ) + rn_alb_oce * ( 1._wp - at_i_b ) 
     165         CALL iom_put( 'albedo' , zalb ) 
     166         DEALLOCATE( zalb, zmskalb ) 
     167      ENDIF 
     168      ! 
    148169      ! --- category-dependent fields --- ! 
    149170      IF( iom_use('icemask_cat' ) )   CALL iom_put( 'icemask_cat' ,                  zmsk00l                                   ) ! ice mask 0% 
Note: See TracChangeset for help on using the changeset viewer.