From 569e4e3cc160258cff0ae23d550cb7b5771e567b Mon Sep 17 00:00:00 2001
From: clem <clement.rousset@locean.ipsl.fr>
Date: Thu, 6 Oct 2022 12:52:07 +0200
Subject: [PATCH] optimization again

---
 src/ICE/icethd_dh.F90 | 286 +++++++++++++++++++-----------------------
 1 file changed, 129 insertions(+), 157 deletions(-)

diff --git a/src/ICE/icethd_dh.F90 b/src/ICE/icethd_dh.F90
index 3a3b56657..6e51cdc54 100644
--- a/src/ICE/icethd_dh.F90
+++ b/src/ICE/icethd_dh.F90
@@ -86,11 +86,11 @@ CONTAINS
       REAL(wp), DIMENSION(jpij) ::   zq_bot      ! heat for bottom ablation                    (J.m-2)
       REAL(wp), DIMENSION(jpij) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2)
       REAL(wp), DIMENSION(jpij) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2)
-      REAL(wp), DIMENSION(jpij) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
-      REAL(wp), DIMENSION(jpij) ::   zdeltah
+      REAL(wp) ::   zevap_rema  ! remaining mass flux from sublimation        (kg.m-2)
+      REAL(wp) ::   zdeltah
       REAL(wp), DIMENSION(jpij) ::   zsnw        ! distribution of snow after wind blowing
 
-      INTEGER , DIMENSION(jpij,nlay_i)     ::   icount    ! number of layers vanishing by melting
+      INTEGER , DIMENSION(nlay_i)     ::   icount    ! number of layers vanishing by melting
       REAL(wp), DIMENSION(jpij,0:nlay_i+1) ::   zh_i      ! ice layer thickness (m)
       REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   zh_s      ! snw layer thickness (m)
       REAL(wp), DIMENSION(jpij,0:nlay_s  ) ::   ze_s      ! snw layer enthalpy (J.m-3)
@@ -154,16 +154,26 @@ CONTAINS
          zf_tt(ji)         = qcn_ice_bot_1d(ji) + qsb_ice_bot_1d(ji) + fhld_1d(ji) + qtr_ice_bot_1d(ji) * frq_m_1d(ji)
          zq_bot(ji)        = MAX( 0._wp, zf_tt(ji) * rDt_ice )
       END DO
