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.F in trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/p4zsed.F @ 719

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

get back to the nemo_v2_3 version for trunk
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.1 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
6CDIR$ LIST
7      SUBROUTINE p4zsed
8#if defined key_passivetrc && defined key_trc_pisces
9CCC---------------------------------------------------------------------
10CCC
11CCC          ROUTINE p4zsed : PISCES MODEL
12CCC          *****************************
13CCC
14CCC  PURPOSE :
15CCC  ---------
16CCC         Compute loss of organic matter in the sediments. This
17CCC         is by no way a sediment model. The loss is simply 
18CCC         computed to balance the inout from rivers and dust
19CCC
20CC   INPUT :
21CC   -----
22CC      common
23CC              all the common defined in opa
24CC
25CC
26CC   OUTPUT :                   : no
27CC   ------
28CC
29CC   EXTERNAL :
30CC   --------
31CC             None
32CC
33CC   MODIFICATIONS:
34CC   --------------
35CC      original  : 2004 - O. Aumont 
36CC----------------------------------------------------------------------
37CC parameters and commons
38CC ======================
39CDIR$ NOLIST
40      USE oce_trc
41      USE trp_trc
42      USE sms
43      USE lib_mpp
44      IMPLICIT NONE
45#include "domzgr_substitute.h90"
46CDIR$ LIST
47CC----------------------------------------------------------------------
48CC local declarations
49CC ==================
50      INTEGER ji, jj, jk, ikt
51      REAL sumsedsi,sumsedpo4,sumsedcal
52      REAL xconctmp,denitot,nitrpottot,nitrpot(jpi,jpj,jpk)
53      REAL xlim,xconctmp2,zstep,zfact
54      REAL irondep(jpi,jpj,jpk),sidep(jpi,jpj)
55      REAL zvol
56CC
57C
58C     Time step duration for the biology
59C     ----------------------------------
60C
61        zstep=rfact2/rjjss
62C
63C
64C     Initialisation of variables used to compute deposition
65C     ------------------------------------------------------
66C
67      irondep     = 0.
68      sidep       = 0.
69C
70C     Iron and Si deposition at the surface
71C     -------------------------------------
72C
73       do jj=1,jpj
74         do ji=1,jpi
75         irondep(ji,jj,1)=(0.014*dust(ji,jj)/(55.85*rmoss)
76     &      +3E-10/raass)*rfact2/fse3t(ji,jj,1)
77         sidep(ji,jj)=8.8*0.075*dust(ji,jj)*rfact2
78     &      /(fse3t(ji,jj,1)*28.1*rmoss)
79         end do
80       end do
81C
82C     Iron solubilization of particles in the water column
83C     ----------------------------------------------------
84C
85      do jk=2,jpk-1
86        do jj=1,jpj
87          do ji=1,jpi
88          irondep(ji,jj,jk)=dust(ji,jj)/(10.*55.85*rmoss)*rfact2
89     &      *0.0001
90          end do
91        end do
92      end do
93C
94C    Add the external input of nutrients, carbon and alkalinity
95C    ----------------------------------------------------------
96C
97        DO jj = 1,jpj
98          DO ji = 1,jpi
99          trn(ji,jj,1,jppo4) = trn(ji,jj,1,jppo4)
100     &      +rivinp(ji,jj)*rfact2
101          trn(ji,jj,1,jpno3) = trn(ji,jj,1,jpno3)
102     &      +(rivinp(ji,jj)+nitdep(ji,jj))*rfact2
103          trn(ji,jj,1,jpfer) = trn(ji,jj,1,jpfer)
104     &      +rivinp(ji,jj)*9E-5*rfact2
105          trn(ji,jj,1,jpsil) = trn(ji,jj,1,jpsil)
106     &      +sidep(ji,jj)+cotdep(ji,jj)*rfact2/6.
107          trn(ji,jj,1,jpdic) = trn(ji,jj,1,jpdic)
108     &      +rivinp(ji,jj)*rfact2*2.631
109          trn(ji,jj,1,jptal) = trn(ji,jj,1,jptal)
110     &      +(cotdep(ji,jj)-rno3*(rivinp(ji,jj)
111     &      +nitdep(ji,jj)))*rfact2
112          END DO
113        END DO
114C
115
116C
117C     Add the external input of iron which is 3D distributed
118C     (dust, river and sediment mobilization)
119C     ------------------------------------------------------
120C
121        DO jk=1,jpkm1
122          DO jj=1,jpj
123            DO ji=1,jpi
124          trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer)
125     &      +irondep(ji,jj,jk)+ironsed(ji,jj,jk)*rfact2
126            END DO
127          END DO
128        END DO
129C
130C     Initialisation of variables used to compute Sinking Speed
131C     ---------------------------------------------------------
132C
133        sumsedsi = 0.
134        sumsedpo4 = 0.
135        sumsedcal = 0.
136C
137C    Loss of biogenic silicon, Caco3 organic carbon in the sediments. 
138C    First, the total loss is computed.
139C    The factor for calcite comes from the alkalinity effect
140C    -------------------------------------------------------------
141C
142        DO jj=2,jpjm1
143          DO ji=2,jpim1
144            ikt=max(mbathy(ji,jj)-1,1)
145            zfact=e1t(ji,jj)*e2t(ji,jj)/rjjss
146            sumsedsi=sumsedsi+zfact*trn(ji,jj,ikt,jpdsi)
147#if ! defined key_trc_kriest
148     &               *wsbio4(ji,jj,ikt) 
149#else
150     &               *wscal(ji,jj,ikt)
151#endif
152            sumsedcal=sumsedcal+trn(ji,jj,ikt,jpcal)*wscal(ji,jj,ikt)
153     &          *2.*zfact
154            sumsedpo4=sumsedpo4+
155     &          (trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt))*zfact
156          END DO
157        END DO
158
159         IF( lk_mpp ) THEN
160            CALL mpp_sum( sumsedsi )   ! sums over the global domain
161            CALL mpp_sum( sumsedcal )   ! sums over the global domain
162            CALL mpp_sum( sumsedpo4 )   ! sums over the global domain
163         ENDIF
164C
165C    Then this loss is scaled at each bottom grid cell for
166C    equilibrating the total budget of silica in the ocean.
167C    Thus, the amount of silica lost in the sediments equal
168C    the supply at the surface (dust+rivers)
169C    ------------------------------------------------------
170C
171        DO jj=1,jpj
172          DO ji=1,jpi
173            ikt=max(mbathy(ji,jj)-1,1)
174            xconctmp=trn(ji,jj,ikt,jpdsi)*zstep/fse3t(ji,jj,ikt)
175#if ! defined key_trc_kriest
176     &               *wsbio4(ji,jj,ikt) 
177#else
178     &               *wscal(ji,jj,ikt)
179#endif
180            trn(ji,jj,ikt,jpdsi)=trn(ji,jj,ikt,jpdsi)-xconctmp
181            trn(ji,jj,ikt,jpsil)=trn(ji,jj,ikt,jpsil)+xconctmp
182     &          *(1.-(sumdepsi+rivalkinput/raass/6.)/sumsedsi)
183          END DO
184        END DO
185
186        DO jj=1,jpj
187          DO ji=1,jpi
188            ikt=max(mbathy(ji,jj)-1,1)
189            xconctmp=trn(ji,jj,ikt,jpcal)*wscal(ji,jj,ikt)*zstep
190     &          /fse3t(ji,jj,ikt)
191            trn(ji,jj,ikt,jpcal)=trn(ji,jj,ikt,jpcal)-xconctmp
192            trn(ji,jj,ikt,jptal)=trn(ji,jj,ikt,jptal)+xconctmp
193     &          *(1.-(rivalkinput/raass)/sumsedcal)*2.
194            trn(ji,jj,ikt,jpdic)=trn(ji,jj,ikt,jpdic)+xconctmp
195     &          *(1.-(rivalkinput/raass)/sumsedcal)
196          END DO
197        END DO
198
199        DO jj=1,jpj
200          DO ji=1,jpi
201            ikt=max(mbathy(ji,jj)-1,1)
202#if ! defined key_trc_kriest
203            xconctmp=trn(ji,jj,ikt,jpgoc)
204            xconctmp2=trn(ji,jj,ikt,jppoc)
205            trn(ji,jj,ikt,jpgoc)=trn(ji,jj,ikt,jpgoc)
206     &          -xconctmp*wsbio4(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
207            trn(ji,jj,ikt,jppoc)=trn(ji,jj,ikt,jppoc)
208     &          -xconctmp2*wsbio3(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
209            trn(ji,jj,ikt,jpdoc)=trn(ji,jj,ikt,jpdoc)
210     &          +(xconctmp*wsbio4(ji,jj,ikt)+xconctmp2*wsbio3(ji,jj,ikt)
211     $          )*zstep/fse3t(ji,jj,ikt)*(1.-rivpo4input/(raass
212     $          *sumsedpo4))
213            trn(ji,jj,ikt,jpbfe)=trn(ji,jj,ikt,jpbfe)
214     &          -trn(ji,jj,ikt,jpbfe)*wsbio4(ji,jj,ikt)*zstep
215     &          /fse3t(ji,jj,ikt)
216            trn(ji,jj,ikt,jpsfe)=trn(ji,jj,ikt,jpsfe)
217     &          -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)*zstep
218     &          /fse3t(ji,jj,ikt)
219#else
220            xconctmp=trn(ji,jj,ikt,jpnum)
221            xconctmp2=trn(ji,jj,ikt,jppoc)
222            trn(ji,jj,ikt,jpnum)=trn(ji,jj,ikt,jpnum)
223     &          -xconctmp*wsbio4(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
224            trn(ji,jj,ikt,jppoc)=trn(ji,jj,ikt,jppoc)
225     &          -xconctmp2*wsbio3(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
226            trn(ji,jj,ikt,jpdoc)=trn(ji,jj,ikt,jpdoc)
227     &          +(xconctmp2*wsbio3(ji,jj,ikt))
228     $          *zstep/fse3t(ji,jj,ikt)*(1.-rivpo4input/(raass
229     $          *sumsedpo4))
230            trn(ji,jj,ikt,jpsfe)=trn(ji,jj,ikt,jpsfe)
231     &          -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)*zstep
232     &          /fse3t(ji,jj,ikt)
233
234#endif
235          END DO
236        END DO
237C
238C  Nitrogen fixation (simple parameterization). The total gain
239C  from nitrogen fixation is scaled to balance the loss by 
240C  denitrification
241C  -------------------------------------------------------------
242C
243        denitot=0.
244        DO jk=1,jpk-1
245          DO jj=2,jpj-1
246            DO ji=2,jpi-1
247        denitot=denitot+denitr(ji,jj,jk)*rdenit*e1t(ji,jj)*e2t(ji,jj)
248     &    *fse3t(ji,jj,jk)*tmask(ji,jj,jk)*znegtr(ji,jj,jk)
249            END DO
250          END DO
251        END DO
252
253        IF( lk_mpp )   CALL mpp_sum( denitot )  ! sum over the global domain
254C
255C  Potential nitrogen fication dependant on temperature
256C  and iron
257C  ----------------------------------------------------
258C
259       DO jk=1,jpk
260        DO jj=1,jpj
261          DO ji=1,jpi
262        xlim=(1.-xnanono3(ji,jj,jk)-xnanonh4(ji,jj,jk))
263        if (xlim.le.0.2) xlim=0.01
264        nitrpot(ji,jj,jk)=max(0.,(0.6*tgfunc(ji,jj,jk)-2.15)/rjjss)
265#if defined key_off_degrad
266     &    *facvol(ji,jj,jk)
267#endif
268     &    *xlim*rfact2*trn(ji,jj,jk,jpfer)/(conc3
269     &    +trn(ji,jj,jk,jpfer))*(1.-exp(-etot(ji,jj,jk)/50.))
270          END DO
271        END DO
272       END DO
273C
274      nitrpottot=0.
275      DO jk=1,jpkm1
276        DO jj=2,jpj-1
277          DO ji=2,jpi-1
278        nitrpottot=nitrpottot+nitrpot(ji,jj,jk)*e1t(ji,jj)
279     &    *e2t(ji,jj)*tmask(ji,jj,jk)*fse3t(ji,jj,jk)
280          END DO
281        END DO
282      END DO
283
284        IF( lk_mpp )   CALL mpp_sum( nitrpottot )  ! sum over the global domain
285C
286C  Nitrogen change due to nitrogen fixation
287C  ----------------------------------------
288C
289       DO jk=1,jpk
290        DO jj=1,jpj
291          DO ji=1,jpi
292#if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
293        zfact=nitrpot(ji,jj,jk)*denitot/nitrpottot
294#else
295        zfact=nitrpot(ji,jj,jk)*1.E-7
296#endif
297        trn(ji,jj,jk,jpnh4)=trn(ji,jj,jk,jpnh4)+zfact
298        trn(ji,jj,jk,jpoxy)=trn(ji,jj,jk,jpoxy)+zfact*o2nit
299        trn(ji,jj,jk,jppo4)=trn(ji,jj,jk,jppo4)+30./46.*zfact
300          END DO
301        END DO
302       END DO
303C
304#    if defined key_trc_diaadd
305        DO jj = 1,jpj
306          DO ji = 1,jpi
307        trc2d(ji,jj,13) = nitrpot(ji,jj,1)*1E-7*fse3t(ji,jj,1)*1E3
308     &    /rfact2
309        trc2d(ji,jj,12) = irondep(ji,jj,1)*1e3*rfact2r
310     &    *fse3t(ji,jj,1)
311          END DO
312        END DO
313#    endif
314C
315#endif
316      RETURN
317      END
Note: See TracBrowser for help on using the repository browser.