p4zsed.F90 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429
  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 5424 2018-04-27 07:03:10Z ufla $
  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(:,:,:) :: zirondep, zsoufer
  71. !!---------------------------------------------------------------------
  72. !
  73. IF( nn_timing == 1 ) CALL timing_start('p4z_sed')
  74. !
  75. IF( kt == nittrc000 .AND. knt == 1 ) r1_rday = 1. / rday
  76. !
  77. ! Allocate temporary workspace
  78. CALL wrk_alloc( jpi, jpj, zdenit2d, zbureff )
  79. CALL wrk_alloc( jpi, jpj, zsedcal, zsedsi, zsedc )
  80. CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
  81. CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
  82. zdenit2d(:,:) = 0.e0
  83. zbureff (:,:) = 0.e0
  84. zsedsi (:,:) = 0.e0
  85. zsedcal (:,:) = 0.e0
  86. zsedc (:,:) = 0.e0
  87. ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
  88. ! ----------------------------------------------------
  89. IF( ln_ironice ) THEN
  90. !
  91. CALL wrk_alloc( jpi, jpj, zironice )
  92. !
  93. DO jj = 1, jpj
  94. DO ji = 1, jpi
  95. zdep = rfact2 / fse3t(ji,jj,1)
  96. zwflux = fmmflx(ji,jj) / 1000._wp
  97. zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
  98. zfplus = MAX( 0._wp, -zwflux ) * icefeinput * zdep
  99. zironice(ji,jj) = zfplus + zfminus
  100. END DO
  101. END DO
  102. !
  103. tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:)
  104. !
  105. IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) ) &
  106. & CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
  107. !
  108. CALL wrk_dealloc( jpi, jpj, zironice )
  109. !
  110. ENDIF
  111. ! Add the external input of nutrients from dust deposition
  112. ! ----------------------------------------------------------
  113. IF( ln_dust ) THEN
  114. !
  115. CALL wrk_alloc( jpi, jpj, zpdep, zsidep )
  116. CALL wrk_alloc( jpi, jpj, jpk, zirondep )
  117. ! ! Iron and Si deposition at the surface
  118. IF( ln_solub ) THEN
  119. zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss
  120. ELSE
  121. zirondep(:,:,1) = dustsolub * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss
  122. ENDIF
  123. zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1
  124. zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r
  125. ! ! Iron solubilization of particles in the water column
  126. ! ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ; wdust in m/j
  127. zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
  128. DO jk = 2, jpkm1
  129. zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. )
  130. END DO
  131. ! ! Iron solubilization of particles in the water column
  132. tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep (:,:)
  133. tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep (:,:)
  134. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)
  135. !
  136. IF( lk_iomput ) THEN
  137. IF( knt == nrdttrc ) THEN
  138. IF( iom_use( "Irondep" ) ) &
  139. & CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
  140. IF( iom_use( "pdust" ) ) &
  141. & CALL iom_put( "pdust" , dust(:,:) / ( wdust * rday ) * tmask(:,:,1) ) ! dust concentration at surface
  142. ENDIF
  143. ELSE
  144. IF( ln_diatrc ) &
  145. & trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
  146. ENDIF
  147. CALL wrk_dealloc( jpi, jpj, zpdep, zsidep )
  148. CALL wrk_dealloc( jpi, jpj, jpk, zirondep )
  149. !
  150. ENDIF
  151. ! Add the external input of nutrients from river
  152. ! ----------------------------------------------------------
  153. IF( ln_river ) THEN
  154. DO jj = 1, jpj
  155. DO ji = 1, jpi
  156. DO jk = 1, nk_rnf(ji,jj)
  157. tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + rivdip(ji,jj) * rfact2
  158. tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + rivdin(ji,jj) * rfact2
  159. tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + rivdic(ji,jj) * 5.e-5 * rfact2
  160. tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + rivdsi(ji,jj) * rfact2
  161. tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + rivdic(ji,jj) * rfact2
  162. tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
  163. ENDDO
  164. ENDDO
  165. ENDDO
  166. ENDIF
  167. ! Add the external input of nutrients from nitrogen deposition
  168. ! ----------------------------------------------------------
  169. IF( ln_ndepo ) THEN
  170. tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
  171. tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
  172. ENDIF
  173. ! Add the external input of iron from sediment mobilization
  174. ! ------------------------------------------------------
  175. IF( ln_ironsed ) THEN
  176. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
  177. !
  178. IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) ) &
  179. & CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
  180. ENDIF
  181. ! Add the external input of iron from hydrothermal vents
  182. ! ------------------------------------------------------
  183. IF( ln_hydrofe ) THEN
  184. tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
  185. !
  186. IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) ) &
  187. & CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
  188. ENDIF
  189. ! OA: Warning, the following part is necessary, especially with Kriest
  190. ! to avoid CFL problems above the sediments
  191. ! --------------------------------------------------------------------
  192. DO jj = 1, jpj
  193. DO ji = 1, jpi
  194. ikt = mbkt(ji,jj)
  195. zdep = fse3t(ji,jj,ikt) / xstep
  196. zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
  197. zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
  198. zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
  199. END DO
  200. END DO
  201. #if ! defined key_sed
  202. ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
  203. ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
  204. ! -------------------------------------------------------
  205. DO jj = 1, jpj
  206. DO ji = 1, jpi
  207. IF( tmask(ji,jj,1) == 1 ) THEN
  208. ikt = mbkt(ji,jj)
  209. # if defined key_kriest
  210. zflx = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) * 1E3 * 1E6 / 1E4
  211. # else
  212. zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
  213. & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E3 * 1E6 / 1E4
  214. #endif
  215. zflx = LOG10( MAX( 1E-3, zflx ) )
  216. zo2 = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
  217. zno3 = LOG10( MAX( 1. , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
  218. zdep = LOG10( fsdepw(ji,jj,ikt+1) )
  219. zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3 &
  220. & + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
  221. zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
  222. !
  223. zflx = ( trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) &
  224. & + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
  225. zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
  226. ENDIF
  227. END DO
  228. END DO
  229. #endif
  230. ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
  231. ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
  232. ! ------------------------------------------------------
  233. #if ! defined key_sed
  234. zrivsil = 1._wp - sedsilfrac
  235. #endif
  236. DO jj = 1, jpj
  237. DO ji = 1, jpi
  238. ikt = mbkt(ji,jj)
  239. zdep = xstep / fse3t(ji,jj,ikt)
  240. zws4 = zwsbio4(ji,jj) * zdep
  241. zwsc = zwscal (ji,jj) * zdep
  242. # if defined key_kriest
  243. zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
  244. # else
  245. zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
  246. # endif
  247. zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
  248. !
  249. tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
  250. tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
  251. #if ! defined key_sed
  252. tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil
  253. ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
  254. ! The factor for calcite comes from the alkalinity effect
  255. ! -------------------------------------------------------------
  256. zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
  257. zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
  258. zrivalk = sedcalfrac * zfactcal
  259. tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
  260. tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
  261. zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss * fse3t(ji,jj,ikt)
  262. zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss * fse3t(ji,jj,ikt)
  263. #endif
  264. END DO
  265. END DO
  266. DO jj = 1, jpj
  267. DO ji = 1, jpi
  268. ikt = mbkt(ji,jj)
  269. zdep = xstep / fse3t(ji,jj,ikt)
  270. zws4 = zwsbio4(ji,jj) * zdep
  271. zws3 = zwsbio3(ji,jj) * zdep
  272. zrivno3 = 1. - zbureff(ji,jj)
  273. # if ! defined key_kriest
  274. tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4
  275. tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
  276. tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
  277. tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
  278. zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
  279. # else
  280. tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4
  281. tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
  282. tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
  283. zwstpoc = trb(ji,jj,ikt,jppoc) * zws3
  284. # endif
  285. #if ! defined key_sed
  286. ! The 0.5 factor in zpdenit is to avoid negative NO3 concentration after
  287. ! denitrification in the sediments. Not very clever, but simpliest option.
  288. zpdenit = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, &
  289. zdenit2d(ji,jj) * zwstpoc * zrivno3 * (1. - nitrfac2(ji,jj,ikt) ) )
  290. z1pdenit = zwstpoc * zrivno3 - zpdenit
  291. zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
  292. tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit
  293. tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit
  294. tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit
  295. tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * zpdenit
  296. tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
  297. tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * zpdenit )
  298. tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit
  299. sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
  300. zsedc(ji,jj) = (1. - zrivno3) * zwstpoc * fse3t(ji,jj,ikt)
  301. #endif
  302. END DO
  303. END DO
  304. ! Nitrogen fixation process
  305. ! Small source iron from particulate inorganic iron
  306. !-----------------------------------
  307. DO jk = 1, jpkm1
  308. DO jj = 1, jpj
  309. DO ji = 1, jpi
  310. ! ! Potential nitrogen fixation dependant on temperature and iron
  311. zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
  312. IF( zlim <= 0.2 ) zlim = 0.01
  313. #if defined key_degrad
  314. zfact = zlim * rfact2 * facvol(ji,jj,jk)
  315. #else
  316. zfact = zlim * rfact2
  317. #endif
  318. ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) )
  319. ztrpo4 = trb (ji,jj,jk,jppo4) / ( concnnh4 + trb (ji,jj,jk,jppo4) )
  320. zlight = ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) )
  321. nitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) &
  322. & * zfact * MIN( ztrfer, ztrpo4 ) * zlight
  323. zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
  324. END DO
  325. END DO
  326. END DO
  327. ! Nitrogen change due to nitrogen fixation
  328. ! ----------------------------------------
  329. DO jk = 1, jpkm1
  330. DO jj = 1, jpj
  331. DO ji = 1, jpi
  332. zfact = nitrpot(ji,jj,jk) * nitrfix
  333. tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact
  334. tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact
  335. tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit * zfact
  336. tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
  337. & * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
  338. tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
  339. END DO
  340. END DO
  341. END DO
  342. IF( lk_iomput ) THEN
  343. IF( knt == nrdttrc ) THEN
  344. zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molC/m3/s
  345. IF( iom_use("Nfix" ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * rno3 * zfact * tmask(:,:,:) ) ! nitrogen fixation
  346. IF( iom_use("INTNFIX") ) THEN ! nitrogen fixation rate in ocean ( vertically integrated )
  347. CALL wrk_alloc( jpi, jpj, zwork )
  348. zwork(:,:) = 0.
  349. DO jk = 1, jpkm1
  350. zwork(:,:) = zwork(:,:) + nitrpot(:,:,jk) * nitrfix * rno3 * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
  351. ENDDO
  352. CALL iom_put( "INTNFIX", zwork )
  353. CALL wrk_dealloc( jpi, jpj, zwork )
  354. ENDIF
  355. IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * zfact )
  356. IF( iom_use("SedSi" ) ) CALL iom_put( "SedSi", zsedsi (:,:) * zfact )
  357. IF( iom_use("SedC" ) ) CALL iom_put( "SedC", zsedc (:,:) * zfact )
  358. IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * rno3 * zfact )
  359. ENDIF
  360. ELSE
  361. IF( ln_diatrc ) THEN
  362. zfact = 1.e+3 * rfact2r ! conversion from molC/l/kt to molC/m3/s
  363. trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * zfact * fse3t(:,:,1) * tmask(:,:,1)
  364. ENDIF
  365. ENDIF
  366. !
  367. IF(ln_ctl) THEN ! print mean trends (USEd for debugging)
  368. WRITE(charout, fmt="('sed ')")
  369. CALL prt_ctl_trc_info(charout)
  370. CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
  371. ENDIF
  372. !
  373. CALL wrk_dealloc( jpi, jpj, zdenit2d, zbureff )
  374. CALL wrk_dealloc( jpi, jpj, zsedcal , zsedsi, zsedc )
  375. CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
  376. CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
  377. !
  378. IF( nn_timing == 1 ) CALL timing_stop('p4z_sed')
  379. !
  380. 9100 FORMAT(i8,3f10.5)
  381. !
  382. END SUBROUTINE p4z_sed
  383. INTEGER FUNCTION p4z_sed_alloc()
  384. !!----------------------------------------------------------------------
  385. !! *** ROUTINE p4z_sed_alloc ***
  386. !!----------------------------------------------------------------------
  387. ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
  388. !
  389. IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
  390. !
  391. END FUNCTION p4z_sed_alloc
  392. #else
  393. !!======================================================================
  394. !! Dummy module : No PISCES bio-model
  395. !!======================================================================
  396. CONTAINS
  397. SUBROUTINE p4z_sed ! Empty routine
  398. END SUBROUTINE p4z_sed
  399. #endif
  400. !!======================================================================
  401. END MODULE p4zsed