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_r12072_MERGE_OPTION2_2019/src/TOP/PISCES/P4Z – NEMO

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/TOP/PISCES/P4Z/p4zsms.F90 @ 12202

Last change on this file since 12202 was 12202, checked in by cetlod, 4 years ago

dev_merge_option2 : merge in dev_r11613_ENHANCE-04_namelists_as_internalfiles

  • Property svn:keywords set to Id
File size: 26.5 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 p4zbc           ! 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) ::   xfact, 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 )
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      !!
62      INTEGER ::   ji, jj, jk, jnt, jn, jl
63      REAL(wp) ::  ztra
64      CHARACTER (len=25) :: charout
65      REAL(wp), ALLOCATABLE, DIMENSION(:,:    ) :: zw2d
66      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:  ) :: zw3d
67      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::   ztrdt   ! 4D workspace
68
69      !!---------------------------------------------------------------------
70      !
71      IF( ln_timing )   CALL timing_start('p4z_sms')
72      !
73      IF( kt == nittrc000 ) THEN
74        !
75        ALLOCATE( xnegtr(jpi,jpj,jpk) )
76        !
77        IF( .NOT. ln_rsttr ) THEN
78            CALL p4z_che                              ! initialize the chemical constants
79            CALL ahini_for_at(hi)   !  set PH at kt=nit000
80            t_oce_co2_flx_cum = 0._wp
81        ELSE
82            CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields
83        ENDIF
84        !
85      ENDIF
86      !
87      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers
88      !
89      rfact = r2dttrc
90      !
91      ! trends computation initialisation
92      IF( l_trdtrc )  THEN
93         ALLOCATE( ztrdt(jpi,jpj,jpk,jp_pisces) )  !* store now fields before applying the Asselin filter
94         ztrdt(:,:,:,:)  = trn(:,:,:,:)
95      ENDIF
96      !
97
98      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN
99         rfactr  = 1. / rfact
100         rfact2  = rfact / REAL( nrdttrc, wp )
101         rfact2r = 1. / rfact2
102         xstep = rfact2 / rday         ! Time step duration for biology
103         xfact = 1.e+3 * rfact2r
104         IF(lwp) WRITE(numout,*) 
105         IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rfact  = ', rfact, ' rdt = ', rdt
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( ll_bc )    CALL p4z_bc( kt )   ! external sources of nutrients
117      !
118#if ! defined key_sed_off
119      CALL p4z_che              ! computation of chemical constants
120      CALL p4z_int( kt )        ! computation of various rates for biogeochemistry
121      !
122      DO jnt = 1, nrdttrc          ! Potential time splitting if requested
123         !
124         CALL p4z_bio( kt, jnt )   ! Biology
125         CALL p4z_lys( kt, jnt )   ! Compute CaCO3 saturation
126         CALL p4z_sed( kt, jnt )   ! Surface and Bottom boundary conditions
127         CALL p4z_flx( kt, jnt )   ! Compute surface fluxes
128         !
129         xnegtr(:,:,:) = 1.e0
130         DO jn = jp_pcs0, jp_pcs1
131            DO jk = 1, jpk
132               DO jj = 1, jpj
133                  DO ji = 1, jpi
134                     IF( ( trb(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN
135                        ztra             = ABS( trb(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )
136                        xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk),  ztra )
137                     ENDIF
138                 END DO
139               END DO
140            END DO
141         END DO
142         !                                ! where at least 1 tracer concentration becomes negative
143         !                                !
144         DO jn = jp_pcs0, jp_pcs1
145           trb(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)
146         END DO
147        !
148        IF(  iom_use( 'INTdtAlk' ) .OR. iom_use( 'INTdtDIC' ) .OR. iom_use( 'INTdtFer' ) .OR.  &
149          &  iom_use( 'INTdtDIN' ) .OR. iom_use( 'INTdtDIP' ) .OR. iom_use( 'INTdtSil' ) )  THEN
150          !
151          ALLOCATE( zw3d(jpi,jpj,jpk), zw2d(jpi,jpj) )
152          zw3d(:,:,jpk) = 0.
153          DO jk = 1, jpkm1
154              zw3d(:,:,jk) = xnegtr(:,:,jk) * xfact * e3t_n(:,:,jk) * tmask(:,:,jk)
155          ENDDO
156          !
157          zw2d(:,:) = 0.
158          DO jk = 1, jpkm1
159             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jptal)
160          ENDDO
161          CALL iom_put( 'INTdtAlk', zw2d )
162          !
163          zw2d(:,:) = 0.
164          DO jk = 1, jpkm1
165             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpdic)
166          ENDDO
167          CALL iom_put( 'INTdtDIC', zw2d )
168          !
169          zw2d(:,:) = 0.
170          DO jk = 1, jpkm1
171             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * rno3 * ( tra(:,:,jk,jpno3) + tra(:,:,jk,jpnh4) )
172          ENDDO
173          CALL iom_put( 'INTdtDIN', zw2d )
174          !
175          zw2d(:,:) = 0.
176          DO jk = 1, jpkm1
177             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * po4r * tra(:,:,jk,jppo4)
178          ENDDO
179          CALL iom_put( 'INTdtDIP', zw2d )
180          !
181          zw2d(:,:) = 0.
182          DO jk = 1, jpkm1
183             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpfer)
184          ENDDO
185          CALL iom_put( 'INTdtFer', zw2d )
186          !
187          zw2d(:,:) = 0.
188          DO jk = 1, jpkm1
189             zw2d(:,:) = zw2d(:,:) + zw3d(:,:,jk) * tra(:,:,jk,jpsil)
190          ENDDO
191          CALL iom_put( 'INTdtSil', zw2d )
192          !
193          DEALLOCATE( zw3d, zw2d )
194        ENDIF
195        !
196         DO jn = jp_pcs0, jp_pcs1
197            tra(:,:,:,jn) = 0._wp
198         END DO
199         !
200         IF( ln_top_euler ) THEN
201            DO jn = jp_pcs0, jp_pcs1
202               trn(:,:,:,jn) = trb(:,:,:,jn)
203            END DO
204         ENDIF
205      END DO
206      !
207      IF( l_trdtrc ) THEN
208         DO jn = jp_pcs0, jp_pcs1
209           ztrdt(:,:,:,jn) = ( trb(:,:,:,jn) - ztrdt(:,:,:,jn) ) * rfact2r 
210           CALL trd_trc( ztrdt(:,:,:,jn), jn, jptra_sms, kt )   ! save trends
211         END DO
212         DEALLOCATE( ztrdt ) 
213      END IF
214#endif
215      !
216      IF( ln_sediment ) THEN 
217         !
218         CALL sed_model( kt )     !  Main program of Sediment model
219         !
220         IF( ln_top_euler ) THEN
221            DO jn = jp_pcs0, jp_pcs1
222               trn(:,:,:,jn) = trb(:,:,:,jn)
223            END DO
224         ENDIF
225         !
226      ENDIF
227      !
228      IF( lrst_trc )  CALL p4z_rst( kt, 'WRITE' )  !* Write PISCES informations in restart file
229      !
230
231      IF( lk_iomput .OR. ln_check_mass )  CALL p4z_chk_mass( kt )    ! Mass conservation checking
232
233      IF( lwm .AND. kt == nittrc000    )  CALL FLUSH( numonp )       ! flush output namelist PISCES
234      !
235      IF( ln_timing )  CALL timing_stop('p4z_sms')
236      !
237   END SUBROUTINE p4z_sms
238
239
240   SUBROUTINE p4z_sms_init
241      !!----------------------------------------------------------------------
242      !!                     ***  p4z_sms_init  *** 
243      !!
244      !! ** Purpose :   read PISCES namelist
245      !!
246      !! ** input   :   file 'namelist.trc.s' containing the following
247      !!             namelist: natext, natbio, natsms
248      !!----------------------------------------------------------------------
249      INTEGER :: ios                 ! Local integer output status for namelist read
250      !!
251      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale,    &
252         &                   ldocp, ldocz, lthet, no3rat3, po4rat3
253         !
254      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp
255      NAMELIST/nampismass/ ln_check_mass
256      !!----------------------------------------------------------------------
257      !
258      IF(lwp) THEN
259         WRITE(numout,*)
260         WRITE(numout,*) 'p4z_sms_init : PISCES initialization'
261         WRITE(numout,*) '~~~~~~~~~~~~'
262      ENDIF
263
264      READ  ( numnatp_ref, nampisbio, IOSTAT = ios, ERR = 901)
265901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisbio in reference namelist' )
266      READ  ( numnatp_cfg, nampisbio, IOSTAT = ios, ERR = 902 )
267902   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisbio in configuration namelist' )
268      IF(lwm) WRITE( numonp, nampisbio )
269      !
270      IF(lwp) THEN                         ! control print
271         WRITE(numout,*) '   Namelist : nampisbio'
272         WRITE(numout,*) '      frequency for the biology                 nrdttrc     =', nrdttrc
273         WRITE(numout,*) '      POC sinking speed                         wsbio       =', wsbio
274         WRITE(numout,*) '      half saturation constant for mortality    xkmort      =', xkmort 
275         IF( ln_p5z ) THEN
276            WRITE(numout,*) '      N/C in zooplankton                        no3rat3     =', no3rat3
277            WRITE(numout,*) '      P/C in zooplankton                        po4rat3     =', po4rat3
278         ENDIF
279         WRITE(numout,*) '      Fe/C in zooplankton                       ferat3      =', ferat3
280         WRITE(numout,*) '      Big particles sinking speed               wsbio2      =', wsbio2
281         WRITE(numout,*) '      Big particles maximum sinking speed       wsbio2max   =', wsbio2max
282         WRITE(numout,*) '      Big particles sinking speed length scale  wsbio2scale =', wsbio2scale
283         IF( ln_ligand ) THEN
284            IF( ln_p4z ) THEN
285               WRITE(numout,*) '      Phyto ligand production per unit doc           ldocp  =', ldocp
286               WRITE(numout,*) '      Zoo ligand production per unit doc             ldocz  =', ldocz
287               WRITE(numout,*) '      Proportional loss of ligands due to Fe uptake  lthet  =', lthet
288            ENDIF
289         ENDIF
290      ENDIF
291
292
293      READ  ( numnatp_ref, nampisdmp, IOSTAT = ios, ERR = 905)
294905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampisdmp in reference namelist' )
295      READ  ( numnatp_cfg, nampisdmp, IOSTAT = ios, ERR = 906 )
296906   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampisdmp in configuration namelist' )
297      IF(lwm) WRITE( numonp, nampisdmp )
298      !
299      IF(lwp) THEN                         ! control print
300         WRITE(numout,*)
301         WRITE(numout,*) '   Namelist : nampisdmp --- relaxation to GLODAP'
302         WRITE(numout,*) '      Relaxation of tracer to glodap mean value   ln_pisdmp =', ln_pisdmp
303         WRITE(numout,*) '      Frequency of Relaxation                     nn_pisdmp =', nn_pisdmp
304      ENDIF
305
306      READ  ( numnatp_ref, nampismass, IOSTAT = ios, ERR = 907)
307907   IF( ios /= 0 )   CALL ctl_nam ( ios , 'nampismass in reference namelist' )
308      READ  ( numnatp_cfg, nampismass, IOSTAT = ios, ERR = 908 )
309908   IF( ios >  0 )   CALL ctl_nam ( ios , 'nampismass in configuration namelist' )
310      IF(lwm) WRITE( numonp, nampismass )
311
312      IF(lwp) THEN                         ! control print
313         WRITE(numout,*)
314         WRITE(numout,*) '   Namelist : nampismass  --- mass conservation checking'
315         WRITE(numout,*) '      Flag to check mass conservation of NO3/Si/TALK   ln_check_mass = ', ln_check_mass
316      ENDIF
317      !
318   END SUBROUTINE p4z_sms_init
319
320
321   SUBROUTINE p4z_rst( kt, cdrw )
322      !!---------------------------------------------------------------------
323      !!                   ***  ROUTINE p4z_rst  ***
324      !!
325      !!  ** Purpose : Read or write variables in restart file:
326      !!
327      !!  WRITE(READ) mode:
328      !!       kt        : number of time step since the begining of the experiment at the
329      !!                   end of the current(previous) run
330      !!---------------------------------------------------------------------
331      INTEGER         , INTENT(in) ::   kt         ! ocean time-step
332      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag
333      !!---------------------------------------------------------------------
334      !
335      IF( TRIM(cdrw) == 'READ' ) THEN
336         !
337         IF(lwp) WRITE(numout,*)
338         IF(lwp) WRITE(numout,*) ' p4z_rst : Read specific variables from pisces model '
339         IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
340         !
341         IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN
342            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  )
343         ELSE
344            CALL p4z_che                              ! initialize the chemical constants
345            CALL ahini_for_at(hi)
346         ENDIF
347         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )
348         IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN
349            CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  )
350         ELSE
351            xksimax(:,:) = xksi(:,:)
352         ENDIF
353         !
354         IF( iom_varid( numrtr, 'tcflxcum', ldstop = .FALSE. ) > 0 ) THEN  ! cumulative total flux of carbon
355            CALL iom_get( numrtr, 'tcflxcum' , t_oce_co2_flx_cum  )
356         ELSE
357            t_oce_co2_flx_cum = 0._wp
358         ENDIF
359         !
360         IF( ln_p5z ) THEN
361            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN
362               CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sizep(:,:,:)  )
363               CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sizen(:,:,:)  )
364               CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  )
365            ELSE
366               sizep(:,:,:) = 1.
367               sizen(:,:,:) = 1.
368               sized(:,:,:) = 1.
369            ENDIF
370        ENDIF
371        !
372      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
373         IF( kt == nitrst ) THEN
374            IF(lwp) WRITE(numout,*)
375            IF(lwp) WRITE(numout,*) 'p4z_rst : write pisces restart file  kt =', kt
376            IF(lwp) WRITE(numout,*) '~~~~~~~'
377         ENDIF
378         CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) )
379         CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) )
380         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) )
381         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum )
382         IF( ln_p5z ) THEN
383            CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sizep(:,:,:) )
384            CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sizen(:,:,:) )
385            CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) )
386         ENDIF
387      ENDIF
388      !
389   END SUBROUTINE p4z_rst
390
391
392   SUBROUTINE p4z_dmp( kt )
393      !!----------------------------------------------------------------------
394      !!                    ***  p4z_dmp  ***
395      !!
396      !! ** purpose  : Relaxation of some tracers
397      !!----------------------------------------------------------------------
398      !
399      INTEGER, INTENT( in )  ::     kt ! time step
400      !
401      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. )
402      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates
403      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate
404      REAL(wp) ::  silmean = 91.51     ! mean value of silicate
405      !
406      REAL(wp) :: zarea, zalksumn, zpo4sumn, zno3sumn, zsilsumn
407      REAL(wp) :: zalksumb, zpo4sumb, zno3sumb, zsilsumb
408      !!---------------------------------------------------------------------
409
410      IF(lwp)  WRITE(numout,*)
411      IF(lwp)  WRITE(numout,*) ' p4z_dmp : Restoring of nutrients at time-step kt = ', kt
412      IF(lwp)  WRITE(numout,*)
413
414      IF( cn_cfg == "ORCA" .OR. cn_cfg == "orca") THEN
415         IF( .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) !
416            !                                                ! --------------------------- !
417            ! set total alkalinity, phosphate, nitrate & silicate
418            zarea          = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6             
419
420            zalksumn = glob_sum( 'p4zsms', trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
421            zpo4sumn = glob_sum( 'p4zsms', trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
422            zno3sumn = glob_sum( 'p4zsms', trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
423            zsilsumn = glob_sum( 'p4zsms', trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
424 
425            IF(lwp) WRITE(numout,*) '       TALKN mean : ', zalksumn
426            trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn
427
428            IF(lwp) WRITE(numout,*) '       PO4N  mean : ', zpo4sumn
429            trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn
430
431            IF(lwp) WRITE(numout,*) '       NO3N  mean : ', zno3sumn
432            trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn
433
434            IF(lwp) WRITE(numout,*) '       SiO3N mean : ', zsilsumn
435            trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )
436            !
437            !
438            IF( .NOT. ln_top_euler ) THEN
439               zalksumb = glob_sum( 'p4zsms', trb(:,:,:,jptal) * cvol(:,:,:)  ) * zarea
440               zpo4sumb = glob_sum( 'p4zsms', trb(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea * po4r
441               zno3sumb = glob_sum( 'p4zsms', trb(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea * rno3
442               zsilsumb = glob_sum( 'p4zsms', trb(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea
443 
444               IF(lwp) WRITE(numout,*) ' '
445               IF(lwp) WRITE(numout,*) '       TALKB mean : ', zalksumb
446               trb(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb
447
448               IF(lwp) WRITE(numout,*) '       PO4B  mean : ', zpo4sumb
449               trb(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb
450
451               IF(lwp) WRITE(numout,*) '       NO3B  mean : ', zno3sumb
452               trb(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb
453
454               IF(lwp) WRITE(numout,*) '       SiO3B mean : ', zsilsumb
455               trb(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )
456           ENDIF
457        ENDIF
458        !
459      ENDIF
460        !
461   END SUBROUTINE p4z_dmp
462
463
464   SUBROUTINE p4z_chk_mass( kt )
465      !!----------------------------------------------------------------------
466      !!                  ***  ROUTINE p4z_chk_mass  ***
467      !!
468      !! ** Purpose :  Mass conservation check
469      !!
470      !!---------------------------------------------------------------------
471      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index     
472      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot
473      CHARACTER(LEN=100)   ::   cltxt
474      INTEGER :: jk
475      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwork
476      !!----------------------------------------------------------------------
477      !
478      IF( kt == nittrc000 ) THEN
479         xfact1 = rfact2r * 12. / 1.e15 * ryyss    ! conversion molC/kt --> PgC/yr
480         xfact2 = 1.e+3 * rno3 * 14. / 1.e12 * ryyss   ! conversion molC/l/s ----> TgN/m3/yr
481         xfact3 = 1.e+3 * rfact2r * rno3   ! conversion molC/l/kt ----> molN/m3/s
482         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si, Fer
483            CALL ctl_opn( numco2, 'carbon.budget'  , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
484            CALL ctl_opn( numnut, 'nutrient.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
485            CALL ctl_opn( numnit, 'nitrogen.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
486            cltxt='time-step   Alkalinity        Nitrate        Phosphorus         Silicate           Iron'
487            IF( lwp ) WRITE(numnut,*)  TRIM(cltxt)
488            IF( lwp ) WRITE(numnut,*) 
489         ENDIF
490      ENDIF
491
492      IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
493         !   Compute the budget of NO3, ALK, Si, Fer
494         IF( ln_p4z ) THEN
495            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      &
496               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
497               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &       
498               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
499        ELSE
500            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   &
501               &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      & 
502               &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   &
503               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3 
504        ENDIF
505        !
506        no3budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  ) 
507        no3budget = no3budget / areatot
508        CALL iom_put( "pno3tot", no3budget )
509      ENDIF
510      !
511      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
512         IF( ln_p4z ) THEN
513            zwork(:,:,:) =    trn(:,:,:,jppo4)                                         &
514               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      &
515               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &       
516               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) 
517        ELSE
518            zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      &
519               &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      & 
520               &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   &
521               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3 
522        ENDIF
523        !
524        po4budget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  ) 
525        po4budget = po4budget / areatot
526        CALL iom_put( "ppo4tot", po4budget )
527      ENDIF
528      !
529      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
530         zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi) 
531         !
532         silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  ) 
533         silbudget = silbudget / areatot
534         CALL iom_put( "psiltot", silbudget )
535      ENDIF
536      !
537      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
538         zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.             
539         !
540         alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  )         !
541         alkbudget = alkbudget / areatot
542         CALL iom_put( "palktot", alkbudget )
543      ENDIF
544      !
545      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN
546         zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   &
547            &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      &
548            &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3   
549         !
550         ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:)  ) 
551         ferbudget = ferbudget / areatot
552         CALL iom_put( "pfertot", ferbudget )
553      ENDIF
554      !
555      ! Global budget of N SMS : denitrification in the water column and in the sediment
556      !                          nitrogen fixation by the diazotrophs
557      ! --------------------------------------------------------------------------------
558      IF( iom_use( "tnfix" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
559         znitrpottot  = glob_sum ( 'p4zsms', nitrpot(:,:,:) * nitrfix * cvol(:,:,:) )
560         CALL iom_put( "tnfix"  , znitrpottot * xfact3 )  ! Global  nitrogen fixation molC/l  to molN/m3
561      ENDIF
562      !
563      IF( iom_use( "tdenit" ) .OR.  ( ln_check_mass .AND. kt == nitend )  ) THEN
564         zrdenittot = glob_sum ( 'p4zsms', denitr(:,:,:) * rdenit * xnegtr(:,:,:) * cvol(:,:,:) )
565         zsdenittot = glob_sum ( 'p4zsms', sdenit(:,:) * e1e2t(:,:) * tmask(:,:,1) )
566         CALL iom_put( "tdenit" , ( zrdenittot + zsdenittot ) * xfact3 )  ! Total denitrification molC/l to molN/m3
567      ENDIF
568      !
569      IF( ln_check_mass .AND. kt == nitend ) THEN   ! Compute the budget of NO3, ALK, Si, Fer
570         t_atm_co2_flx  = t_atm_co2_flx / glob_sum( 'p4zsms', e1e2t(:,:) )
571         t_oce_co2_flx  = t_oce_co2_flx         * xfact1 * (-1 )
572         tpp            = tpp           * 1000. * xfact1
573         t_oce_co2_exp  = t_oce_co2_exp * 1000. * xfact1
574         IF( lwp ) WRITE(numco2,9000) ndastp, t_atm_co2_flx, t_oce_co2_flx, tpp, t_oce_co2_exp
575         IF( lwp ) WRITE(numnut,9100) ndastp, alkbudget        * 1.e+06, &
576             &                                no3budget * rno3 * 1.e+06, &
577             &                                po4budget * po4r * 1.e+06, &
578             &                                silbudget        * 1.e+06, &
579             &                                ferbudget        * 1.e+09
580         !
581         IF( lwp ) WRITE(numnit,9200) ndastp, znitrpottot * xfact2  , &
582            &                             zrdenittot  * xfact2  , &
583            &                             zsdenittot  * xfact2
584      ENDIF
585      !
586 9000  FORMAT(i8,f10.5,e18.10,f10.5,f10.5)
587 9100  FORMAT(i8,5e18.10)
588 9200  FORMAT(i8,3f10.5)
589       !
590   END SUBROUTINE p4z_chk_mass
591
592   !!======================================================================
593END MODULE p4zsms 
Note: See TracBrowser for help on using the repository browser.