trcsub.F90 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603
  1. MODULE trcsub
  2. !!======================================================================
  3. !! *** MODULE trcsubstp ***
  4. !!TOP : Averages physics variables for TOP substepping.
  5. !!======================================================================
  6. !! History : 1.0 ! 2011-10 (K. Edwards) Original
  7. !!----------------------------------------------------------------------
  8. #if defined key_top
  9. !!----------------------------------------------------------------------
  10. !! trc_sub : passive tracer system sub-stepping
  11. !!----------------------------------------------------------------------
  12. USE oce_trc ! ocean dynamics and active tracers variables
  13. USE trc
  14. USE prtctl_trc ! Print control for debbuging
  15. USE iom
  16. USE in_out_manager
  17. USE lbclnk
  18. USE trabbl
  19. USE zdf_oce
  20. USE domvvl
  21. USE divcur ! hor. divergence and curl (div & cur routines)
  22. USE sbcrnf, ONLY: h_rnf, nk_rnf ! River runoff
  23. USE bdy_oce
  24. #if defined key_agrif
  25. USE agrif_opa_update
  26. USE agrif_opa_interp
  27. #endif
  28. IMPLICIT NONE
  29. PUBLIC trc_sub_stp ! called by trc_stp
  30. PUBLIC trc_sub_ini ! called by trc_ini to initialize substepping arrays.
  31. PUBLIC trc_sub_reset ! called by trc_stp to reset physics variables
  32. PUBLIC trc_sub_ssh ! called by trc_stp to reset physics variables
  33. !!* Module variables
  34. REAL(wp) :: r1_ndttrc ! 1 / nn_dttrc
  35. REAL(wp) :: r1_ndttrcp1 ! 1 / (nn_dttrc+1)
  36. !!* Substitution
  37. # include "top_substitute.h90"
  38. !!----------------------------------------------------------------------
  39. !! NEMO/TOP 3.3 , NEMO Consortium (2010)
  40. !! $Id: trcsub.F90 3977 2017-02-20 14:03:23Z ufla $
  41. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  42. !!----------------------------------------------------------------------
  43. CONTAINS
  44. SUBROUTINE trc_sub_stp( kt )
  45. !!-------------------------------------------------------------------
  46. !! *** ROUTINE trc_stp ***
  47. !!
  48. !! ** Purpose : Average variables needed for sub-stepping passive tracers
  49. !!
  50. !! ** Method : Called every timestep to increment _tm (time mean) variables
  51. !! on TOP steps, calculate averages.
  52. !!-------------------------------------------------------------------
  53. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  54. INTEGER :: ji,jj,jk ! dummy loop indices
  55. REAL(wp) :: z1_ne3t, z1_ne3u, z1_ne3v, z1_ne3w
  56. !!-------------------------------------------------------------------
  57. !
  58. IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
  59. !
  60. IF( kt == nit000 ) THEN
  61. IF(lwp) WRITE(numout,*)
  62. IF(lwp) WRITE(numout,*) 'trc_sub_stp : substepping of the passive tracers'
  63. IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
  64. !
  65. sshb_hold (:,:) = sshn (:,:)
  66. emp_b_hold (:,:) = emp_b (:,:)
  67. !
  68. r1_ndttrc = 1._wp / REAL( nn_dttrc , wp )
  69. r1_ndttrcp1 = 1._wp / REAL( nn_dttrc + 1, wp )
  70. !
  71. ENDIF
  72. IF( MOD( kt , nn_dttrc ) /= 0 ) THEN
  73. !
  74. un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)
  75. vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)
  76. tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)
  77. tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)
  78. rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)
  79. avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)
  80. # if defined key_zdfddm
  81. avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)
  82. # endif
  83. #if defined key_ldfslp
  84. wslpi_tm(:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)
  85. wslpj_tm(:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)
  86. uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:)
  87. vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)
  88. #endif
  89. # if defined key_trabbl
  90. IF( nn_bbl_ldf == 1 ) THEN
  91. ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
  92. ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
  93. ENDIF
  94. IF( nn_bbl_adv == 1 ) THEN
  95. utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
  96. vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
  97. ENDIF
  98. # endif
  99. !
  100. sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
  101. rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
  102. h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
  103. hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
  104. fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
  105. emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
  106. fmmflx_tm(:,:) = fmmflx_tm(:,:) + fmmflx(:,:)
  107. qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
  108. wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
  109. ELSE ! It is time to substep
  110. ! 1. set temporary arrays to hold physics variables
  111. un_temp (:,:,:) = un (:,:,:)
  112. vn_temp (:,:,:) = vn (:,:,:)
  113. wn_temp (:,:,:) = wn (:,:,:)
  114. tsn_temp (:,:,:,:) = tsn (:,:,:,:)
  115. rhop_temp (:,:,:) = rhop (:,:,:)
  116. avt_temp (:,:,:) = avt (:,:,:)
  117. # if defined key_zdfddm
  118. avs_temp (:,:,:) = avs (:,:,:)
  119. # endif
  120. #if defined key_ldfslp
  121. wslpi_temp (:,:,:) = wslpi (:,:,:)
  122. wslpj_temp (:,:,:) = wslpj (:,:,:)
  123. uslp_temp (:,:,:) = uslp (:,:,:)
  124. vslp_temp (:,:,:) = vslp (:,:,:)
  125. #endif
  126. # if defined key_trabbl
  127. IF( nn_bbl_ldf == 1 ) THEN
  128. ahu_bbl_temp(:,:) = ahu_bbl(:,:)
  129. ahv_bbl_temp(:,:) = ahv_bbl(:,:)
  130. ENDIF
  131. IF( nn_bbl_adv == 1 ) THEN
  132. utr_bbl_temp(:,:) = utr_bbl(:,:)
  133. vtr_bbl_temp(:,:) = vtr_bbl(:,:)
  134. ENDIF
  135. # endif
  136. sshn_temp (:,:) = sshn (:,:)
  137. sshb_temp (:,:) = sshb (:,:)
  138. ssha_temp (:,:) = ssha (:,:)
  139. rnf_temp (:,:) = rnf (:,:)
  140. h_rnf_temp (:,:) = h_rnf (:,:)
  141. hmld_temp (:,:) = hmld (:,:)
  142. fr_i_temp (:,:) = fr_i (:,:)
  143. emp_temp (:,:) = emp (:,:)
  144. emp_b_temp (:,:) = emp_b (:,:)
  145. fmmflx_temp(:,:) = fmmflx(:,:)
  146. qsr_temp (:,:) = qsr (:,:)
  147. wndm_temp (:,:) = wndm (:,:)
  148. ! ! Variables reset in trc_sub_ssh
  149. rotn_temp (:,:,:) = rotn (:,:,:)
  150. hdivn_temp (:,:,:) = hdivn (:,:,:)
  151. rotb_temp (:,:,:) = rotb (:,:,:)
  152. hdivb_temp (:,:,:) = hdivb (:,:,:)
  153. !
  154. ! 2. Create averages and reassign variables
  155. un_tm (:,:,:) = un_tm (:,:,:) + un (:,:,:) * fse3u(:,:,:)
  156. vn_tm (:,:,:) = vn_tm (:,:,:) + vn (:,:,:) * fse3v(:,:,:)
  157. tsn_tm (:,:,:,jp_tem) = tsn_tm (:,:,:,jp_tem) + tsn (:,:,:,jp_tem) * fse3t(:,:,:)
  158. tsn_tm (:,:,:,jp_sal) = tsn_tm (:,:,:,jp_sal) + tsn (:,:,:,jp_sal) * fse3t(:,:,:)
  159. rhop_tm (:,:,:) = rhop_tm (:,:,:) + rhop (:,:,:) * fse3t(:,:,:)
  160. avt_tm (:,:,:) = avt_tm (:,:,:) + avt (:,:,:) * fse3w(:,:,:)
  161. # if defined key_zdfddm
  162. avs_tm (:,:,:) = avs_tm (:,:,:) + avs (:,:,:) * fse3w(:,:,:)
  163. # endif
  164. #if defined key_ldfslp
  165. wslpi_tm (:,:,:) = wslpi_tm(:,:,:) + wslpi(:,:,:)
  166. wslpj_tm (:,:,:) = wslpj_tm(:,:,:) + wslpj(:,:,:)
  167. uslp_tm (:,:,:) = uslp_tm (:,:,:) + uslp (:,:,:)
  168. vslp_tm (:,:,:) = vslp_tm (:,:,:) + vslp (:,:,:)
  169. #endif
  170. # if defined key_trabbl
  171. IF( nn_bbl_ldf == 1 ) THEN
  172. ahu_bbl_tm(:,:) = ahu_bbl_tm(:,:) + ahu_bbl(:,:)
  173. ahv_bbl_tm(:,:) = ahv_bbl_tm(:,:) + ahv_bbl(:,:)
  174. ENDIF
  175. IF( nn_bbl_adv == 1 ) THEN
  176. utr_bbl_tm(:,:) = utr_bbl_tm(:,:) + utr_bbl(:,:)
  177. vtr_bbl_tm(:,:) = vtr_bbl_tm(:,:) + vtr_bbl(:,:)
  178. ENDIF
  179. # endif
  180. sshn_tm (:,:) = sshn_tm (:,:) + sshn (:,:)
  181. rnf_tm (:,:) = rnf_tm (:,:) + rnf (:,:)
  182. h_rnf_tm (:,:) = h_rnf_tm (:,:) + h_rnf (:,:)
  183. hmld_tm (:,:) = hmld_tm (:,:) + hmld (:,:)
  184. fr_i_tm (:,:) = fr_i_tm (:,:) + fr_i (:,:)
  185. emp_tm (:,:) = emp_tm (:,:) + emp (:,:)
  186. fmmflx_tm(:,:) = fmmflx_tm (:,:) + fmmflx(:,:)
  187. qsr_tm (:,:) = qsr_tm (:,:) + qsr (:,:)
  188. wndm_tm (:,:) = wndm_tm (:,:) + wndm (:,:)
  189. !
  190. sshn (:,:) = sshn_tm (:,:) * r1_ndttrcp1
  191. sshb (:,:) = sshb_hold (:,:)
  192. rnf (:,:) = rnf_tm (:,:) * r1_ndttrcp1
  193. h_rnf (:,:) = h_rnf_tm (:,:) * r1_ndttrcp1
  194. hmld (:,:) = hmld_tm (:,:) * r1_ndttrcp1
  195. ! variables that are initialized after averages
  196. emp_b (:,:) = emp_b_hold (:,:)
  197. IF( kt == nittrc000 ) THEN
  198. wndm (:,:) = wndm_tm (:,:) * r1_ndttrc
  199. qsr (:,:) = qsr_tm (:,:) * r1_ndttrc
  200. emp (:,:) = emp_tm (:,:) * r1_ndttrc
  201. fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrc
  202. fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrc
  203. # if defined key_trabbl
  204. IF( nn_bbl_ldf == 1 ) THEN
  205. ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrc
  206. ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrc
  207. ENDIF
  208. IF( nn_bbl_adv == 1 ) THEN
  209. utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrc
  210. vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrc
  211. ENDIF
  212. # endif
  213. ELSE
  214. wndm (:,:) = wndm_tm (:,:) * r1_ndttrcp1
  215. qsr (:,:) = qsr_tm (:,:) * r1_ndttrcp1
  216. emp (:,:) = emp_tm (:,:) * r1_ndttrcp1
  217. fmmflx(:,:) = fmmflx_tm (:,:) * r1_ndttrcp1
  218. fr_i (:,:) = fr_i_tm (:,:) * r1_ndttrcp1
  219. # if defined key_trabbl
  220. IF( nn_bbl_ldf == 1 ) THEN
  221. ahu_bbl(:,:) = ahu_bbl_tm (:,:) * r1_ndttrcp1
  222. ahv_bbl(:,:) = ahv_bbl_tm (:,:) * r1_ndttrcp1
  223. ENDIF
  224. IF( nn_bbl_adv == 1 ) THEN
  225. utr_bbl(:,:) = utr_bbl_tm (:,:) * r1_ndttrcp1
  226. vtr_bbl(:,:) = vtr_bbl_tm (:,:) * r1_ndttrcp1
  227. ENDIF
  228. # endif
  229. ENDIF
  230. !
  231. DO jk = 1, jpk
  232. DO jj = 1, jpj
  233. DO ji = 1, jpi
  234. z1_ne3t = r1_ndttrcp1 / fse3t(ji,jj,jk)
  235. z1_ne3u = r1_ndttrcp1 / fse3u(ji,jj,jk)
  236. z1_ne3v = r1_ndttrcp1 / fse3v(ji,jj,jk)
  237. z1_ne3w = r1_ndttrcp1 / fse3w(ji,jj,jk)
  238. !
  239. un (ji,jj,jk) = un_tm (ji,jj,jk) * z1_ne3u
  240. vn (ji,jj,jk) = vn_tm (ji,jj,jk) * z1_ne3v
  241. tsn (ji,jj,jk,jp_tem) = tsn_tm (ji,jj,jk,jp_tem) * z1_ne3t
  242. tsn (ji,jj,jk,jp_sal) = tsn_tm (ji,jj,jk,jp_sal) * z1_ne3t
  243. rhop (ji,jj,jk) = rhop_tm (ji,jj,jk) * z1_ne3t
  244. avt (ji,jj,jk) = avt_tm (ji,jj,jk) * z1_ne3w
  245. # if defined key_zdfddm
  246. avs (ji,jj,jk) = avs_tm (ji,jj,jk) * z1_ne3w
  247. # endif
  248. #if defined key_ldfslp
  249. wslpi(ji,jj,jk) = wslpi_tm(ji,jj,jk)
  250. wslpj(ji,jj,jk) = wslpj_tm(ji,jj,jk)
  251. uslp (ji,jj,jk) = uslp_tm (ji,jj,jk)
  252. vslp (ji,jj,jk) = vslp_tm (ji,jj,jk)
  253. #endif
  254. ENDDO
  255. ENDDO
  256. ENDDO
  257. !
  258. CALL trc_sub_ssh( kt ) ! after ssh & vertical velocity
  259. !
  260. ENDIF
  261. !
  262. IF( nn_timing == 1 ) CALL timing_start('trc_sub_stp')
  263. !
  264. END SUBROUTINE trc_sub_stp
  265. SUBROUTINE trc_sub_ini
  266. !!-------------------------------------------------------------------
  267. !! *** ROUTINE trc_sub_ini ***
  268. !!
  269. !! ** Purpose : Initialize variables needed for sub-stepping passive tracers
  270. !!
  271. !! ** Method :
  272. !! Compute the averages for sub-stepping
  273. !!-------------------------------------------------------------------
  274. INTEGER :: ierr
  275. !!-------------------------------------------------------------------
  276. !
  277. IF( nn_timing == 1 ) CALL timing_start('trc_sub_ini')
  278. !
  279. IF(lwp) WRITE(numout,*)
  280. IF(lwp) WRITE(numout,*) 'trc_sub_ini : initial set up of the passive tracers substepping'
  281. IF(lwp) WRITE(numout,*) '~~~~~~~'
  282. ierr = trc_sub_alloc ()
  283. IF( lk_mpp ) CALL mpp_sum( ierr )
  284. IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_sub_alloc : unable to allocate standard ocean arrays' )
  285. un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
  286. vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
  287. tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
  288. tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
  289. rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
  290. avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
  291. # if defined key_zdfddm
  292. avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
  293. # endif
  294. #if defined key_ldfslp
  295. wslpi_tm(:,:,:) = wslpi(:,:,:)
  296. wslpj_tm(:,:,:) = wslpj(:,:,:)
  297. uslp_tm (:,:,:) = uslp (:,:,:)
  298. vslp_tm (:,:,:) = vslp (:,:,:)
  299. #endif
  300. sshn_tm (:,:) = sshn (:,:)
  301. rnf_tm (:,:) = rnf (:,:)
  302. h_rnf_tm (:,:) = h_rnf (:,:)
  303. hmld_tm (:,:) = hmld (:,:)
  304. ! Physics variables that are set after initialization:
  305. fr_i_tm(:,:) = 0._wp
  306. emp_tm (:,:) = 0._wp
  307. fmmflx_tm(:,:) = 0._wp
  308. qsr_tm (:,:) = 0._wp
  309. wndm_tm(:,:) = 0._wp
  310. # if defined key_trabbl
  311. IF( nn_bbl_ldf == 1 ) THEN
  312. ahu_bbl_tm(:,:) = 0._wp
  313. ahv_bbl_tm(:,:) = 0._wp
  314. ENDIF
  315. IF( nn_bbl_adv == 1 ) THEN
  316. utr_bbl_tm(:,:) = 0._wp
  317. vtr_bbl_tm(:,:) = 0._wp
  318. ENDIF
  319. # endif
  320. !
  321. IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ini')
  322. !
  323. END SUBROUTINE trc_sub_ini
  324. SUBROUTINE trc_sub_reset( kt )
  325. !!-------------------------------------------------------------------
  326. !! *** ROUTINE trc_sub_reset ***
  327. !!
  328. !! ** Purpose : Reset physics variables averaged for substepping
  329. !!
  330. !! ** Method :
  331. !! Compute the averages for sub-stepping
  332. !!-------------------------------------------------------------------
  333. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  334. INTEGER :: jk ! dummy loop indices
  335. !!-------------------------------------------------------------------
  336. !
  337. IF( nn_timing == 1 ) CALL timing_start('trc_sub_reset')
  338. !
  339. ! restore physics variables
  340. un (:,:,:) = un_temp (:,:,:)
  341. vn (:,:,:) = vn_temp (:,:,:)
  342. wn (:,:,:) = wn_temp (:,:,:)
  343. tsn (:,:,:,:) = tsn_temp (:,:,:,:)
  344. rhop (:,:,:) = rhop_temp (:,:,:)
  345. avt (:,:,:) = avt_temp (:,:,:)
  346. # if defined key_zdfddm
  347. avs (:,:,:) = avs_temp (:,:,:)
  348. # endif
  349. #if defined key_ldfslp
  350. wslpi (:,:,:) = wslpi_temp (:,:,:)
  351. wslpj (:,:,:) = wslpj_temp (:,:,:)
  352. uslp (:,:,:) = uslp_temp (:,:,:)
  353. vslp (:,:,:) = vslp_temp (:,:,:)
  354. #endif
  355. sshn (:,:) = sshn_temp (:,:)
  356. sshb (:,:) = sshb_temp (:,:)
  357. ssha (:,:) = ssha_temp (:,:)
  358. rnf (:,:) = rnf_temp (:,:)
  359. h_rnf (:,:) = h_rnf_temp (:,:)
  360. !
  361. hmld (:,:) = hmld_temp (:,:)
  362. fr_i (:,:) = fr_i_temp (:,:)
  363. emp (:,:) = emp_temp (:,:)
  364. fmmflx(:,:) = fmmflx_temp(:,:)
  365. emp_b (:,:) = emp_b_temp (:,:)
  366. qsr (:,:) = qsr_temp (:,:)
  367. wndm (:,:) = wndm_temp (:,:)
  368. # if defined key_trabbl
  369. IF( nn_bbl_ldf == 1 ) THEN
  370. ahu_bbl(:,:) = ahu_bbl_temp(:,:)
  371. ahv_bbl(:,:) = ahv_bbl_temp(:,:)
  372. ENDIF
  373. IF( nn_bbl_adv == 1 ) THEN
  374. utr_bbl(:,:) = utr_bbl_temp(:,:)
  375. vtr_bbl(:,:) = vtr_bbl_temp(:,:)
  376. ENDIF
  377. # endif
  378. !
  379. hdivn (:,:,:) = hdivn_temp (:,:,:)
  380. rotn (:,:,:) = rotn_temp (:,:,:)
  381. hdivb (:,:,:) = hdivb_temp (:,:,:)
  382. rotb (:,:,:) = rotb_temp (:,:,:)
  383. !
  384. ! Start new averages
  385. un_tm (:,:,:) = un (:,:,:) * fse3u(:,:,:)
  386. vn_tm (:,:,:) = vn (:,:,:) * fse3v(:,:,:)
  387. tsn_tm (:,:,:,jp_tem) = tsn (:,:,:,jp_tem) * fse3t(:,:,:)
  388. tsn_tm (:,:,:,jp_sal) = tsn (:,:,:,jp_sal) * fse3t(:,:,:)
  389. rhop_tm (:,:,:) = rhop (:,:,:) * fse3t(:,:,:)
  390. avt_tm (:,:,:) = avt (:,:,:) * fse3w(:,:,:)
  391. # if defined key_zdfddm
  392. avs_tm (:,:,:) = avs (:,:,:) * fse3w(:,:,:)
  393. # endif
  394. #if defined key_ldfslp
  395. wslpi_tm(:,:,:) = wslpi(:,:,:)
  396. wslpj_tm(:,:,:) = wslpj(:,:,:)
  397. uslp_tm (:,:,:) = uslp (:,:,:)
  398. vslp_tm (:,:,:) = vslp (:,:,:)
  399. #endif
  400. !
  401. sshb_hold (:,:) = sshn (:,:)
  402. emp_b_hold (:,:) = emp (:,:)
  403. sshn_tm (:,:) = sshn (:,:)
  404. rnf_tm (:,:) = rnf (:,:)
  405. h_rnf_tm (:,:) = h_rnf (:,:)
  406. hmld_tm (:,:) = hmld (:,:)
  407. fr_i_tm (:,:) = fr_i (:,:)
  408. emp_tm (:,:) = emp (:,:)
  409. fmmflx_tm (:,:) = fmmflx(:,:)
  410. qsr_tm (:,:) = qsr (:,:)
  411. wndm_tm (:,:) = wndm (:,:)
  412. # if defined key_trabbl
  413. IF( nn_bbl_ldf == 1 ) THEN
  414. ahu_bbl_tm(:,:) = ahu_bbl(:,:)
  415. ahv_bbl_tm(:,:) = ahv_bbl(:,:)
  416. ENDIF
  417. IF( nn_bbl_adv == 1 ) THEN
  418. utr_bbl_tm(:,:) = utr_bbl(:,:)
  419. vtr_bbl_tm(:,:) = vtr_bbl(:,:)
  420. ENDIF
  421. # endif
  422. !
  423. !
  424. IF( nn_timing == 1 ) CALL timing_stop('trc_sub_reset')
  425. !
  426. END SUBROUTINE trc_sub_reset
  427. SUBROUTINE trc_sub_ssh( kt )
  428. !!----------------------------------------------------------------------
  429. !! *** ROUTINE trc_sub_ssh ***
  430. !!
  431. !! ** Purpose : compute the after ssh (ssha), the now vertical velocity
  432. !! and update the now vertical coordinate (lk_vvl=T).
  433. !!
  434. !! ** Method : - Using the incompressibility hypothesis, the vertical
  435. !! velocity is computed by integrating the horizontal divergence
  436. !! from the bottom to the surface minus the scale factor evolution.
  437. !! The boundary conditions are w=0 at the bottom (no flux) and.
  438. !!
  439. !! ** action : ssha : after sea surface height
  440. !! wn : now vertical velocity
  441. !! sshu_a, sshv_a, sshf_a : after sea surface height (lk_vvl=T)
  442. !!
  443. !! Reference : Leclair, M., and G. Madec, 2009, Ocean Modelling.
  444. !!----------------------------------------------------------------------
  445. !
  446. INTEGER, INTENT(in) :: kt ! time step
  447. !
  448. INTEGER :: ji, jj, jk ! dummy loop indices
  449. REAL(wp) :: zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0 ! local scalars
  450. REAL(wp), POINTER, DIMENSION(:,:) :: zhdiv
  451. !!---------------------------------------------------------------------
  452. !
  453. IF( nn_timing == 1 ) CALL timing_start('trc_sub_ssh')
  454. !
  455. ! Allocate temporary workspace
  456. CALL wrk_alloc( jpi, jpj, zhdiv )
  457. IF( kt == nittrc000 ) THEN
  458. !
  459. IF(lwp) WRITE(numout,*)
  460. IF(lwp) WRITE(numout,*) 'trc_sub_ssh : after sea surface height and now vertical velocity '
  461. IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ '
  462. !
  463. wn(:,:,jpk) = 0._wp ! bottom boundary condition: w=0 (set once for all)
  464. !
  465. ENDIF
  466. !
  467. CALL div_cur( kt ) ! Horizontal divergence & Relative vorticity
  468. !
  469. z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog)
  470. IF( neuler == 0 .AND. kt == nittrc000 ) z2dt = rdt
  471. ! !------------------------------!
  472. ! ! After Sea Surface Height !
  473. ! !------------------------------!
  474. zhdiv(:,:) = 0._wp
  475. DO jk = 1, jpkm1 ! Horizontal divergence of barotropic transports
  476. zhdiv(:,:) = zhdiv(:,:) + fse3t(:,:,jk) * hdivn(:,:,jk)
  477. END DO
  478. ! ! Sea surface elevation time stepping
  479. ! In forward Euler time stepping case, the same formulation as in the leap-frog case can be used
  480. ! because emp_b field is initialized with the vlaues of emp field. Hence, 0.5 * ( emp + emp_b ) = emp
  481. z1_rau0 = 0.5 / rau0
  482. ssha(:,:) = ( sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) ) ) * tmask(:,:,1)
  483. #if ! defined key_dynspg_ts
  484. ! These lines are not necessary with time splitting since
  485. ! boundary condition on sea level is set during ts loop
  486. #if defined key_agrif
  487. CALL agrif_ssh( kt )
  488. #endif
  489. #if defined key_bdy
  490. ssha(:,:) = ssha(:,:) * bdytmask(:,:)
  491. CALL lbc_lnk( ssha, 'T', 1. )
  492. #endif
  493. #endif
  494. ! !------------------------------!
  495. ! ! Now Vertical Velocity !
  496. ! !------------------------------!
  497. z1_2dt = 1.e0 / z2dt
  498. DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence
  499. ! - ML - need 3 lines here because replacement of fse3t by its expression yields too long lines otherwise
  500. wn(:,:,jk) = wn(:,:,jk+1) - fse3t_n(:,:,jk) * hdivn(:,:,jk) &
  501. & - ( fse3t_a(:,:,jk) - fse3t_b(:,:,jk) ) &
  502. & * tmask(:,:,jk) * z1_2dt
  503. #if defined key_bdy
  504. wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:)
  505. #endif
  506. END DO
  507. !
  508. CALL wrk_dealloc( jpi, jpj, zhdiv )
  509. !
  510. IF( nn_timing == 1 ) CALL timing_stop('trc_sub_ssh')
  511. !
  512. END SUBROUTINE trc_sub_ssh
  513. INTEGER FUNCTION trc_sub_alloc()
  514. !!-------------------------------------------------------------------
  515. !! *** ROUTINE trc_sub_alloc ***
  516. !!-------------------------------------------------------------------
  517. USE lib_mpp, ONLY: ctl_warn
  518. INTEGER :: ierr
  519. !!-------------------------------------------------------------------
  520. !
  521. ALLOCATE( un_temp(jpi,jpj,jpk) , vn_temp(jpi,jpj,jpk) , &
  522. & wn_temp(jpi,jpj,jpk) , avt_temp(jpi,jpj,jpk) , &
  523. & rhop_temp(jpi,jpj,jpk) , rhop_tm(jpi,jpj,jpk) , &
  524. & sshn_temp(jpi,jpj) , sshb_temp(jpi,jpj) , &
  525. & ssha_temp(jpi,jpj) , &
  526. #if defined key_ldfslp
  527. & wslpi_temp(jpi,jpj,jpk) , wslpj_temp(jpi,jpj,jpk), &
  528. & uslp_temp(jpi,jpj,jpk) , vslp_temp(jpi,jpj,jpk), &
  529. #endif
  530. #if defined key_trabbl
  531. & ahu_bbl_temp(jpi,jpj) , ahv_bbl_temp(jpi,jpj), &
  532. & utr_bbl_temp(jpi,jpj) , vtr_bbl_temp(jpi,jpj), &
  533. #endif
  534. & rnf_temp(jpi,jpj) , h_rnf_temp(jpi,jpj) , &
  535. & tsn_temp(jpi,jpj,jpk,2) , emp_b_temp(jpi,jpj), &
  536. & emp_temp(jpi,jpj) , fmmflx_temp(jpi,jpj), &
  537. & hmld_temp(jpi,jpj) , qsr_temp(jpi,jpj) , &
  538. & fr_i_temp(jpi,jpj) , fr_i_tm(jpi,jpj) , &
  539. & wndm_temp(jpi,jpj) , wndm_tm(jpi,jpj) , &
  540. # if defined key_zdfddm
  541. & avs_tm(jpi,jpj,jpk) , avs_temp(jpi,jpj,jpk) , &
  542. # endif
  543. & hdivn_temp(jpi,jpj,jpk) , hdivb_temp(jpi,jpj,jpk), &
  544. & rotn_temp(jpi,jpj,jpk) , rotb_temp(jpi,jpj,jpk), &
  545. & un_tm(jpi,jpj,jpk) , vn_tm(jpi,jpj,jpk) , &
  546. & avt_tm(jpi,jpj,jpk) , &
  547. & sshn_tm(jpi,jpj) , sshb_hold(jpi,jpj) , &
  548. & tsn_tm(jpi,jpj,jpk,2) , &
  549. & emp_tm(jpi,jpj) , fmmflx_tm(jpi,jpj) , &
  550. & emp_b_hold(jpi,jpj) , &
  551. & hmld_tm(jpi,jpj) , qsr_tm(jpi,jpj) , &
  552. #if defined key_ldfslp
  553. & wslpi_tm(jpi,jpj,jpk) , wslpj_tm(jpi,jpj,jpk), &
  554. & uslp_tm(jpi,jpj,jpk) , vslp_tm(jpi,jpj,jpk), &
  555. #endif
  556. #if defined key_trabbl
  557. & ahu_bbl_tm(jpi,jpj) , ahv_bbl_tm(jpi,jpj), &
  558. & utr_bbl_tm(jpi,jpj) , vtr_bbl_tm(jpi,jpj), &
  559. #endif
  560. & rnf_tm(jpi,jpj) , h_rnf_tm(jpi,jpj) , &
  561. & STAT=trc_sub_alloc )
  562. IF( trc_sub_alloc /= 0 ) CALL ctl_warn('trc_sub_alloc: failed to allocate arrays')
  563. !
  564. END FUNCTION trc_sub_alloc
  565. #else
  566. !!----------------------------------------------------------------------
  567. !! Default key NO passive tracers
  568. !!----------------------------------------------------------------------
  569. CONTAINS
  570. SUBROUTINE trc_sub_stp( kt ) ! Empty routine
  571. WRITE(*,*) 'trc_sub_stp: You should not have seen this print! error?', kt
  572. END SUBROUTINE trc_sub_stp
  573. SUBROUTINE trc_sub_ini ! Empty routine
  574. WRITE(*,*) 'trc_sub_ini: You should not have seen this print! error?', kt
  575. END SUBROUTINE trc_sub_ini
  576. #endif
  577. !!======================================================================
  578. END MODULE trcsub