+      
+      
+      CALL ice_var_snwblow( 1._wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing
+      
+      z1_rho = 1._wp / ( rhos+rho0-rhoi )
 
-      !                       ! ============ !
-      !                       !     Snow     !
-      !                       ! ============ !
-      !
-      ! Internal melting
-      ! ----------------
-      ! IF snow temperature is above freezing point, THEN snow melts (should not happen but sometimes it does)
-      DO jk = 1, nlay_s
-         DO ji = 1, npti
+      IF( nn_icesal == 2 ) THEN   ;   num_iter_max = 5  ! salinity varying in time
+      ELSE                        ;   num_iter_max = 1
+      ENDIF
+     
+      DO ji = 1, npti
+         
+         !                       ! ============ !
+         !                       !     Snow     !
+         !                       ! ============ !
+         !
+         ! Internal melting
+         ! ----------------
+         ! IF snow temperature is above freezing point, THEN snow melts (should not happen but sometimes it does)
+         DO jk = 1, nlay_s
             IF( t_s_1d(ji,jk) > rt0 ) THEN
                hfx_res_1d    (ji) = hfx_res_1d    (ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! heat flux to the ocean [W.m-2], < 0
                wfx_snw_sum_1d(ji) = wfx_snw_sum_1d(ji) + rhos        * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice   ! mass flux
@@ -174,13 +184,10 @@ CONTAINS
                ze_s    (ji,jk) = 0._wp
             END IF
          END DO
-      END DO
 
-      ! Snow precipitation
-      !-------------------
-      CALL ice_var_snwblow( 1._wp - at_i_1d(1:npti), zsnw(1:npti) )   ! snow distribution over ice after wind blowing
+         ! Snow precipitation
+         !-------------------
 
-      DO ji = 1, npti
          IF( sprecip_1d(ji) > 0._wp ) THEN
             zh_s(ji,0) = zsnw(ji) * sprecip_1d(ji) * rDt_ice * r1_rhos / at_i_1d(ji)   ! thickness of precip
             ze_s(ji,0) = MAX( 0._wp, - qprec_ice_1d(ji) )                              ! enthalpy of the precip (>0, J.m-3)
@@ -191,14 +198,12 @@ CONTAINS
             ! update thickness
             h_s_1d(ji) = h_s_1d(ji) + zh_s(ji,0)
          ENDIF
-      END DO
 
-      ! Snow melting
-      ! ------------
-      ! If heat still available (zq_top > 0)
-      ! then all snw precip has been melted and we need to melt more snow
-      DO jk = 0, nlay_s
-         DO ji = 1, npti
+         ! Snow melting
+         ! ------------
+         ! If heat still available (zq_top > 0)
+         ! then all snw precip has been melted and we need to melt more snow
+         DO jk = 0, nlay_s
             IF( zh_s(ji,jk) > 0._wp .AND. zq_top(ji) > 0._wp ) THEN
                !
                rswitch = MAX( 0._wp , SIGN( 1._wp , ze_s(ji,jk) - epsi20 ) )
@@ -217,22 +222,16 @@ CONTAINS
                !
             ENDIF
          END DO
-      END DO
 
-      ! Snow sublimation
-      !-----------------
-      ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
-      !    comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean)
-      zdeltah   (1:npti) = 0._wp ! total snow thickness that sublimates, < 0
-      zevap_rema(1:npti) = 0._wp
-      DO ji = 1, npti
-         zdeltah   (ji) = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0
-         zevap_rema(ji) = evap_ice_1d(ji) * rDt_ice + zdeltah(ji) * rhos               ! remaining evap in kg.m-2 (used for ice sublimation later on)
-      END DO
+         ! Snow sublimation
+         !-----------------
+         ! qla_ice is always >=0 (upwards), heat goes to the atmosphere, therefore snow sublimates
+         !    comment: not counted in mass/heat exchange in iceupdate.F90 since this is an exchange with atm. (not ocean)
+         zdeltah    = MAX( - evap_ice_1d(ji) * r1_rhos * rDt_ice, - h_s_1d(ji) )   ! amount of snw that sublimates, < 0
+         zevap_rema = evap_ice_1d(ji) * rDt_ice + zdeltah * rhos               ! remaining evap in kg.m-2 (used for ice sublimation later on)
 
-      DO jk = 0, nlay_s
-         DO ji = 1, npti
-            zdum = MAX( -zh_s(ji,jk), zdeltah(ji) ) ! snow layer thickness that sublimates, < 0
+         DO jk = 0, nlay_s
+            zdum = MAX( -zh_s(ji,jk), zdeltah ) ! snow layer thickness that sublimates, < 0
             !
             hfx_sub_1d    (ji) = hfx_sub_1d    (ji) + ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! Heat flux of snw that sublimates [W.m-2], < 0
             wfx_snw_sub_1d(ji) = wfx_snw_sub_1d(ji) - rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! Mass flux by sublimation
@@ -243,19 +242,17 @@ CONTAINS
 !!$            IF( zh_s(ji,jk) == 0._wp )   ze_s(ji,jk) = 0._wp
 
             ! update sublimation left
-            zdeltah(ji) = MIN( zdeltah(ji) - zdum, 0._wp )
+            zdeltah = MIN( zdeltah - zdum, 0._wp )
          END DO
-      END DO
 
-      !
-      !                       ! ============ !
-      !                       !     Ice      !
-      !                       ! ============ !
+         !
+         !                       ! ============ !
+         !                       !     Ice      !
+         !                       ! ============ !
 
-      ! Surface ice melting
-      !--------------------
-      DO jk = 1, nlay_i
-         DO ji = 1, npti
+         ! Surface ice melting
+         !--------------------
+         DO jk = 1, nlay_i
             ztmelts = - rTmlt * sz_i_1d(ji,jk)   ! Melting point of layer k [C]
 
             IF( t_i_1d(ji,jk) >= (ztmelts+rt0) ) THEN   !-- Internal melting
@@ -311,7 +308,7 @@ CONTAINS
             !
             ! Ice sublimation
             ! ---------------
-            zdum               = MAX( - zh_i(ji,jk) , - zevap_rema(ji) * r1_rhoi )
+            zdum               = MAX( - zh_i(ji,jk) , - zevap_rema * r1_rhoi )
             !
             hfx_sub_1d(ji)     = hfx_sub_1d(ji)     + e_i_1d(ji,jk) * zdum              * a_i_1d(ji) * r1_Dt_ice ! Heat flux [W.m-2], < 0
             wfx_ice_sub_1d(ji) = wfx_ice_sub_1d(ji) - rhoi          * zdum              * a_i_1d(ji) * r1_Dt_ice ! Mass flux > 0
@@ -320,7 +317,7 @@ CONTAINS
             !                                                                                                            but salt should remain in the ice except
             !                                                                                                            if all ice is melted. => must be corrected
             ! update remaining mass flux and thickness
-            zevap_rema(ji) = zevap_rema(ji) + zdum * rhoi
+            zevap_rema = zevap_rema + zdum * rhoi
             zh_i(ji,jk)    = MAX( 0._wp, zh_i(ji,jk) + zdum )
             h_i_1d(ji)     = MAX( 0._wp, h_i_1d(ji)  + zdum )
             dh_i_sub(ji)   = dh_i_sub(ji) + zdum
@@ -332,35 +329,29 @@ CONTAINS
             ! record which layers have disappeared (for bottom melting)
             !    => icount=0 : no layer has vanished
             !    => icount=5 : 5 layers have vanished
-            rswitch       = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) )
-            icount(ji,jk) = NINT( rswitch )
+            rswitch    = MAX( 0._wp , SIGN( 1._wp , - zh_i(ji,jk) ) )
+            icount(jk) = NINT( rswitch )
 
          END DO
