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.
p4zsed.F90 in branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 20.8 KB
Line 
1MODULE p4zsed
2   !!======================================================================
3   !!                         ***  MODULE p4sed  ***
4   !! TOP :   PISCES Compute loss of organic matter in the sediments
5   !!======================================================================
6   !! History :   1.0  !  2004-03 (O. Aumont) Original code
7   !!             2.0  !  2007-12 (C. Ethe, G. Madec)  F90
8   !!             3.4  !  2011-06 (C. Ethe) USE of fldread
9   !!             3.5  !  2012-07 (O. Aumont) improvment of river input of nutrients
10   !!----------------------------------------------------------------------
11#if defined key_pisces
12   !!----------------------------------------------------------------------
13   !!   'key_pisces'                                       PISCES bio-model
14   !!----------------------------------------------------------------------
15   !!   p4z_sed        :  Compute loss of organic matter in the sediments
16   !!----------------------------------------------------------------------
17   USE oce_trc         !  shared variables between ocean and passive tracers
18   USE trc             !  passive tracers common variables
19   USE sms_pisces      !  PISCES Source Minus Sink variables
20   USE p4zsink         !  vertical flux of particulate matter due to sinking
21   USE p4zopt          !  optical model
22   USE p4zlim          !  Co-limitations of differents nutrients
23   USE p4zsbc          !  External source of nutrients
24   USE p4zint          !  interpolation and computation of various fields
25   USE iom             !  I/O manager
26   USE prtctl_trc      !  print control for debugging
27
28   IMPLICIT NONE
29   PRIVATE
30
31   PUBLIC   p4z_sed 
32   PUBLIC   p4z_sed_alloc
33 
34
35   !! * Module variables
36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: nitrpot    !: Nitrogen fixation
37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:  ) :: sdenit     !: Nitrate reduction in the sediments
38   REAL(wp) :: r1_rday                  !: inverse of rday
39
40   !! * Substitutions
41#  include "domzgr_substitute.h90"
42   !!----------------------------------------------------------------------
43   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
44   !! $Id$
45   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
46   !!----------------------------------------------------------------------
47CONTAINS
48
49   SUBROUTINE p4z_sed( kt, knt )
50      !!---------------------------------------------------------------------
51      !!                     ***  ROUTINE p4z_sed  ***
52      !!
53      !! ** Purpose :   Compute loss of organic matter in the sediments. This
54      !!              is by no way a sediment model. The loss is simply
55      !!              computed to balance the inout from rivers and dust
56      !!
57      !! ** Method  : - ???
58      !!---------------------------------------------------------------------
59      !
60      INTEGER, INTENT(in) ::   kt, knt ! ocean time step
61      INTEGER  ::   ji, jj, jk, ikt
62#if ! defined key_sed
63      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal
64      REAL(wp) ::   zrivalk, zrivsil, zrivno3
65#endif
66      REAL(wp) ::  zwflux, zfminus, zfplus
67      REAL(wp) ::  zlim, zfact, zfactcal
68      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit
69      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc
70      REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight
71      !
72      CHARACTER (len=25) :: charout
73      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3
74      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff
75      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal
76      REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer
77      !!---------------------------------------------------------------------
78      !
79      IF( nn_timing == 1 )  CALL timing_start('p4z_sed')
80      !
81      IF( kt == nittrc000 .AND. knt == 1 )   r1_rday  = 1. / rday
82      !
83      ! Allocate temporary workspace
84      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
85      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
86      CALL wrk_alloc( jpi, jpj, jpk, zsoufer )
87
88      zdenit2d(:,:) = 0.e0
89      zbureff (:,:) = 0.e0
90      zwork1  (:,:) = 0.e0
91      zwork2  (:,:) = 0.e0
92      zwork3  (:,:) = 0.e0
93
94      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al.
95      ! ----------------------------------------------------
96      IF( ln_ironice ) THEN 
97         !                                             
98         CALL wrk_alloc( jpi, jpj, zironice )
99         !                                             
100         DO jj = 1, jpj
101            DO ji = 1, jpi
102               zdep    = rfact2 / fse3t(ji,jj,1)
103               zwflux  = fmmflx(ji,jj) / 1000._wp
104               zfminus = MIN( 0._wp, -zwflux ) * trb(ji,jj,1,jpfer) * zdep
105               zfplus  = MAX( 0._wp, -zwflux ) * icefeinput * zdep
106               zironice(ji,jj) =  zfplus + zfminus
107            END DO
108         END DO
109         !
110         tra(:,:,1,jpfer) = tra(:,:,1,jpfer) + zironice(:,:) 
111         !
112         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironice" ) )   &
113            &   CALL iom_put( "Ironice", zironice(:,:) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! iron flux from ice
114         !
115         CALL wrk_dealloc( jpi, jpj, zironice )
116         !                                             
117      ENDIF
118
119      ! Add the external input of nutrients from dust deposition
120      ! ----------------------------------------------------------
121      IF( ln_dust ) THEN
122         !                                             
123         CALL wrk_alloc( jpi, jpj,      zpdep, zsidep )
124         CALL wrk_alloc( jpi, jpj, jpk, zirondep      )
125         !                                              ! Iron and Si deposition at the surface
126         IF( ln_solub ) THEN
127            zirondep(:,:,1) = solub(:,:) * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
128         ELSE
129            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 55.85 + 3.e-10 * r1_ryyss 
130         ENDIF
131         zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 28.1 
132         zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / fse3t(:,:,1) / 31. / po4r 
133         !                                              ! Iron solubilization of particles in the water column
134         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j
135         zwdust = 0.03 * rday / ( wdust * 55.85 ) / ( 270. * rday )
136         DO jk = 2, jpkm1
137            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -fsdept(:,:,jk) / 540. )
138         END DO
139         !                                              ! Iron solubilization of particles in the water column
140         tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:)
141         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:)
142         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:) 
143         !
144         IF( lk_iomput ) THEN
145            IF( knt == nrdttrc ) THEN
146                IF( iom_use( "Irondep" ) )   &
147                &  CALL iom_put( "Irondep", zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) ) ! surface downward dust depo of iron
148                IF( iom_use( "pdust" ) )   &
149                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface
150            ENDIF
151         ELSE                                   
152            IF( ln_diatrc )  &
153              &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
154         ENDIF
155         CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep )
156         CALL wrk_dealloc( jpi, jpj, jpk, zirondep      )
157         !                                             
158      ENDIF
159     
160      ! Add the external input of nutrients from river
161      ! ----------------------------------------------------------
162      IF( ln_river ) THEN
163         DO jj = 1, jpj
164            DO ji = 1, jpi
165               DO jk = 1, nk_rnf(ji,jj)
166                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) +  rivdip(ji,jj) * rfact2
167                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) +  rivdin(ji,jj) * rfact2
168                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) +  rivdic(ji,jj) * 5.e-5 * rfact2
169                  tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) +  rivdsi(ji,jj) * rfact2
170                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +  rivdic(ji,jj) * rfact2
171                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) +  ( rivalk(ji,jj) - rno3 * rivdin(ji,jj) ) * rfact2
172               ENDDO
173            ENDDO
174         ENDDO
175      ENDIF
176     
177      ! Add the external input of nutrients from nitrogen deposition
178      ! ----------------------------------------------------------
179      IF( ln_ndepo ) THEN
180         tra(:,:,1,jpno3) = tra(:,:,1,jpno3) + nitdep(:,:) * rfact2
181         tra(:,:,1,jptal) = tra(:,:,1,jptal) - rno3 * nitdep(:,:) * rfact2
182      ENDIF
183
184      ! Add the external input of iron from sediment mobilization
185      ! ------------------------------------------------------
186      IF( ln_ironsed ) THEN
187         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2
188         !
189         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   &
190            &   CALL iom_put( "Ironsed", ironsed(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! iron inputs from sediments
191      ENDIF
192
193      ! Add the external input of iron from hydrothermal vents
194      ! ------------------------------------------------------
195      IF( ln_hydrofe ) THEN
196         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2
197         !
198         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   &
199            &   CALL iom_put( "HYDR", hydrofe(:,:,:) * 1.e+3 * tmask(:,:,:) ) ! hydrothermal iron input
200      ENDIF
201
202      ! OA: Warning, the following part is necessary, especially with Kriest
203      ! to avoid CFL problems above the sediments
204      ! --------------------------------------------------------------------
205      DO jj = 1, jpj
206         DO ji = 1, jpi
207            ikt  = mbkt(ji,jj)
208            zdep = fse3t(ji,jj,ikt) / xstep
209            zwsbio4(ji,jj) = MIN( 0.99 * zdep, wsbio4(ji,jj,ikt) )
210            zwscal (ji,jj) = MIN( 0.99 * zdep, wscal (ji,jj,ikt) )
211            zwsbio3(ji,jj) = MIN( 0.99 * zdep, wsbio3(ji,jj,ikt) )
212         END DO
213      END DO
214
215#if ! defined key_sed
216      ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used
217      ! Computation of the fraction of organic matter that is permanently buried from Dunne's model
218      ! -------------------------------------------------------
219      DO jj = 1, jpj
220         DO ji = 1, jpi
221           IF( tmask(ji,jj,1) == 1 ) THEN
222              ikt = mbkt(ji,jj)
223# if defined key_kriest
224              zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4
225# else
226              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
227                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4
228#endif
229              zflx  = LOG10( MAX( 1E-3, zflx ) )
230              zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) )
231              zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) )
232              zdep  = LOG10( fsdepw(ji,jj,ikt+1) )
233              zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    &
234              &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2
235              zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) )
236              !
237              zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   &
238                &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6
239              zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2
240           ENDIF
241         END DO
242      END DO 
243
244      ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.
245      ! First, the total loss is computed.
246      ! The factor for calcite comes from the alkalinity effect
247      ! -------------------------------------------------------------
248      DO jj = 1, jpj
249         DO ji = 1, jpi
250            IF( tmask(ji,jj,1) == 1 ) THEN
251               ikt = mbkt(ji,jj) 
252# if defined key_kriest
253               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj)
254               zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)
255# else
256               zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj)
257               zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
258# endif
259               ! For calcite, burial efficiency is made a function of saturation
260               zfactcal      = MIN( excess(ji,jj,ikt), 0.2 )
261               zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
262               zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal
263            ENDIF
264         END DO
265      END DO
266      zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday
267      zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday
268      zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday
269#endif
270
271      ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean.
272      ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers)
273      ! ------------------------------------------------------
274#if ! defined key_sed
275      zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn )
276#endif
277
278      DO jj = 1, jpj
279         DO ji = 1, jpi
280            ikt  = mbkt(ji,jj)
281            zdep = xstep / fse3t(ji,jj,ikt) 
282            zws4 = zwsbio4(ji,jj) * zdep
283            zwsc = zwscal (ji,jj) * zdep
284# if defined key_kriest
285            zsiloss = trb(ji,jj,ikt,jpgsi) * zws4
286# else
287            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc
288# endif
289            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc
290            !
291            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss
292            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss
293#if ! defined key_sed
294            tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil 
295            zfactcal = MIN( excess(ji,jj,ikt), 0.2 )
296            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) )
297            zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn )
298            tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0
299            tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk
300#endif
301         END DO
302      END DO
303
304      DO jj = 1, jpj
305         DO ji = 1, jpi
306            ikt  = mbkt(ji,jj)
307            zdep = xstep / fse3t(ji,jj,ikt) 
308            zws4 = zwsbio4(ji,jj) * zdep
309            zws3 = zwsbio3(ji,jj) * zdep
310            zrivno3 = 1. - zbureff(ji,jj)
311# if ! defined key_kriest
312            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4 
313            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
314            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4
315            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
316            zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3
317# else
318            tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4 
319            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3
320            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3
321            zwstpoc = trb(ji,jj,ikt,jppoc) * zws3 
322# endif
323
324#if ! defined key_sed
325            ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification
326            ! in the sediments and just above the sediments. Not very clever, but simpliest option.
327            zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 )
328            z1pdenit = zwstpoc * zrivno3 - zpdenit
329            zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) )
330            zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) )
331            tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt
332            tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt
333            tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt
334            tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt)
335            tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut
336            tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) )
337            tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt
338            sdenit(ji,jj) = rdenit * zpdenit * fse3t(ji,jj,ikt)
339#endif
340         END DO
341      END DO
342
343      ! Nitrogen fixation process
344      ! Small source iron from particulate inorganic iron
345      !-----------------------------------
346      DO jk = 1, jpkm1
347         DO jj = 1, jpj
348            DO ji = 1, jpi
349               !                      ! Potential nitrogen fixation dependant on temperature and iron
350               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) )
351               IF( zlim <= 0.2 )   zlim = 0.01
352#if defined key_degrad
353               zfact = zlim * rfact2 * facvol(ji,jj,jk)
354#else
355               zfact = zlim * rfact2
356#endif
357               ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       )
358               ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) ) 
359               zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) ) 
360               nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   &
361                 &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight
362               zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk))
363            END DO
364         END DO
365      END DO
366
367      ! Nitrogen change due to nitrogen fixation
368      ! ----------------------------------------
369      DO jk = 1, jpkm1
370         DO jj = 1, jpj
371            DO ji = 1, jpi
372               zfact = nitrpot(ji,jj,jk) * nitrfix
373               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact
374               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact
375               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact 
376               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) &
377               &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep
378               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep
379           END DO
380         END DO
381      END DO
382
383      IF( lk_iomput ) THEN
384         IF( knt == nrdttrc ) THEN
385            zfact = 1.e+3 * rfact2r * rno3  !  conversion from molC/l/kt  to molN/m3/s
386            IF( iom_use("Nfix"   ) ) CALL iom_put( "Nfix", nitrpot(:,:,:) * nitrfix * zfact * tmask(:,:,:) )  ! nitrogen fixation
387            IF( iom_use("INTNFIX") ) THEN   ! nitrogen fixation rate in ocean ( vertically integrated )
388               zwork1(:,:) = 0.
389               DO jk = 1, jpkm1
390                 zwork1(:,:) = zwork1(:,:) + nitrpot(:,:,jk) * nitrfix * zfact * fse3t(:,:,jk) * tmask(:,:,jk)
391               ENDDO
392               CALL iom_put( "INTNFIX" , zwork1 ) 
393            ENDIF
394         ENDIF
395      ELSE
396         IF( ln_diatrc )  &
397            &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1)
398      ENDIF
399      !
400      IF(ln_ctl) THEN  ! print mean trends (USEd for debugging)
401         WRITE(charout, fmt="('sed ')")
402         CALL prt_ctl_trc_info(charout)
403         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm)
404      ENDIF
405      !
406      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff )
407      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal )
408      CALL wrk_dealloc( jpi, jpj, jpk, zsoufer )
409      !
410      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed')
411      !
412 9100  FORMAT(i8,3f10.5)
413      !
414   END SUBROUTINE p4z_sed
415
416
417   INTEGER FUNCTION p4z_sed_alloc()
418      !!----------------------------------------------------------------------
419      !!                     ***  ROUTINE p4z_sed_alloc  ***
420      !!----------------------------------------------------------------------
421      ALLOCATE( nitrpot(jpi,jpj,jpk), sdenit(jpi,jpj), STAT=p4z_sed_alloc )
422      !
423      IF( p4z_sed_alloc /= 0 )   CALL ctl_warn('p4z_sed_alloc: failed to allocate arrays')
424      !
425   END FUNCTION p4z_sed_alloc
426
427
428#else
429   !!======================================================================
430   !!  Dummy module :                                   No PISCES bio-model
431   !!======================================================================
432CONTAINS
433   SUBROUTINE p4z_sed                         ! Empty routine
434   END SUBROUTINE p4z_sed
435#endif 
436
437   !!======================================================================
438END MODULE p4zsed
Note: See TracBrowser for help on using the repository browser.