p4zsms.F90 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595
  1. MODULE p4zsms
  2. !!======================================================================
  3. !! *** MODULE p4zsms ***
  4. !! TOP : PISCES Source Minus Sink manager
  5. !!======================================================================
  6. !! History : 1.0 ! 2004-03 (O. Aumont) Original code
  7. !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90
  8. !!----------------------------------------------------------------------
  9. #if defined key_pisces
  10. !!----------------------------------------------------------------------
  11. !! 'key_pisces' PISCES bio-model
  12. !!----------------------------------------------------------------------
  13. !! p4zsms : Time loop of passive tracers sms
  14. !!----------------------------------------------------------------------
  15. USE oce_trc ! shared variables between ocean and passive tracers
  16. USE trc ! passive tracers common variables
  17. USE trcdta
  18. USE sms_pisces ! PISCES Source Minus Sink variables
  19. USE p4zbio ! Biological model
  20. USE p4zche ! Chemical model
  21. USE p4zlys ! Calcite saturation
  22. USE p4zflx ! Gas exchange
  23. USE p4zsbc ! External source of nutrients
  24. USE p4zsed ! Sedimentation
  25. USE p4zint ! time interpolation
  26. USE p4zrem ! remineralisation
  27. USE iom ! I/O manager
  28. USE trd_oce ! Ocean trends variables
  29. USE trdtrc ! TOP trends variables
  30. USE sedmodel ! Sediment model
  31. USE prtctl_trc ! print control for debugging
  32. IMPLICIT NONE
  33. PRIVATE
  34. PUBLIC p4z_sms_init ! called in p4zsms.F90
  35. PUBLIC p4z_sms ! called in p4zsms.F90
  36. REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
  37. REAL(wp) :: xfact1, xfact2, xfact3
  38. INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget
  39. REAL(wp) ::dicbudget ! EC-Earth change: add global carbon inventory
  40. !!* Array used to indicate negative tracer values
  41. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???
  42. !! * Substitutions
  43. # include "top_substitute.h90"
  44. !!----------------------------------------------------------------------
  45. !! NEMO/TOP 3.3 , NEMO Consortium (2010)
  46. !! $Id: p4zsms.F90 3320 2012-03-05 16:37:52Z cetlod $
  47. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  48. !!----------------------------------------------------------------------
  49. CONTAINS
  50. SUBROUTINE p4z_sms( kt )
  51. !!---------------------------------------------------------------------
  52. !! *** ROUTINE p4z_sms ***
  53. !!
  54. !! ** Purpose : Managment of the call to Biological sources and sinks
  55. !! routines of PISCES bio-model
  56. !!
  57. !! ** Method : - at each new day ...
  58. !! - several calls of bio and sed ???
  59. !! - ...
  60. !!---------------------------------------------------------------------
  61. !
  62. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  63. !!
  64. INTEGER :: ji, jj, jk, jnt, jn, jl
  65. REAL(wp) :: ztra
  66. #if defined key_kriest
  67. REAL(wp) :: zcoef1, zcoef2
  68. #endif
  69. CHARACTER (len=25) :: charout
  70. !!---------------------------------------------------------------------
  71. !
  72. IF( nn_timing == 1 ) CALL timing_start('p4z_sms')
  73. !
  74. IF( kt == nittrc000 ) THEN
  75. !
  76. ALLOCATE( xnegtr(jpi,jpj,jpk) )
  77. !
  78. CALL p4z_che ! initialize the chemical constants
  79. !
  80. IF( .NOT. ln_rsttr ) THEN ; CALL p4z_che_ahini( hi ) ! set PH at kt=nit000
  81. ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields
  82. ENDIF
  83. !
  84. ENDIF
  85. !
  86. IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers
  87. !
  88. ! ! set time step size (Euler/Leapfrog)
  89. IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc(1) ! at nittrc000
  90. ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc(1) ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
  91. ENDIF
  92. !
  93. IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
  94. rfactr = 1. / rfact
  95. rfact2 = rfact / FLOAT( nrdttrc )
  96. rfact2r = 1. / rfact2
  97. xstep = rfact2 / rday ! Time step duration for biology
  98. IF(lwp) WRITE(numout,*)
  99. IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)
  100. IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
  101. IF(lwp) WRITE(numout,*)
  102. ENDIF
  103. IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
  104. DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
  105. trb(:,:,:,jn) = trn(:,:,:,jn)
  106. END DO
  107. ENDIF
  108. !
  109. IF( ndayflxtr /= nday_year ) THEN ! New days
  110. !
  111. ndayflxtr = nday_year
  112. IF(lwp) write(numout,*)
  113. IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
  114. IF(lwp) write(numout,*) '~~~~~~'
  115. CALL p4z_che ! computation of chemical constants
  116. CALL p4z_int( kt ) ! computation of various rates for biogeochemistry
  117. !
  118. ENDIF
  119. IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients
  120. DO jnt = 1, nrdttrc ! Potential time splitting if requested
  121. !
  122. CALL p4z_bio( kt, jnt ) ! Biology
  123. CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation
  124. CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions
  125. CALL p4z_flx( kt, jnt ) ! Compute surface fluxes
  126. !
  127. xnegtr(:,:,:) = 1.e0
  128. DO jn = jp_pcs0, jp_pcs1
  129. DO jk = 1, jpk
  130. DO jj = 1, jpj
  131. DO ji = 1, jpi
  132. IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
  133. ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
  134. xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
  135. ENDIF
  136. END DO
  137. END DO
  138. END DO
  139. END DO
  140. ! ! where at least 1 tracer concentration becomes negative
  141. ! !
  142. DO jn = jp_pcs0, jp_pcs1
  143. trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
  144. END DO
  145. !
  146. DO jn = jp_pcs0, jp_pcs1
  147. tra(:,:,:,jn) = 0._wp
  148. END DO
  149. !
  150. IF( ln_top_euler ) THEN
  151. DO jn = jp_pcs0, jp_pcs1
  152. trn(:,:,:,jn) = trb(:,:,:,jn)
  153. END DO
  154. ENDIF
  155. END DO
  156. #if defined key_kriest
  157. !
  158. zcoef1 = 1.e0 / xkr_massp
  159. zcoef2 = 1.e0 / xkr_massp / 1.1
  160. DO jk = 1,jpkm1
  161. trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )
  162. trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 )
  163. END DO
  164. !
  165. #endif
  166. !
  167. !
  168. IF( l_trdtrc ) THEN
  169. DO jn = jp_pcs0, jp_pcs1
  170. CALL trd_trc( tra(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
  171. END DO
  172. END IF
  173. !
  174. IF( lk_sed ) THEN
  175. !
  176. CALL sed_model( kt ) ! Main program of Sediment model
  177. !
  178. DO jn = jp_pcs0, jp_pcs1
  179. CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
  180. END DO
  181. !
  182. ENDIF
  183. !
  184. IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file
  185. !
  186. IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking
  187. IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES
  188. IF( nn_timing == 1 ) CALL timing_stop('p4z_sms')
  189. !
  190. !
  191. END SUBROUTINE p4z_sms
  192. SUBROUTINE p4z_sms_init
  193. !!----------------------------------------------------------------------
  194. !! *** p4z_sms_init ***
  195. !!
  196. !! ** Purpose : read PISCES namelist
  197. !!
  198. !! ** input : file 'namelist.trc.s' containing the following
  199. !! namelist: natext, natbio, natsms
  200. !! natkriest ("key_kriest")
  201. !!----------------------------------------------------------------------
  202. NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max
  203. #if defined key_kriest
  204. NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max
  205. #endif
  206. NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
  207. NAMELIST/nampismass/ ln_check_mass
  208. INTEGER :: ios ! Local integer output status for namelist read
  209. !!----------------------------------------------------------------------
  210. REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables
  211. READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
  212. 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp )
  213. REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables
  214. READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
  215. 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp )
  216. IF(lwm) WRITE ( numonp, nampisbio )
  217. IF(lwp) THEN ! control print
  218. WRITE(numout,*) ' Namelist : nampisbio'
  219. WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc
  220. WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
  221. WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
  222. WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3
  223. WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
  224. WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max
  225. WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max
  226. ENDIF
  227. #if defined key_kriest
  228. ! ! nampiskrp : kriest parameters
  229. ! ! -----------------------------
  230. REWIND( numnatp_ref ) ! Namelist nampiskrp in reference namelist : Pisces Kriest
  231. READ ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903)
  232. 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp )
  233. REWIND( numnatp_cfg ) ! Namelist nampiskrp in configuration namelist : Pisces Kriest
  234. READ ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 )
  235. 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp )
  236. IF(lwm) WRITE ( numonp, nampiskrp )
  237. IF(lwp) THEN
  238. WRITE(numout,*)
  239. WRITE(numout,*) ' Namelist : nampiskrp'
  240. WRITE(numout,*) ' Sinking exponent xkr_eta = ', xkr_eta
  241. WRITE(numout,*) ' N content exponent xkr_zeta = ', xkr_zeta
  242. WRITE(numout,*) ' N content factor xkr_ncontent = ', xkr_ncontent
  243. WRITE(numout,*) ' Minimum mass for Aggregates xkr_mass_min = ', xkr_mass_min
  244. WRITE(numout,*) ' Maximum mass for Aggregates xkr_mass_max = ', xkr_mass_max
  245. WRITE(numout,*)
  246. ENDIF
  247. ! Computation of some variables
  248. xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta
  249. #endif
  250. REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping
  251. READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
  252. 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp )
  253. REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping
  254. READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
  255. 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp )
  256. IF(lwm) WRITE ( numonp, nampisdmp )
  257. IF(lwp) THEN ! control print
  258. WRITE(numout,*)
  259. WRITE(numout,*) ' Namelist : nampisdmp'
  260. WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
  261. WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
  262. WRITE(numout,*) ' '
  263. ENDIF
  264. REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check
  265. READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
  266. 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp )
  267. REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check
  268. READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
  269. 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp )
  270. IF(lwm) WRITE ( numonp, nampismass )
  271. IF(lwp) THEN ! control print
  272. WRITE(numout,*) ' '
  273. WRITE(numout,*) ' Namelist parameter for mass conservation checking'
  274. WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
  275. WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
  276. ENDIF
  277. END SUBROUTINE p4z_sms_init
  278. SUBROUTINE p4z_rst( kt, cdrw )
  279. !!---------------------------------------------------------------------
  280. !! *** ROUTINE p4z_rst ***
  281. !!
  282. !! ** Purpose : Read or write variables in restart file:
  283. !!
  284. !! WRITE(READ) mode:
  285. !! kt : number of time step since the begining of the experiment at the
  286. !! end of the current(previous) run
  287. !!---------------------------------------------------------------------
  288. INTEGER , INTENT(in) :: kt ! ocean time-step
  289. CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
  290. !!---------------------------------------------------------------------
  291. IF( TRIM(cdrw) == 'READ' ) THEN
  292. !
  293. IF(lwp) WRITE(numout,*)
  294. IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
  295. IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
  296. !
  297. IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
  298. CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) )
  299. ELSE
  300. CALL p4z_che_ahini( hi )
  301. ENDIF
  302. CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
  303. IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
  304. CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
  305. ELSE
  306. xksimax(:,:) = xksi(:,:)
  307. ENDIF
  308. !
  309. IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN ! cumulative total flux of carbon
  310. CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum )
  311. ELSE
  312. t_oce_co2_flx_cum = 0._wp
  313. ENDIF
  314. !
  315. ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
  316. IF( kt == nitrst ) THEN
  317. IF(lwp) WRITE(numout,*)
  318. IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
  319. IF(lwp) WRITE(numout,*) '~~~~~~~'
  320. ENDIF
  321. CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
  322. CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
  323. CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
  324. CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
  325. ENDIF
  326. !
  327. END SUBROUTINE p4z_rst
  328. SUBROUTINE p4z_dmp( kt )
  329. !!----------------------------------------------------------------------
  330. !! *** p4z_dmp ***
  331. !!
  332. !! ** purpose : Relaxation of some tracers
  333. !!----------------------------------------------------------------------
  334. !
  335. INTEGER, INTENT( in ) :: kt ! time step
  336. !
  337. REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
  338. REAL(wp) :: po4mean = 2.165 ! mean value of phosphates
  339. REAL(wp) :: no3mean = 30.90 ! mean value of nitrate
  340. REAL(wp) :: silmean = 91.51 ! mean value of silicate
  341. !
  342. REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
  343. REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
  344. !!---------------------------------------------------------------------
  345. IF(lwp) WRITE(numout,*)
  346. IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
  347. IF(lwp) WRITE(numout,*)
  348. IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) !
  349. ! ! --------------------------- !
  350. ! set total alkalinity, phosphate, nitrate & silicate
  351. zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6
  352. zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
  353. zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
  354. zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
  355. zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
  356. IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
  357. trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
  358. IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
  359. trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
  360. IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
  361. trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
  362. IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
  363. trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
  364. !
  365. !
  366. IF( .NOT. ln_top_euler ) THEN
  367. zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea
  368. zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
  369. zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
  370. zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
  371. IF(lwp) WRITE(numout,*) ' '
  372. IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
  373. trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
  374. IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
  375. trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
  376. IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
  377. trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
  378. IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
  379. trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
  380. ENDIF
  381. !
  382. ENDIF
  383. !
  384. END SUBROUTINE p4z_dmp
  385. SUBROUTINE p4z_chk_mass( kt )
  386. !!----------------------------------------------------------------------
  387. !! *** ROUTINE p4z_chk_mass ***
  388. !!
  389. !! ** Purpose : Mass conservation check
  390. !!
  391. !!---------------------------------------------------------------------
  392. !
  393. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  394. REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
  395. CHARACTER(LEN=100) :: cltxt
  396. REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
  397. INTEGER :: jk
  398. !!----------------------------------------------------------------------
  399. !
  400. !!---------------------------------------------------------------------
  401. IF( kt == nittrc000 ) THEN
  402. xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
  403. xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
  404. xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
  405. IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
  406. CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  407. CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  408. CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  409. cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
  410. IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
  411. IF( lwp ) WRITE(numnut,*)
  412. ENDIF
  413. ENDIF
  414. ! BEGIN EC-Earth change: add global carbon inventory
  415. IF( iom_use( "dictot" ) .OR. (ln_check_mass .AND. kt == nitend ) ) THEN
  416. dicbudget = glob_sum( ( trn(:,:,:,jpdic) &
  417. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  418. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  419. & + trn(:,:,:,jppoc) &
  420. #if ! defined key_kriest
  421. & + trn(:,:,:,jpgoc) &
  422. #endif
  423. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  424. CALL iom_put( "dictot", dicbudget )
  425. ENDIF
  426. ! END EC-Earth change
  427. !
  428. IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  429. ! Compute the budget of NO3, ALK, Si, Fer
  430. no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) &
  431. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  432. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  433. & + trn(:,:,:,jppoc) &
  434. #if ! defined key_kriest
  435. & + trn(:,:,:,jpgoc) &
  436. #endif
  437. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  438. !
  439. no3budget = no3budget / areatot
  440. CALL iom_put( "pno3tot", no3budget )
  441. ENDIF
  442. !
  443. IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  444. po4budget = glob_sum( ( trn(:,:,:,jppo4) &
  445. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  446. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  447. & + trn(:,:,:,jppoc) &
  448. #if ! defined key_kriest
  449. & + trn(:,:,:,jpgoc) &
  450. #endif
  451. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  452. po4budget = po4budget / areatot
  453. CALL iom_put( "ppo4tot", po4budget )
  454. ENDIF
  455. !
  456. IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  457. silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &
  458. & + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )
  459. !
  460. silbudget = silbudget / areatot
  461. CALL iom_put( "psiltot", silbudget )
  462. ENDIF
  463. !
  464. IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  465. alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 &
  466. & + trn(:,:,:,jptal) &
  467. & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) )
  468. !
  469. alkbudget = alkbudget / areatot
  470. CALL iom_put( "palktot", alkbudget )
  471. ENDIF
  472. !
  473. IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  474. ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) &
  475. & + trn(:,:,:,jpdfe) &
  476. #if ! defined key_kriest
  477. & + trn(:,:,:,jpbfe) &
  478. #endif
  479. & + trn(:,:,:,jpsfe) &
  480. & + trn(:,:,:,jpzoo) * ferat3 &
  481. & + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) )
  482. !
  483. ferbudget = ferbudget / areatot
  484. CALL iom_put( "pfertot", ferbudget )
  485. ENDIF
  486. !
  487. ! Global budget of N SMS : denitrification in the water column and in the sediment
  488. ! nitrogen fixation by the diazotrophs
  489. ! --------------------------------------------------------------------------------
  490. IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  491. znitrpottot = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
  492. CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
  493. ENDIF
  494. !
  495. IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  496. zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) ! denitrification in the water column
  497. zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! denitrification in the sediments
  498. CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification in molN/m3
  499. ENDIF
  500. IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
  501. t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
  502. t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
  503. tpp = tpp * 1000. * xfact1
  504. t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
  505. IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
  506. IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
  507. & no3budget * rno3 * 1.e+06, &
  508. & po4budget * po4r * 1.e+06, &
  509. & silbudget * 1.e+06, &
  510. & ferbudget * 1.e+09
  511. !
  512. IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
  513. & zrdenittot * xfact2 , &
  514. & zsdenittot * xfact2
  515. ENDIF
  516. !
  517. 9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
  518. 9100 FORMAT(i8,5e18.10)
  519. 9200 FORMAT(i8,3f10.5)
  520. !
  521. END SUBROUTINE p4z_chk_mass
  522. #else
  523. !!======================================================================
  524. !! Dummy module : No PISCES bio-model
  525. !!======================================================================
  526. CONTAINS
  527. SUBROUTINE p4z_sms( kt ) ! Empty routine
  528. INTEGER, INTENT( in ) :: kt
  529. WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt
  530. END SUBROUTINE p4z_sms
  531. #endif
  532. !!======================================================================
  533. END MODULE p4zsms