-      END DO
 
-      ! remaining "potential" evap is sent to ocean
-      DO ji = 1, npti
-         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema(ji) * a_i_1d(ji) * r1_Dt_ice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
-      END DO
+         ! remaining "potential" evap is sent to ocean
+         wfx_err_sub_1d(ji) = wfx_err_sub_1d(ji) - zevap_rema * a_i_1d(ji) * r1_Dt_ice  ! <=0 (net evap for the ocean in kg.m-2.s-1)
 
 
-      ! Ice Basal growth
-      !------------------
-      ! Basal growth is driven by heat imbalance at the ice-ocean interface,
-      ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux
-      ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).
-      ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice
+         ! Ice Basal growth
+         !------------------
+         ! Basal growth is driven by heat imbalance at the ice-ocean interface,
+         ! between the inner conductive flux  (qcn_ice_bot), from the open water heat flux
+         ! (fhld) and the sensible ice-ocean flux (qsb_ice_bot).
+         ! qcn_ice_bot is positive downwards. qsb_ice_bot and fhld are positive to the ice
 
-      ! If salinity varies in time, an iterative procedure is required, because
-      ! the involved quantities are inter-dependent.
-      ! Basal growth (dh_i_bog) depends upon new ice specific enthalpy (zEi),
-      ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bog)
-      ! -> need for an iterative procedure, which converges quickly
+         ! If salinity varies in time, an iterative procedure is required, because
+         ! the involved quantities are inter-dependent.
+         ! Basal growth (dh_i_bog) depends upon new ice specific enthalpy (zEi),
+         ! which depends on forming ice salinity (s_i_new), which depends on dh/dt (dh_i_bog)
+         ! -> need for an iterative procedure, which converges quickly
 
-      num_iter_max = 1
-      IF( nn_icesal == 2 )   num_iter_max = 5  ! salinity varying in time
 
-      DO ji = 1, npti
          IF(  zf_tt(ji) < 0._wp  ) THEN
             DO iter = 1, num_iter_max   ! iterations
 
@@ -409,13 +400,11 @@ CONTAINS
 
          ENDIF
 
-      END DO
 
