p4zsms.F90 44 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890
  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. PUBLIC trc_sms_cfix ! called in trcstp.F90
  37. REAL(wp) :: alkbudget, no3budget, silbudget, ferbudget, po4budget
  38. REAL(wp) :: xfact, xfact1, xfact2, xfact3
  39. REAL(wp) :: dicmasst0 ! EC-Earth C mass conservation correction
  40. REAL(wp) :: sedrivdicsum ! EC-Earth C mass conservation correction
  41. INTEGER :: numco2, numnut, numnit !: logical unit for co2 budget
  42. INTEGER :: numcdiag !: logical unit for extra C budget - R. Bernardello
  43. REAL(wp) :: alkmax = 3200.0e-6_wp ! max value of dic
  44. REAL(wp) :: dicmax = 2800e-6_wp ! mean value of alkalinity
  45. REAL(wp) :: po4max = 10.0e-6_wp ! mean value of phosphates
  46. REAL(wp) :: no3max = 50.0e-6_wp ! mean value of nitrate
  47. REAL(wp) :: silmax = 250.0e-6_wp ! mean value of silicate
  48. REAL(wp) :: fermax = 6.0e-8_wp
  49. REAL(wp) ::dicbudget ! EC-Earth change: add global carbon inventory
  50. !!* Array used to indicate negative tracer values
  51. REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xnegtr !: ???
  52. !! * Substitutions
  53. # include "top_substitute.h90"
  54. !!----------------------------------------------------------------------
  55. !! NEMO/TOP 3.3 , NEMO Consortium (2010)
  56. !! $Id: p4zsms.F90 3320 2012-03-05 16:37:52Z cetlod $
  57. !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
  58. !!----------------------------------------------------------------------
  59. CONTAINS
  60. SUBROUTINE p4z_sms( kt )
  61. !!---------------------------------------------------------------------
  62. !! *** ROUTINE p4z_sms ***
  63. !!
  64. !! ** Purpose : Managment of the call to Biological sources and sinks
  65. !! routines of PISCES bio-model
  66. !!
  67. !! ** Method : - at each new day ...
  68. !! - several calls of bio and sed ???
  69. !! - ...
  70. !!---------------------------------------------------------------------
  71. !
  72. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  73. !!
  74. INTEGER :: ji, jj, jk, jnt, jn, jl
  75. REAL(wp) :: ztra
  76. REAL(wp) :: dicmassbefore, dicmassafter ! EC-Earth C mass conservation correction
  77. #if defined key_kriest
  78. REAL(wp) :: zcoef1, zcoef2
  79. #endif
  80. CHARACTER (len=25) :: charout
  81. REAL(wp), POINTER, DIMENSION(:,:) :: zw2d
  82. REAL(wp), POINTER, DIMENSION(:,:,:,:) :: ztrdt ! 4D workspace
  83. !!---------------------------------------------------------------------
  84. !
  85. IF( nn_timing == 1 ) CALL timing_start('p4z_sms')
  86. !
  87. IF( kt == nittrc000 ) THEN
  88. !
  89. ALLOCATE( xnegtr(jpi,jpj,jpk) )
  90. !
  91. CALL p4z_che ! initialize the chemical constants
  92. !
  93. IF( .NOT. ln_rsttr ) THEN ; CALL p4z_che_ahini( hi ) ! set PH at kt=nit000
  94. ELSE ; CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields
  95. ENDIF
  96. !
  97. ENDIF
  98. !
  99. IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt ) ! Relaxation of some tracers
  100. !
  101. ! ! set time step size (Euler/Leapfrog)
  102. IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN ; rfact = rdttrc(1) ! at nittrc000
  103. ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN ; rfact = 2. * rdttrc(1) ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog)
  104. ENDIF
  105. !
  106. ! trends computation initialisation
  107. IF( l_trdtrc ) THEN
  108. CALL wrk_alloc( jpi, jpj, jpk, jp_pisces, ztrdt ) !* store now fields before applying the Asselin filter
  109. ztrdt(:,:,:,:) = trn(:,:,:,:)
  110. ENDIF
  111. !
  112. IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
  113. rfactr = 1. / rfact
  114. rfact2 = rfact / FLOAT( nrdttrc )
  115. rfact2r = 1. / rfact2
  116. xstep = rfact2 / rday ! Time step duration for biology
  117. xfact = 1.e+3 * rfact2r
  118. IF(lwp) WRITE(numout,*)
  119. IF(lwp) WRITE(numout,*) ' Passive Tracer time step rfact = ', rfact, ' rdt = ', rdttra(1)
  120. IF(lwp) write(numout,*) ' PISCES Biology time step rfact2 = ', rfact2
  121. IF(lwp) WRITE(numout,*)
  122. ENDIF
  123. IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN
  124. DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter
  125. trb(:,:,:,jn) = trn(:,:,:,jn)
  126. END DO
  127. ENDIF
  128. !
  129. IF( ndayflxtr /= nday_year ) THEN ! New days
  130. !
  131. ndayflxtr = nday_year
  132. IF(lwp) write(numout,*)
  133. IF(lwp) write(numout,*) ' New chemical constants and various rates for biogeochemistry at new day : ', nday_year
  134. IF(lwp) write(numout,*) '~~~~~~'
  135. CALL p4z_che ! computation of chemical constants
  136. CALL p4z_int( kt ) ! computation of various rates for biogeochemistry
  137. !
  138. ENDIF
  139. IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients
  140. DO jnt = 1, nrdttrc ! Potential time splitting if requested
  141. !
  142. CALL p4z_bio( kt, jnt ) ! Biology
  143. CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation
  144. dicmassbefore = glob_sum( ( tra(:,:,:,jpdic) &
  145. & + tra(:,:,:,jpphy) + tra(:,:,:,jpdia) &
  146. & + tra(:,:,:,jpzoo) + tra(:,:,:,jpmes) &
  147. & + tra(:,:,:,jppoc) &
  148. & + tra(:,:,:,jpgoc) &
  149. & + tra(:,:,:,jpdoc) + tra(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  150. CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions
  151. dicmassafter = glob_sum( ( tra(:,:,:,jpdic) &
  152. & + tra(:,:,:,jpphy) + tra(:,:,:,jpdia) &
  153. & + tra(:,:,:,jpzoo) + tra(:,:,:,jpmes) &
  154. & + tra(:,:,:,jppoc) &
  155. & + tra(:,:,:,jpgoc) &
  156. & + tra(:,:,:,jpdoc) + tra(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  157. sedrivdicsum = sedrivdicsum + dicmassafter - dicmassbefore
  158. CALL p4z_flx( kt, jnt ) ! Compute surface fluxes
  159. !
  160. xnegtr(:,:,:) = 1.e0
  161. DO jn = jp_pcs0, jp_pcs1
  162. DO jk = 1, jpk
  163. DO jj = 1, jpj
  164. DO ji = 1, jpi
  165. IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
  166. ztra = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
  167. xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra )
  168. !!!!introducing a check to debug sedimentation problem, after O. Aumont suggestion. Raffa April 2019
  169. IF (mig(ji) == 64 .and. mjg(jj) == 203 .and. jk == 55 ) THEN
  170. write(0,*) 'error ',jn,xnegtr(ji,jj,jk)
  171. ENDIF
  172. IF (mig(ji) == 64 .and. mjg(jj) == 203 .and. jk == 56 ) THEN
  173. write(0,*) 'error ',jn,xnegtr(ji,jj,jk)
  174. ENDIF
  175. IF (mig(ji) == 64 .and. mjg(jj) == 203 .and. jk == 57 ) THEN
  176. write(0,*) 'error ',jn,xnegtr(ji,jj,jk)
  177. ENDIF
  178. IF (mig(ji) == 64 .and. mjg(jj) == 203 .and. jk == 58 ) THEN
  179. write(0,*) 'error ',jn,xnegtr(ji,jj,jk)
  180. ENDIF
  181. IF (mig(ji) == 64 .and. mjg(jj) == 203 .and. jk == 59 ) THEN
  182. write(0,*) 'error ',jn,xnegtr(ji,jj,jk)
  183. ENDIF
  184. !!!!!end of debugging
  185. ENDIF
  186. END DO
  187. END DO
  188. END DO
  189. END DO
  190. ! ! where at least 1 tracer concentration becomes negative
  191. ! !
  192. DO jn = jp_pcs0, jp_pcs1
  193. trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
  194. END DO
  195. !
  196. ! Additional CMIP6 diagnostics : At this stage tra includes all terms
  197. IF( lk_iomput ) THEN
  198. CALL wrk_alloc( jpi, jpj, zw2d )
  199. !
  200. IF( iom_use( "INTdtAlk" ) ) THEN
  201. zw2d(:,:) = 0.
  202. ! DO jk = 1, jpkm1
  203. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  204. zw2d(:,:) = zw2d(:,:) &
  205. & + xnegtr(:,:,jk) * tra(:,:,jk,jptal) * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  206. ENDDO
  207. CALL iom_put( "INTdtAlk", zw2d )
  208. ENDIF
  209. !
  210. IF( iom_use( "INTdtDIC" ) ) THEN
  211. zw2d(:,:) = 0.
  212. ! DO jk = 1, jpkm1
  213. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  214. zw2d(:,:) = zw2d(:,:) &
  215. & + xnegtr(:,:,jk) * tra(:,:,jk,jpdic) * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  216. ENDDO
  217. CALL iom_put( "INTdtDIC", zw2d )
  218. ENDIF
  219. !
  220. IF( iom_use( "INTdtFer" ) ) THEN
  221. zw2d(:,:) = 0.
  222. ! DO jk = 1, jpkm1
  223. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  224. zw2d(:,:) = zw2d(:,:) &
  225. & + xnegtr(:,:,jk) * tra(:,:,jk,jpfer) * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  226. ENDDO
  227. CALL iom_put( "INTdtFer", zw2d )
  228. ENDIF
  229. !
  230. IF( iom_use( "INTdtDIN" ) ) THEN
  231. zw2d(:,:) = 0.
  232. ! DO jk = 1, jpkm1
  233. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  234. zw2d(:,:) = zw2d(:,:) &
  235. & + xnegtr(:,:,jk) * ( tra(:,:,jk,jpno3) + tra(:,:,jk,jpnh4) ) &
  236. & * rno3 * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  237. ENDDO
  238. CALL iom_put( "INTdtDIN", zw2d )
  239. ENDIF
  240. !
  241. IF( iom_use( "INTdtDIP" ) ) THEN
  242. zw2d(:,:) = 0.
  243. ! DO jk = 1, jpkm1
  244. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  245. zw2d(:,:) = zw2d(:,:) &
  246. & + xnegtr(:,:,jk) * tra(:,:,jk,jppo4) * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  247. ENDDO
  248. CALL iom_put( "INTdtDIP", zw2d )
  249. ENDIF
  250. !
  251. IF( iom_use( "INTdtSil" ) ) THEN
  252. zw2d(:,:) = 0.
  253. ! DO jk = 1, jpkm1
  254. DO jk = 1, 24 ! fbddt* diagnostics are requested as sum over the upper 100m only - R. Bernardello (Jan 2020).
  255. zw2d(:,:) = zw2d(:,:) &
  256. & + xnegtr(:,:,jk) * tra(:,:,jk,jpsil) * xfact * fse3t(:,:,jk) * tmask(:,:,jk)
  257. ENDDO
  258. CALL iom_put( "INTdtSil", zw2d )
  259. ENDIF
  260. CALL wrk_dealloc( jpi, jpj, zw2d )
  261. ENDIF
  262. !
  263. DO jn = jp_pcs0, jp_pcs1
  264. tra(:,:,:,jn) = 0._wp
  265. END DO
  266. !
  267. IF( ln_top_euler ) THEN
  268. DO jn = jp_pcs0, jp_pcs1
  269. trn(:,:,:,jn) = trb(:,:,:,jn)
  270. END DO
  271. ENDIF
  272. END DO
  273. ! threshold values to avoid huge concentration, especially on river mouths
  274. DO jk = 1,jpkm1
  275. trn(:,:,jk,jptal) = MIN( trn(:,:,jk,jptal), alkmax )
  276. trn(:,:,jk,jpdic) = MIN( trn(:,:,jk,jpdic), dicmax )
  277. trn(:,:,jk,jppo4) = MIN( trn(:,:,jk,jppo4), po4max / po4r )
  278. trn(:,:,jk,jpsil) = MIN( trn(:,:,jk,jpsil), silmax )
  279. trn(:,:,jk,jpfer) = MIN( trn(:,:,jk,jpfer), fermax )
  280. trn(:,:,jk,jpno3) = MIN( trn(:,:,jk,jpno3), no3max / rno3 )
  281. !
  282. trb(:,:,jk,jptal) = MIN( trb(:,:,jk,jptal), alkmax )
  283. trb(:,:,jk,jpdic) = MIN( trb(:,:,jk,jpdic), dicmax )
  284. trb(:,:,jk,jppo4) = MIN( trb(:,:,jk,jppo4), po4max / po4r )
  285. trb(:,:,jk,jpsil) = MIN( trb(:,:,jk,jpsil), silmax )
  286. trb(:,:,jk,jpfer) = MIN( trb(:,:,jk,jpfer), fermax )
  287. trb(:,:,jk,jpno3) = MIN( trb(:,:,jk,jpno3), no3max / rno3 )
  288. END DO
  289. #if defined key_kriest
  290. !
  291. zcoef1 = 1.e0 / xkr_massp
  292. zcoef2 = 1.e0 / xkr_massp / 1.1
  293. DO jk = 1,jpkm1
  294. trb(:,:,jk,jpnum) = MAX( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk) )
  295. trb(:,:,jk,jpnum) = MIN( trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2 )
  296. END DO
  297. !
  298. #endif
  299. !
  300. !
  301. IF( l_trdtrc ) THEN
  302. DO jn = jp_pcs0, jp_pcs1
  303. ztrdt(:,:,:,jn) = ( trb(:,:,:,jn) - ztrdt(:,:,:,jn) ) * rfact2r
  304. CALL trd_trc( ztrdt(:,:,:,jn), jn, jptra_sms, kt ) ! save trends
  305. END DO
  306. CALL wrk_dealloc( jpi, jpj, jpk, jp_pisces, ztrdt )
  307. END IF
  308. !
  309. IF( lk_sed ) THEN
  310. !
  311. CALL sed_model( kt ) ! Main program of Sediment model
  312. !
  313. DO jn = jp_pcs0, jp_pcs1
  314. CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )
  315. END DO
  316. !
  317. ENDIF
  318. !
  319. IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' ) !* Write PISCES informations in restart file
  320. !
  321. IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt ) ! Mass conservation checking
  322. IF ( lwm .AND. kt == nittrc000 ) CALL FLUSH ( numonp ) ! flush output namelist PISCES
  323. IF( nn_timing == 1 ) CALL timing_stop('p4z_sms')
  324. !
  325. !
  326. END SUBROUTINE p4z_sms
  327. SUBROUTINE p4z_sms_init
  328. !!----------------------------------------------------------------------
  329. !! *** p4z_sms_init ***
  330. !!
  331. !! ** Purpose : read PISCES namelist
  332. !!
  333. !! ** input : file 'namelist.trc.s' containing the following
  334. !! namelist: natext, natbio, natsms
  335. !! natkriest ("key_kriest")
  336. !!----------------------------------------------------------------------
  337. NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max
  338. #if defined key_kriest
  339. NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max
  340. #endif
  341. NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
  342. NAMELIST/nampismass/ ln_check_mass
  343. INTEGER :: ios ! Local integer output status for namelist read
  344. !!----------------------------------------------------------------------
  345. REWIND( numnatp_ref ) ! Namelist nampisbio in reference namelist : Pisces variables
  346. READ ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
  347. 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in reference namelist', lwp )
  348. REWIND( numnatp_cfg ) ! Namelist nampisbio in configuration namelist : Pisces variables
  349. READ ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
  350. 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisbio in configuration namelist', lwp )
  351. IF(lwm) WRITE ( numonp, nampisbio )
  352. IF(lwp) THEN ! control print
  353. WRITE(numout,*) ' Namelist : nampisbio'
  354. WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc
  355. WRITE(numout,*) ' POC sinking speed wsbio =', wsbio
  356. WRITE(numout,*) ' half saturation constant for mortality xkmort =', xkmort
  357. WRITE(numout,*) ' Fe/C in zooplankton ferat3 =', ferat3
  358. WRITE(numout,*) ' Big particles sinking speed wsbio2 =', wsbio2
  359. WRITE(numout,*) ' Maximum number of iterations for POC niter1max =', niter1max
  360. WRITE(numout,*) ' Maximum number of iterations for GOC niter2max =', niter2max
  361. ENDIF
  362. #if defined key_kriest
  363. ! ! nampiskrp : kriest parameters
  364. ! ! -----------------------------
  365. REWIND( numnatp_ref ) ! Namelist nampiskrp in reference namelist : Pisces Kriest
  366. READ ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903)
  367. 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp )
  368. REWIND( numnatp_cfg ) ! Namelist nampiskrp in configuration namelist : Pisces Kriest
  369. READ ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 )
  370. 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp )
  371. IF(lwm) WRITE ( numonp, nampiskrp )
  372. IF(lwp) THEN
  373. WRITE(numout,*)
  374. WRITE(numout,*) ' Namelist : nampiskrp'
  375. WRITE(numout,*) ' Sinking exponent xkr_eta = ', xkr_eta
  376. WRITE(numout,*) ' N content exponent xkr_zeta = ', xkr_zeta
  377. WRITE(numout,*) ' N content factor xkr_ncontent = ', xkr_ncontent
  378. WRITE(numout,*) ' Minimum mass for Aggregates xkr_mass_min = ', xkr_mass_min
  379. WRITE(numout,*) ' Maximum mass for Aggregates xkr_mass_max = ', xkr_mass_max
  380. WRITE(numout,*)
  381. ENDIF
  382. ! Computation of some variables
  383. xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta
  384. #endif
  385. REWIND( numnatp_ref ) ! Namelist nampisdmp in reference namelist : Pisces damping
  386. READ ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
  387. 905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in reference namelist', lwp )
  388. REWIND( numnatp_cfg ) ! Namelist nampisdmp in configuration namelist : Pisces damping
  389. READ ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
  390. 906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdmp in configuration namelist', lwp )
  391. IF(lwm) WRITE ( numonp, nampisdmp )
  392. IF(lwp) THEN ! control print
  393. WRITE(numout,*)
  394. WRITE(numout,*) ' Namelist : nampisdmp'
  395. WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp
  396. WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp
  397. WRITE(numout,*) ' '
  398. ENDIF
  399. REWIND( numnatp_ref ) ! Namelist nampismass in reference namelist : Pisces mass conservation check
  400. READ ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
  401. 907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in reference namelist', lwp )
  402. REWIND( numnatp_cfg ) ! Namelist nampismass in configuration namelist : Pisces mass conservation check
  403. READ ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
  404. 908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismass in configuration namelist', lwp )
  405. IF(lwm) WRITE ( numonp, nampismass )
  406. IF(lwp) THEN ! control print
  407. WRITE(numout,*) ' '
  408. WRITE(numout,*) ' Namelist parameter for mass conservation checking'
  409. WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
  410. WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass
  411. ENDIF
  412. END SUBROUTINE p4z_sms_init
  413. SUBROUTINE p4z_rst( kt, cdrw )
  414. !!---------------------------------------------------------------------
  415. !! *** ROUTINE p4z_rst ***
  416. !!
  417. !! ** Purpose : Read or write variables in restart file:
  418. !!
  419. !! WRITE(READ) mode:
  420. !! kt : number of time step since the begining of the experiment at the
  421. !! end of the current(previous) run
  422. !!---------------------------------------------------------------------
  423. INTEGER , INTENT(in) :: kt ! ocean time-step
  424. CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
  425. !!---------------------------------------------------------------------
  426. IF( TRIM(cdrw) == 'READ' ) THEN
  427. !
  428. IF(lwp) WRITE(numout,*)
  429. IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
  430. IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
  431. !
  432. IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
  433. CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) )
  434. ELSE
  435. CALL p4z_che_ahini( hi )
  436. ENDIF
  437. CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
  438. IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
  439. CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:) )
  440. ELSE
  441. xksimax(:,:) = xksi(:,:)
  442. ENDIF
  443. !
  444. !
  445. ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
  446. IF( kt == nitrst ) THEN
  447. IF(lwp) WRITE(numout,*)
  448. IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file kt =', kt
  449. IF(lwp) WRITE(numout,*) '~~~~~~~'
  450. ENDIF
  451. CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
  452. CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
  453. CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
  454. ! CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
  455. ! CALL iom_rstput( kt, nitrst, numrtw, 'zsedccum', zsedc_cum )
  456. ! CALL iom_rstput( kt, nitrst, numrtw, 'dicmasst0', dicmasst0 )
  457. ENDIF
  458. !
  459. END SUBROUTINE p4z_rst
  460. SUBROUTINE p4z_dmp( kt )
  461. !!----------------------------------------------------------------------
  462. !! *** p4z_dmp ***
  463. !!
  464. !! ** purpose : Relaxation of some tracers
  465. !!----------------------------------------------------------------------
  466. !
  467. INTEGER, INTENT( in ) :: kt ! time step
  468. !
  469. !!REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
  470. !!REAL(wp) :: po4mean = 2.165 ! mean value of phosphates
  471. !!REAL(wp) :: no3mean = 30.90 ! mean value of nitrate
  472. !!REAL(wp) :: silmean = 91.51 ! mean value of silicate
  473. !
  474. REAL(wp) :: alkmean = 2397.26347 ! mean value of alkalinity (these values come from 650-years preindustrial spinup with EC-Earth3-CC;Raffa-Dec 2019 )
  475. REAL(wp) :: po4mean = 2.31391 ! mean value of phosphates (these values come from 650-years preindustrial spinup with EC-Earth3-CC;Raffa-Dec 2019 )
  476. REAL(wp) :: no3mean = 31.43366 ! mean value of nitrate (these values come from 650-years preindustrial spinup with EC-Earth3-CC;Raffa-Dec 2019 )
  477. REAL(wp) :: silmean = 90.80826 ! mean value of silicate (these values come from 650-years preindustrial spinup with EC-Earth3-CC;Raffa-Dec 2019 )
  478. !
  479. REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
  480. REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
  481. !!---------------------------------------------------------------------
  482. IF(lwp) WRITE(numout,*)
  483. IF(lwp) WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
  484. IF(lwp) WRITE(numout,*)
  485. IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA configuration (not 1D) !
  486. ! ! --------------------------- !
  487. ! set total alkalinity, phosphate, nitrate & silicate
  488. zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6
  489. zalksumn = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea
  490. zpo4sumn = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
  491. zno3sumn = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
  492. zsilsumn = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
  493. IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn
  494. trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
  495. IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn
  496. trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
  497. IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn
  498. trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
  499. IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn
  500. trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
  501. !
  502. !
  503. IF( .NOT. ln_top_euler ) THEN
  504. zalksumb = glob_sum( trb(:,:,:,jptal) * cvol(:,:,:) ) * zarea
  505. zpo4sumb = glob_sum( trb(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r
  506. zno3sumb = glob_sum( trb(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3
  507. zsilsumb = glob_sum( trb(:,:,:,jpsil) * cvol(:,:,:) ) * zarea
  508. IF(lwp) WRITE(numout,*) ' '
  509. IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb
  510. trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
  511. IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb
  512. trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
  513. IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb
  514. trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
  515. IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb
  516. trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
  517. ENDIF
  518. !
  519. ENDIF
  520. !
  521. END SUBROUTINE p4z_dmp
  522. SUBROUTINE p4z_chk_mass( kt )
  523. !!----------------------------------------------------------------------
  524. !! *** ROUTINE p4z_chk_mass ***
  525. !!
  526. !! ** Purpose : Mass conservation check
  527. !!
  528. !!---------------------------------------------------------------------
  529. !
  530. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  531. REAL(wp) :: zrdenittot, zsdenittot, znitrpottot
  532. CHARACTER(LEN=100) :: cltxt
  533. REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol
  534. INTEGER :: jk
  535. !!----------------------------------------------------------------------
  536. !
  537. !!---------------------------------------------------------------------
  538. IF( kt == nittrc000 ) THEN
  539. xfact1 = rfact2r * 12. / 1.e15 * ryyss ! conversion molC/kt --> PgC/yr
  540. xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss ! conversion molC/l/s ----> TgN/m3/yr
  541. xfact3 = 1.e+3 * rfact2r * rno3 ! conversion molC/l/kt ----> molN/m3/s
  542. IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si, Fer
  543. CALL ctl_opn( numco2, 'carbon.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  544. CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  545. CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  546. cltxt='time-step Alkalinity Nitrate Phosphorus Silicate Iron'
  547. IF( lwp ) WRITE(numnut,*) TRIM(cltxt)
  548. IF( lwp ) WRITE(numnut,*)
  549. ENDIF
  550. ENDIF
  551. ! BEGIN EC-Earth change: add global carbon inventory
  552. IF( iom_use( "dictot" ) .OR. (ln_check_mass .AND. kt == nitend ) ) THEN
  553. dicbudget = glob_sum( ( trn(:,:,:,jpdic) &
  554. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  555. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  556. & + trn(:,:,:,jppoc) &
  557. #if ! defined key_kriest
  558. & + trn(:,:,:,jpgoc) &
  559. #endif
  560. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  561. CALL iom_put( "dictot", dicbudget )
  562. ENDIF
  563. ! END EC-Earth change
  564. !
  565. IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  566. ! Compute the budget of NO3, ALK, Si, Fer
  567. no3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) &
  568. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  569. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  570. & + trn(:,:,:,jppoc) &
  571. #if ! defined key_kriest
  572. & + trn(:,:,:,jpgoc) &
  573. #endif
  574. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  575. !
  576. no3budget = no3budget / areatot
  577. CALL iom_put( "pno3tot", no3budget )
  578. ENDIF
  579. !
  580. IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  581. po4budget = glob_sum( ( trn(:,:,:,jppo4) &
  582. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  583. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  584. & + trn(:,:,:,jppoc) &
  585. #if ! defined key_kriest
  586. & + trn(:,:,:,jpgoc) &
  587. #endif
  588. & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) )
  589. po4budget = po4budget / areatot
  590. CALL iom_put( "ppo4tot", po4budget )
  591. ENDIF
  592. !
  593. IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  594. silbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) &
  595. & + trn(:,:,:,jpdsi) ) * cvol(:,:,:) )
  596. !
  597. silbudget = silbudget / areatot
  598. CALL iom_put( "psiltot", silbudget )
  599. ENDIF
  600. !
  601. IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  602. alkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 &
  603. & + trn(:,:,:,jptal) &
  604. & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) )
  605. !
  606. alkbudget = alkbudget / areatot
  607. CALL iom_put( "palktot", alkbudget )
  608. ENDIF
  609. !
  610. IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  611. ferbudget = glob_sum( ( trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) &
  612. & + trn(:,:,:,jpdfe) &
  613. #if ! defined key_kriest
  614. & + trn(:,:,:,jpbfe) &
  615. #endif
  616. & + trn(:,:,:,jpsfe) &
  617. & + trn(:,:,:,jpzoo) * ferat3 &
  618. & + trn(:,:,:,jpmes) * ferat3 ) * cvol(:,:,:) )
  619. !
  620. ferbudget = ferbudget / areatot
  621. CALL iom_put( "pfertot", ferbudget )
  622. ENDIF
  623. !
  624. ! Global budget of N SMS : denitrification in the water column and in the sediment
  625. ! nitrogen fixation by the diazotrophs
  626. ! --------------------------------------------------------------------------------
  627. IF( iom_use( "tnfix" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  628. znitrpottot = glob_sum ( nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
  629. CALL iom_put( "tnfix" , znitrpottot * xfact3 ) ! Global nitrogen fixation molC/l to molN/m3
  630. ENDIF
  631. !
  632. IF( iom_use( "tdenit" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN
  633. zrdenittot = glob_sum ( denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) ) ! denitrification in the water column
  634. zsdenittot = glob_sum ( sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) ) ! denitrification in the sediments
  635. CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 ) ! Total denitrification in molN/m3
  636. ENDIF
  637. IF( ln_check_mass .AND. kt == nitend ) THEN ! Compute the budget of NO3, ALK, Si, Fer
  638. t_atm_co2_flx = t_atm_co2_flx / glob_sum( e1e2t(:,:) )
  639. t_oce_co2_flx = t_oce_co2_flx * xfact1 * (-1 )
  640. tpp = tpp * 1000. * xfact1
  641. t_oce_co2_exp = t_oce_co2_exp * 1000. * xfact1
  642. IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
  643. IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget * 1.e+06, &
  644. & no3budget * rno3 * 1.e+06, &
  645. & po4budget * po4r * 1.e+06, &
  646. & silbudget * 1.e+06, &
  647. & ferbudget * 1.e+09
  648. !
  649. IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2 , &
  650. & zrdenittot * xfact2 , &
  651. & zsdenittot * xfact2
  652. ENDIF
  653. !
  654. 9000 FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
  655. 9100 FORMAT(i8,5e18.10)
  656. 9200 FORMAT(i8,3f10.5)
  657. !
  658. END SUBROUTINE p4z_chk_mass
  659. SUBROUTINE trc_sms_cfix( kt )
  660. !!----------------------------------------------------------------------
  661. !! *** ROUTINE trc_sms_cfix ***
  662. !!
  663. !! ** Purpose : Correction for mass conservation of Carbon (EC-Earth fix)
  664. !!
  665. !!---------------------------------------------------------------------
  666. !
  667. INTEGER, INTENT( in ) :: kt ! ocean time-step index
  668. CHARACTER(LEN=200) :: cltxt
  669. REAL(wp) :: dicmasstend, dicres, totvol ! EC-Earth C mass conservation correction
  670. REAL(wp) :: dicend, docend, phyend, phy2end ! EC-Earth C mass conservation correction
  671. REAL(wp) :: pocend, gocend, zooend, zoo2end, caco3end ! EC-Earth C mass conservation correction
  672. INTEGER :: jk
  673. LOGICAL :: file_exist
  674. !!----------------------------------------------------------------------
  675. !
  676. !!---------------------------------------------------------------------
  677. !!!!Begin EC-Earth modification for mass conservation of carbon. Author Raffaele Bernardello, January 2019
  678. !
  679. ! We don't get satisfying mass conservation for passive tracers in NEMO. Drift in total mass is of
  680. ! the order of a few thousandths/year. Over a long spinup (thousands of years) this results in a drift of
  681. ! several points %. After much researching and asking around it seems we are not the only ones with this problem
  682. ! however, we haven't been able to find the reason. We need a workaround in order to run the ocean spinup needed for
  683. ! CMIP6. Unlike other tracers, DIC does not have a total mass correction available in PISCES
  684. ! code. So we are creating one here. Other tracers (NO3, Alk, PO4) are periodically adjusted in total mass to conserve
  685. ! the initial amount. This can't be done with DIC because the spun-up state will be used to run transient simulations
  686. ! with increase of atmospheric CO2 and consequent ocean uptake. So, the ocean DIC needs to be trully equilibrated.
  687. !
  688. ! 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
  689. ! of the leg. Plus, we consider the accumulated air-sea co2 flux, sedimentation of C and Cal, and river input during the leg.
  690. ! The change in internal mass has to equal the sum of sink and sources. The residual is used to compute a homogeneous
  691. ! global correction to be applied uniformly everywhere to DIC.
  692. !
  693. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  694. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  695. !
  696. IF( kt == nittrc000 ) THEN
  697. dicmasst0 = 0._wp
  698. ! total mass at initial time-step
  699. dicmasst0 = glob_sum( ( trn(:,:,:,jpdic) &
  700. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  701. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  702. & + trn(:,:,:,jppoc) &
  703. & + trn(:,:,:,jpgoc) &
  704. & + trn(:,:,:,jpdoc) + trn(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  705. ! Initialize t_oce_co2_flx_cum and zsedc_cum
  706. t_oce_co2_flx_cum = 0._wp
  707. zsedc_cum = 0._wp
  708. riverdicsum = 0._wp
  709. sedrivdicsum = 0._wp
  710. IF(lwp) THEN
  711. WRITE(numout,*) 't_oce_co2_flx_cum (mol C) as initialized in this chunk', t_oce_co2_flx_cum
  712. WRITE(numout,*) 'zsedc_cum (mol C) as initialized in this chunk', zsedc_cum
  713. WRITE(numout,*) 'riverdicsum (mol C) as initialized in this chunk', riverdicsum
  714. WRITE(numout,*) 'sedrivdicsum (mol C) as initialized in this chunk', sedrivdicsum
  715. WRITE(numout,*) 'dicmasst0 (mol C) as initialized in this chunk', dicmasst0
  716. END IF
  717. !
  718. IF (lwp) THEN
  719. INQUIRE(file="ocean.carbon", EXIST=file_exist)
  720. IF ( .NOT. file_exist) THEN
  721. CALL ctl_opn( numcdiag, 'ocean.carbon', 'NEW', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
  722. cltxt=' date TotC-t1-PgC TotC-t2-PgC riv+sed-PgC fgco2-PgC corr-PgC'
  723. IF( lwp ) WRITE(numcdiag,'(a)') TRIM(cltxt)
  724. ELSE
  725. numcdiag=get_unit()
  726. OPEN( numcdiag, FILE='ocean.carbon', STATUS='OLD', POSITION='APPEND', ACTION='WRITE')
  727. END IF
  728. END IF
  729. END IF
  730. !
  731. !
  732. IF( kt == nitend ) THEN
  733. dicmasstend = glob_sum( ( trn(:,:,:,jpdic) &
  734. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  735. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  736. & + trn(:,:,:,jppoc) &
  737. & + trn(:,:,:,jpgoc) &
  738. & + trn(:,:,:,jpdoc) + trn(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  739. dicend = glob_sum( trn(:,:,:,jpdic) * cvol(:,:,:)) * 1.E3
  740. docend = glob_sum( trn(:,:,:,jpdoc) * cvol(:,:,:)) * 1.E3
  741. phyend = glob_sum( trn(:,:,:,jpphy) * cvol(:,:,:)) * 1.E3
  742. phy2end = glob_sum( trn(:,:,:,jpdia) * cvol(:,:,:)) * 1.E3
  743. zooend = glob_sum( trn(:,:,:,jpzoo) * cvol(:,:,:)) * 1.E3
  744. zoo2end = glob_sum( trn(:,:,:,jpmes) * cvol(:,:,:)) * 1.E3
  745. pocend = glob_sum( trn(:,:,:,jppoc) * cvol(:,:,:)) * 1.E3
  746. gocend = glob_sum( trn(:,:,:,jpgoc) * cvol(:,:,:)) * 1.E3
  747. caco3end = glob_sum( trn(:,:,:,jpcal) * cvol(:,:,:)) * 1.E3
  748. totvol = glob_sum( cvol(:,:,:) )
  749. dicres = (dicmasstend - dicmasst0 - t_oce_co2_flx_cum + zsedc_cum - riverdicsum)/(totvol * 1.E3) ! mol C/l (note: areatot is global volume (sic))
  750. IF(lwp) WRITE(numout,*) 'dicres (mol C/l) as calculated here with zsedc_cum=', dicres
  751. dicres = (dicmasstend - dicmasst0 - t_oce_co2_flx_cum - sedrivdicsum)/(totvol * 1.E3) ! mol C/l (note: areatot is global volume (sic))
  752. IF(lwp) WRITE(numout,*) 'dicres (mol C/l) as calculated here with sedrivdicsum=', dicres
  753. !
  754. IF(lwp) THEN
  755. WRITE(numout,*) 'dicmasstend (mol C) =', dicmasstend
  756. WRITE(numout,*) 'dicmasst0 (mol C) =', dicmasst0
  757. WRITE(numout,*) 't_oce_co2_flx_cum (mol C) as calculated in this chunk', t_oce_co2_flx_cum
  758. WRITE(numout,*) 'zsedc_cum (mol C) as calculated in this chunk', zsedc_cum
  759. WRITE(numout,*) 'rivdicinput (mol C) as calculated at beginning', rivdicinput * 1.E3
  760. WRITE(numout,*) 'rivdicinput (mol C) as calculated in this chunk', riverdicsum
  761. WRITE(numout,*) 'sedrivdicsum (mol C) as calculated in this chunk', sedrivdicsum
  762. WRITE(numout,*) 'dicres (mol C/l) as calculated here =', dicres
  763. WRITE(numout,*) 'totvol =', totvol
  764. END IF
  765. !
  766. ! apply correction to dic
  767. trn(:,:,:,jpdic) = (trn(:,:,:,jpdic) - dicres) * tmask (:,:,:)
  768. trb(:,:,:,jpdic) = (trb(:,:,:,jpdic) - dicres) * tmask (:,:,:)
  769. dicmasstend = glob_sum( ( trn(:,:,:,jpdic) &
  770. & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) &
  771. & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) &
  772. & + trn(:,:,:,jppoc) &
  773. & + trn(:,:,:,jpgoc) &
  774. & + trn(:,:,:,jpdoc) + trn(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  775. IF( lwp ) WRITE(cltxt,'(I4.4,I2.2,I2.2,2f13.5,3f12.5)') &
  776. nyear, nmonth, nday, &
  777. dicmasst0 * 12.e-15 , &
  778. dicmasstend * 12.e-15, &
  779. sedrivdicsum *12.e-15 , &
  780. t_oce_co2_flx_cum * 12.e-15, &
  781. dicres * (totvol * 1.e3) *12.e-15
  782. IF( lwp ) WRITE(numcdiag,'(a)') TRIM(cltxt)
  783. IF( lwp ) WRITE(numout,*) 'printing to ocean.carbon ',TRIM(cltxt)
  784. !
  785. dicres = (dicmasstend - dicmasst0 - t_oce_co2_flx_cum - sedrivdicsum)/(totvol * 1.E3) ! mol C/l (note: areatot is global volume (sic))
  786. IF(lwp) WRITE(numout,*) 'dicmasstend (trn) after correction (mol C) =', dicmasstend
  787. IF(lwp) WRITE(numout,*) 'dicres (trn) (mol C/l) as calculated here =', dicres
  788. dicmasstend = glob_sum( ( trb(:,:,:,jpdic) &
  789. & + trb(:,:,:,jpphy) + trb(:,:,:,jpdia) &
  790. & + trb(:,:,:,jpzoo) + trb(:,:,:,jpmes) &
  791. & + trb(:,:,:,jppoc) &
  792. & + trb(:,:,:,jpgoc) &
  793. & + trb(:,:,:,jpdoc) + trb(:,:,:,jpcal) ) * cvol(:,:,:) ) * 1.E3 ! mol C
  794. dicres = (dicmasstend - dicmasst0 - t_oce_co2_flx_cum - sedrivdicsum)/(totvol * 1.E3) ! mol C/l (note: areatot is global volume (sic))
  795. IF(lwp) WRITE(numout,*) 'dicmasstend (trb) after correction (mol C) =', dicmasstend
  796. IF(lwp) WRITE(numout,*) 'dicres (trb) (mol C/l) as calculated here =', dicres
  797. END IF
  798. !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  799. END SUBROUTINE trc_sms_cfix
  800. #else
  801. !!======================================================================
  802. !! Dummy module : No PISCES bio-model
  803. !!======================================================================
  804. CONTAINS
  805. SUBROUTINE p4z_sms( kt ) ! Empty routine
  806. INTEGER, INTENT( in ) :: kt
  807. WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt
  808. END SUBROUTINE p4z_sms
  809. #endif
  810. !!======================================================================
  811. END MODULE p4zsms