New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
p4zsms.F90 in branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/CNRS/dev_r6270_PISCES_QUOTA/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90 @ 6848

Last change on this file since 6848 was 6841, checked in by aumont, 8 years ago

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