-      ! Ice Basal melt
-      !---------------
-      DO jk = nlay_i, 1, -1
-         DO ji = 1, npti
-            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(ji,jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting
+         ! Ice Basal melt
+         !---------------
+         DO jk = nlay_i, 1, -1
+            IF(  zf_tt(ji)  >  0._wp  .AND. jk > icount(jk) ) THEN   ! do not calculate where layer has already disappeared by surface melting
 
                ztmelts = - rTmlt * sz_i_1d(ji,jk)  ! Melting point of layer jk (C)
 
@@ -470,12 +459,10 @@ CONTAINS
                zh_i_old(ji,jk) = zh_i_old(ji,jk) + zdum
             ENDIF
          END DO
-      END DO
 
-      ! Remove snow if ice has melted entirely
-      ! --------------------------------------
-      DO jk = 0, nlay_s
-         DO ji = 1,npti
+         ! Remove snow if ice has melted entirely
+         ! --------------------------------------
+         DO jk = 0, nlay_s
             IF( h_i_1d(ji) == 0._wp ) THEN
                ! mass & energy loss to the ocean
                hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zh_s(ji,jk) * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0
@@ -487,19 +474,17 @@ CONTAINS
                zh_s  (ji,jk) = 0._wp
             ENDIF
          END DO
-      END DO
 
-      ! Snow load on ice
-      ! -----------------
-      ! When snow load exceeds Archimede's limit and sst is positive,
-      ! snow-ice formation (next bloc) can lead to negative ice enthalpy.
-      ! Therefore we consider here that this excess of snow falls into the ocean
-      zdeltah(1:npti) = h_s_1d(1:npti) + h_i_1d(1:npti) * (rhoi-rho0) * r1_rhos
-      DO jk = 0, nlay_s
-         DO ji = 1, npti
-            IF( zdeltah(ji) > 0._wp .AND. sst_1d(ji) > 0._wp ) THEN
+         ! Snow load on ice
+         ! -----------------
+         ! When snow load exceeds Archimede's limit and sst is positive,
+         ! snow-ice formation (next bloc) can lead to negative ice enthalpy.
+         ! Therefore we consider here that this excess of snow falls into the ocean
+         zdeltah = h_s_1d(ji) + h_i_1d(ji) * (rhoi-rho0) * r1_rhos
+         DO jk = 0, nlay_s
+            IF( zdeltah > 0._wp .AND. sst_1d(ji) > 0._wp ) THEN
                ! snow layer thickness that falls into the ocean
-               zdum = MIN( zdeltah(ji) , zh_s(ji,jk) )
+               zdum = MIN( zdeltah , zh_s(ji,jk) )
                ! mass & energy loss to the ocean
                hfx_res_1d(ji) = hfx_res_1d(ji) - ze_s(ji,jk) * zdum * a_i_1d(ji) * r1_Dt_ice  ! heat flux to the ocean [W.m-2], < 0
                wfx_res_1d(ji) = wfx_res_1d(ji) + rhos        * zdum * a_i_1d(ji) * r1_Dt_ice  ! mass flux
@@ -507,18 +492,14 @@ CONTAINS
                h_s_1d(ji)    = MAX( 0._wp, h_s_1d(ji)  - zdum )
                zh_s  (ji,jk) = MAX( 0._wp, zh_s(ji,jk) - zdum )
                ! update snow thickness that still has to fall
-               zdeltah(ji)   = MAX( 0._wp, zdeltah(ji) - zdum )
+               zdeltah   = MAX( 0._wp, zdeltah - zdum )
             ENDIF
          END DO
-      END DO
 
-      ! Snow-Ice formation
-      ! ------------------
-      ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level,
-      ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice)
-      z1_rho = 1._wp / ( rhos+rho0-rhoi )
-      zdeltah(1:npti) = 0._wp
-      DO ji = 1, npti
+         ! Snow-Ice formation
+         ! ------------------
+         ! When snow load exceeds Archimede's limit, snow-ice interface goes down under sea-level,
+         ! flooding of seawater transforms snow into ice. Thickness that is transformed is dh_snowice (positive for the ice)
          !
          dh_snowice(ji) = MAX( 0._wp , ( rhos * h_s_1d(ji) + (rhoi-rho0) * h_i_1d(ji) ) * z1_rho )
 
