p4zsed.F90 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544
  1. MODULE p4zsed
  2. !!======================================================================
  3. !! *** MODULE p4sed ***
  4. !! TOP : PISCES Compute loss of organic matter in the sediments
  5. !!======================================================================
  6. !! History : 1.0 ! 2004-03 (O. Aumont) Original code
  7. !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
  8. !! 3.4 ! 2011-06 (C. Ethe) USE of fldread
  9. !! 3.5 ! 2012-07 (O. Aumont) improvment of river input of nutrients
  10. !!----------------------------------------------------------------------
  11. #if defined key_pisces
  12. !!----------------------------------------------------------------------
  13. !! 'key_pisces' PISCES bio-model
  14. !!----------------------------------------------------------------------
  15. !! p4z_sed : Compute loss of organic matter in the sediments
  16. !!----------------------------------------------------------------------
  17. USE oce_trc ! shared variables between ocean and passive tracers
  18. USE trc ! passive tracers common variables
  19. USE sms_pisces ! PISCES Source Minus Sink variables
  20. USE p4zsink ! vertical flux of particulate matter due to sinking
  21. USE p4zopt ! optical model
  22. USE p4zlim ! Co-limitations of differents nutrients
  23. USE p4zsbc ! External source of nutrients
  24. USE p4zint ! interpolation and computation of various fields
  25. USE iom ! I/O manager
  26. USE prtctl_trc ! print control for debugging
  27. IMPLICIT NONE
  28. PRIVATE
  29. PUBLIC p4z_sed
  30. PUBLIC p4z_sed_alloc
  31. !! * Module variables
  32. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot !: Nitrogen fixation
  33. REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,: ) :: sdenit !: Nitrate reduction in the sediments
  34. REAL(wp) :: r1_rday !: inverse of rday
  35. !!* Substitution
  36. # include "top_substitute.h90"
  37. !!----------------------------------------------------------------------
  38. !! NEMO/TOP 3.3 , NEMO Consortium (2010)
  39. !! $Id: p4zsed.F90 9241 2018-01-16 12:59:31Z cetlod $
  40. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  41. !!----------------------------------------------------------------------
  42. CONTAINS
  43. SUBROUTINE p4z_sed( kt, knt )
  44. !!---------------------------------------------------------------------
  45. !! *** ROUTINE p4z_sed ***
  46. !!
  47. !! ** Purpose : Compute loss of organic matter in the sediments. This
  48. !! is by no way a sediment model. The loss is simply
  49. !! computed to balance the inout from rivers and dust
  50. !!
  51. !! ** Method : - ???
  52. !!---------------------------------------------------------------------
  53. !
  54. INTEGER, INTENT(in) :: kt, knt ! ocean time step
  55. INTEGER :: ji, jj, jk, ikt
  56. #if ! defined key_sed
  57. REAL(wp) :: zrivalk, zrivsil, zrivno3
  58. #endif
  59. REAL(wp) :: zwflux, zfminus, zfplus
  60. REAL(wp) :: zlim, zfact, zfactcal
  61. REAL(wp) :: zo2, zno3, zflx, zpdenit, z1pdenit, zolimit
  62. REAL(wp) :: zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
  63. REAL(wp) :: ztrfer, ztrpo4, zwdust, zlight
  64. !
  65. CHARACTER (len=25) :: charout
  66. REAL(wp), POINTER, DIMENSION(:,: ) :: zpdep, zsidep, zwork
  67. REAL(wp), POINTER, DIMENSION(:,: ) :: zsedcal, zsedsi, zsedc
  68. REAL(wp), POINTER, DIMENSION(:,: ) :: zdenit2d, zironice, zbureff
  69. REAL(wp), POINTER, DIMENSION(:,: ) :: zwsbio3, zwsbio4, zwscal
  70. REAL(wp), POINTER, DIMENSION(:,: ) :: zfesupply, znsupply
  71. REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
  72. !!---------------------------------------------------------------------
  73. !
  74. IF( nn_timing == 1 ) CALL timing_start('p4z_sed')
  75. !
  76. IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday
  77. !
  78. ! Allocate temporary workspace
  79. CALL wrk_alloc( jpi, jpj, zdenit2d, zbureff, zwork )
  80. CALL wrk_alloc( jpi, jpj, zsedcal, zsedsi, zsedc )
  81. CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
  82. CALL wrk_alloc( jpi, jpj, zfesupply, znsupply )
  83. CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
  84. !
  85. zdenit2d (:,:) = 0._wp
  86. zbureff (:,:) = 0._wp
  87. zsedsi (:,:) = 0._wp
  88. zsedcal (:,:) = 0._wp
  89. zsedc (:,:) = 0._wp
  90. zwork (:,:) = 0._wp
  91. !!!!Begin EC-Earth modification for mass conservation of carbon. Author Raffaele Bernardello, January 2019
  92. !
  93. ! We don't get satisfying mass conservation for passive tracers in NEMO. Drift in total mass is of
  94. ! the order of a few thousandths/year. Over a long spinup (thousands of years) this results in a drift of
  95. ! several points %. After much researching and asking around it seems we are not the only ones with this problem
  96. ! however, we haven't been able to find the reason. We need a workaround in order to run the ocean spinup needed for
  97. ! CMIP6. Unlike other tracers, DIC does not have a total mass correction available in PISCES
  98. ! code. So we are creating one here. Other tracers (NO3, Alk, PO4) are periodically adjusted in total mass to conserve
  99. ! the initial amount. This can't be done with DIC because the spun-up state will be used to run transient simulations
  100. ! with increase of atmospheric CO2 and consequent ocean uptake. So, the ocean DIC needs to be trully equilibrated.
  101. !
  102. ! Here, we compute the total amount of C in the ocean at the beginning of the leg. Then we do the same at the end
  103. ! of the leg. Plus, we consider the accumulated air-sea co2 flux, sedimentation of C and Cal, and river input during the leg.
  104. ! The change in internal mass has to equal the sum of sink and sources. The residual is used to compute a homogeneous
  105. ! global correction to be applied uniformly everywhere to DIC.
  106. !
  107. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  108. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  109. !
  110. ! initialize cumulative sedimentation
  111. ! IF( kt == nittrc000 ) THEN
  112. ! zsedc_cum = 0._wp
  113. ! END IF !already initializes in p4zsms.F90
  114. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  115. ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
  116. ! ----------------------------------------------------
  117. IF( ln_ironice ) THEN
  118. !
  119. CALL wrk_alloc( jpi, jpj, zironice )
  120. !
  121. DO jj = 1, jpj
  122. DO ji = 1, jpi
  123. zdep = rfact2 / fse3t(ji,jj,1)
  124. zwflux = fmmflx(ji,jj) / 1000._wp
  125. zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
  126. zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep
  127. zironice(ji,jj) = zfplus + zfminus
  128. END DO
  129. END DO
  130. !
  131. tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)
  132. !
  133. IF( lk_iomput ) THEN
  134. IF( knt == nrdttrc .AND. iom_use( "Ironice" ) ) THEN
  135. zwork(:,:) = zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  136. CALL iom_put( "Ironice", zwork(:,:) ) ! iron flux from ice
  137. ENDIF
  138. IF( iom_use( "IronSupply" ) ) THEN
  139. CALL wrk_alloc( jpi, jpj, zfesupply )
  140. zfesupply(:,:) = 0._wp
  141. zfesupply(:,:) = zfesupply(:,:) + zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  142. ENDIF
  143. ENDIF
  144. !
  145. CALL wrk_dealloc( jpi, jpj, zironice )
  146. !
  147. ENDIF
  148. ! Add the external input of nutrients from dust deposition
  149. ! ----------------------------------------------------------
  150. IF( ln_dust ) THEN
  151. !
  152. CALL wrk_alloc( jpi, jpj, zpdep, zsidep )
  153. CALL wrk_alloc( jpi, jpj, jpk, zirondep )
  154. ! ! Iron and Si deposition at the surface
  155. IF( ln_solub ) THEN
  156. zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss
  157. ELSE
  158. zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss
  159. ENDIF
  160. zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1
  161. zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r
  162. ! ! Iron solubilization of particles in the water column
  163. ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j
  164. zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
  165. DO jk = 2, jpkm1
  166. zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. )
  167. END DO
  168. ! ! Iron solubilization of particles in the water column
  169. tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep (:,:)
  170. tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:)
  171. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)
  172. !
  173. IF( lk_iomput ) THEN
  174. IF( knt == nrdttrc ) THEN
  175. IF( iom_use( "Irondep" ) ) THEN
  176. zwork(:,:) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  177. CALL iom_put( "Irondep", zwork(:,:) ) ! surface downward dust depo of iron
  178. ENDIF
  179. IF( iom_use( "pdust" ) ) THEN
  180. zwork(:,:) = dust(:,:) / ( wdust * rday ) * tmask(:,:,1)
  181. CALL iom_put( "pdust" , zwork(:,:) ) ! dust concentration at surface
  182. ENDIF
  183. ENDIF
  184. IF( iom_use("IronSupply" ) ) &
  185. & zfesupply(:,:) = zfesupply(:,:) + zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  186. ELSE
  187. IF( ln_diatrc ) &
  188. & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  189. ENDIF
  190. !
  191. CALL wrk_dealloc( jpi, jpj, zpdep, zsidep )
  192. CALL wrk_dealloc( jpi, jpj, jpk, zirondep )
  193. !
  194. ENDIF
  195. ! Add the external input of nutrients from river
  196. ! ----------------------------------------------------------
  197. IF( ln_river ) THEN
  198. DO jj = 1, jpj
  199. DO ji = 1, jpi
  200. DO jk = 1, nk_rnf(ji,jj)
  201. tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2
  202. tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2
  203. tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2
  204. tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2
  205. tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2
  206. tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
  207. ENDDO
  208. ENDDO
  209. ENDDO
  210. !
  211. IF( lk_iomput ) THEN
  212. !
  213. IF( iom_use("IronSupply" ) ) &
  214. & zfesupply(:,:) = zfesupply(:,:) + rivdic(:,:) * 5.e-5 * rfact2 * tmask(:,:,1)
  215. !
  216. IF( iom_use("NitrSupply" ) ) THEN
  217. CALL wrk_alloc( jpi, jpj, znsupply )
  218. znsupply(:,:) = 0._wp
  219. znsupply(:,:) = znsupply(:,:) + rivdin(:,:) * rfact2 * tmask(:,:,1)
  220. ENDIF
  221. !
  222. IF( knt == nrdttrc ) THEN
  223. IF( iom_use( "rivDIC" ) ) CALL iom_put( "rivDIC" , rivdic(:,:) * tmask(:,:,1) )
  224. IF( iom_use( "rivTAlk" ) ) CALL iom_put( "rivTAlk", rivalk(:,:) * tmask(:,:,1) )
  225. IF( iom_use( "rivNO3" ) ) CALL iom_put( "rivNO3" , rivdin(:,:) * tmask(:,:,1) )
  226. IF( iom_use( "rivPO4" ) ) CALL iom_put( "rivPO4" , rivdip(:,:) * tmask(:,:,1) )
  227. IF( iom_use( "rivIron" ) ) CALL iom_put( "rivIron", rivdic(:,:) * 5.e-5 * tmask(:,:,1) )
  228. IF( iom_use( "rivSi" ) ) CALL iom_put( "rivSi" , rivdsi(:,:) * tmask(:,:,1) )
  229. ENDIF
  230. ENDIF
  231. !
  232. ENDIF
  233. !!!!Begin EC-Earth modification for mass conservation of carbon. Author Raffaele Bernardello, April 2019
  234. !
  235. !keep track of actual amount of dic coming from rivers
  236. riverdicsum=riverdicsum+glob_sum(rivdic(:,:)*e1e2t(:,:)*h_rnf(:,:))*1.E3*rfact2
  237. !!!!End of EC-Earth modification
  238. ! Add the external input of nutrients from nitrogen deposition
  239. ! ----------------------------------------------------------
  240. IF( ln_ndepo ) THEN
  241. tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
  242. tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
  243. !
  244. IF( iom_use( "NitrSupply" ) ) &
  245. & znsupply(:,:) = znsupply(:,:) + nitdep(:,:) * rfact2
  246. !
  247. ENDIF
  248. ! Add the external input of iron from sediment mobilization
  249. ! ------------------------------------------------------
  250. IF( ln_ironsed ) THEN
  251. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
  252. !
  253. IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) &
  254. & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
  255. !
  256. IF( iom_use( "IronSupply" ) ) THEN
  257. DO jk = 1, jpkm1
  258. zfesupply(:,:) = zfesupply(:,:) + ironsed(:,:,jk) * 1.e+3 * tmask(:,:,jk) * fse3t(:,:,jk)
  259. ENDDO
  260. ENDIF
  261. !
  262. ENDIF
  263. ! Add the external input of iron from hydrothermal vents
  264. ! ------------------------------------------------------
  265. IF( ln_hydrofe ) THEN
  266. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
  267. !
  268. IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) ) &
  269. & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
  270. !
  271. IF( iom_use( "IronSupply" ) ) THEN
  272. DO jk = 1, jpkm1
  273. zfesupply(:,:) = zfesupply(:,:) + hydrofe(:,:,jk) * 1.e+3 * tmask(:,:,jk) * fse3t(:,:,jk)
  274. ENDDO
  275. ENDIF
  276. !
  277. ENDIF
  278. ! OA: Warning, the following part is necessary, especially with Kriest
  279. ! to avoid CFL problems above the sediments
  280. ! --------------------------------------------------------------------
  281. DO jj = 1, jpj
  282. DO ji = 1, jpi
  283. ikt = mbkt(ji,jj)
  284. zdep = fse3t(ji,jj,ikt) / xstep
  285. zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
  286. zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
  287. zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
  288. END DO
  289. END DO
  290. #if ! defined key_sed
  291. ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
  292. ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
  293. ! -------------------------------------------------------
  294. DO jj = 1, jpj
  295. DO ji = 1, jpi
  296. IF( tmask(ji,jj,1) == 1 ) THEN
  297. ikt = mbkt(ji,jj)
  298. # if defined key_kriest
  299. zflx = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4
  300. # else
  301. zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
  302. & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4
  303. #endif
  304. zflx = LOG10( MAX( 1E-3, zflx ) )
  305. zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
  306. zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
  307. zdep = LOG10( fsdepw(ji,jj,ikt+1) )
  308. zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 &
  309. & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
  310. zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
  311. !
  312. zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
  313. & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
  314. zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
  315. ENDIF
  316. END DO
  317. END DO
  318. #endif
  319. ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
  320. ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
  321. ! ------------------------------------------------------
  322. #if ! defined key_sed
  323. zrivsil = 1._wp - sedsilfrac
  324. #endif
  325. DO jj = 1, jpj
  326. DO ji = 1, jpi
  327. ikt = mbkt(ji,jj)
  328. zdep = xstep / fse3t(ji,jj,ikt)
  329. zws4 = zwsbio4(ji,jj) * zdep
  330. zwsc = zwscal (ji,jj) * zdep
  331. # if defined key_kriest
  332. zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
  333. # else
  334. zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
  335. # endif
  336. zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
  337. !
  338. tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
  339. tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
  340. #if ! defined key_sed
  341. tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil
  342. ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
  343. ! The factor for calcite comes from the alkalinity effect
  344. ! -------------------------------------------------------------
  345. zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
  346. zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
  347. zrivalk = sedcalfrac * zfactcal
  348. tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
  349. tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
  350. zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * fse3t(ji,jj,ikt)
  351. zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * fse3t(ji,jj,ikt)
  352. #endif
  353. END DO
  354. END DO
  355. DO jj = 1, jpj
  356. DO ji = 1, jpi
  357. ikt = mbkt(ji,jj)
  358. zdep = xstep / fse3t(ji,jj,ikt)
  359. zws4 = zwsbio4(ji,jj) * zdep
  360. zws3 = zwsbio3(ji,jj) * zdep
  361. zrivno3 = 1. - zbureff(ji,jj)
  362. # if ! defined key_kriest
  363. tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4
  364. tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
  365. tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
  366. tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
  367. zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
  368. # else
  369. tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4
  370. tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
  371. tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
  372. zwstpoc = trb(ji,jj,ikt,jppoc) * zws3
  373. # endif
  374. #if ! defined key_sed
  375. ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
  376. ! denitrification in the sediments. Not very clever, but simpliest option.
  377. zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, &
  378. zdenit2d(ji,jj) * zwstpoc * zrivno3 )
  379. z1pdenit = zwstpoc * zrivno3 - zpdenit
  380. zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
  381. tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit
  382. tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit
  383. tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit
  384. tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit
  385. tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
  386. tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit )
  387. tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit
  388. sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
  389. zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * fse3t(ji,jj,ikt)
  390. #endif
  391. END DO
  392. END DO
  393. ! EC-Earth C mass conservation correction
  394. ! cumulate sedimentation
  395. zsedc_cum = zsedc_cum + glob_sum( (zsedc(:,:) + zsedcal(:,:) ) * 1.E3 * e1e2t(:,:) * tmask(:,:,ikt) ) ! mol C
  396. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  397. ! Nitrogen fixation process
  398. ! Small source iron from particulate inorganic iron
  399. !-----------------------------------
  400. DO jk = 1, jpkm1
  401. DO jj = 1, jpj
  402. DO ji = 1, jpi
  403. ! ! Potential nitrogen fixation dependant on temperature and iron
  404. zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
  405. IF( zlim <= 0.2 ) zlim = 0.01
  406. #if defined key_degrad
  407. zfact = zlim * rfact2 * facvol(ji,jj,jk)
  408. #else
  409. zfact = zlim * rfact2
  410. #endif
  411. ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
  412. ztrpo4 = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) )
  413. zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) )
  414. nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
  415. & * zfact * MIN( ztrfer, ztrpo4 ) * zlight
  416. zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
  417. END DO
  418. END DO
  419. END DO
  420. ! Nitrogen change due to nitrogen fixation
  421. ! ----------------------------------------
  422. DO jk = 1, jpkm1
  423. DO jj = 1, jpj
  424. DO ji = 1, jpi
  425. zfact = nitrpot(ji,jj,jk) * nitrfix
  426. tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact
  427. tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact
  428. tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact
  429. tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
  430. & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
  431. tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
  432. END DO
  433. END DO
  434. END DO
  435. IF( iom_use( "IronSupply" ) ) THEN
  436. DO jk = 1, jpkm1
  437. zfesupply(:,:) = zfesupply(:,:) + 0.002 * 4E-10 * zsoufer(:,:,jk) * xstep * fse3t(:,:,jk)
  438. ENDDO
  439. ENDIF
  440. IF( lk_iomput ) THEN
  441. IF( knt == nrdttrc ) THEN
  442. zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molC/m3/s
  443. IF( iom_use("Nfix" ) ) &
  444. & CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation
  445. !
  446. IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated )
  447. zwork(:,:) = 0.
  448. DO jk = 1, jpkm1
  449. zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
  450. ENDDO
  451. CALL iom_put( "INTNFIX", zwork )
  452. ENDIF
  453. !
  454. IF( iom_use("NitrSupply") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated )
  455. DO jk = 1, jpkm1
  456. znsupply(:,:) = znsupply(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
  457. ENDDO
  458. CALL iom_put( "NitrSupply", znsupply(:,:) )
  459. CALL wrk_dealloc( jpi, jpj, znsupply )
  460. ENDIF
  461. IF( iom_use( "IronSupply" ) ) THEN
  462. CALL iom_put( "IronSupply", zfesupply(:,:) )
  463. CALL wrk_dealloc( jpi, jpj, zfesupply )
  464. ENDIF
  465. IF( iom_use( "SedCal" ) ) CALL iom_put( "SedCal" , zsedcal(:,:) * zfact )
  466. IF( iom_use( "SedSi" ) ) CALL iom_put( "SedSi" , zsedsi (:,:) * zfact )
  467. IF( iom_use( "SedC" ) ) CALL iom_put( "SedC" , zsedc (:,:) * zfact )
  468. IF( iom_use( "Sdenit" ) ) CALL iom_put( "Sdenit" , sdenit (:,:) * rno3 * zfact )
  469. ENDIF
  470. ELSE
  471. IF( ln_diatrc ) THEN
  472. zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molC/m3/s
  473. trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * zfact * fse3t(:,:,1) * tmask(:,:,1)
  474. ENDIF
  475. ENDIF
  476. !
  477. IF(ln_ctl) THEN ! print mean trends (USEd for debugging)
  478. WRITE(charout, fmt="('sed ')")
  479. CALL prt_ctl_trc_info(charout)
  480. CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
  481. ENDIF
  482. !
  483. CALL wrk_dealloc( jpi, jpj, zdenit2d, zbureff, zwork )
  484. CALL wrk_dealloc( jpi, jpj, zsedcal , zsedsi , zsedc )
  485. CALL wrk_dealloc( jpi, jpj, zwsbio3 , zwsbio4, zwscal )
  486. CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
  487. !
  488. IF( nn_timing == 1 ) CALL timing_stop('p4z_sed')
  489. !
  490. 9100 FORMAT(i8,3f10.5)
  491. !
  492. END SUBROUTINE p4z_sed
  493. INTEGER FUNCTION p4z_sed_alloc()
  494. !!----------------------------------------------------------------------
  495. !! *** ROUTINE p4z_sed_alloc ***
  496. !!----------------------------------------------------------------------
  497. ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
  498. !
  499. IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
  500. !
  501. END FUNCTION p4z_sed_alloc
  502. #else
  503. !!======================================================================
  504. !! Dummy module : No PISCES bio-model
  505. !!======================================================================
  506. CONTAINS
  507. SUBROUTINE p4z_sed ! Empty routine
  508. END SUBROUTINE p4z_sed
  509. #endif
  510. !!======================================================================
  511. END MODULE p4zsed