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 tags/nemo_v2_3/NEMO/TOP_SRC/SMS – NEMO

source: tags/nemo_v2_3/NEMO/TOP_SRC/SMS/p4zsed.F @ 736

Last change on this file since 736 was 736, checked in by cetlod, 17 years ago

add tmask_i in global sum, see ticket:17
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 10.4 KB
Line 
1
2CCC $Header: /home/opalod/NEMOCVSROOT/NEMO/TOP_SRC/SMS/p4zsed.F,v 1.9 2007/10/12 09:35:04 opalod Exp $ 
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)*3E-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=1,jpj
143          DO ji=1,jpi
144            ikt=max(mbathy(ji,jj)-1,1)
145            zfact=e1t(ji,jj)*e2t(ji,jj)/rjjss*tmask_i(ji,jj)
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#if  defined key_trc_kriest
155            sumsedpo4=sumsedpo4+
156     &          (trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt))*zfact
157#else
158            sumsedpo4=sumsedpo4+(trn(ji,jj,ikt,jpgoc)*wsbio4(ji,jj,ikt)
159     &    +trn(ji,jj,ikt,jppoc)*wsbio3(ji,jj,ikt))*zfact
160#endif
161          END DO
162        END DO
163
164         IF( lk_mpp ) THEN
165            CALL mpp_sum( sumsedsi )   ! sums over the global domain
166            CALL mpp_sum( sumsedcal )   ! sums over the global domain
167            CALL mpp_sum( sumsedpo4 )   ! sums over the global domain
168         ENDIF
169C
170C    Then this loss is scaled at each bottom grid cell for
171C    equilibrating the total budget of silica in the ocean.
172C    Thus, the amount of silica lost in the sediments equal
173C    the supply at the surface (dust+rivers)
174C    ------------------------------------------------------
175C
176        DO jj=1,jpj
177          DO ji=1,jpi
178            ikt=max(mbathy(ji,jj)-1,1)
179            xconctmp=trn(ji,jj,ikt,jpdsi)*zstep/fse3t(ji,jj,ikt)
180#if ! defined key_trc_kriest
181     &               *wsbio4(ji,jj,ikt) 
182#else
183     &               *wscal(ji,jj,ikt)
184#endif
185            trn(ji,jj,ikt,jpdsi)=trn(ji,jj,ikt,jpdsi)-xconctmp
186            trn(ji,jj,ikt,jpsil)=trn(ji,jj,ikt,jpsil)+xconctmp
187     &          *(1.-(sumdepsi+rivalkinput/raass/6.)/sumsedsi)
188          END DO
189        END DO
190
191        DO jj=1,jpj
192          DO ji=1,jpi
193            ikt=max(mbathy(ji,jj)-1,1)
194            xconctmp=trn(ji,jj,ikt,jpcal)*wscal(ji,jj,ikt)*zstep
195     &          /fse3t(ji,jj,ikt)
196            trn(ji,jj,ikt,jpcal)=trn(ji,jj,ikt,jpcal)-xconctmp
197            trn(ji,jj,ikt,jptal)=trn(ji,jj,ikt,jptal)+xconctmp
198     &          *(1.-(rivalkinput/raass)/sumsedcal)*2.
199            trn(ji,jj,ikt,jpdic)=trn(ji,jj,ikt,jpdic)+xconctmp
200     &          *(1.-(rivalkinput/raass)/sumsedcal)
201          END DO
202        END DO
203
204        DO jj=1,jpj
205          DO ji=1,jpi
206            ikt=max(mbathy(ji,jj)-1,1)
207#if ! defined key_trc_kriest
208            xconctmp=trn(ji,jj,ikt,jpgoc)
209            xconctmp2=trn(ji,jj,ikt,jppoc)
210            trn(ji,jj,ikt,jpgoc)=trn(ji,jj,ikt,jpgoc)
211     &          -xconctmp*wsbio4(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
212            trn(ji,jj,ikt,jppoc)=trn(ji,jj,ikt,jppoc)
213     &          -xconctmp2*wsbio3(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
214            trn(ji,jj,ikt,jpdoc)=trn(ji,jj,ikt,jpdoc)
215     &          +(xconctmp*wsbio4(ji,jj,ikt)+xconctmp2*wsbio3(ji,jj,ikt)
216     $          )*zstep/fse3t(ji,jj,ikt)*(1.-rivpo4input/(raass
217     $          *sumsedpo4))
218            trn(ji,jj,ikt,jpbfe)=trn(ji,jj,ikt,jpbfe)
219     &          -trn(ji,jj,ikt,jpbfe)*wsbio4(ji,jj,ikt)*zstep
220     &          /fse3t(ji,jj,ikt)
221            trn(ji,jj,ikt,jpsfe)=trn(ji,jj,ikt,jpsfe)
222     &          -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)*zstep
223     &          /fse3t(ji,jj,ikt)
224#else
225            xconctmp=trn(ji,jj,ikt,jpnum)
226            xconctmp2=trn(ji,jj,ikt,jppoc)
227            trn(ji,jj,ikt,jpnum)=trn(ji,jj,ikt,jpnum)
228     &          -xconctmp*wsbio4(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
229            trn(ji,jj,ikt,jppoc)=trn(ji,jj,ikt,jppoc)
230     &          -xconctmp2*wsbio3(ji,jj,ikt)*zstep/fse3t(ji,jj,ikt)
231            trn(ji,jj,ikt,jpdoc)=trn(ji,jj,ikt,jpdoc)
232     &          +(xconctmp2*wsbio3(ji,jj,ikt))
233     $          *zstep/fse3t(ji,jj,ikt)*(1.-rivpo4input/(raass
234     $          *sumsedpo4))
235            trn(ji,jj,ikt,jpsfe)=trn(ji,jj,ikt,jpsfe)
236     &          -trn(ji,jj,ikt,jpsfe)*wsbio3(ji,jj,ikt)*zstep
237     &          /fse3t(ji,jj,ikt)
238
239#endif
240          END DO
241        END DO
242C
243C  Nitrogen fixation (simple parameterization). The total gain
244C  from nitrogen fixation is scaled to balance the loss by 
245C  denitrification
246C  -------------------------------------------------------------
247C
248        denitot=0.
249        DO jk=1,jpk-1
250          DO jj=2,jpj-1
251            DO ji=2,jpi-1
252        denitot=denitot+denitr(ji,jj,jk)*rdenit*e1t(ji,jj)*e2t(ji,jj)
253     &    *fse3t(ji,jj,jk)*tmask(ji,jj,jk)*tmask_i(ji,jj)
254     &    *znegtr(ji,jj,jk)
255            END DO
256          END DO
257        END DO
258
259        IF( lk_mpp )   CALL mpp_sum( denitot )  ! sum over the global domain
260C
261C  Potential nitrogen fication dependant on temperature
262C  and iron
263C  ----------------------------------------------------
264C
265       DO jk=1,jpk
266        DO jj=1,jpj
267          DO ji=1,jpi
268        xlim=(1.-xnanono3(ji,jj,jk)-xnanonh4(ji,jj,jk))
269        if (xlim.le.0.2) xlim=0.01
270        nitrpot(ji,jj,jk)=max(0.,(0.6*tgfunc(ji,jj,jk)-2.15)/rjjss)
271#if defined key_off_degrad
272     &    *facvol(ji,jj,jk)
273#endif
274     &    *xlim*rfact2*trn(ji,jj,jk,jpfer)/(conc3
275     &    +trn(ji,jj,jk,jpfer))*(1.-exp(-etot(ji,jj,jk)/50.))
276          END DO
277        END DO
278       END DO
279C
280      nitrpottot=0.
281      DO jk=1,jpkm1
282        DO jj=1,jpj
283          DO ji=1,jpi
284        nitrpottot=nitrpottot+nitrpot(ji,jj,jk)*e1t(ji,jj)
285     &    *e2t(ji,jj)*tmask(ji,jj,jk)*tmask_i(ji,jj)*fse3t(ji,jj,jk)
286          END DO
287        END DO
288      END DO
289
290        IF( lk_mpp )   CALL mpp_sum( nitrpottot )  ! sum over the global domain
291C
292C  Nitrogen change due to nitrogen fixation
293C  ----------------------------------------
294C
295       DO jk=1,jpk
296        DO jj=1,jpj
297          DO ji=1,jpi
298#if ! defined key_cfg_1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )
299        zfact=nitrpot(ji,jj,jk)*denitot/nitrpottot
300#else
301        zfact=nitrpot(ji,jj,jk)*1.E-7
302#endif
303        trn(ji,jj,jk,jpnh4)=trn(ji,jj,jk,jpnh4)+zfact
304        trn(ji,jj,jk,jpoxy)=trn(ji,jj,jk,jpoxy)+zfact*o2nit
305        trn(ji,jj,jk,jppo4)=trn(ji,jj,jk,jppo4)+30./46.*zfact
306          END DO
307        END DO
308       END DO
309C
310#    if defined key_trc_diaadd
311        DO jj = 1,jpj
312          DO ji = 1,jpi
313        trc2d(ji,jj,13) = nitrpot(ji,jj,1)*1E-7*fse3t(ji,jj,1)*1E3
314     &    /rfact2
315        trc2d(ji,jj,12) = irondep(ji,jj,1)*1e3*rfact2r
316     &    *fse3t(ji,jj,1)
317          END DO
318        END DO
319#    endif
320C
321#endif
322      RETURN
323      END
Note: See TracBrowser for help on using the repository browser.