diff --git a/src/ICE/icethd_dh.F90 b/src/ICE/icethd_dh.F90
index 3a3b5665707912f9f06d6d7bd3d6dbcd74142939..6e51cdc54ac1e203553fa575317677827f0c1c1a 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