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 NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90 @ 11504

Last change on this file since 11504 was 11504, checked in by davestorkey, 5 years ago

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Strip out all references to nn_dttrc
and the trcsub.F90 module. Notes:

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