thd_ice.F90 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369
  1. MODULE thd_ice
  2. !!======================================================================
  3. !! *** MODULE thd_ice ***
  4. !! LIM sea-ice : Ice thermodynamics in 1D
  5. !!=====================================================================
  6. !! History : 3.0 ! 2002-11 (C. Ethe) F90: Free form and module
  7. !!----------------------------------------------------------------------
  8. USE in_out_manager ! I/O manager
  9. USE lib_mpp ! MPP library
  10. USE ice, ONLY : nlay_i, nlay_s
  11. IMPLICIT NONE
  12. PRIVATE
  13. PUBLIC thd_ice_alloc ! Routine called by nemogcm.F90
  14. !!---------------------------
  15. !! * Share Module variables
  16. !!---------------------------
  17. ! !!! ** ice-thermo namelist (namicethd) **
  18. REAL(wp), PUBLIC :: rn_himin !: minimum ice thickness
  19. REAL(wp), PUBLIC :: rn_maxfrazb !: maximum portion of frazil ice collecting at the ice bottom
  20. REAL(wp), PUBLIC :: rn_vfrazb !: threshold drift speed for collection of bottom frazil ice
  21. REAL(wp), PUBLIC :: rn_Cfrazb !: squeezing coefficient for collection of bottom frazil ice
  22. REAL(wp), PUBLIC :: rn_hnewice !: thickness for new ice formation (m)
  23. LOGICAL , PUBLIC :: ln_frazil !: use of frazil ice collection as function of wind (T) or not (F)
  24. !!-----------------------------
  25. !! * Share 1D Module variables
  26. !!-----------------------------
  27. !: In ice thermodynamics, to spare memory, the vectors are folded
  28. !: from 1D to 2D vectors. The following variables, with ending _1d
  29. !: are the variables corresponding to 2d vectors
  30. INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npb !: address vector for 1d vertical thermo computations
  31. INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: nplm !: address vector for mono-category lateral melting
  32. INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: npac !: address vector for new ice formation
  33. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qlead_1d
  34. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ftr_ice_1d
  35. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qsr_ice_1d
  36. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr1_i0_1d
  37. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fr2_i0_1d
  38. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qns_ice_1d
  39. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_bo_1d
  40. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: rn_amax_1d
  41. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sum_1d
  42. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bom_1d
  43. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_bog_1d
  44. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_dif_1d
  45. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_opw_1d
  46. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_snw_1d
  47. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_1d
  48. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_rem_1d
  49. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_err_dif_1d
  50. ! heat flux associated with ice-atmosphere mass exchange
  51. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_sub_1d
  52. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_spr_1d
  53. ! heat flux associated with ice-ocean mass exchange
  54. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_thd_1d
  55. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hfx_res_1d
  56. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_1d
  57. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_sum_1d
  58. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sub_1d
  59. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_snw_sub_1d
  60. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_ice_sub_1d
  61. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bog_1d
  62. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_bom_1d
  63. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sum_1d
  64. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_sni_1d
  65. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_opw_1d
  66. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_res_1d
  67. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: wfx_spr_1d
  68. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bri_1d
  69. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bog_1d
  70. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_bom_1d
  71. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sum_1d
  72. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sni_1d
  73. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_opw_1d
  74. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_res_1d
  75. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sfx_sub_1d
  76. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sprecip_1d !: <==> the 2D sprecip
  77. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: frld_1d !: <==> the 2D frld
  78. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: at_i_1d !: <==> the 2D at_i
  79. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhtur_1d !: <==> the 2D fhtur
  80. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fhld_1d !: <==> the 2D fhld
  81. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dqns_ice_1d !: <==> the 2D dqns_ice
  82. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: evap_ice_1d !: <==> the 2D evap_ice
  83. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qprec_ice_1d !: <==> the 2D qprec_ice
  84. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: qevap_ice_1d !: <==> the 3D qevap_ice
  85. ! ! to reintegrate longwave flux inside the ice thermodynamics
  86. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: i0 !: fraction of radiation transmitted to the ice
  87. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_fl_1d !: Ice salinity variations due to flushing
  88. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_gd_1d !: Ice salinity variations due to gravity drainage
  89. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_se_1d !: Ice salinity variations due to basal salt entrapment
  90. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dsm_i_si_1d !: Ice salinity variations due to lateral accretion
  91. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: hicol_1d !: Ice collection thickness accumulated in leads
  92. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_su_1d !: <==> the 2D t_su
  93. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: t_si_1d !: <==> the 2D t_si
  94. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: a_i_1d !: <==> the 2D a_i
  95. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_i_1d !: <==> the 2D ht_s
  96. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: ht_s_1d !: <==> the 2D ht_i
  97. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_su !: Surface Conduction flux
  98. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: fc_bo_i !: Bottom Conduction flux
  99. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_s_tot !: Snow accretion/ablation [m]
  100. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_surf !: Ice surface accretion/ablation [m]
  101. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_sub !: Ice surface sublimation [m]
  102. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_i_bott !: Ice bottom accretion/ablation [m]
  103. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: dh_snowice !: Snow ice formation [m of ice]
  104. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: sm_i_1d !: Ice bulk salinity [ppt]
  105. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: s_i_new !: Salinity of new ice at the bottom
  106. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_s_1d !: corresponding to the 2D var t_s
  107. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: t_i_1d !: corresponding to the 2D var t_i
  108. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: s_i_1d !: profiled ice salinity
  109. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_i_1d !: Ice enthalpy per unit volume
  110. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: q_s_1d !: Snow enthalpy per unit volume
  111. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: qh_i_old !: ice heat content (q*h, J.m-2)
  112. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: h_i_old !: ice thickness layer (m)
  113. ! Conduction flux diagnostics (SIMIP)
  114. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: diag_fc_bo_1d !: <==> the 2D diag_fc_bo
  115. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) :: diag_fc_su_1d !: <==> the 2D diag_fc_su
  116. INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point
  117. !!----------------------------------------------------------------------
  118. !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
  119. !! $Id: thd_ice.F90 8158 2017-06-09 07:09:35Z vancop $
  120. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  121. !!----------------------------------------------------------------------
  122. CONTAINS
  123. FUNCTION thd_ice_alloc()
  124. !!---------------------------------------------------------------------!
  125. !! *** ROUTINE thd_ice_alloc ***
  126. !!---------------------------------------------------------------------!
  127. INTEGER :: thd_ice_alloc ! return value
  128. INTEGER :: ierr(4)
  129. !!---------------------------------------------------------------------!
  130. ALLOCATE( npb (jpij) , nplm (jpij) , npac (jpij) , &
  131. & qlead_1d (jpij) , ftr_ice_1d(jpij) , qsr_ice_1d (jpij) , &
  132. & fr1_i0_1d(jpij) , fr2_i0_1d (jpij) , qns_ice_1d(jpij) , &
  133. & t_bo_1d (jpij) , &
  134. & hfx_sum_1d(jpij) , hfx_bom_1d(jpij) ,hfx_bog_1d(jpij) , &
  135. & hfx_dif_1d(jpij) , hfx_opw_1d(jpij) , &
  136. & rn_amax_1d(jpij) , &
  137. & hfx_thd_1d(jpij) , hfx_spr_1d(jpij) , &
  138. & hfx_snw_1d(jpij) , hfx_sub_1d(jpij) , hfx_err_1d(jpij) , &
  139. & hfx_res_1d(jpij) , hfx_err_rem_1d(jpij) , hfx_err_dif_1d(jpij) , STAT=ierr(1) )
  140. #if defined key_init_alloc_zero
  141. npb = 0
  142. nplm = 0
  143. npac = 0
  144. qlead_1d = 0
  145. ftr_ice_1d = 0
  146. qsr_ice_1d = 0
  147. fr1_i0_1d = 0
  148. fr2_i0_1d = 0
  149. qns_ice_1d = 0
  150. t_bo_1d = 0
  151. hfx_sum_1d = 0
  152. hfx_bom_1d = 0
  153. hfx_bog_1d = 0
  154. hfx_dif_1d = 0
  155. hfx_opw_1d = 0
  156. rn_amax_1d = 0
  157. hfx_thd_1d = 0
  158. hfx_spr_1d = 0
  159. hfx_snw_1d = 0
  160. hfx_sub_1d = 0
  161. hfx_err_1d = 0
  162. hfx_res_1d = 0
  163. hfx_err_rem_1d = 0
  164. hfx_err_dif_1d = 0
  165. #elif defined key_init_alloc_huge
  166. npb = HUGE(npb)
  167. nplm = HUGE(nplm)
  168. npac = HUGE(npac)
  169. qlead_1d = HUGE(qlead_1d)
  170. ftr_ice_1d = HUGE(ftr_ice_1d)
  171. qsr_ice_1d = HUGE(qsr_ice_1d)
  172. fr1_i0_1d = HUGE(fr1_i0_1d)
  173. fr2_i0_1d = HUGE(fr2_i0_1d)
  174. qns_ice_1d = HUGE(qns_ice_1d)
  175. t_bo_1d = HUGE(t_bo_1d)
  176. hfx_sum_1d = HUGE(hfx_sum_1d)
  177. hfx_bom_1d = HUGE(hfx_bom_1d)
  178. hfx_bog_1d = HUGE(hfx_bog_1d)
  179. hfx_dif_1d = HUGE(hfx_dif_1d)
  180. hfx_opw_1d = HUGE(hfx_opw_1d)
  181. rn_amax_1d = HUGE(rn_amax_1d)
  182. hfx_thd_1d = HUGE(hfx_thd_1d)
  183. hfx_spr_1d = HUGE(hfx_spr_1d)
  184. hfx_snw_1d = HUGE(hfx_snw_1d)
  185. hfx_sub_1d = HUGE(hfx_sub_1d)
  186. hfx_err_1d = HUGE(hfx_err_1d)
  187. hfx_res_1d = HUGE(hfx_res_1d)
  188. hfx_err_rem_1d = HUGE(hfx_err_rem_1d)
  189. hfx_err_dif_1d = HUGE(hfx_err_dif_1d)
  190. #endif
  191. !
  192. ALLOCATE( sprecip_1d (jpij) , frld_1d (jpij) , at_i_1d (jpij) , &
  193. & fhtur_1d (jpij) , wfx_snw_1d (jpij) , wfx_snw_sum_1d(jpij), wfx_spr_1d (jpij) , &
  194. & fhld_1d (jpij) , wfx_sub_1d (jpij) , wfx_bog_1d (jpij) , wfx_bom_1d(jpij) , &
  195. & wfx_sum_1d(jpij) , wfx_sni_1d (jpij) , wfx_opw_1d (jpij) , wfx_res_1d(jpij) , &
  196. & wfx_snw_sub_1d(jpij), wfx_ice_sub_1d(jpij) , &
  197. & dqns_ice_1d(jpij) , evap_ice_1d (jpij), &
  198. & qprec_ice_1d(jpij), qevap_ice_1d(jpij), i0 (jpij) , &
  199. & sfx_bri_1d (jpij) , sfx_bog_1d (jpij) , sfx_bom_1d (jpij) , sfx_sum_1d (jpij), &
  200. & sfx_sni_1d (jpij) , sfx_opw_1d (jpij) , sfx_res_1d (jpij) , sfx_sub_1d (jpij), &
  201. & dsm_i_fl_1d(jpij) , dsm_i_gd_1d(jpij) , dsm_i_se_1d(jpij) , &
  202. & dsm_i_si_1d(jpij) , hicol_1d (jpij) , STAT=ierr(2) )
  203. #if defined key_init_alloc_zero
  204. sprecip_1d = 0
  205. frld_1d = 0
  206. at_i_1d = 0
  207. fhtur_1d = 0
  208. wfx_snw_1d = 0
  209. wfx_snw_sum_1d = 0
  210. wfx_spr_1d = 0
  211. fhld_1d = 0
  212. wfx_sub_1d = 0
  213. wfx_bog_1d = 0
  214. wfx_bom_1d = 0
  215. wfx_sum_1d = 0
  216. wfx_sni_1d = 0
  217. wfx_opw_1d = 0
  218. wfx_res_1d = 0
  219. wfx_snw_sub_1d = 0
  220. wfx_ice_sub_1d = 0
  221. dqns_ice_1d = 0
  222. evap_ice_1d = 0
  223. qprec_ice_1d = 0
  224. qevap_ice_1d = 0
  225. i0 = 0
  226. sfx_bri_1d = 0
  227. sfx_bog_1d = 0
  228. sfx_bom_1d = 0
  229. sfx_sum_1d = 0
  230. sfx_sni_1d = 0
  231. sfx_opw_1d = 0
  232. sfx_res_1d = 0
  233. sfx_sub_1d = 0
  234. dsm_i_fl_1d = 0
  235. dsm_i_gd_1d = 0
  236. dsm_i_se_1d = 0
  237. dsm_i_si_1d = 0
  238. hicol_1d = 0
  239. #elif defined key_init_alloc_huge
  240. sprecip_1d = HUGE(sprecip_1d)
  241. frld_1d = HUGE(frld_1d)
  242. at_i_1d = HUGE(at_i_1d)
  243. fhtur_1d = HUGE(fhtur_1d)
  244. wfx_snw_1d = HUGE(wfx_snw_1d)
  245. wfx_snw_sum_1d = HUGE(wfx_snw_sum_1d)
  246. wfx_spr_1d = HUGE(wfx_spr_1d)
  247. fhld_1d = HUGE(fhld_1d)
  248. wfx_sub_1d = HUGE(wfx_sub_1d)
  249. wfx_bog_1d = HUGE(wfx_bog_1d)
  250. wfx_bom_1d = HUGE(wfx_bom_1d)
  251. wfx_sum_1d = HUGE(wfx_sum_1d)
  252. wfx_sni_1d = HUGE(wfx_sni_1d)
  253. wfx_opw_1d = HUGE(wfx_opw_1d)
  254. wfx_res_1d = HUGE(wfx_res_1d)
  255. wfx_snw_sub_1d = HUGE(wfx_snw_sub_1d)
  256. wfx_ice_sub_1d = HUGE(wfx_ice_sub_1d)
  257. dqns_ice_1d = HUGE(dqns_ice_1d)
  258. evap_ice_1d = HUGE(evap_ice_1d)
  259. qprec_ice_1d = HUGE(qprec_ice_1d)
  260. qevap_ice_1d = HUGE(qevap_ice_1d)
  261. i0 = HUGE(i0)
  262. sfx_bri_1d = HUGE(sfx_bri_1d)
  263. sfx_bog_1d = HUGE(sfx_bog_1d)
  264. sfx_bom_1d = HUGE(sfx_bom_1d)
  265. sfx_sum_1d = HUGE(sfx_sum_1d)
  266. sfx_sni_1d = HUGE(sfx_sni_1d)
  267. sfx_opw_1d = HUGE(sfx_opw_1d)
  268. sfx_res_1d = HUGE(sfx_res_1d)
  269. sfx_sub_1d = HUGE(sfx_sub_1d)
  270. dsm_i_fl_1d = HUGE(dsm_i_fl_1d)
  271. dsm_i_gd_1d = HUGE(dsm_i_gd_1d)
  272. dsm_i_se_1d = HUGE(dsm_i_se_1d)
  273. dsm_i_si_1d = HUGE(dsm_i_si_1d)
  274. hicol_1d = HUGE(hicol_1d)
  275. #endif
  276. !
  277. ALLOCATE( t_su_1d (jpij) , t_si_1d (jpij) , a_i_1d (jpij) , ht_i_1d (jpij) , &
  278. & ht_s_1d (jpij) , fc_su (jpij) , fc_bo_i (jpij) , &
  279. & dh_s_tot (jpij) , dh_i_surf(jpij) , dh_i_sub (jpij) , &
  280. & dh_i_bott (jpij) ,dh_snowice(jpij) , sm_i_1d (jpij) , s_i_new (jpij) , &
  281. & t_s_1d(jpij,nlay_s) , t_i_1d(jpij,nlay_i) , s_i_1d(jpij,nlay_i) , &
  282. & q_i_1d(jpij,nlay_i+1) , q_s_1d(jpij,nlay_s) , &
  283. & qh_i_old(jpij,0:nlay_i+1), h_i_old(jpij,0:nlay_i+1) , STAT=ierr(3))
  284. #if defined key_init_alloc_zero
  285. t_su_1d = 0
  286. t_si_1d = 0
  287. a_i_1d = 0
  288. ht_i_1d = 0
  289. ht_s_1d = 0
  290. fc_su = 0
  291. fc_bo_i = 0
  292. dh_s_tot = 0
  293. dh_i_surf = 0
  294. dh_i_sub = 0
  295. dh_i_bott = 0
  296. dh_snowice = 0
  297. sm_i_1d = 0
  298. s_i_new = 0
  299. t_s_1d = 0
  300. t_i_1d = 0
  301. s_i_1d = 0
  302. q_i_1d = 0
  303. q_s_1d = 0
  304. qh_i_old = 0
  305. h_i_old = 0
  306. #elif defined key_init_alloc_huge
  307. t_su_1d = HUGE(t_su_1d)
  308. t_si_1d = HUGE(t_si_1d)
  309. a_i_1d = HUGE(a_i_1d)
  310. ht_i_1d = HUGE(ht_i_1d)
  311. ht_s_1d = HUGE(ht_s_1d)
  312. fc_su = HUGE(fc_su)
  313. fc_bo_i = HUGE(fc_bo_i)
  314. dh_s_tot = HUGE(dh_s_tot)
  315. dh_i_surf = HUGE(dh_i_surf)
  316. dh_i_sub = HUGE(dh_i_sub)
  317. dh_i_bott = HUGE(dh_i_bott)
  318. dh_snowice = HUGE(dh_snowice)
  319. sm_i_1d = HUGE(sm_i_1d)
  320. s_i_new = HUGE(s_i_new)
  321. t_s_1d = HUGE(t_s_1d)
  322. t_i_1d = HUGE(t_i_1d)
  323. s_i_1d = HUGE(s_i_1d)
  324. q_i_1d = HUGE(q_i_1d)
  325. q_s_1d = HUGE(q_s_1d)
  326. qh_i_old = HUGE(qh_i_old)
  327. h_i_old = HUGE(h_i_old)
  328. #endif
  329. !
  330. ALLOCATE( diag_fc_bo_1d(jpij), diag_fc_su_1d(jpij), STAT=ierr(4) )
  331. #if defined key_init_alloc_zero
  332. diag_fc_bo_1d = 0
  333. diag_fc_su_1d = 0
  334. #elif defined key_init_alloc_huge
  335. diag_fc_bo_1d = HUGE(diag_fc_bo_1d )
  336. diag_fc_su_1d = HUGE(diag_fc_su_1d)
  337. #endif
  338. !
  339. thd_ice_alloc = MAXVAL( ierr )
  340. IF( thd_ice_alloc /= 0 ) CALL ctl_warn( 'thd_ice_alloc: failed to allocate arrays.' )
  341. !
  342. END FUNCTION thd_ice_alloc
  343. !!======================================================================
  344. END MODULE thd_ice