limthd_zdf_2.F90 47 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827
  1. MODULE limthd_zdf_2
  2. !!======================================================================
  3. !! *** MODULE limthd_zdf_2 ***
  4. !! thermodynamic growth and decay of the ice
  5. !!======================================================================
  6. !! History : 1.0 ! 01-04 (LIM) Original code
  7. !! 2.0 ! 02-08 (C. Ethe, G. Madec) F90
  8. !!----------------------------------------------------------------------
  9. #if defined key_lim2
  10. !!----------------------------------------------------------------------
  11. !! 'key_lim2' LIM 2.0 sea-ice model
  12. !!----------------------------------------------------------------------
  13. !! lim_thd_zdf_2 : vertical accr./abl. and lateral ablation of sea ice
  14. !!----------------------------------------------------------------------
  15. USE par_oce ! ocean parameters
  16. USE phycst ! ???
  17. USE thd_ice_2
  18. USE ice_2
  19. USE limistate_2
  20. USE sbc_oce, ONLY : ln_cpl
  21. USE in_out_manager
  22. USE lib_mpp ! MPP library
  23. USE wrk_nemo ! work arrays
  24. USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
  25. IMPLICIT NONE
  26. PRIVATE
  27. PUBLIC lim_thd_zdf_2 ! called by lim_thd_2
  28. REAL(wp) :: epsi20 = 1.e-20 , & ! constant values
  29. & epsi13 = 1.e-13 , &
  30. & zzero = 0.e0 , &
  31. & zone = 1.e0
  32. !!----------------------------------------------------------------------
  33. !! NEMO/LIM2 3.3 , UCL - NEMO Consortium (2010)
  34. !! $Id: limthd_zdf_2.F90 4990 2014-12-15 16:42:49Z timgraham $
  35. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  36. !!----------------------------------------------------------------------
  37. CONTAINS
  38. SUBROUTINE lim_thd_zdf_2( kideb , kiut )
  39. !!------------------------------------------------------------------
  40. !! *** ROUTINE lim_thd_zdf_2 ***
  41. !!
  42. !! ** Purpose : This routine determines the time evolution of snow
  43. !! and sea-ice thicknesses, concentration and heat content
  44. !! due to the vertical and lateral thermodynamic accretion-
  45. !! ablation processes. One only treats the case of lat. abl.
  46. !! For lateral accretion, see routine lim_lat_accr
  47. !!
  48. !! ** Method : The representation of vertical growth and decay of
  49. !! the sea-ice model is based upon the diffusion of heat
  50. !! through the external and internal boundaries of a
  51. !! three-layer system (two layers of ice and one layer and
  52. !! one layer of snow, if present, on top of the ice).
  53. !!
  54. !! ** Action : - Calculation of some intermediates variables
  55. !! - Calculation of surface temperature
  56. !! - Calculation of available heat for surface ablation
  57. !! - Calculation of the changes in internal temperature
  58. !! of the three-layer system, due to vertical diffusion
  59. !! processes
  60. !! - Performs surface ablation and bottom accretion-ablation
  61. !! - Performs snow-ice formation
  62. !! - Performs lateral ablation
  63. !!
  64. !! References : Fichefet T. and M. Maqueda 1997, J. Geophys. Res., 102(C6), 12609-12646
  65. !! Fichefet T. and M. Maqueda 1999, Clim. Dyn, 15(4), 251-268
  66. !!------------------------------------------------------------------
  67. INTEGER, INTENT(in) :: kideb ! Start point on which the the computation is applied
  68. INTEGER, INTENT(in) :: kiut ! End point on which the the computation is applied
  69. !!
  70. INTEGER :: ji ! dummy loop indices
  71. REAL(wp), POINTER, DIMENSION(:) :: zqcmlts ! energy due to surface melting
  72. REAL(wp), POINTER, DIMENSION(:) :: zqcmltb ! energy due to bottom melting
  73. REAL(wp), POINTER, DIMENSION(:) :: ztsmlt ! snow/ice surface melting temperature
  74. REAL(wp), POINTER, DIMENSION(:) :: ztbif ! int. temp. at the mid-point of the 1st layer of the snow/ice sys.
  75. REAL(wp), POINTER, DIMENSION(:) :: zksn ! effective conductivity of snow
  76. REAL(wp), POINTER, DIMENSION(:) :: zkic ! effective conductivity of ice
  77. REAL(wp), POINTER, DIMENSION(:) :: zksndh ! thermal cond. at the mid-point of the 1st layer of the snow/ice sys.
  78. REAL(wp), POINTER, DIMENSION(:) :: zfcsu ! conductive heat flux at the surface of the snow/ice system
  79. REAL(wp), POINTER, DIMENSION(:) :: zfcsudt ! = zfcsu * dt
  80. REAL(wp), POINTER, DIMENSION(:) :: zi0 ! frac. of the net SW rad. which is not absorbed at the surface
  81. REAL(wp), POINTER, DIMENSION(:) :: z1mi0 ! fraction of the net SW radiation absorbed at the surface
  82. REAL(wp), POINTER, DIMENSION(:) :: zqmax ! maximum energy stored in brine pockets
  83. REAL(wp), POINTER, DIMENSION(:) :: zrcpdt ! h_su*rho_su*cp_su/dt(h_su being the thick. of surf. layer)
  84. REAL(wp), POINTER, DIMENSION(:) :: zts_old ! previous surface temperature
  85. REAL(wp), POINTER, DIMENSION(:) :: zidsn , z1midsn , zidsnic ! temporary variables
  86. REAL(wp), POINTER, DIMENSION(:) :: zfnet ! net heat flux at the top surface( incl. conductive heat flux)
  87. REAL(wp), POINTER, DIMENSION(:) :: zsprecip ! snow accumulation
  88. REAL(wp), POINTER, DIMENSION(:) :: zhsnw_old ! previous snow thickness
  89. REAL(wp), POINTER, DIMENSION(:) :: zdhictop ! change in ice thickness due to top surf ablation/accretion
  90. REAL(wp), POINTER, DIMENSION(:) :: zdhicbot ! change in ice thickness due to bottom surf abl/acc
  91. REAL(wp), POINTER, DIMENSION(:) :: zqsup ! energy transmitted to ocean (coming from top surf abl/acc)
  92. REAL(wp), POINTER, DIMENSION(:) :: zqocea ! energy transmitted to ocean (coming from bottom sur abl/acc)
  93. REAL(wp), POINTER, DIMENSION(:) :: zfrl_old ! previous sea/ice fraction
  94. REAL(wp), POINTER, DIMENSION(:) :: zfrld_1d ! new sea/ice fraction
  95. REAL(wp), POINTER, DIMENSION(:) :: zep ! internal temperature of the 2nd layer of the snow/ice system
  96. REAL(wp), DIMENSION(3) :: &
  97. zplediag & ! principle diagonal, subdiag. and supdiag. of the
  98. , zsubdiag & ! tri-diagonal matrix coming from the computation
  99. , zsupdiag & ! of the temperatures inside the snow-ice system
  100. , zsmbr ! second member
  101. REAL(wp) :: &
  102. zhsu & ! thickness of surface layer
  103. , zhe & ! effective thickness for compu. of equ. thermal conductivity
  104. , zheshth & ! = zhe / thth
  105. , zghe & ! correction factor of the thermal conductivity
  106. , zumsb & ! parameter for numerical method to solve heat-diffusion eq.
  107. , zkhsn & ! conductivity at the snow layer
  108. , zkhic & ! conductivity at the ice layers
  109. , zkint & ! equivalent conductivity at the snow-ice interface
  110. , zkhsnint & ! = zkint*dt / (hsn*rhosn*cpsn)
  111. , zkhicint & ! = 2*zkint*dt / (hic*rhoic*cpic)
  112. , zpiv1, zpiv2 & ! temporary scalars used to solve the tri-diagonal system
  113. , zb2, zd2 & ! temporary scalars used to solve the tri-diagonal system
  114. , zb3, zd3 & ! temporary scalars used to solve the tri-diagonal system
  115. , ztint ! equivalent temperature at the snow-ice interface
  116. REAL(wp) :: &
  117. zexp & ! exponential function of the ice thickness
  118. , zfsab & ! part of solar radiation stored in brine pockets
  119. , zfts & ! value of energy balance function when the temp. equal surf. temp.
  120. , zdfts & ! value of derivative of ztfs when the temp. equal surf. temp.
  121. , zdts & ! surface temperature increment
  122. , zqsnw_mlt & ! energy needed to melt snow
  123. , zdhsmlt & ! change in snow thickness due to melt
  124. , zhsn & ! snow thickness (previous+accumulation-melt)
  125. , zqsn_mlt_rem & ! remaining heat coming from snow melting
  126. , zqice_top_mlt &! energy used to melt ice at top surface
  127. , zdhssub & ! change in snow thick. due to sublimation or evaporation
  128. , zdhisub & ! change in ice thick. due to sublimation or evaporation
  129. , zdhsn & ! snow ice thickness increment
  130. , zdtsn & ! snow internal temp. increment
  131. , zdtic & ! ice internal temp. increment
  132. , zqnes ! conductive energy due to ice melting in the first ice layer
  133. REAL(wp) :: &
  134. ztbot & ! temperature at the bottom surface
  135. , zfcbot & ! conductive heat flux at bottom surface
  136. , zqice_bot & ! energy used for bottom melting/growing
  137. , zqice_bot_mlt &! energy used for bottom melting
  138. , zqstbif_bot & ! part of energy stored in brine pockets used for bottom melting
  139. , zqstbif_old & ! temporary var. for zqstbif_bot
  140. , zdhicmlt & ! change in ice thickness due to bottom melting
  141. , zdhicm & ! change in ice thickness var.
  142. , zdhsnm & ! change in snow thickness var.
  143. , zhsnfi & ! snow thickness var.
  144. , zc1, zpc1 & ! temporary variables
  145. , zc2, zpc2 & ! temporary variables
  146. , zp1, zp2 & ! temporary variables
  147. , ztb2, ztb3 ! temporary variables
  148. REAL(wp) :: &
  149. zdrmh & ! change in snow/ice thick. after snow-ice formation
  150. , zhicnew & ! new ice thickness
  151. , zhsnnew & ! new snow thickness
  152. , zquot &
  153. , ztneq & ! temporary temp. variables
  154. , zqice &
  155. , zqicetot & ! total heat inside the snow/ice system
  156. , zdfrl & ! change in ice concentration
  157. , zdvsnvol & ! change in snow volume
  158. , zdrfrl1, zdrfrl2, zihsn, zidhb, zihic & ! temporary scalars
  159. , zihe, zihq, ziexp, ziqf, zihnf & ! temporary scalars
  160. , zibmlt, ziqr, zihgnew, zind, ztmp ! temporary scalars
  161. !!----------------------------------------------------------------------
  162. CALL wrk_alloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax )
  163. CALL wrk_alloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot )
  164. CALL wrk_alloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb )
  165. !-----------------------------------------------------------------------
  166. ! 1. Boundaries conditions for snow/ice system internal temperature
  167. ! - If tbif_1d(ji,1) > rt0_snow, tbif_1d(ji,1) = rt0_snow
  168. ! - If tbif_1d(ji,2/3) > rt0_ice, tbif_1d(ji,2/3) = rt0_ice
  169. ! Computation of energies due to surface and bottom melting
  170. !-----------------------------------------------------------------------
  171. DO ji = kideb , kiut
  172. ! do nothing if the snow (ice) thickness falls below its minimum thickness
  173. zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
  174. zihic = MAX( zzero , SIGN( zone , hicdif - h_ice_1d(ji) ) )
  175. !--energy required to bring snow to its melting point (rt0_snow)
  176. zqcmlts(ji) = ( MAX ( zzero , rcpsn * h_snow_1d(ji) * ( tbif_1d(ji,1) - rt0_snow ) ) ) * ( 1.0 - zihsn )
  177. !--energy required to bring ice to its melting point (rt0_ice)
  178. zqcmltb(ji) = ( MAX( zzero , rcpic * ( tbif_1d(ji,2) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
  179. & + MAX( zzero , rcpic * ( tbif_1d(ji,3) - rt0_ice ) * ( h_ice_1d(ji) / 2. ) ) &
  180. & ) * ( 1.0 - zihic )
  181. !--limitation of snow/ice system internal temperature
  182. tbif_1d(ji,1) = MIN( rt0_snow, tbif_1d(ji,1) )
  183. tbif_1d(ji,2) = MIN( rt0_ice , tbif_1d(ji,2) )
  184. tbif_1d(ji,3) = MIN( rt0_ice , tbif_1d(ji,3) )
  185. END DO
  186. !-------------------------------------------
  187. ! 2. Calculate some intermediate variables.
  188. !-------------------------------------------
  189. ! initialisation of the thickness of surface layer
  190. zhsu = hnzst
  191. DO ji = kideb , kiut
  192. zind = MAX( zzero , SIGN( zone , zhsu - h_snow_1d(ji) ) )
  193. zihsn = MAX( zzero , SIGN( zone , hsndif - h_snow_1d(ji) ) )
  194. zihsn = MAX( zihsn , zind )
  195. zihic = MAX( zzero , sign( zone , hicdif - h_ice_1d(ji) ) )
  196. ! 2.1. Computation of surface melting temperature
  197. !----------------------------------------------------
  198. zind = MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
  199. ztsmlt(ji) = ( 1.0 - zind ) * rt0_snow + zind * rt0_ice
  200. !
  201. ! 2.2. Effective conductivity of snow and ice
  202. !-----------------------------------------------
  203. !---computation of the correction factor on the thermal conductivity
  204. !-- (Morales Maqueda, 1995 ; Fichefet and Morales Maqueda, 1997)
  205. zhe = ( rcdsn / ( rcdsn + rcdic ) ) * h_ice_1d(ji) &
  206. & + ( rcdic / ( rcdsn + rcdic ) ) * h_snow_1d(ji)
  207. zihe = MAX( zzero , SIGN( zone , 2.0 * zhe - thth ) )
  208. zheshth = zhe / thth
  209. zghe = ( 1.0 - zihe ) * zheshth * ( 2.0 - zheshth ) &
  210. & + zihe * 0.5 * ( 1.5 + LOG( 2.0 * zheshth ) )
  211. !---effective conductivities
  212. zksn(ji) = zghe * rcdsn
  213. zkic(ji) = zghe * rcdic
  214. !
  215. ! 2.3. Computation of the conductive heat flux from the snow/ice
  216. ! system interior toward the top surface
  217. !------------------------------------------------------------------
  218. !---Thermal conductivity at the mid-point of the first snow/ice system layer
  219. zksndh(ji) = ( ( 1.0 - zihsn ) * 2.0 * zksn(ji) + zihsn * 4.0 * zkic(ji) ) &
  220. & / ( ( 1.0 - zihsn ) * h_snow_1d(ji) &
  221. & + zihsn * ( ( 1.0 + 3.0 * zihic ) * h_ice_1d(ji) &
  222. & + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
  223. !---internal temperature at the mid-point of the first snow/ice system layer
  224. ztbif(ji) = ( 1.0 - zihsn ) * tbif_1d(ji,1) &
  225. & + zihsn * ( ( 1.0 - zihic ) * tbif_1d(ji,2) &
  226. & + zihic * tfu_1d(ji) )
  227. !---conductive heat flux
  228. zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
  229. END DO
  230. !--------------------------------------------------------------------
  231. ! 3. Calculate :
  232. ! - fstbif_1d, part of solar radiation absorbing inside the ice
  233. ! assuming an exponential absorption (Grenfell and Maykut, 1977)
  234. ! - zqmax, maximum energy stored in brine pockets
  235. ! - qstbif_1d, total energy stored in brine pockets (updating)
  236. !-------------------------------------------------------------------
  237. DO ji = kideb , kiut
  238. zihsn = MAX( zzero , SIGN (zone , -h_snow_1d(ji) ) )
  239. zihic = MAX( zzero , 1.0 - ( h_ice_1d(ji) / zhsu ) )
  240. zind = MAX( zzero , SIGN (zone , hicdif - h_ice_1d(ji) ) )
  241. !--Computation of the fraction of the net shortwave radiation which
  242. !--penetrates inside the ice cover ( See Forcat)
  243. zi0(ji) = zihsn * ( fr1_i0_1d(ji) + zihic * fr2_i0_1d(ji) )
  244. zexp = MIN( zone , EXP( -1.5 * ( h_ice_1d(ji) - zhsu ) ) )
  245. fstbif_1d(ji) = zi0(ji) * qsr_ice_1d(ji) * zexp
  246. !--Computation of maximum energy stored in brine pockets zqmax and update
  247. !--the total energy stored in brine pockets, if less than zqmax
  248. zqmax(ji) = MAX( zzero , 0.5 * xlic * ( h_ice_1d(ji) - hicmin ) )
  249. zfsab = zi0(ji) * qsr_ice_1d(ji) * ( 1.0 - zexp )
  250. zihq = ( 1.0 - zind ) * MAX(zzero, SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) ) &
  251. & + zind * zone
  252. qstbif_1d(ji) = ( qstbif_1d(ji) + ( 1.0 - zihq ) * zfsab * rdt_ice ) * swiqst
  253. !--fraction of shortwave radiation absorbed at surface
  254. ziexp = zihq * zexp + ( 1.0 - zihq ) * ( swiqst + ( 1.0 - swiqst ) * zexp )
  255. z1mi0(ji) = 1.0 - zi0(ji) * ziexp
  256. END DO
  257. !--------------------------------------------------------------------------------
  258. ! 4. Computation of the surface temperature : determined by considering the
  259. ! budget of a thin layer of thick. zhsu at the top surface (H. Grenier, 1995)
  260. ! and based on a surface energy balance :
  261. ! hsu * rcp * dT/dt = Fsr + Fnsr(T) + Fcs(T),
  262. ! where - Fsr is the net absorbed solar radiation,
  263. ! - Fnsr is the total non solar radiation (incoming and outgoing long-wave,
  264. ! sensible and latent heat fluxes)
  265. ! - Fcs the conductive heat flux at the top of surface
  266. !------------------------------------------------------------------------------
  267. ! 4.1. Computation of intermediate values
  268. !---------------------------------------------
  269. DO ji = kideb, kiut
  270. zrcpdt(ji) = ( rcpsn * MIN( h_snow_1d(ji) , zhsu ) &
  271. & + rcpic * MAX( zhsu - h_snow_1d(ji) , zzero ) ) / rdt_ice
  272. zts_old(ji) = sist_1d(ji)
  273. END DO
  274. ! 4.2. Computation of surface temperature by expanding the eq. of energy balance
  275. ! with Ts = Tp + DT. One obtain , F(Tp) + DT * DF(Tp) = 0
  276. ! where - F(Tp) = Fsr + Fnsr(Tp) + Fcs(Tp)
  277. ! - DF(Tp)= (dFnsr(Tp)/dT) + (dFcs(Tp)/dT) - hsu*rcp/dt
  278. !---------------------------------------------------------------------------------
  279. DO ji = kideb, kiut
  280. !---computation of the derivative of energy balance function
  281. zdfts = zksndh(ji) & ! contribution of the conductive heat flux
  282. & + zrcpdt(ji) & ! contribution of hsu * rcp / dt
  283. & - dqns_ice_1d (ji) ! contribution of the total non solar radiation
  284. !---computation of the energy balance function
  285. zfts = - z1mi0 (ji) * qsr_ice_1d(ji) & ! net absorbed solar radiation
  286. & - qns_ice_1d(ji) & ! total non solar radiation
  287. & - zfcsu (ji) ! conductive heat flux from the surface
  288. !---computation of surface temperature increment
  289. zdts = -zfts / zdfts
  290. !---computation of the new surface temperature
  291. sist_1d(ji) = sist_1d(ji) + zdts
  292. END DO
  293. !----------------------------------------------------------------------------
  294. ! 5. Boundary condition at the top surface
  295. !-- IF Tsb < Tmelt, Fnet = Fcs (the net heat flux equal the conductive heat flux)
  296. ! Otherwise Tsb = Tmelt and Qnet(Tmelt) > 0
  297. ! Fnet(Tmelt) is therefore the net surface flux needed for melting
  298. !----------------------------------------------------------------------------
  299. ! 5.1. Limitation of surface temperature and update total non solar fluxes,
  300. ! latent heat flux and conductive flux at the top surface
  301. !----------------------------------------------------------------------
  302. IF ( .NOT. ln_cpl ) THEN ! duplicate the loop for performances issues
  303. DO ji = kideb, kiut
  304. sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
  305. qns_ice_1d(ji) = qns_ice_1d(ji) + dqns_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
  306. qla_ice_1d(ji) = qla_ice_1d(ji) + dqla_ice_1d(ji) * ( sist_1d(ji) - zts_old(ji) )
  307. zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
  308. END DO
  309. ELSE
  310. DO ji = kideb, kiut
  311. sist_1d(ji) = MIN( ztsmlt(ji) , sist_1d(ji) )
  312. qla_ice_1d(ji) = -9999. ! default definition, not used as parsub = 0. in this case
  313. zfcsu(ji) = zksndh(ji) * ( ztbif(ji) - sist_1d(ji) )
  314. END DO
  315. ENDIF
  316. ! 5.2. Calculate available heat for surface ablation.
  317. !---------------------------------------------------------------------
  318. DO ji = kideb, kiut
  319. zfnet(ji) = qns_ice_1d(ji) + z1mi0(ji) * qsr_ice_1d(ji) + zfcsu(ji)
  320. zfnet(ji) = MAX( zzero , zfnet(ji) )
  321. zfnet(ji) = zfnet(ji) * MAX( zzero , SIGN( zone , sist_1d(ji) - ztsmlt(ji) ) )
  322. END DO
  323. !-------------------------------------------------------------------------
  324. ! 6. Calculate changes in internal temperature due to vertical diffusion
  325. ! processes. The evolution of this temperature is governed by the one-
  326. ! dimensionnal heat-diffusion equation.
  327. ! Given the temperature tbif(1/2/3), at time m we solve a set
  328. ! of finite difference equations to obtain new tempe. Each tempe is coupled
  329. ! to the temp. immediatly above and below by heat conduction terms. Thus
  330. ! we have a set of equations of the form A * T = B, where A is a tridiagonal
  331. ! matrix, T a vector whose components are the unknown new temp.
  332. !-------------------------------------------------------------------------
  333. !--parameter for the numerical methode use to solve the heat-diffusion equation
  334. !- implicit, explicit or Crank-Nicholson
  335. zumsb = 1.0 - sbeta
  336. DO ji = kideb, kiut
  337. zidsn(ji) = MAX ( zzero, SIGN( zone, hsndif - h_snow_1d(ji) ) )
  338. z1midsn(ji) = 1.0 - zidsn(ji)
  339. zihic = MAX ( zzero, SIGN( zone, hicdif - h_ice_1d(ji) ) )
  340. zidsnic(ji) = zidsn(ji) * zihic
  341. zfcsudt(ji) = zfcsu(ji) * rdt_ice
  342. END DO
  343. DO ji = kideb, kiut
  344. ! 6.1 Calculate intermediate variables.
  345. !----------------------------------------
  346. !--conductivity at the snow surface
  347. zkhsn = 2.0 * zksn(ji) * rdt_ice / rcpsn
  348. !--conductivity at the ice surface
  349. zkhic = 4.0 * zkic(ji) * rdt_ice / MAX( h_ice_1d(ji) * h_ice_1d(ji) * rcpic , epsi20 )
  350. !--conductivity at the snow/ice interface
  351. zkint = 4.0 * zksn(ji) * zkic(ji) &
  352. & / ( zksn(ji) * h_ice_1d(ji) + 2.0 * zkic(ji) * h_snow_1d(ji) * z1midsn(ji))
  353. zkhsnint = zkint * rdt_ice / rcpsn
  354. zkhicint = zkint * 2.0 * rdt_ice / MAX( h_ice_1d(ji) * rcpic , epsi20 )
  355. ! 6.2. Fulfill the linear system matrix.
  356. !-----------------------------------------
  357. !$$$ zplediag(1) = 1 + sbeta * z1midsn(ji) * ( zkhsn + zkhsnint )
  358. zplediag(1) = zidsn(ji) + z1midsn(ji) * h_snow_1d(ji) &
  359. & + sbeta * z1midsn(ji) * zkhsnint
  360. zplediag(2) = 1 + sbeta * ( z1midsn(ji) * zkhicint + zkhic )
  361. zplediag(3) = 1 + 3.0 * sbeta * zkhic
  362. zsubdiag(1) = 0.e0
  363. zsubdiag(2) = -1.e0 * z1midsn(ji) * sbeta * zkhicint
  364. zsubdiag(3) = -1.e0 * sbeta * zkhic
  365. zsupdiag(1) = -1.e0 * z1midsn(ji) * sbeta * zkhsnint
  366. zsupdiag(2) = zsubdiag(3)
  367. zsupdiag(3) = 0.e0
  368. ! 6.3. Fulfill the idependent term vector.
  369. !-------------------------------------------
  370. !$$$ zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) * &
  371. !$$$ & ( tbif_1d(ji,1) + zkhsn * sist_1d(ji)
  372. !$$$ & - zumsb * ( zkhsn * tbif_1d(ji,1)
  373. !$$$ & + zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) ) )
  374. zsmbr(1) = zidsn(ji) * sist_1d(ji) + z1midsn(ji) * &
  375. & ( h_snow_1d(ji) * tbif_1d(ji,1) - ( zfcsudt(ji) / rcpsn ) &
  376. & - zumsb * zkhsnint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) )
  377. zsmbr(2) = tbif_1d(ji,2) &
  378. & - zidsn(ji) * ( 1.0 - zidsnic(ji) ) &
  379. & * ( zfcsudt(ji) / MAX( h_ice_1d(ji) * rcpic , epsi20 ) ) &
  380. & + zumsb * ( zkhicint * ( tbif_1d(ji,1) - tbif_1d(ji,2) ) &
  381. & - zkhic * ( tbif_1d(ji,2) - tbif_1d(ji,3) ) )
  382. zsmbr(3) = tbif_1d(ji,3) &
  383. & + zkhic * ( 2.0 * tfu_1d(ji) &
  384. & + zumsb * ( tbif_1d(ji,2) - 3.0 * tbif_1d(ji,3) ) )
  385. ! 6.4. Solve the system (Gauss elimination method).
  386. !----------------------------------------------------
  387. zpiv1 = zsubdiag(2) / zplediag(1)
  388. zb2 = zplediag(2) - zpiv1 * zsupdiag(1)
  389. zd2 = zsmbr(2) - zpiv1 * zsmbr(1)
  390. zpiv2 = zsubdiag(3) / zb2
  391. zb3 = zplediag(3) - zpiv2 * zsupdiag(2)
  392. zd3 = zsmbr(3) - zpiv2 * zd2
  393. tbif_1d(ji,3) = zd3 / zb3
  394. tbif_1d(ji,2) = ( zd2 - zsupdiag(2) * tbif_1d(ji,3) ) / zb2
  395. tbif_1d(ji,1) = ( zsmbr(1) - zsupdiag(1) * tbif_1d(ji,2) ) / zplediag(1)
  396. !--- taking into account the particular case of zidsnic(ji) = 1
  397. ztint = ( zkic(ji) * h_snow_1d(ji) * tfu_1d (ji) &
  398. & + zksn(ji) * h_ice_1d(ji) * sist_1d(ji) ) &
  399. & / ( zkic(ji) * h_snow_1d(ji) + zksn(ji) * h_ice_1d(ji) )
  400. tbif_1d(ji,1) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,1) &
  401. & + zidsnic(ji) * ( ztint + sist_1d(ji) ) / 2.0
  402. tbif_1d(ji,2) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,2) &
  403. & + zidsnic(ji) * ( 3.0 * ztint + tfu_1d(ji) ) / 4.0
  404. tbif_1d(ji,3) = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3) &
  405. & + zidsnic(ji) * ( ztint + 3.0 * tfu_1d(ji) ) / 4.0
  406. END DO
  407. !----------------------------------------------------------------------
  408. ! 9. Take into account surface ablation and bottom accretion-ablation.|
  409. !----------------------------------------------------------------------
  410. !---Snow accumulation in one thermodynamic time step
  411. zsprecip(kideb:kiut) = sprecip_1d(kideb:kiut) * rdt_ice / rhosn
  412. DO ji = kideb, kiut
  413. ! 9.1. Surface ablation and update of snow thickness and qstbif_1d
  414. !--------------------------------------------------------------------
  415. !--------------------------------------------------------------------------
  416. !-- Melting snow processes :
  417. !-- Melt at the upper surface is computed from the difference between
  418. !-- the net heat flux (including the conductive heat flux) at the upper
  419. !-- surface and the pre-existing energy due to surface melting
  420. !------------------------------------------------------------------------------
  421. !-- store the snow thickness
  422. zhsnw_old(ji) = h_snow_1d(ji)
  423. !--computation of the energy needed to melt snow
  424. zqsnw_mlt = zfnet(ji) * rdt_ice - zqcmlts(ji)
  425. !--change in snow thickness due to melt
  426. zdhsmlt = - zqsnw_mlt / xlsn
  427. !-- compute new snow thickness, taking into account the part of snow accumulation
  428. ! (as snow precipitation) and the part of snow lost due to melt
  429. zhsn = h_snow_1d(ji) + zsprecip(ji) + zdhsmlt
  430. h_snow_1d(ji) = MAX( zzero , zhsn )
  431. !-- compute the volume of snow lost after surface melting and the associated mass
  432. dvsbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnw_old(ji) - zsprecip(ji) )
  433. dvsbq_1d(ji) = MIN( zzero , dvsbq_1d(ji) )
  434. ztmp = rhosn * dvsbq_1d(ji)
  435. rdm_snw_1d(ji) = ztmp
  436. !--heat content of the water provided to the ocean (referenced to rt0)
  437. rdq_snw_1d(ji) = cpic * ztmp * ( rt0_snow - rt0 )
  438. !-- If the snow is completely melted the remaining heat is used to melt ice
  439. zqsn_mlt_rem = MAX( zzero , -zhsn ) * xlsn
  440. zqice_top_mlt = zqsn_mlt_rem
  441. zqstbif_old = qstbif_1d(ji)
  442. !--------------------------------------------------------------------------
  443. !-- Melting ice processes at the top surface :
  444. !-- The energy used to melt ice, zqice_top_mlt, is taken from the energy
  445. !-- stored in brine pockets qstbif_1d and the remaining energy coming
  446. !-- from the melting snow process zqsn_mlt_rem.
  447. !-- If qstbif_1d > zqsn_mlt_rem then, one uses only a zqsn_mlt_rem part
  448. !-- of qstbif_1d to melt ice,
  449. !-- zqice_top_mlt = zqice_top_mlt + zqsn_mlt_rem
  450. !-- qstbif_1d = qstbif_1d - zqsn_mlt_rem
  451. !-- Otherwise one uses all qstbif_1d to melt ice
  452. !-- zqice_top_mlt = zqice_top_mlt + qstbif_1d
  453. !-- qstbif_1d = 0
  454. !------------------------------------------------------
  455. ziqf = MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqsn_mlt_rem ) )
  456. zqice_top_mlt = ziqf * ( zqice_top_mlt + zqsn_mlt_rem ) &
  457. & + ( 1.0 - ziqf ) * ( zqice_top_mlt + qstbif_1d(ji) )
  458. qstbif_1d(ji) = ziqf * ( qstbif_1d(ji) - zqsn_mlt_rem ) &
  459. & + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji) )
  460. !-- The contribution of the energy stored in brine pockets qstbif_1d to melt
  461. !-- ice is taking into account only when qstbif_1d is less than zqmax.
  462. !-- Otherwise, only the remaining energy coming from the melting snow
  463. !-- process is used
  464. zihq = MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
  465. zqice_top_mlt = zihq * zqice_top_mlt &
  466. & + ( 1.0 - zihq ) * zqsn_mlt_rem
  467. qstbif_1d(ji) = zihq * qstbif_1d(ji) &
  468. & + ( 1.0 - zihq ) * zqstbif_old
  469. !--change in ice thickness due to melt at the top surface
  470. zdhictop(ji) = -zqice_top_mlt / xlic
  471. !--compute the volume formed after surface melting
  472. dvsbq_1d(ji) = zdhictop(ji) * ( 1.0 - frld_1d(ji) )
  473. !-------------------------------------------------------------------------
  474. !-- A small variation at the surface also occurs because of sublimation
  475. !-- associated with the latent flux. If qla_ice_1d is negative, snow condensates at
  476. ! the surface. Otherwise, snow evaporates
  477. !-----------------------------------------------------------------------
  478. !----change in snow and ice thicknesses due to sublimation or evaporation
  479. zdhssub = parsub * ( qla_ice_1d(ji) / ( rhosn * xsn ) ) * rdt_ice
  480. zhsn = h_snow_1d(ji) - zdhssub
  481. zdhisub = MAX( zzero , -zhsn ) * rhosn/rhoic
  482. zdhictop(ji) = zdhictop(ji) - zdhisub
  483. h_snow_1d(ji) = MAX( zzero , zhsn )
  484. !-------------------------------------------------
  485. !-- Update Internal temperature and qstbif_1d.
  486. !-------------------------------------------
  487. zihsn = MAX( zzero , SIGN( zone, -h_snow_1d(ji) ) )
  488. tbif_1d(ji,1) = ( 1.0 - zihsn ) * tbif_1d(ji,1) + zihsn * tfu_1d(ji)
  489. !--change in snow internal temperature if snow has increased
  490. zihnf = MAX( zzero , SIGN( zone , h_snow_1d(ji) - zhsnw_old(ji) ) )
  491. zdhsn = 1.0 - zhsnw_old(ji) / MAX( h_snow_1d(ji) , epsi20 )
  492. zdtsn = zdhsn * ( sist_1d(ji) - tbif_1d(ji,1) )
  493. tbif_1d(ji,1) = tbif_1d(ji,1) + z1midsn(ji) * zihnf * zdtsn
  494. !--energy created due to ice melting in the first ice layer
  495. zqnes = ( rt0_ice - tbif_1d(ji,2) ) * rcpic * ( h_ice_1d(ji) / 2. )
  496. !--change in first ice layer internal temperature
  497. ziqr = MAX( zzero , SIGN( zone , qstbif_1d(ji) - zqnes ) )
  498. zdtic = qstbif_1d(ji) / ( rcpic * ( h_ice_1d(ji) / 2. ) )
  499. tbif_1d(ji,2) = ziqr * rt0_ice + ( 1 - ziqr ) * ( tbif_1d(ji,2) + zdtic )
  500. !--update qstbif_1d
  501. qstbif_1d(ji) = ziqr * ( qstbif_1d(ji) - zqnes ) * swiqst
  502. !-- 9.2. Calculate bottom accretion-ablation and update qstbif_1d.
  503. ! Growth and melting at bottom ice surface are governed by
  504. ! -xlic * Dh = (Fcb - Fbot ) * Dt
  505. ! where Fbot is the net downward heat flux from ice to the ocean
  506. ! and Fcb is the conductive heat flux at the bottom surface
  507. !---------------------------------------------------------------------------
  508. ztbot = ( 1.0 - zidsnic(ji) ) * tbif_1d(ji,3) + zidsnic(ji) * sist_1d(ji)
  509. !---computes conductive heat flux at bottom surface
  510. zfcbot = 4.0 * zkic(ji) * ( tfu_1d(ji) - ztbot ) &
  511. & / ( h_ice_1d(ji) + zidsnic(ji) * ( 3. * h_ice_1d(ji) &
  512. & + 4.0 * zkic(ji)/zksn(ji) * h_snow_1d(ji) ) )
  513. !---computation of net energy needed for bottom melting/growing
  514. zqice_bot = ( zfcbot - ( fbif_1d(ji) + qlbbq_1d(ji) ) ) * rdt_ice
  515. zqstbif_bot = qstbif_1d(ji)
  516. !---switch to know if bottom surface melts ( = 1 ) or grows ( = 0 )occurs
  517. zibmlt = MAX( zzero , SIGN( zone , -zqice_bot ) )
  518. !--particular case of melting (in the same way as the top surface)
  519. zqice_bot_mlt = zqice_bot
  520. zqstbif_old = zqstbif_bot
  521. ziqf = MAX ( zzero , SIGN( zone , qstbif_1d(ji) + zqice_bot_mlt ) )
  522. zqice_bot_mlt = ziqf * ( zqice_bot_mlt + zqice_bot_mlt ) &
  523. & + ( 1.0 - ziqf ) * ( zqice_bot_mlt + qstbif_1d(ji) )
  524. qstbif_1d(ji) = ziqf * ( qstbif_1d(ji) + zqice_bot_mlt ) &
  525. & + ( 1.0 - ziqf ) * ( qstbif_1d(ji) - qstbif_1d(ji) )
  526. !-- The contribution of the energy stored in brine pockets qstbif_1d to melt
  527. !-- ice is taking into account only when qstbif_1d is less than zqmax.
  528. zihq = MAX ( zzero , SIGN( zone , qstbif_1d(ji) - zqmax(ji) ) )
  529. zqice_bot_mlt = zihq * zqice_bot_mlt &
  530. & + ( 1.0 - zihq ) * zqice_bot
  531. qstbif_1d(ji) = zihq * qstbif_1d(ji) &
  532. & + ( 1.0 - zihq ) * zqstbif_old
  533. !---treatment of the case of melting/growing
  534. zqice_bot = zibmlt * ( zqice_bot_mlt - zqcmltb(ji) ) &
  535. & + ( 1.0 - zibmlt ) * ( zqice_bot - zqcmltb(ji) )
  536. qstbif_1d(ji) = zibmlt * qstbif_1d(ji) &
  537. & + ( 1.0 - zibmlt ) * zqstbif_bot
  538. !--computes change in ice thickness due to melt or growth
  539. zdhicbot(ji) = zqice_bot / xlic
  540. !--limitation of bottom melting if so : hmelt maximum melting at bottom
  541. zdhicmlt = MAX( hmelt , zdhicbot(ji) )
  542. !-- output part due to bottom melting only
  543. IF( zdhicmlt < 0.e0 ) rdvomif_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicmlt
  544. !--energy after bottom melting/growing
  545. zqsup(ji) = ( 1.0 - frld_1d(ji) ) * xlic * ( zdhicmlt - zdhicbot(ji) )
  546. !-- compute the new thickness and the newly formed volume after bottom melting/growing
  547. zdhicbot(ji) = zdhicmlt
  548. dvbbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * zdhicbot(ji)
  549. ! 9.3. Updating ice thickness after top surface ablation
  550. ! and bottom surface accretion/ablation
  551. !---------------------------------------------------------------
  552. zhicnew = h_ice_1d(ji) + zdhictop(ji) + zdhicbot(ji)
  553. !
  554. ! 9.4. Case of total ablation (ice is gone but snow may be left)
  555. !-------------------------------------------------------------------
  556. zhsn = h_snow_1d(ji)
  557. zihgnew = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
  558. zihsn = MAX( zzero , SIGN( zone , -zhsn ) )
  559. !---convert
  560. zdhicm = ( 1.0 - zihgnew ) * ( zhicnew - qstbif_1d(ji) / xlic )
  561. zdhsnm = ( 1.0 - zihsn ) * zdhicm * rhoic / rhosn
  562. !---updating new ice thickness and computing the newly formed ice mass
  563. zhicnew = zihgnew * zhicnew
  564. ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) ) * rhoic
  565. rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
  566. !---heat content of the water provided to the ocean (referenced to rt0)
  567. ! use of rt0_ice is OK for melting ice; in the case of freezing, tfu_1d should be used.
  568. ! This is done in 9.5 section (see below)
  569. rdq_ice_1d(ji) = cpic * ztmp * ( rt0_ice - rt0 )
  570. !---updating new snow thickness and computing the newly formed snow mass
  571. zhsnfi = zhsn + zdhsnm
  572. h_snow_1d(ji) = MAX( zzero , zhsnfi )
  573. ztmp = ( 1.0 - frld_1d(ji) ) * ( h_snow_1d(ji) - zhsn ) * rhosn
  574. rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
  575. !---updating the heat content of the water provided to the ocean (referenced to rt0)
  576. rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
  577. !--remaining energy in case of total ablation
  578. zqocea(ji) = - ( zihsn * xlic * zdhicm + xlsn * ( zhsnfi - h_snow_1d(ji) ) ) * ( 1.0 - frld_1d(ji) )
  579. qstbif_1d(ji) = zihgnew * qstbif_1d(ji)
  580. !
  581. ! 9.5. Update internal temperature and ice thickness.
  582. !-------------------------------------------------------
  583. !
  584. sist_1d(ji) = zihgnew * sist_1d(ji) + ( 1.0 - zihgnew ) * tfu_1d(ji)
  585. zidhb = MAX( zzero , SIGN( zone , - zdhicbot(ji) ) )
  586. zc1 = - zhicnew * 0.5
  587. zpc1 = MIN( 0.5 * zone , - h_ice_1d(ji) * 0.5 - zdhictop(ji) )
  588. zc2 = - zhicnew
  589. zpc2 = zidhb * zc2 + ( 1.0 - zidhb ) * ( - h_ice_1d(ji) - zdhictop(ji) )
  590. zp1 = MAX( zpc1 , zc1 )
  591. zp2 = MAX( zpc2 , zc1 )
  592. zep(ji) = tbif_1d(ji,2)
  593. ztb2 = 2.0 * ( - zp1 * tbif_1d(ji,2) &
  594. & + ( zp1 - zp2 ) * tbif_1d(ji,3) &
  595. & + ( zp2 - zc1 ) * tfu_1d(ji) ) / MAX( zhicnew , epsi20 )
  596. tbif_1d(ji,2) = zihgnew * ztb2 + ( 1.0 - zihgnew ) * tfu_1d(ji)
  597. !---
  598. zp1 = MIN( zpc1 , zc1 )
  599. zp2 = MIN( zpc2 , zc1 )
  600. zp1 = MAX( zc2 , zp1 )
  601. ztb3 = 2.0 * ( ( 1.0 - zidhb ) * ( ( zc1 - zp2 ) * tbif_1d(ji,3) &
  602. & + ( zp2 - zc2 ) * tfu_1d(ji) ) &
  603. & + zidhb * ( ( zc1 - zp1 ) * zep(ji) &
  604. & + ( zp1 - zc2 ) * tbif_1d(ji,3)) ) / MAX( zhicnew , epsi20 )
  605. tbif_1d(ji,3) = zihgnew * ztb3 + ( 1.0 - zihgnew ) * tfu_1d(ji)
  606. h_ice_1d(ji) = zhicnew
  607. ! update the ice heat content given to the ocean in freezing case
  608. ! (part due to difference between rt0_ice and tfu_1d)
  609. ztmp = ( 1. - zidhb ) * rhoic * dvbbq_1d(ji)
  610. rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0_ice )
  611. END DO
  612. !----------------------------------------------------------------------------
  613. ! 10. Surface accretion.
  614. ! The change of ice thickness after snow/ice formation is such that
  615. ! the interface between snow and ice is located at the same height
  616. ! as the ocean surface. It is given by (Fichefet and Morales Maqueda 1999)
  617. ! D(h_ice) = (- D(hsn)/alph) = [rhosn*hsn - (rau0 - rhoic)*hic]
  618. ! / [alph*rhosn+rau0 - rhoic]
  619. !----------------------------------------------------------------------------
  620. !
  621. DO ji = kideb , kiut
  622. !-- Computation of the change of ice thickness after snow-ice formation
  623. zdrmh = ( rhosn * h_snow_1d(ji) + ( rhoic - rau0 ) * h_ice_1d(ji) ) &
  624. & / ( alphs * rhosn + rau0 - rhoic )
  625. zdrmh = MAX( zzero , zdrmh )
  626. !--New ice and snow thicknesses Fichefet and Morales Maqueda (1999)
  627. zhicnew = MAX( h_ice_1d(ji) , h_ice_1d(ji) + zdrmh )
  628. zhsnnew = MIN( h_snow_1d(ji) , h_snow_1d(ji) - alphs * zdrmh )
  629. !---Compute new ice temperatures. snow temperature remains unchanged
  630. ! Lepparanta (1983):
  631. zihic = 1.0 - MAX( zzero , SIGN( zone , -zhicnew ) )
  632. zquot = ( 1.0 - zihic ) &
  633. & + zihic * MIN( zone , h_ice_1d(ji) / MAX( zhicnew , epsi20 ) )
  634. ztneq = alphs * cnscg * tbif_1d(ji,1) &
  635. & + ( 1.0 - alphs * ( rhosn/rhoic ) ) * tfu_1d(ji)
  636. zep(ji) = tbif_1d(ji,2)
  637. tbif_1d(ji,2) = ztneq - zquot * zquot * ( ztneq - tbif_1d(ji,2) )
  638. tbif_1d(ji,3) = 2.0 * ztneq &
  639. & + zquot * ( tbif_1d(ji,3) + zep(ji) - 2.0 * ztneq ) - tbif_1d(ji,2)
  640. !--- Lepparanta (1983) (latent heat released during white ice formation
  641. ! goes to the ocean -for lateral ablation-)
  642. qldif_1d(ji) = qldif_1d(ji) + zdrmh * ( 1.0 - alphs * ( rhosn/rhoic ) ) * xlic * ( 1.0 - frld_1d(ji) )
  643. !-- Changes in ice volume and ice mass Lepparanta (1983):
  644. dvnbq_1d(ji) = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d(ji) )
  645. dmgwi_1d(ji) = dmgwi_1d(ji) + ( 1.0 -frld_1d(ji) ) * ( h_snow_1d(ji) - zhsnnew ) * rhosn
  646. !--- volume change of ice and snow (used for ocean-ice freshwater flux computation)
  647. ztmp = ( 1.0 - frld_1d(ji) ) * ( zhicnew - h_ice_1d (ji) ) * rhoic
  648. rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
  649. rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * ( tfu_1d(ji) - rt0 )
  650. !!gm BUG ?? snow ==> only needed for nn_ice_embd == 0 (standard levitating sea-ice)
  651. ztmp = ( 1.0 - frld_1d(ji) ) * ( zhsnnew - h_snow_1d(ji) ) * rhosn
  652. rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
  653. rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( rt0_snow - rt0 )
  654. !--- Actualize new snow and ice thickness.
  655. h_snow_1d(ji) = zhsnnew
  656. h_ice_1d (ji) = zhicnew
  657. END DO
  658. !----------------------------------------------------
  659. ! 11. Lateral ablation (Changes in sea/ice fraction)
  660. !----------------------------------------------------
  661. DO ji = kideb , kiut
  662. zfrl_old(ji) = frld_1d(ji)
  663. zihic = 1.0 - MAX( zzero , SIGN( zone , -h_ice_1d(ji) ) )
  664. zihsn = 1.0 - MAX( zzero , SIGN( zone , -h_snow_1d(ji) ) )
  665. !--In the case of total ablation (all the ice ice has melted) frld = 1
  666. frld_1d(ji) = ( 1.0 - zihic ) + zihic * zfrl_old(ji)
  667. !--Part of solar radiation absorbing inside the ice and going
  668. !--through the ocean
  669. fscbq_1d(ji) = ( 1.0 - zfrl_old(ji) ) * ( 1.0 - thcm_1d(ji) ) * fstbif_1d(ji)
  670. !--Total remaining energy after bottom melting/growing
  671. qfvbq_1d(ji) = zqsup(ji) + ( 1.0 - zihic ) * zqocea(ji)
  672. !--Updating of total heat from the ocean
  673. qldif_1d(ji) = qldif_1d(ji) + qfvbq_1d(ji) + ( 1.0 - zihic ) * fscbq_1d(ji) * rdt_ice
  674. !--Computation of total heat inside the snow/ice system
  675. zqice = h_snow_1d(ji) * xlsn + h_ice_1d(ji) * xlic
  676. zqicetot = ( 1.0 - frld_1d(ji) ) * zqice
  677. !--The concentration of ice is reduced (frld increases) if the heat
  678. !--exchange between ice and ocean is positive
  679. ziqf = MAX( zzero , SIGN( zone , zqicetot - qldif_1d(ji) ) )
  680. zdfrl = qldif_1d(ji) / MAX( epsi20 , zqice )
  681. frld_1d(ji) = ( 1.0 - ziqf ) &
  682. & + ziqf * ( frld_1d(ji) + MAX( zzero , zdfrl ) )
  683. fltbif_1d(ji) = ( ( 1.0 - zfrl_old(ji) ) * qstbif_1d(ji) - zqicetot ) / rdt_ice
  684. !-- Opening of leads: Hakkinen & Mellor, 1992.
  685. zdfrl = - ( zdhictop(ji) + zdhicbot(ji) ) * hakspl * ( 1.0 - zfrl_old(ji) ) &
  686. & / MAX( epsi13 , h_ice_1d(ji) + h_snow_1d(ji) * rhosn/rhoic )
  687. zfrld_1d(ji) = frld_1d(ji) + MAX( zzero , zdfrl )
  688. !--Limitation of sea-ice fraction <= 1
  689. zfrld_1d(ji) = ziqf * MIN( 0.99 * zone , zfrld_1d(ji) ) + ( 1 - ziqf )
  690. !---Update surface and internal temperature and snow/ice thicknesses.
  691. sist_1d(ji) = sist_1d(ji) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - sist_1d(ji) )
  692. tbif_1d(ji,1) = tbif_1d(ji,1) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,1) )
  693. tbif_1d(ji,2) = tbif_1d(ji,2) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,2) )
  694. tbif_1d(ji,3) = tbif_1d(ji,3) + ( 1.0 - ziqf ) * ( tfu_1d(ji) - tbif_1d(ji,3) )
  695. !--variation of ice volume and ice mass
  696. dvlbq_1d(ji) = zihic * ( zfrl_old(ji) - frld_1d(ji) ) * h_ice_1d(ji)
  697. ztmp = dvlbq_1d(ji) * rhoic
  698. rdm_ice_1d(ji) = rdm_ice_1d(ji) + ztmp
  699. !!gm
  700. !!gm This should be split in two parts:
  701. !!gm 1- heat required to bring sea-ice to tfu : this part should be added to the heat flux taken from the ocean
  702. !!gm cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0_ice )
  703. !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_ice_1d
  704. !!gm cpic * ztmp * ( rt0_ice - rt0 )
  705. !!gm Currently we put all the heat in rdq_ice_1d
  706. rdq_ice_1d(ji) = rdq_ice_1d(ji) + cpic * ztmp * 0.5 * ( tbif_1d(ji,2) + tbif_1d(ji,3) - 2.* rt0 )
  707. !
  708. !--variation of snow volume and snow mass
  709. zdvsnvol = zihsn * ( zfrl_old(ji) - frld_1d(ji) ) * h_snow_1d(ji)
  710. ztmp = zdvsnvol * rhosn
  711. rdm_snw_1d(ji) = rdm_snw_1d(ji) + ztmp
  712. !!gm
  713. !!gm This should be split in two parts:
  714. !!gm 1- heat required to bring snow to tfu : this part should be added to the heat flux taken from the ocean
  715. !!gm cpic * ztmp * ( tbif_1d(ji,1) - rt0_snow )
  716. !!gm 2- heat content of lateral ablation referenced to rt0 : this part only put in rdq_snw_1d
  717. !!gm cpic * ztmp * ( rt0_snow - rt0 )
  718. !!gm Currently we put all the heat in rdq_snw_1d
  719. rdq_snw_1d(ji) = rdq_snw_1d(ji) + cpic * ztmp * ( tbif_1d(ji,1) - rt0 )
  720. h_snow_1d(ji) = ziqf * h_snow_1d(ji)
  721. zdrfrl1 = ziqf * ( 1.0 - frld_1d(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
  722. zdrfrl2 = ziqf * ( 1.0 - zfrl_old(ji) ) / MAX( epsi20 , 1.0 - zfrld_1d(ji) )
  723. h_snow_1d (ji) = zdrfrl1 * h_snow_1d(ji)
  724. h_ice_1d (ji) = zdrfrl1 * h_ice_1d(ji)
  725. qstbif_1d(ji) = zdrfrl2 * qstbif_1d(ji)
  726. frld_1d(ji) = zfrld_1d(ji)
  727. !
  728. END DO
  729. !
  730. CALL wrk_dealloc( jpij, ztsmlt, ztbif , zksn , zkic , zksndh , zfcsu , zfcsudt , zi0 , z1mi0 , zqmax )
  731. CALL wrk_dealloc( jpij, zrcpdt, zts_old, zidsn , z1midsn , zidsnic, zfnet , zsprecip, zhsnw_old, zdhictop, zdhicbot )
  732. CALL wrk_dealloc( jpij, zqsup , zqocea , zfrl_old, zfrld_1d, zep , zqcmlts, zqcmltb )
  733. !
  734. END SUBROUTINE lim_thd_zdf_2
  735. #else
  736. !!----------------------------------------------------------------------
  737. !! Default Option NO sea-ice model
  738. !!----------------------------------------------------------------------
  739. CONTAINS
  740. SUBROUTINE lim_thd_zdf_2 ! Empty routine
  741. END SUBROUTINE lim_thd_zdf_2
  742. #endif
  743. !!======================================================================
  744. END MODULE limthd_zdf_2