limvar.F90 35 KB

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