@@ -545,31 +526,29 @@ CONTAINS
 
          ! update thickness
          zh_i(ji,0)  = zh_i(ji,0) + dh_snowice(ji)
-         zdeltah(ji) =              dh_snowice(ji)
+         zdeltah =              dh_snowice(ji)
 
          ! update heat content (J.m-2) and layer thickness
          zh_i_old(ji,0) = zh_i_old(ji,0) + dh_snowice(ji)
          ze_i_old(ji,0) = ze_i_old(ji,0) + zfmdt * zEw           ! 1st part (sea water enthalpy)
 
-      END DO
-      !
-      DO jk = nlay_s, 0, -1   ! flooding of snow starts from the base
-         DO ji = 1, npti
-            zdum           = MIN( zdeltah(ji), zh_s(ji,jk) )     ! amount of snw that floods, > 0
+         !
+         DO jk = nlay_s, 0, -1   ! flooding of snow starts from the base
+            zdum           = MIN( zdeltah, zh_s(ji,jk) )     ! amount of snw that floods, > 0
             zh_s(ji,jk)    = MAX( 0._wp, zh_s(ji,jk) - zdum )    ! remove some snow thickness
             ze_i_old(ji,0) = ze_i_old(ji,0) + zdum * ze_s(ji,jk) ! 2nd part (snow enthalpy)
             ! update dh_snowice
-            zdeltah(ji)    = MAX( 0._wp, zdeltah(ji) - zdum )
+            zdeltah    = MAX( 0._wp, zdeltah - zdum )
          END DO
-      END DO
-      !
-      !
+         !
+         !
 !!$      ! --- Update snow diags --- !
 !!$      !!clem: this is wrong. dh_s_tot is not used anyway
 !!$      DO ji = 1, npti
-!!$         dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah(ji) + zdh_s_sub(ji) - dh_snowice(ji)
+!!$         dh_s_tot(ji) = dh_s_tot(ji) + dh_s_mlt(ji) + zdeltah + zdh_s_sub(ji) - dh_snowice(ji)
 !!$      END DO
-      !
+         !
+      END DO ! npti
       !
       ! Remapping of snw enthalpy on a regular grid
       !--------------------------------------------
@@ -631,61 +610,54 @@ CONTAINS
       INTEGER  :: ji         !  dummy loop indices
       INTEGER  :: jk0, jk1   !  old/new layer indices
       !
-      REAL(wp), DIMENSION(jpij,0:nlay_s+1) ::   zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
-      REAL(wp), DIMENSION(jpij,0:nlay_s)   ::   zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces
-      REAL(wp), DIMENSION(jpij)            ::   zhnew               ! new layers thicknesses
+      REAL(wp), DIMENSION(0:nlay_s+1) ::   zeh_cum0, zh_cum0   ! old cumulative enthlapies and layers interfaces
+      REAL(wp), DIMENSION(0:nlay_s)   ::   zeh_cum1, zh_cum1   ! new cumulative enthlapies and layers interfaces
+      REAL(wp)                        ::   zhnew               ! new layers thicknesses
       !!-------------------------------------------------------------------
 
-      !--------------------------------------------------------------------------
-      !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
-      !--------------------------------------------------------------------------
-      zeh_cum0(1:npti,0) = 0._wp
-      zh_cum0 (1:npti,0) = 0._wp
-      DO jk0 = 1, nlay_s+1
-         DO ji = 1, npti
-            zeh_cum0(ji,jk0) = zeh_cum0(ji,jk0-1) + pe_old(ji,jk0-1) * ph_old(ji,jk0-1)
-            zh_cum0 (ji,jk0) = zh_cum0 (ji,jk0-1) + ph_old(ji,jk0-1)
+      DO ji = 1, npti
+         !--------------------------------------------------------------------------
+         !  1) Cumulative integral of old enthalpy * thickness and layers interfaces
+         !--------------------------------------------------------------------------
+         zeh_cum0(0) = 0._wp
+         zh_cum0 (0) = 0._wp
+         DO jk0 = 1, nlay_s+1
+            zeh_cum0(jk0) = zeh_cum0(jk0-1) + pe_old(ji,jk0-1) * ph_old(ji,jk0-1)
+            zh_cum0 (jk0) = zh_cum0 (jk0-1) + ph_old(ji,jk0-1)
          END DO
