limsbc_2.F90 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518
  1. MODULE limsbc_2
  2. !!======================================================================
  3. !! *** MODULE limsbc_2 ***
  4. !! LIM-2 : updates the fluxes at the ocean surface with ice-ocean fluxes
  5. !!======================================================================
  6. !! History : LIM ! 2000-01 (H. Goosse) Original code
  7. !! 1.0 ! 2002-07 (C. Ethe, G. Madec) re-writing F90
  8. !! 3.0 ! 2006-07 (G. Madec) surface module
  9. !! 3.3 ! 2009-05 (G. Garric, C. Bricaud) addition of the lim2_evp case
  10. !! - ! 2010-11 (G. Madec) ice-ocean stress computed at each ocean time-step
  11. !! 3.3.1 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
  12. !! 3.5 ! 2012-11 ((G. Madec, Y. Aksenov, A. Coward) salt and heat fluxes associated with e-p
  13. !!----------------------------------------------------------------------
  14. #if defined key_lim2
  15. !!----------------------------------------------------------------------
  16. !! 'key_lim2' LIM 2.0 sea-ice model
  17. !!----------------------------------------------------------------------
  18. !! lim_sbc_alloc_2 : allocate the limsbc arrays
  19. !! lim_sbc_init : initialisation
  20. !! lim_sbc_flx_2 : update mass, heat and salt fluxes at the ocean surface
  21. !! lim_sbc_tau_2 : update i- and j-stresses, and its modulus at the ocean surface
  22. !!----------------------------------------------------------------------
  23. USE par_oce ! ocean parameters
  24. USE phycst ! physical constants
  25. USE dom_oce ! ocean domain
  26. USE domvvl ! ocean vertical scale factors
  27. USE dom_ice_2 ! LIM-2: ice domain
  28. USE ice_2 ! LIM-2: ice variables
  29. USE sbc_ice ! surface boundary condition: ice
  30. USE sbc_oce ! surface boundary condition: ocean
  31. USE sbccpl
  32. USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
  33. USE albedo ! albedo parameters
  34. USE lbclnk ! ocean lateral boundary condition - MPP exchanges
  35. USE lib_mpp ! MPP library
  36. USE wrk_nemo ! work arrays
  37. USE in_out_manager ! I/O manager
  38. USE iom ! I/O library
  39. USE prtctl ! Print control
  40. USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
  41. IMPLICIT NONE
  42. PRIVATE
  43. PUBLIC lim_sbc_init_2 ! called by ice_init_2
  44. PUBLIC lim_sbc_flx_2 ! called by sbc_ice_lim_2
  45. PUBLIC lim_sbc_tau_2 ! called by sbc_ice_lim_2
  46. REAL(wp) :: r1_rdtice ! = 1. / rdt_ice
  47. REAL(wp) :: epsi16 = 1.e-16_wp ! constant values
  48. REAL(wp) :: rzero = 0._wp ! - -
  49. REAL(wp) :: rone = 1._wp ! - -
  50. !
  51. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: soce_0, sice_0 ! constant SSS and ice salinity used in levitating sea-ice case
  52. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: utau_oce, vtau_oce ! air-ocean surface i- & j-stress [N/m2]
  53. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: tmod_io ! modulus of the ice-ocean relative velocity [m/s]
  54. !! * Substitutions
  55. # include "vectopt_loop_substitute.h90"
  56. # include "domzgr_substitute.h90"
  57. !!----------------------------------------------------------------------
  58. !! NEMO/LIM2 4.0 , UCL - NEMO Consortium (2011)
  59. !! $Id: limsbc_2.F90 4990 2014-12-15 16:42:49Z timgraham $
  60. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  61. !!----------------------------------------------------------------------
  62. CONTAINS
  63. INTEGER FUNCTION lim_sbc_alloc_2()
  64. !!-------------------------------------------------------------------
  65. !! *** ROUTINE lim_sbc_alloc_2 ***
  66. !!-------------------------------------------------------------------
  67. ALLOCATE( soce_0(jpi,jpj) , utau_oce(jpi,jpj) , &
  68. & sice_0(jpi,jpj) , vtau_oce(jpi,jpj) , tmod_io(jpi,jpj), STAT=lim_sbc_alloc_2)
  69. !
  70. IF( lk_mpp ) CALL mpp_sum( lim_sbc_alloc_2 )
  71. IF( lim_sbc_alloc_2 /= 0 ) CALL ctl_warn('lim_sbc_alloc_2: failed to allocate arrays.')
  72. !
  73. END FUNCTION lim_sbc_alloc_2
  74. SUBROUTINE lim_sbc_flx_2( kt )
  75. !!-------------------------------------------------------------------
  76. !! *** ROUTINE lim_sbc_2 ***
  77. !!
  78. !! ** Purpose : Update surface ocean boundary condition over areas
  79. !! that are at least partially covered by sea-ice
  80. !!
  81. !! ** Action : - comput. of the momentum, heat and freshwater/salt
  82. !! fluxes at the ice-ocean interface.
  83. !! - Update the fluxes provided to the ocean
  84. !!
  85. !! ** Outputs : - qsr : sea heat flux : solar
  86. !! - qns : sea heat flux : non solar (including heat content of the mass flux)
  87. !! - emp : freshwater budget: mass flux
  88. !! - sfx : freshwater budget: salt flux due to Freezing/Melting
  89. !! - fr_i : ice fraction
  90. !! - tn_ice : sea-ice surface temperature
  91. !! - alb_ice : sea-ice albedo (ln_cpl=T)
  92. !!
  93. !! References : Goosse, H. et al. 1996, Bul. Soc. Roy. Sc. Liege, 65, 87-90.
  94. !! Tartinville et al. 2001 Ocean Modelling, 3, 95-108.
  95. !!---------------------------------------------------------------------
  96. INTEGER, INTENT(in) :: kt ! number of iteration
  97. !!
  98. INTEGER :: ji, jj ! dummy loop indices
  99. INTEGER :: ii0, ii1, ij0, ij1 ! local integers
  100. INTEGER :: ifvt, i1mfr, idfr, iflt ! - -
  101. INTEGER :: ial, iadv, ifral, ifrdv ! - -
  102. REAL(wp) :: zqsr, zqns, zfmm ! local scalars
  103. REAL(wp) :: zinda, zfsalt, zemp ! - -
  104. REAL(wp) :: zemp_snw, zqhc, zcd ! - -
  105. REAL(wp) :: zswitch ! - -
  106. REAL(wp), POINTER, DIMENSION(:,:) :: zqnsoce ! 2D workspace
  107. REAL(wp), POINTER, DIMENSION(:,:,:) :: zalb, zalbp ! 2D/3D workspace
  108. !!---------------------------------------------------------------------
  109. CALL wrk_alloc( jpi, jpj, zqnsoce )
  110. CALL wrk_alloc( jpi, jpj, 1, zalb, zalbp )
  111. SELECT CASE( nn_ice_embd ) ! levitating or embedded sea-ice option
  112. CASE( 0 ) ; zswitch = 1 ! (0) standard levitating sea-ice : salt exchange only
  113. CASE( 1, 2 ) ; zswitch = 0 ! (1) levitating sea-ice: salt and volume exchange but no pressure effect
  114. ! (2) embedded sea-ice : salt and volume fluxes and pressure
  115. END SELECT !
  116. !------------------------------------------!
  117. ! heat flux at the ocean surface !
  118. !------------------------------------------!
  119. zqnsoce(:,:) = qns(:,:)
  120. DO jj = 1, jpj
  121. DO ji = 1, jpi
  122. zinda = 1.0 - MAX( rzero , SIGN( rone, - ( 1.0 - pfrld(ji,jj) ) ) )
  123. ifvt = zinda * MAX( rzero , SIGN( rone, - phicif(ji,jj) ) )
  124. i1mfr = 1.0 - MAX( rzero , SIGN( rone, - ( 1.0 - frld(ji,jj) ) ) )
  125. idfr = 1.0 - MAX( rzero , SIGN( rone, frld(ji,jj) - pfrld(ji,jj) ) )
  126. iflt = zinda * (1 - i1mfr) * (1 - ifvt )
  127. ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr
  128. iadv = ( 1 - i1mfr ) * zinda
  129. ifral = ( 1 - i1mfr * ( 1 - ial ) )
  130. ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv
  131. !!$ attempt to explain the tricky flags set above....
  132. !!$ zinda = 1.0 - AINT( pfrld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice adv, but before ice thermo)
  133. !!$ i1mfr = 1.0 - AINT( frld(ji,jj) ) ! = 0. if ice-free ocean else 1. (after ice thermo)
  134. !!$
  135. !!$ IF( phicif(ji,jj) <= 0. ) THEN ; ifvt = zinda ! = zinda if previous thermodynamic step overmelted the ice???
  136. !!$ ELSE ; ifvt = 0. !
  137. !!$ ENDIF
  138. !!$
  139. !!$ IF( frld(ji,jj) >= pfrld(ji,jj) ) THEN ; idfr = 0. ! = 0. if lead fraction increases due to ice thermodynamics
  140. !!$ ELSE ; idfr = 1.
  141. !!$ ENDIF
  142. !!$
  143. !!$ iflt = zinda * (1 - i1mfr) * (1 - ifvt ) ! = 1. if ice (not only snow) at previous time and ice-free ocean currently
  144. !!$
  145. !!$ ial = ifvt * i1mfr + ( 1 - ifvt ) * idfr
  146. !!$ = i1mfr if ifvt = 1 i.e.
  147. !!$ = idfr if ifvt = 0
  148. !!$! snow no ice ice ice or nothing lead fraction increases
  149. !!$! at previous now at previous
  150. !!$! -> ice area increases ??? -> ice area decreases ???
  151. !!$
  152. !!$ iadv = ( 1 - i1mfr ) * zinda
  153. !!$! pure ocean ice at
  154. !!$! at current previous
  155. !!$! -> = 1. if ice disapear between previous and current
  156. !!$
  157. !!$ ifral = ( 1 - i1mfr * ( 1 - ial ) )
  158. !!$! ice at ???
  159. !!$! current
  160. !!$! -> ???
  161. !!$
  162. !!$ ifrdv = ( 1 - ifral * ( 1 - ial ) ) * iadv
  163. !!$! ice disapear
  164. !!$
  165. !!$
  166. ! computation the solar flux at ocean surface
  167. IF( ln_cpl ) THEN
  168. zqsr = qsr_tot(ji,jj) + ( fstric(ji,jj) - qsr_ice(ji,jj,1) ) * ( 1.0 - pfrld(ji,jj) )
  169. ELSE
  170. zqsr = pfrld(ji,jj) * qsr(ji,jj) + ( 1. - pfrld(ji,jj) ) * fstric(ji,jj)
  171. ENDIF
  172. ! computation the non solar heat flux at ocean surface
  173. zqns = - ( 1. - thcm(ji,jj) ) * zqsr & ! part of the solar energy used in leads
  174. & + iflt * ( fscmbq(ji,jj) + ffltbif(ji,jj) ) &
  175. & + ifral * ( ial * qcmif(ji,jj) + (1 - ial) * qldif(ji,jj) ) * r1_rdtice &
  176. & + ifrdv * ( qfvbq(ji,jj) + qdtcn(ji,jj) ) * r1_rdtice
  177. fsbbq(ji,jj) = ( 1.0 - ( ifvt + iflt ) ) * fscmbq(ji,jj) ! store residual heat flux (to put into the ocean at the next time-step)
  178. zqhc = ( rdq_snw(ji,jj) &
  179. & + rdq_ice(ji,jj) * ( 1.- zswitch) ) * r1_rdtice ! heat flux due to snow ( & ice heat content,
  180. ! ! if ice/ocean mass exchange active)
  181. qsr (ji,jj) = zqsr ! solar heat flux
  182. qns (ji,jj) = zqns - fdtcn(ji,jj) + zqhc ! non solar heat flux
  183. !
  184. ! !------------------------------------------!
  185. ! ! mass and salt flux at the ocean surface !
  186. ! !------------------------------------------!
  187. !
  188. ! mass flux at the ocean-atmosphere interface (open ocean fraction = leads area)
  189. ! ! coupled mode:
  190. IF( ln_cpl ) THEN
  191. zemp = + emp_tot(ji,jj) & ! net mass flux over the grid cell (ice+ocean area)
  192. & - emp_ice(ji,jj) * ( 1. - pfrld(ji,jj) ) ! minus the mass flux intercepted by sea-ice
  193. ELSE
  194. ! ! forced mode:
  195. zemp = + emp(ji,jj) * frld(ji,jj) & ! mass flux over open ocean fraction
  196. & - tprecip(ji,jj) * ( 1. - frld(ji,jj) ) & ! liquid precip. over ice reaches directly the ocean
  197. & + sprecip(ji,jj) * ( 1. - pfrld(ji,jj) ) ! snow is intercepted by sea-ice (previous frld)
  198. ENDIF
  199. !
  200. ! mass flux at the ocean/ice interface (sea ice fraction)
  201. zemp_snw = rdm_snw(ji,jj) * r1_rdtice ! snow melting = pure water that enters the ocean
  202. zfmm = rdm_ice(ji,jj) * r1_rdtice ! Freezing minus Melting (F-M)
  203. fmmflx(ji,jj) = zfmm ! F/M mass flux save at least for biogeochemical model
  204. ! salt flux at the ice/ocean interface (sea ice fraction) [PSU*kg/m2/s]
  205. zfsalt = - sice_0(ji,jj) * zfmm ! F-M salt exchange
  206. zcd = soce_0(ji,jj) * zfmm ! concentration/dilution term due to F-M
  207. !
  208. ! salt flux only : add concentration dilution term in salt flux and no F-M term in volume flux
  209. ! salt and mass fluxes : non concentration dilution term in salt flux and add F-M term in volume flux
  210. sfx (ji,jj) = zfsalt + zswitch * zcd ! salt flux (+ C/D if no ice/ocean mass exchange)
  211. emp (ji,jj) = zemp + zemp_snw + ( 1.- zswitch) * zfmm ! mass flux (+ F/M mass flux if ice/ocean mass exchange)
  212. !
  213. END DO
  214. END DO
  215. ! !------------------------------------------!
  216. ! ! mass of snow and ice per unit area !
  217. ! !------------------------------------------!
  218. IF( nn_ice_embd /= 0 ) THEN ! embedded sea-ice (mass required)
  219. snwice_mass_b(:,:) = snwice_mass(:,:) ! save mass from the previous ice time step
  220. ! ! new mass per unit area
  221. snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) )
  222. ! ! time evolution of snow+ice mass
  223. snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / rdt_ice
  224. ENDIF
  225. IF( iom_use('hflx_ice_cea' ) ) CALL iom_put( 'hflx_ice_cea', - fdtcn(:,:) )
  226. IF( iom_use('qns_io_cea' ) ) CALL iom_put( 'qns_io_cea', qns(:,:) - zqnsoce(:,:) * pfrld(:,:) )
  227. IF( iom_use('qsr_io_cea' ) ) CALL iom_put( 'qsr_io_cea', fstric(:,:) * (1.e0 - pfrld(:,:)) )
  228. IF( iom_use('isnwmlt_cea' ) ) CALL iom_put( 'isnwmlt_cea' , rdm_snw(:,:) * r1_rdtice )
  229. IF( iom_use('fsal_virt_cea') ) CALL iom_put( 'fsal_virt_cea', soce_0(:,:) * rdm_ice(:,:) * r1_rdtice )
  230. IF( iom_use('fsal_real_cea') ) CALL iom_put( 'fsal_real_cea', - sice_0(:,:) * rdm_ice(:,:) * r1_rdtice )
  231. !-----------------------------------------------!
  232. ! Coupling variables !
  233. !-----------------------------------------------!
  234. IF( ln_cpl) THEN
  235. tn_ice(:,:,1) = sist(:,:) ! sea-ice surface temperature
  236. ht_i(:,:,1) = hicif(:,:)
  237. ht_s(:,:,1) = hsnif(:,:)
  238. a_i(:,:,1) = fr_i(:,:)
  239. ! ! Computation of snow/ice and ocean albedo
  240. CALL albedo_ice( tn_ice, ht_i, ht_s, zalbp, zalb )
  241. alb_ice(:,:,1) = 0.5 * ( zalbp(:,:,1) + zalb (:,:,1) ) ! Ice albedo (mean clear and overcast skys)
  242. IF( iom_use('icealb_cea' ) ) CALL iom_put( 'icealb_cea', alb_ice(:,:,1) * fr_i(:,:) ) ! ice albedo
  243. ENDIF
  244. IF(ln_ctl) THEN ! control print
  245. CALL prt_ctl(tab2d_1=qsr , clinfo1=' lim_sbc: qsr : ', tab2d_2=qns , clinfo2=' qns : ')
  246. CALL prt_ctl(tab2d_1=emp , clinfo1=' lim_sbc: emp : ', tab2d_2=sfx , clinfo2=' sfx : ')
  247. CALL prt_ctl(tab2d_1=fr_i , clinfo1=' lim_sbc: fr_i : ', tab2d_2=tn_ice(:,:,1), clinfo2=' tn_ice : ')
  248. ENDIF
  249. !
  250. CALL wrk_dealloc( jpi, jpj, zqnsoce )
  251. CALL wrk_dealloc( jpi, jpj, 1, zalb, zalbp )
  252. !
  253. END SUBROUTINE lim_sbc_flx_2
  254. SUBROUTINE lim_sbc_tau_2( kt , pu_oce, pv_oce )
  255. !!-------------------------------------------------------------------
  256. !! *** ROUTINE lim_sbc_tau_2 ***
  257. !!
  258. !! ** Purpose : Update the ocean surface stresses due to the ice
  259. !!
  260. !! ** Action : * at each ice time step (every nn_fsbc time step):
  261. !! - compute the modulus of ice-ocean relative velocity
  262. !! at T-point (C-grid) or I-point (B-grid)
  263. !! tmod_io = rhoco * | U_ice-U_oce |
  264. !! - update the modulus of stress at ocean surface
  265. !! taum = frld * taum + (1-frld) * tmod_io * | U_ice-U_oce |
  266. !! * at each ocean time step (each kt):
  267. !! compute linearized ice-ocean stresses as
  268. !! Utau = tmod_io * | U_ice - pU_oce |
  269. !! using instantaneous current ocean velocity (usually before)
  270. !!
  271. !! NB: - the averaging operator used depends on the ice dynamics grid (cp_ice_msh='I' or 'C')
  272. !! - ice-ocean rotation angle only allowed in cp_ice_msh='I' case
  273. !! - here we make an approximation: taum is only computed every ice time step
  274. !! This avoids mutiple average to pass from T -> U,V grids and next from U,V grids
  275. !! to T grid. taum is used in TKE and GLS, which should not be too sensitive to this approximation...
  276. !!
  277. !! ** Outputs : - utau, vtau : surface ocean i- and j-stress (u- & v-pts) updated with ice-ocean fluxes
  278. !! - taum : modulus of the surface ocean stress (T-point) updated with ice-ocean fluxes
  279. !!---------------------------------------------------------------------
  280. INTEGER , INTENT(in) :: kt ! ocean time-step index
  281. REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pu_oce, pv_oce ! surface ocean currents
  282. !!
  283. INTEGER :: ji, jj ! dummy loop indices
  284. REAL(wp) :: zfrldu, zat_u, zu_i, zutau_ice, zu_t, zmodt ! local scalar
  285. REAL(wp) :: zfrldv, zat_v, zv_i, zvtau_ice, zv_t, zmodi ! - -
  286. REAL(wp) :: zsang, zumt ! - -
  287. REAL(wp), POINTER, DIMENSION(:,:) :: ztio_u, ztio_v ! ocean stress below sea-ice
  288. !!---------------------------------------------------------------------
  289. !
  290. CALL wrk_alloc( jpi, jpj, ztio_u, ztio_v )
  291. !
  292. SELECT CASE( cp_ice_msh )
  293. ! !-----------------------!
  294. CASE( 'I' ) ! B-grid ice dynamics ! I-point (i.e. F-point with sea-ice indexation)
  295. ! !--=--------------------!
  296. !
  297. IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
  298. !CDIR NOVERRCHK
  299. DO jj = 1, jpj !* modulus of ice-ocean relative velocity at I-point
  300. !CDIR NOVERRCHK
  301. DO ji = 1, jpi
  302. zu_i = u_ice(ji,jj) - u_oce(ji,jj) ! ice-ocean relative velocity at I-point
  303. zv_i = v_ice(ji,jj) - v_oce(ji,jj)
  304. tmod_io(ji,jj) = SQRT( zu_i * zu_i + zv_i * zv_i ) ! modulus of this velocity (at I-point)
  305. END DO
  306. END DO
  307. !CDIR NOVERRCHK
  308. DO jj = 1, jpjm1 !* update the modulus of stress at ocean surface (T-point)
  309. !CDIR NOVERRCHK
  310. DO ji = 1, jpim1 ! NO vector opt.
  311. ! ! modulus of U_ice-U_oce at T-point
  312. zumt = 0.25_wp * ( tmod_io(ji+1,jj) + tmod_io(ji ,jj ) &
  313. & + tmod_io(ji,jj+1) + tmod_io(ji+1,jj+1) )
  314. ! ! update the modulus of stress at ocean surface
  315. taum(ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zumt * zumt
  316. END DO
  317. END DO
  318. CALL lbc_lnk( taum, 'T', 1. )
  319. !
  320. utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step
  321. vtau_oce(:,:) = vtau(:,:)
  322. !
  323. ENDIF
  324. !
  325. ! !== at each ocean time-step ==!
  326. !
  327. ! !* ice/ocean stress WITH a ice-ocean rotation angle at I-point
  328. DO jj = 2, jpj
  329. zsang = SIGN( 1._wp, gphif(1,jj) ) * sangvg ! change the cosine angle sign in the SH
  330. DO ji = 2, jpi ! NO vect. opt. possible
  331. ! ... ice-ocean relative velocity at I-point using instantaneous surface ocean current at u- & v-pts
  332. zu_i = u_ice(ji,jj) - 0.5_wp * ( pu_oce(ji-1,jj ) + pu_oce(ji-1,jj-1) ) * tmu(ji,jj)
  333. zv_i = v_ice(ji,jj) - 0.5_wp * ( pv_oce(ji ,jj-1) + pv_oce(ji-1,jj-1) ) * tmu(ji,jj)
  334. ! ... components of stress with a ice-ocean rotation angle
  335. zmodi = rhoco * tmod_io(ji,jj)
  336. ztio_u(ji,jj) = zmodi * ( cangvg * zu_i - zsang * zv_i )
  337. ztio_v(ji,jj) = zmodi * ( cangvg * zv_i + zsang * zu_i )
  338. END DO
  339. END DO
  340. ! !* surface ocean stresses at u- and v-points
  341. DO jj = 2, jpjm1
  342. DO ji = 2, jpim1 ! NO vector opt.
  343. ! ! ice-ocean stress at U and V-points (from I-point values)
  344. zutau_ice = 0.5_wp * ( ztio_u(ji+1,jj) + ztio_u(ji+1,jj+1) )
  345. zvtau_ice = 0.5_wp * ( ztio_v(ji,jj+1) + ztio_v(ji+1,jj+1) )
  346. ! ! open-ocean (lead) fraction at U- & V-points (from T-point values)
  347. zfrldu = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj) )
  348. zfrldv = 0.5_wp * ( frld(ji,jj) + frld(ji,jj+1) )
  349. ! ! update the surface ocean stress (ice-cover wheighted)
  350. utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice
  351. vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice
  352. END DO
  353. END DO
  354. CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition
  355. !
  356. !
  357. ! !-----------------------!
  358. CASE( 'C' ) ! C-grid ice dynamics ! U & V-points (same as in the ocean)
  359. ! !--=--------------------!
  360. !
  361. IF( MOD( kt-1, nn_fsbc ) == 0 ) THEN !== Ice time-step only ==! (i.e. surface module time-step)
  362. !CDIR NOVERRCHK
  363. DO jj = 2, jpjm1 !* modulus of the ice-ocean velocity at T-point
  364. !CDIR NOVERRCHK
  365. DO ji = fs_2, fs_jpim1
  366. zu_t = u_ice(ji,jj) + u_ice(ji-1,jj) - u_oce(ji,jj) - u_oce(ji-1,jj) ! 2*(U_ice-U_oce) at T-point
  367. zv_t = v_ice(ji,jj) + v_ice(ji,jj-1) - v_oce(ji,jj) - v_oce(ji,jj-1)
  368. zmodt = 0.25_wp * ( zu_t * zu_t + zv_t * zv_t ) ! |U_ice-U_oce|^2
  369. ! ! update the modulus of stress at ocean surface
  370. taum (ji,jj) = frld(ji,jj) * taum(ji,jj) + ( 1._wp - frld(ji,jj) ) * rhoco * zmodt
  371. tmod_io(ji,jj) = SQRT( zmodt ) * rhoco ! rhoco*|Uice-Uoce|
  372. END DO
  373. END DO
  374. CALL lbc_lnk( taum, 'T', 1. ) ; CALL lbc_lnk( tmod_io, 'T', 1. )
  375. !
  376. utau_oce(:,:) = utau(:,:) !* save the air-ocean stresses at ice time-step
  377. vtau_oce(:,:) = vtau(:,:)
  378. !
  379. ENDIF
  380. !
  381. ! !== at each ocean time-step ==!
  382. !
  383. DO jj = 2, jpjm1 !* ice stress over ocean WITHOUT a ice-ocean rotation angle
  384. DO ji = fs_2, fs_jpim1
  385. ! ! ocean area at u- & v-points
  386. zfrldu = 0.5_wp * ( frld(ji,jj) + frld(ji+1,jj) )
  387. zfrldv = 0.5_wp * ( frld(ji,jj) + frld(ji,jj+1) )
  388. ! ! quadratic drag formulation without rotation
  389. ! ! using instantaneous surface ocean current
  390. zutau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji+1,jj) ) * ( u_ice(ji,jj) - pu_oce(ji,jj) )
  391. zvtau_ice = 0.5 * ( tmod_io(ji,jj) + tmod_io(ji,jj+1) ) * ( v_ice(ji,jj) - pv_oce(ji,jj) )
  392. ! ! update the surface ocean stress (ice-cover wheighted)
  393. utau(ji,jj) = zfrldu * utau_oce(ji,jj) + ( 1._wp - zfrldu ) * zutau_ice
  394. vtau(ji,jj) = zfrldv * vtau_oce(ji,jj) + ( 1._wp - zfrldv ) * zvtau_ice
  395. END DO
  396. END DO
  397. CALL lbc_lnk( utau, 'U', -1. ) ; CALL lbc_lnk( vtau, 'V', -1. ) ! lateral boundary condition
  398. !
  399. END SELECT
  400. IF(ln_ctl) CALL prt_ctl( tab2d_1=utau, clinfo1=' lim_sbc: utau : ', mask1=umask, &
  401. & tab2d_2=vtau, clinfo2=' vtau : ' , mask2=vmask )
  402. !
  403. CALL wrk_dealloc( jpi, jpj, ztio_u, ztio_v )
  404. !
  405. END SUBROUTINE lim_sbc_tau_2
  406. SUBROUTINE lim_sbc_init_2
  407. !!-------------------------------------------------------------------
  408. !! *** ROUTINE lim_sbc_init ***
  409. !!
  410. !! ** Purpose : Preparation of the file ice_evolu for the output of
  411. !! the temporal evolution of key variables
  412. !!
  413. !! ** input : Namelist namicedia
  414. !!-------------------------------------------------------------------
  415. !
  416. INTEGER :: jk ! local integer
  417. !
  418. IF(lwp) WRITE(numout,*)
  419. IF(lwp) WRITE(numout,*) 'lim_sbc_init_2 : LIM-2 sea-ice - surface boundary condition'
  420. IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~~~~ '
  421. ! ! allocate lim_sbc arrays
  422. IF( lim_sbc_alloc_2() /= 0 ) CALL ctl_stop( 'STOP', 'lim_sbc_flx_2 : unable to allocate arrays' )
  423. !
  424. r1_rdtice = 1._wp / rdt_ice
  425. !
  426. soce_0(:,:) = soce ! constant SSS and ice salinity used in levitating sea-ice case
  427. sice_0(:,:) = sice
  428. !
  429. IF( cp_cfg == "orca" ) THEN ! decrease ocean & ice reference salinities in the Baltic sea
  430. WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND. &
  431. & 54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp )
  432. soce_0(:,:) = 4._wp
  433. sice_0(:,:) = 2._wp
  434. END WHERE
  435. ENDIF
  436. ! ! embedded sea ice
  437. IF( nn_ice_embd /= 0 ) THEN ! mass exchanges between ice and ocean (case 1 or 2) set the snow+ice mass
  438. snwice_mass (:,:) = tms(:,:) * ( rhosn * hsnif(:,:) + rhoic * hicif(:,:) ) * ( 1.0 - frld(:,:) )
  439. snwice_mass_b(:,:) = snwice_mass(:,:)
  440. ELSE
  441. snwice_mass (:,:) = 0.e0 ! no mass exchanges
  442. snwice_mass_b(:,:) = 0.e0 ! no mass exchanges
  443. snwice_fmass (:,:) = 0.e0 ! no mass exchanges
  444. ENDIF
  445. IF( nn_ice_embd == 2 .AND. & ! full embedment (case 2) & no restart :
  446. & .NOT.ln_rstart ) THEN ! deplete the initial ssh below sea-ice area
  447. sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0
  448. sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0
  449. do jk = 1,jpkm1 ! adjust initial vertical scale factors
  450. fse3t_n(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
  451. fse3t_b(:,:,jk) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) )
  452. end do
  453. fse3t_a(:,:,:) = fse3t_b(:,:,:)
  454. ! Reconstruction of all vertical scale factors at now and before time steps
  455. ! =============================================================================
  456. ! Horizontal scale factor interpolations
  457. ! --------------------------------------
  458. CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3u_b(:,:,:), 'U' )
  459. CALL dom_vvl_interpol( fse3t_b(:,:,:), fse3v_b(:,:,:), 'V' )
  460. CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3u_n(:,:,:), 'U' )
  461. CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3v_n(:,:,:), 'V' )
  462. CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3f_n(:,:,:), 'F' )
  463. ! Vertical scale factor interpolations
  464. ! ------------------------------------
  465. CALL dom_vvl_interpol( fse3t_n(:,:,:), fse3w_n (:,:,:), 'W' )
  466. CALL dom_vvl_interpol( fse3u_n(:,:,:), fse3uw_n(:,:,:), 'UW' )
  467. CALL dom_vvl_interpol( fse3v_n(:,:,:), fse3vw_n(:,:,:), 'VW' )
  468. CALL dom_vvl_interpol( fse3u_b(:,:,:), fse3uw_b(:,:,:), 'UW' )
  469. CALL dom_vvl_interpol( fse3v_b(:,:,:), fse3vw_b(:,:,:), 'VW' )
  470. ! t- and w- points depth
  471. ! ----------------------
  472. fsdept_n(:,:,1) = 0.5_wp * fse3w_n(:,:,1)
  473. fsdepw_n(:,:,1) = 0.0_wp
  474. fsde3w_n(:,:,1) = fsdept_n(:,:,1) - sshn(:,:)
  475. DO jk = 2, jpk
  476. fsdept_n(:,:,jk) = fsdept_n(:,:,jk-1) + fse3w_n(:,:,jk)
  477. fsdepw_n(:,:,jk) = fsdepw_n(:,:,jk-1) + fse3t_n(:,:,jk-1)
  478. fsde3w_n(:,:,jk) = fsdept_n(:,:,jk ) - sshn (:,:)
  479. END DO
  480. ENDIF
  481. !
  482. END SUBROUTINE lim_sbc_init_2
  483. #else
  484. !!----------------------------------------------------------------------
  485. !! Default option Empty module NO LIM 2.0 sea-ice model
  486. !!----------------------------------------------------------------------
  487. #endif
  488. !!======================================================================
  489. END MODULE limsbc_2