limvar.F90 35 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818
  1. MODULE limvar
  2. !!======================================================================
  3. !! *** MODULE limvar ***
  4. !! Different sets of ice model variables
  5. !! how to switch from one to another
  6. !!
  7. !! There are three sets of variables
  8. !! VGLO : global variables of the model
  9. !! - v_i (jpi,jpj,jpl)
  10. !! - v_s (jpi,jpj,jpl)
  11. !! - a_i (jpi,jpj,jpl)
  12. !! - t_s (jpi,jpj,jpl)
  13. !! - e_i (jpi,jpj,nlay_i,jpl)
  14. !! - smv_i(jpi,jpj,jpl)
  15. !! - oa_i (jpi,jpj,jpl)
  16. !! VEQV : equivalent variables sometimes used in the model
  17. !! - ht_i(jpi,jpj,jpl)
  18. !! - ht_s(jpi,jpj,jpl)
  19. !! - t_i (jpi,jpj,nlay_i,jpl)
  20. !! ...
  21. !! VAGG : aggregate variables, averaged/summed over all
  22. !! thickness categories
  23. !! - vt_i(jpi,jpj)
  24. !! - vt_s(jpi,jpj)
  25. !! - at_i(jpi,jpj)
  26. !! - et_s(jpi,jpj) !total snow heat content
  27. !! - et_i(jpi,jpj) !total ice thermal content
  28. !! - smt_i(jpi,jpj) !mean ice salinity
  29. !! - tm_i (jpi,jpj) !mean ice temperature
  30. !!======================================================================
  31. !! History : - ! 2006-01 (M. Vancoppenolle) Original code
  32. !! 3.4 ! 2011-02 (G. Madec) dynamical allocation
  33. !!----------------------------------------------------------------------
  34. #if defined key_lim3
  35. !!----------------------------------------------------------------------
  36. !! 'key_lim3' LIM3 sea-ice model
  37. !!----------------------------------------------------------------------
  38. USE par_oce ! ocean parameters
  39. USE phycst ! physical constants (ocean directory)
  40. USE sbc_oce ! Surface boundary condition: ocean fields
  41. USE ice ! ice variables
  42. USE thd_ice ! ice variables (thermodynamics)
  43. USE dom_ice ! ice domain
  44. USE in_out_manager ! I/O manager
  45. USE lib_mpp ! MPP library
  46. USE wrk_nemo ! work arrays
  47. USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
  48. IMPLICIT NONE
  49. PRIVATE
  50. PUBLIC lim_var_agg
  51. PUBLIC lim_var_glo2eqv
  52. PUBLIC lim_var_eqv2glo
  53. PUBLIC lim_var_salprof
  54. PUBLIC lim_var_bv
  55. PUBLIC lim_var_salprof1d
  56. PUBLIC lim_var_zapsmall
  57. PUBLIC lim_var_itd
  58. !!----------------------------------------------------------------------
  59. !! NEMO/LIM3 3.5 , UCL - NEMO Consortium (2011)
  60. !! $Id: limvar.F90 7814 2017-03-20 16:21:42Z clem $
  61. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  62. !!----------------------------------------------------------------------
  63. CONTAINS
  64. SUBROUTINE lim_var_agg( kn )
  65. !!------------------------------------------------------------------
  66. !! *** ROUTINE lim_var_agg ***
  67. !!
  68. !! ** Purpose : aggregates ice-thickness-category variables to all-ice variables
  69. !! i.e. it turns VGLO into VAGG
  70. !! ** Method :
  71. !!
  72. !! ** Arguments : n = 1, at_i vt_i only
  73. !! n = 2 everything
  74. !!
  75. !! note : you could add an argument when you need only at_i, vt_i
  76. !! and when you need everything
  77. !!------------------------------------------------------------------
  78. INTEGER, INTENT( in ) :: kn ! =1 at_i & vt only ; = what is needed
  79. !
  80. INTEGER :: ji, jj, jk, jl ! dummy loop indices
  81. !!------------------------------------------------------------------
  82. !--------------------
  83. ! Compute variables
  84. !--------------------
  85. ! integrated values
  86. vt_i (:,:) = SUM( v_i, dim=3 )
  87. vt_s (:,:) = SUM( v_s, dim=3 )
  88. at_i (:,:) = SUM( a_i, dim=3 )
  89. et_s(:,:) = SUM( SUM( e_s(:,:,:,:), dim=4 ), dim=3 )
  90. et_i(:,:) = SUM( SUM( e_i(:,:,:,:), dim=4 ), dim=3 )
  91. !
  92. DO jj = 1, jpj
  93. DO ji = 1, jpi
  94. ato_i(ji,jj) = MAX( 1._wp - at_i(ji,jj), 0._wp ) ! open water fraction
  95. END DO
  96. END DO
  97. IF( kn > 1 ) THEN
  98. !
  99. ! mean ice/snow thickness
  100. DO jj = 1, jpj
  101. DO ji = 1, jpi
  102. rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
  103. htm_i(ji,jj) = vt_i(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
  104. htm_s(ji,jj) = vt_s(ji,jj) / MAX( at_i(ji,jj) , epsi10 ) * rswitch
  105. ENDDO
  106. ENDDO
  107. ! mean temperature (K), salinity and age
  108. smt_i(:,:) = 0._wp
  109. tm_i(:,:) = 0._wp
  110. tm_su(:,:) = 0._wp
  111. tm_si(:,:) = 0._wp
  112. om_i (:,:) = 0._wp
  113. DO jl = 1, jpl
  114. DO jj = 1, jpj
  115. DO ji = 1, jpi
  116. rswitch = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi10 ) )
  117. tm_su(ji,jj) = tm_su(ji,jj) + rswitch * ( t_su(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 )
  118. tm_si(ji,jj) = tm_si(ji,jj) + rswitch * ( t_si(ji,jj,jl) - rt0 ) * a_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 )
  119. om_i (ji,jj) = om_i (ji,jj) + rswitch * oa_i(ji,jj,jl) / MAX( at_i(ji,jj) , epsi10 )
  120. END DO
  121. END DO
  122. DO jk = 1, nlay_i
  123. DO jj = 1, jpj
  124. DO ji = 1, jpi
  125. rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
  126. tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) &
  127. & / MAX( vt_i(ji,jj) , epsi10 )
  128. smt_i(ji,jj) = smt_i(ji,jj) + r1_nlay_i * rswitch * s_i(ji,jj,jk,jl) * v_i(ji,jj,jl) &
  129. & / MAX( vt_i(ji,jj) , epsi10 )
  130. END DO
  131. END DO
  132. END DO
  133. END DO
  134. tm_i = tm_i + rt0
  135. tm_su = tm_su + rt0
  136. tm_si = tm_si + rt0
  137. !
  138. ENDIF
  139. !
  140. END SUBROUTINE lim_var_agg
  141. SUBROUTINE lim_var_glo2eqv
  142. !!------------------------------------------------------------------
  143. !! *** ROUTINE lim_var_glo2eqv ***
  144. !!
  145. !! ** Purpose : computes equivalent variables as function of global variables
  146. !! i.e. it turns VGLO into VEQV
  147. !!------------------------------------------------------------------
  148. INTEGER :: ji, jj, jk, jl ! dummy loop indices
  149. REAL(wp) :: zq_i, zaaa, zbbb, zccc, zdiscrim ! local scalars
  150. REAL(wp) :: ztmelts, zq_s, zfac1, zfac2 ! - -
  151. !!------------------------------------------------------------------
  152. !-------------------------------------------------------
  153. ! Ice thickness, snow thickness, ice salinity, ice age
  154. !-------------------------------------------------------
  155. DO jl = 1, jpl
  156. DO jj = 1, jpj
  157. DO ji = 1, jpi
  158. rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes
  159. ht_i(ji,jj,jl) = v_i (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
  160. END DO
  161. END DO
  162. END DO
  163. ! Force the upper limit of ht_i to always be < hi_max (99 m).
  164. DO jj = 1, jpj
  165. DO ji = 1, jpi
  166. rswitch = MAX( 0._wp , SIGN( 1._wp, ht_i(ji,jj,jpl) - epsi20 ) )
  167. ht_i(ji,jj,jpl) = MIN( ht_i(ji,jj,jpl) , hi_max(jpl) )
  168. a_i (ji,jj,jpl) = v_i(ji,jj,jpl) / MAX( ht_i(ji,jj,jpl) , epsi20 ) * rswitch
  169. END DO
  170. END DO
  171. DO jl = 1, jpl
  172. DO jj = 1, jpj
  173. DO ji = 1, jpi
  174. rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes
  175. ht_s(ji,jj,jl) = v_s (ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
  176. o_i(ji,jj,jl) = oa_i(ji,jj,jl) / MAX( a_i(ji,jj,jl) , epsi20 ) * rswitch
  177. END DO
  178. END DO
  179. END DO
  180. IF( nn_icesal == 2 )THEN
  181. DO jl = 1, jpl
  182. DO jj = 1, jpj
  183. DO ji = 1, jpi
  184. rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi20 ) ) !0 if no ice and 1 if yes
  185. sm_i(ji,jj,jl) = smv_i(ji,jj,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * rswitch
  186. ! ! bounding salinity
  187. sm_i(ji,jj,jl) = MAX( sm_i(ji,jj,jl), rn_simin )
  188. END DO
  189. END DO
  190. END DO
  191. ENDIF
  192. CALL lim_var_salprof ! salinity profile
  193. !-------------------
  194. ! Ice temperatures
  195. !-------------------
  196. DO jl = 1, jpl
  197. DO jk = 1, nlay_i
  198. DO jj = 1, jpj
  199. DO ji = 1, jpi
  200. ! ! Energy of melting q(S,T) [J.m-3]
  201. rswitch = MAX( 0.0 , SIGN( 1.0 , v_i(ji,jj,jl) - epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes
  202. zq_i = rswitch * e_i(ji,jj,jk,jl) / MAX( v_i(ji,jj,jl) , epsi20 ) * REAL(nlay_i,wp)
  203. ztmelts = -tmut * s_i(ji,jj,jk,jl) + rt0 ! Ice layer melt temperature
  204. !
  205. zaaa = cpic ! Conversion q(S,T) -> T (second order equation)
  206. zbbb = ( rcp - cpic ) * ( ztmelts - rt0 ) + zq_i * r1_rhoic - lfus
  207. zccc = lfus * (ztmelts-rt0)
  208. zdiscrim = SQRT( MAX(zbbb*zbbb - 4._wp*zaaa*zccc , 0._wp) )
  209. t_i(ji,jj,jk,jl) = rt0 + rswitch *( - zbbb - zdiscrim ) / ( 2.0 *zaaa )
  210. t_i(ji,jj,jk,jl) = MIN( ztmelts, MAX( rt0 - 100._wp, t_i(ji,jj,jk,jl) ) ) ! -100 < t_i < ztmelts
  211. END DO
  212. END DO
  213. END DO
  214. END DO
  215. !--------------------
  216. ! Snow temperatures
  217. !--------------------
  218. zfac1 = 1._wp / ( rhosn * cpic )
  219. zfac2 = lfus / cpic
  220. DO jl = 1, jpl
  221. DO jk = 1, nlay_s
  222. DO jj = 1, jpj
  223. DO ji = 1, jpi
  224. !Energy of melting q(S,T) [J.m-3]
  225. rswitch = MAX( 0._wp , SIGN( 1._wp , v_s(ji,jj,jl) - epsi20 ) ) ! rswitch = 0 if no ice and 1 if yes
  226. zq_s = rswitch * e_s(ji,jj,jk,jl) / MAX( v_s(ji,jj,jl) , epsi20 ) * REAL(nlay_s,wp)
  227. !
  228. t_s(ji,jj,jk,jl) = rt0 + rswitch * ( - zfac1 * zq_s + zfac2 )
  229. t_s(ji,jj,jk,jl) = MIN( rt0, MAX( rt0 - 100._wp , t_s(ji,jj,jk,jl) ) ) ! -100 < t_s < rt0
  230. END DO
  231. END DO
  232. END DO
  233. END DO
  234. !-------------------
  235. ! Mean temperature
  236. !-------------------
  237. ! integrated values
  238. vt_i (:,:) = SUM( v_i, dim=3 )
  239. vt_s (:,:) = SUM( v_s, dim=3 )
  240. at_i (:,:) = SUM( a_i, dim=3 )
  241. tm_i(:,:) = 0._wp
  242. DO jl = 1, jpl
  243. DO jk = 1, nlay_i
  244. DO jj = 1, jpj
  245. DO ji = 1, jpi
  246. rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
  247. tm_i(ji,jj) = tm_i(ji,jj) + r1_nlay_i * rswitch * ( t_i(ji,jj,jk,jl) - rt0 ) * v_i(ji,jj,jl) &
  248. & / MAX( vt_i(ji,jj) , epsi10 )
  249. END DO
  250. END DO
  251. END DO
  252. END DO
  253. tm_i = tm_i + rt0
  254. !
  255. END SUBROUTINE lim_var_glo2eqv
  256. SUBROUTINE lim_var_eqv2glo
  257. !!------------------------------------------------------------------
  258. !! *** ROUTINE lim_var_eqv2glo ***
  259. !!
  260. !! ** Purpose : computes global variables as function of equivalent variables
  261. !! i.e. it turns VEQV into VGLO
  262. !! ** Method :
  263. !!
  264. !! ** History : (01-2006) Martin Vancoppenolle, UCL-ASTR
  265. !!------------------------------------------------------------------
  266. !
  267. v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:)
  268. v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)
  269. smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)
  270. !
  271. END SUBROUTINE lim_var_eqv2glo
  272. SUBROUTINE lim_var_salprof
  273. !!------------------------------------------------------------------
  274. !! *** ROUTINE lim_var_salprof ***
  275. !!
  276. !! ** Purpose : computes salinity profile in function of bulk salinity
  277. !!
  278. !! ** Method : If bulk salinity greater than zsi1,
  279. !! the profile is assumed to be constant (S_inf)
  280. !! If bulk salinity lower than zsi0,
  281. !! the profile is linear with 0 at the surface (S_zero)
  282. !! If it is between zsi0 and zsi1, it is a
  283. !! alpha-weighted linear combination of s_inf and s_zero
  284. !!
  285. !! ** References : Vancoppenolle et al., 2007
  286. !!------------------------------------------------------------------
  287. INTEGER :: ji, jj, jk, jl ! dummy loop index
  288. REAL(wp) :: zfac0, zfac1, zsal
  289. REAL(wp) :: zswi0, zswi01, zargtemp , zs_zero
  290. REAL(wp), POINTER, DIMENSION(:,:,:) :: z_slope_s, zalpha
  291. REAL(wp), PARAMETER :: zsi0 = 3.5_wp
  292. REAL(wp), PARAMETER :: zsi1 = 4.5_wp
  293. !!------------------------------------------------------------------
  294. CALL wrk_alloc( jpi, jpj, jpl, z_slope_s, zalpha )
  295. !---------------------------------------
  296. ! Vertically constant, constant in time
  297. !---------------------------------------
  298. IF( nn_icesal == 1 ) THEN
  299. s_i (:,:,:,:) = rn_icesal
  300. sm_i(:,:,:) = rn_icesal
  301. ENDIF
  302. !-----------------------------------
  303. ! Salinity profile, varying in time
  304. !-----------------------------------
  305. IF( nn_icesal == 2 ) THEN
  306. !
  307. DO jk = 1, nlay_i
  308. s_i(:,:,jk,:) = sm_i(:,:,:)
  309. END DO
  310. !
  311. DO jl = 1, jpl ! Slope of the linear profile
  312. DO jj = 1, jpj
  313. DO ji = 1, jpi
  314. rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i(ji,jj,jl) - epsi20 ) )
  315. z_slope_s(ji,jj,jl) = rswitch * 2._wp * sm_i(ji,jj,jl) / MAX( epsi20 , ht_i(ji,jj,jl) )
  316. END DO
  317. END DO
  318. END DO
  319. !
  320. zfac0 = 1._wp / ( zsi0 - zsi1 ) ! Weighting factor between zs_zero and zs_inf
  321. zfac1 = zsi1 / ( zsi1 - zsi0 )
  322. !
  323. zalpha(:,:,:) = 0._wp
  324. DO jl = 1, jpl
  325. DO jj = 1, jpj
  326. DO ji = 1, jpi
  327. ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
  328. zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i(ji,jj,jl) ) )
  329. ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
  330. zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i(ji,jj,jl) ) )
  331. ! If 2.sm_i GE sss_m then rswitch = 1
  332. ! this is to force a constant salinity profile in the Baltic Sea
  333. rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i(ji,jj,jl) - sss_m(ji,jj) ) )
  334. zalpha(ji,jj,jl) = zswi0 + zswi01 * ( sm_i(ji,jj,jl) * zfac0 + zfac1 )
  335. zalpha(ji,jj,jl) = zalpha(ji,jj,jl) * ( 1._wp - rswitch )
  336. END DO
  337. END DO
  338. END DO
  339. ! Computation of the profile
  340. DO jl = 1, jpl
  341. DO jk = 1, nlay_i
  342. DO jj = 1, jpj
  343. DO ji = 1, jpi
  344. ! ! linear profile with 0 at the surface
  345. zs_zero = z_slope_s(ji,jj,jl) * ( REAL(jk,wp) - 0.5_wp ) * ht_i(ji,jj,jl) * r1_nlay_i
  346. ! ! weighting the profile
  347. s_i(ji,jj,jk,jl) = zalpha(ji,jj,jl) * zs_zero + ( 1._wp - zalpha(ji,jj,jl) ) * sm_i(ji,jj,jl)
  348. ! ! bounding salinity
  349. s_i(ji,jj,jk,jl) = MIN( rn_simax, MAX( s_i(ji,jj,jk,jl), rn_simin ) )
  350. END DO
  351. END DO
  352. END DO
  353. END DO
  354. !
  355. ENDIF ! nn_icesal
  356. !-------------------------------------------------------
  357. ! Vertically varying salinity profile, constant in time
  358. !-------------------------------------------------------
  359. IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
  360. !
  361. sm_i(:,:,:) = 2.30_wp
  362. !
  363. DO jl = 1, jpl
  364. DO jk = 1, nlay_i
  365. zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
  366. zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) )
  367. s_i(:,:,jk,jl) = zsal
  368. END DO
  369. END DO
  370. !
  371. ENDIF ! nn_icesal
  372. !
  373. CALL wrk_dealloc( jpi, jpj, jpl, z_slope_s, zalpha )
  374. !
  375. END SUBROUTINE lim_var_salprof
  376. SUBROUTINE lim_var_bv
  377. !!------------------------------------------------------------------
  378. !! *** ROUTINE lim_var_bv ***
  379. !!
  380. !! ** Purpose : computes mean brine volume (%) in sea ice
  381. !!
  382. !! ** Method : e = - 0.054 * S (ppt) / T (C)
  383. !!
  384. !! References : Vancoppenolle et al., JGR, 2007
  385. !!------------------------------------------------------------------
  386. INTEGER :: ji, jj, jk, jl ! dummy loop indices
  387. !!------------------------------------------------------------------
  388. !
  389. bvm_i(:,:) = 0._wp
  390. bv_i (:,:,:) = 0._wp
  391. DO jl = 1, jpl
  392. DO jk = 1, nlay_i
  393. DO jj = 1, jpj
  394. DO ji = 1, jpi
  395. rswitch = ( 1._wp - MAX( 0._wp , SIGN( 1._wp , (t_i(ji,jj,jk,jl) - rt0) + epsi10 ) ) )
  396. bv_i(ji,jj,jl) = bv_i(ji,jj,jl) - rswitch * tmut * s_i(ji,jj,jk,jl) * r1_nlay_i &
  397. & / MIN( t_i(ji,jj,jk,jl) - rt0, - epsi10 )
  398. END DO
  399. END DO
  400. END DO
  401. DO jj = 1, jpj
  402. DO ji = 1, jpi
  403. rswitch = MAX( 0._wp , SIGN( 1._wp , vt_i(ji,jj) - epsi10 ) )
  404. bvm_i(ji,jj) = bvm_i(ji,jj) + rswitch * bv_i(ji,jj,jl) * v_i(ji,jj,jl) / MAX( vt_i(ji,jj), epsi10 )
  405. END DO
  406. END DO
  407. END DO
  408. !
  409. END SUBROUTINE lim_var_bv
  410. SUBROUTINE lim_var_salprof1d( kideb, kiut )
  411. !!-------------------------------------------------------------------
  412. !! *** ROUTINE lim_thd_salprof1d ***
  413. !!
  414. !! ** Purpose : 1d computation of the sea ice salinity profile
  415. !! Works with 1d vectors and is used by thermodynamic modules
  416. !!-------------------------------------------------------------------
  417. INTEGER, INTENT(in) :: kideb, kiut ! thickness category index
  418. !
  419. INTEGER :: ji, jk ! dummy loop indices
  420. INTEGER :: ii, ij ! local integers
  421. REAL(wp) :: zfac0, zfac1, zargtemp, zsal ! local scalars
  422. REAL(wp) :: zalpha, zswi0, zswi01, zs_zero ! - -
  423. !
  424. REAL(wp), POINTER, DIMENSION(:) :: z_slope_s
  425. REAL(wp), PARAMETER :: zsi0 = 3.5_wp
  426. REAL(wp), PARAMETER :: zsi1 = 4.5_wp
  427. !!---------------------------------------------------------------------
  428. CALL wrk_alloc( jpij, z_slope_s )
  429. !---------------------------------------
  430. ! Vertically constant, constant in time
  431. !---------------------------------------
  432. IF( nn_icesal == 1 ) s_i_1d(:,:) = rn_icesal
  433. !------------------------------------------------------
  434. ! Vertically varying salinity profile, varying in time
  435. !------------------------------------------------------
  436. IF( nn_icesal == 2 ) THEN
  437. !
  438. DO ji = kideb, kiut ! Slope of the linear profile zs_zero
  439. rswitch = MAX( 0._wp , SIGN( 1._wp , ht_i_1d(ji) - epsi20 ) )
  440. z_slope_s(ji) = rswitch * 2._wp * sm_i_1d(ji) / MAX( epsi20 , ht_i_1d(ji) )
  441. END DO
  442. ! Weighting factor between zs_zero and zs_inf
  443. !---------------------------------------------
  444. zfac0 = 1._wp / ( zsi0 - zsi1 )
  445. zfac1 = zsi1 / ( zsi1 - zsi0 )
  446. DO jk = 1, nlay_i
  447. DO ji = kideb, kiut
  448. ii = MOD( npb(ji) - 1 , jpi ) + 1
  449. ij = ( npb(ji) - 1 ) / jpi + 1
  450. ! zswi0 = 1 if sm_i le zsi0 and 0 otherwise
  451. zswi0 = MAX( 0._wp , SIGN( 1._wp , zsi0 - sm_i_1d(ji) ) )
  452. ! zswi01 = 1 if sm_i is between zsi0 and zsi1 and 0 othws
  453. zswi01 = ( 1._wp - zswi0 ) * MAX( 0._wp , SIGN( 1._wp , zsi1 - sm_i_1d(ji) ) )
  454. ! if 2.sm_i GE sss_m then rswitch = 1
  455. ! this is to force a constant salinity profile in the Baltic Sea
  456. rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) )
  457. !
  458. zalpha = ( zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 ) ) * ( 1._wp - rswitch )
  459. !
  460. zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i
  461. ! weighting the profile
  462. s_i_1d(ji,jk) = zalpha * zs_zero + ( 1._wp - zalpha ) * sm_i_1d(ji)
  463. ! bounding salinity
  464. s_i_1d(ji,jk) = MIN( rn_simax, MAX( s_i_1d(ji,jk), rn_simin ) )
  465. END DO
  466. END DO
  467. ENDIF
  468. !-------------------------------------------------------
  469. ! Vertically varying salinity profile, constant in time
  470. !-------------------------------------------------------
  471. IF( nn_icesal == 3 ) THEN ! Schwarzacher (1959) multiyear salinity profile (mean = 2.30)
  472. !
  473. sm_i_1d(:) = 2.30_wp
  474. !
  475. DO jk = 1, nlay_i
  476. zargtemp = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i
  477. zsal = 1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) )
  478. DO ji = kideb, kiut
  479. s_i_1d(ji,jk) = zsal
  480. END DO
  481. END DO
  482. !
  483. ENDIF
  484. !
  485. CALL wrk_dealloc( jpij, z_slope_s )
  486. !
  487. END SUBROUTINE lim_var_salprof1d
  488. SUBROUTINE lim_var_zapsmall
  489. !!-------------------------------------------------------------------
  490. !! *** ROUTINE lim_var_zapsmall ***
  491. !!
  492. !! ** Purpose : Remove too small sea ice areas and correct fluxes
  493. !!
  494. !! history : LIM3.5 - 01-2014 (C. Rousset) original code
  495. !!-------------------------------------------------------------------
  496. INTEGER :: ji, jj, jl, jk ! dummy loop indices
  497. REAL(wp) :: zsal, zvi, zvs, zei, zes
  498. !!-------------------------------------------------------------------
  499. at_i (:,:) = 0._wp
  500. DO jl = 1, jpl
  501. at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
  502. END DO
  503. DO jl = 1, jpl
  504. !-----------------------------------------------------------------
  505. ! Zap ice energy and use ocean heat to melt ice
  506. !-----------------------------------------------------------------
  507. DO jk = 1, nlay_i
  508. DO jj = 1 , jpj
  509. DO ji = 1 , jpi
  510. rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
  511. rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch
  512. rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
  513. rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch &
  514. & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
  515. zei = e_i(ji,jj,jk,jl)
  516. e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch
  517. t_i(ji,jj,jk,jl) = t_i(ji,jj,jk,jl) * rswitch + rt0 * ( 1._wp - rswitch )
  518. ! update exchanges with ocean
  519. hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_i(ji,jj,jk,jl) - zei ) * r1_rdtice ! W.m-2 <0
  520. END DO
  521. END DO
  522. END DO
  523. DO jj = 1 , jpj
  524. DO ji = 1 , jpi
  525. rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) )
  526. rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj ) - epsi10 ) ) * rswitch
  527. rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) - epsi10 ) ) * rswitch
  528. rswitch = MAX( 0._wp , SIGN( 1._wp, v_i(ji,jj,jl) * rswitch &
  529. & / MAX( a_i(ji,jj,jl), epsi10 ) - epsi10 ) ) * rswitch
  530. zsal = smv_i(ji,jj, jl)
  531. zvi = v_i (ji,jj, jl)
  532. zvs = v_s (ji,jj, jl)
  533. zes = e_s (ji,jj,1,jl)
  534. !-----------------------------------------------------------------
  535. ! Zap snow energy
  536. !-----------------------------------------------------------------
  537. t_s(ji,jj,1,jl) = t_s(ji,jj,1,jl) * rswitch + rt0 * ( 1._wp - rswitch )
  538. e_s(ji,jj,1,jl) = e_s(ji,jj,1,jl) * rswitch
  539. !-----------------------------------------------------------------
  540. ! zap ice and snow volume, add water and salt to ocean
  541. !-----------------------------------------------------------------
  542. ato_i(ji,jj) = a_i (ji,jj,jl) * ( 1._wp - rswitch ) + ato_i(ji,jj)
  543. a_i (ji,jj,jl) = a_i (ji,jj,jl) * rswitch
  544. v_i (ji,jj,jl) = v_i (ji,jj,jl) * rswitch
  545. v_s (ji,jj,jl) = v_s (ji,jj,jl) * rswitch
  546. t_su (ji,jj,jl) = t_su (ji,jj,jl) * rswitch + t_bo(ji,jj) * ( 1._wp - rswitch )
  547. oa_i (ji,jj,jl) = oa_i (ji,jj,jl) * rswitch
  548. smv_i(ji,jj,jl) = smv_i(ji,jj,jl) * rswitch
  549. ! update exchanges with ocean
  550. sfx_res(ji,jj) = sfx_res(ji,jj) - ( smv_i(ji,jj,jl) - zsal ) * rhoic * r1_rdtice
  551. wfx_res(ji,jj) = wfx_res(ji,jj) - ( v_i(ji,jj,jl) - zvi ) * rhoic * r1_rdtice
  552. wfx_snw(ji,jj) = wfx_snw(ji,jj) - ( v_s(ji,jj,jl) - zvs ) * rhosn * r1_rdtice
  553. hfx_res(ji,jj) = hfx_res(ji,jj) + ( e_s(ji,jj,1,jl) - zes ) * r1_rdtice ! W.m-2 <0
  554. END DO
  555. END DO
  556. END DO
  557. ! to be sure that at_i is the sum of a_i(jl)
  558. at_i (:,:) = 0._wp
  559. DO jl = 1, jpl
  560. at_i(:,:) = at_i(:,:) + a_i(:,:,jl)
  561. END DO
  562. ! open water = 1 if at_i=0
  563. DO jj = 1, jpj
  564. DO ji = 1, jpi
  565. rswitch = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) )
  566. ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj)
  567. END DO
  568. END DO
  569. !
  570. END SUBROUTINE lim_var_zapsmall
  571. SUBROUTINE lim_var_itd( zhti, zhts, zai, zht_i, zht_s, za_i )
  572. !!------------------------------------------------------------------
  573. !! *** ROUTINE lim_var_itd ***
  574. !!
  575. !! ** Purpose : converting 1-cat ice to multiple ice categories
  576. !!
  577. !! ice thickness distribution follows a gaussian law
  578. !! around the concentration of the most likely ice thickness
  579. !! (similar as limistate.F90)
  580. !!
  581. !! ** Method: Iterative procedure
  582. !!
  583. !! 1) Try to fill the jpl ice categories (bounds hi_max(0:jpl)) with a gaussian
  584. !!
  585. !! 2) Check whether the distribution conserves area and volume, positivity and
  586. !! category boundaries
  587. !!
  588. !! 3) If not (input ice is too thin), the last category is empty and
  589. !! the number of categories is reduced (jpl-1)
  590. !!
  591. !! 4) Iterate until ok (SUM(itest(:) = 4)
  592. !!
  593. !! ** Arguments : zhti: 1-cat ice thickness
  594. !! zhts: 1-cat snow depth
  595. !! zai : 1-cat ice concentration
  596. !!
  597. !! ** Output : jpl-cat
  598. !!
  599. !! (Example of application: BDY forcings when input are cell averaged)
  600. !!
  601. !!-------------------------------------------------------------------
  602. !! History : LIM3.5 - 2012 (M. Vancoppenolle) Original code
  603. !! 2014 (C. Rousset) Rewriting
  604. !!-------------------------------------------------------------------
  605. !! Local variables
  606. INTEGER :: ji, jk, jl ! dummy loop indices
  607. INTEGER :: ijpij, i_fill, jl0
  608. REAL(wp) :: zarg, zV, zconv, zdh, zdv
  609. REAL(wp), DIMENSION(:), INTENT(in) :: zhti, zhts, zai ! input ice/snow variables
  610. REAL(wp), DIMENSION(:,:), INTENT(inout) :: zht_i, zht_s, za_i ! output ice/snow variables
  611. INTEGER , POINTER, DIMENSION(:) :: itest
  612. CALL wrk_alloc( 4, itest )
  613. !--------------------------------------------------------------------
  614. ! initialisation of variables
  615. !--------------------------------------------------------------------
  616. ijpij = SIZE(zhti,1)
  617. zht_i(1:ijpij,1:jpl) = 0._wp
  618. zht_s(1:ijpij,1:jpl) = 0._wp
  619. za_i (1:ijpij,1:jpl) = 0._wp
  620. ! ----------------------------------------
  621. ! distribution over the jpl ice categories
  622. ! ----------------------------------------
  623. DO ji = 1, ijpij
  624. IF( zhti(ji) > 0._wp ) THEN
  625. ! find which category (jl0) the input ice thickness falls into
  626. jl0 = jpl
  627. DO jl = 1, jpl
  628. IF ( ( zhti(ji) >= hi_max(jl-1) ) .AND. ( zhti(ji) < hi_max(jl) ) ) THEN
  629. jl0 = jl
  630. CYCLE
  631. ENDIF
  632. END DO
  633. ! initialisation of tests
  634. itest(:) = 0
  635. i_fill = jpl + 1 !====================================
  636. DO WHILE ( ( SUM( itest(:) ) /= 4 ) .AND. ( i_fill >= 2 ) ) ! iterative loop on i_fill categories
  637. ! iteration !====================================
  638. i_fill = i_fill - 1
  639. ! initialisation of ice variables for each try
  640. zht_i(ji,1:jpl) = 0._wp
  641. za_i (ji,1:jpl) = 0._wp
  642. itest(:) = 0
  643. ! *** case very thin ice: fill only category 1
  644. IF ( i_fill == 1 ) THEN
  645. zht_i(ji,1) = zhti(ji)
  646. za_i (ji,1) = zai (ji)
  647. ! *** case ice is thicker: fill categories >1
  648. ELSE
  649. ! Fill ice thicknesses in the (i_fill-1) cat by hmean
  650. DO jl = 1, i_fill - 1
  651. zht_i(ji,jl) = hi_mean(jl)
  652. END DO
  653. ! Concentrations in the (i_fill-1) categories
  654. za_i(ji,jl0) = zai(ji) / SQRT(REAL(jpl))
  655. DO jl = 1, i_fill - 1
  656. IF ( jl /= jl0 ) THEN
  657. zarg = ( zht_i(ji,jl) - zhti(ji) ) / ( zhti(ji) * 0.5_wp )
  658. za_i(ji,jl) = za_i (ji,jl0) * EXP(-zarg**2)
  659. ENDIF
  660. END DO
  661. ! Concentration in the last (i_fill) category
  662. za_i(ji,i_fill) = zai(ji) - SUM( za_i(ji,1:i_fill-1) )
  663. ! Ice thickness in the last (i_fill) category
  664. zV = SUM( za_i(ji,1:i_fill-1) * zht_i(ji,1:i_fill-1) )
  665. zht_i(ji,i_fill) = ( zhti(ji) * zai(ji) - zV ) / MAX( za_i(ji,i_fill), epsi10 )
  666. ! clem: correction if concentration of upper cat is greater than lower cat
  667. ! (it should be a gaussian around jl0 but sometimes it is not)
  668. IF ( jl0 /= jpl ) THEN
  669. DO jl = jpl, jl0+1, -1
  670. IF ( za_i(ji,jl) > za_i(ji,jl-1) ) THEN
  671. zdv = zht_i(ji,jl) * za_i(ji,jl)
  672. zht_i(ji,jl ) = 0._wp
  673. za_i (ji,jl ) = 0._wp
  674. za_i (ji,1:jl-1) = za_i(ji,1:jl-1) + zdv / MAX( REAL(jl-1) * zhti(ji), epsi10 )
  675. END IF
  676. ENDDO
  677. ENDIF
  678. ENDIF ! case ice is thick or thin
  679. !---------------------
  680. ! Compatibility tests
  681. !---------------------
  682. ! Test 1: area conservation
  683. zconv = ABS( zai(ji) - SUM( za_i(ji,1:jpl) ) )
  684. IF ( zconv < epsi06 ) itest(1) = 1
  685. ! Test 2: volume conservation
  686. zconv = ABS( zhti(ji)*zai(ji) - SUM( za_i(ji,1:jpl)*zht_i(ji,1:jpl) ) )
  687. IF ( zconv < epsi06 ) itest(2) = 1
  688. ! Test 3: thickness of the last category is in-bounds ?
  689. IF ( zht_i(ji,i_fill) >= hi_max(i_fill-1) ) itest(3) = 1
  690. ! Test 4: positivity of ice concentrations
  691. itest(4) = 1
  692. DO jl = 1, i_fill
  693. IF ( za_i(ji,jl) < 0._wp ) itest(4) = 0
  694. END DO
  695. ! !============================
  696. END DO ! end iteration on categories
  697. ! !============================
  698. ENDIF ! if zhti > 0
  699. END DO ! i loop
  700. ! ------------------------------------------------
  701. ! Adding Snow in each category where za_i is not 0
  702. ! ------------------------------------------------
  703. DO jl = 1, jpl
  704. DO ji = 1, ijpij
  705. IF( za_i(ji,jl) > 0._wp ) THEN
  706. zht_s(ji,jl) = zht_i(ji,jl) * ( zhts(ji) / zhti(ji) )
  707. ! In case snow load is in excess that would lead to transformation from snow to ice
  708. ! Then, transfer the snow excess into the ice (different from limthd_dh)
  709. zdh = MAX( 0._wp, ( rhosn * zht_s(ji,jl) + ( rhoic - rau0 ) * zht_i(ji,jl) ) * r1_rau0 )
  710. ! recompute ht_i, ht_s avoiding out of bounds values
  711. zht_i(ji,jl) = MIN( hi_max(jl), zht_i(ji,jl) + zdh )
  712. zht_s(ji,jl) = MAX( 0._wp, zht_s(ji,jl) - zdh * rhoic * r1_rhosn )
  713. ENDIF
  714. ENDDO
  715. ENDDO
  716. CALL wrk_dealloc( 4, itest )
  717. !
  718. END SUBROUTINE lim_var_itd
  719. #else
  720. !!----------------------------------------------------------------------
  721. !! Default option Dummy module NO LIM3 sea-ice model
  722. !!----------------------------------------------------------------------
  723. CONTAINS
  724. SUBROUTINE lim_var_agg ! Empty routines
  725. END SUBROUTINE lim_var_agg
  726. SUBROUTINE lim_var_glo2eqv ! Empty routines
  727. END SUBROUTINE lim_var_glo2eqv
  728. SUBROUTINE lim_var_eqv2glo ! Empty routines
  729. END SUBROUTINE lim_var_eqv2glo
  730. SUBROUTINE lim_var_salprof ! Empty routines
  731. END SUBROUTINE lim_var_salprof
  732. SUBROUTINE lim_var_bv ! Emtpy routines
  733. END SUBROUTINE lim_var_bv
  734. SUBROUTINE lim_var_salprof1d ! Emtpy routines
  735. END SUBROUTINE lim_var_salprof1d
  736. SUBROUTINE lim_var_zapsmall
  737. END SUBROUTINE lim_var_zapsmall
  738. SUBROUTINE lim_var_itd
  739. END SUBROUTINE lim_var_itd
  740. #endif
  741. !!======================================================================
  742. END MODULE limvar