-      END DO
 
-      !------------------------------------
-      !  2) Interpolation on the new layers
-      !------------------------------------
-      ! new layer thickesses
-      DO ji = 1, npti
-         zhnew(ji) = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s
-      END DO
+         !------------------------------------
+         !  2) Interpolation on the new layers
+         !------------------------------------
+         ! new layer thickesses
+         zhnew = SUM( ph_old(ji,0:nlay_s) ) * r1_nlay_s
 
-      ! new layers interfaces
-      zh_cum1(1:npti,0) = 0._wp
-      DO jk1 = 1, nlay_s
-         DO ji = 1, npti
-            zh_cum1(ji,jk1) = zh_cum1(ji,jk1-1) + zhnew(ji)
+         ! new layers interfaces
+         zh_cum1(0) = 0._wp
+         DO jk1 = 1, nlay_s
+            zh_cum1(jk1) = zh_cum1(jk1-1) + zhnew
          END DO
-      END DO
 
-      zeh_cum1(1:npti,0:nlay_s) = 0._wp
-      ! new cumulative q*h => linear interpolation
-      DO jk0 = 1, nlay_s+1
-         DO jk1 = 1, nlay_s-1
-            DO ji = 1, npti
-               IF( zh_cum1(ji,jk1) <= zh_cum0(ji,jk0) .AND. zh_cum1(ji,jk1) > zh_cum0(ji,jk0-1) ) THEN
-                  zeh_cum1(ji,jk1) = ( zeh_cum0(ji,jk0-1) * ( zh_cum0(ji,jk0) - zh_cum1(ji,jk1  ) ) +  &
-                     &                 zeh_cum0(ji,jk0  ) * ( zh_cum1(ji,jk1) - zh_cum0(ji,jk0-1) ) )  &
-                     &             / ( zh_cum0(ji,jk0) - zh_cum0(ji,jk0-1) )
+         zeh_cum1(0:nlay_s) = 0._wp
+         ! new cumulative q*h => linear interpolation
+         DO jk0 = 1, nlay_s+1
+            DO jk1 = 1, nlay_s-1
+               IF( zh_cum1(jk1) <= zh_cum0(jk0) .AND. zh_cum1(jk1) > zh_cum0(jk0-1) )   THEN
+                  zeh_cum1(jk1) = ( zeh_cum0(jk0-1) * ( zh_cum0(jk0) - zh_cum1(jk1  ) ) +  &
+                     &              zeh_cum0(jk0  ) * ( zh_cum1(jk1) - zh_cum0(jk0-1) ) )  &
+                     &            / ( zh_cum0(jk0) - zh_cum0(jk0-1) )
                ENDIF
             END DO
          END DO
-      END DO
-      ! to ensure that total heat content is strictly conserved, set:
-      zeh_cum1(1:npti,nlay_s) = zeh_cum0(1:npti,nlay_s+1)
+         ! to ensure that total heat content is strictly conserved, set:
+         zeh_cum1(nlay_s) = zeh_cum0(nlay_s+1)
 
-      ! new enthalpies
-      DO jk1 = 1, nlay_s
-         DO ji = 1, npti
-            rswitch      = MAX( 0._wp , SIGN( 1._wp , zhnew(ji) - epsi20 ) )
-            pe_new(ji,jk1) = rswitch * ( zeh_cum1(ji,jk1) - zeh_cum1(ji,jk1-1) ) / MAX( zhnew(ji), epsi20 )
+         ! new enthalpies
+         DO jk1 = 1, nlay_s
+            rswitch     = MAX( 0._wp , SIGN( 1._wp , zhnew - epsi20 ) )
+            pe_new(ji,jk1) = rswitch * ( zeh_cum1(jk1) - zeh_cum1(jk1-1) ) / MAX( zhnew, epsi20 )
          END DO
+
       END DO
 
    END SUBROUTINE snw_ent
-- 
GitLab