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

source: trunk/NEMO/TOP_SRC/SMS/p4zbio.F @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 28.5 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 ---------------------------------------------------------------------------
6      SUBROUTINE p4zbio
7CDIR$ LIST
8#if defined key_passivetrc && defined key_trc_pisces
9CCC   ------------------------------------------------------------------
10CCC   
11CCC   ROUTINE p4zbio : PISCES MODEL
12CCC   *****************************
13CCC   
14CC
15CC     PURPOSE.
16CC     --------
17CC          *P4ZBIO* ECOSYSTEM MODEL IN THE WHOLE OCEAN
18CC                   THIS ROUTINE COMPUTES THE DIFFERENT INTERACTIONS
19CC                   BETWEEN THE DIFFERENT COMPARTMENTS OF THE MODEL
20CC     EXTERNAL :
21CC     ----------
22CC          p4zopt, p4zprod, p4znano, p4zdiat, p4zmicro, p4zmeso
23CC          p4zsink, p4zrem
24CC
25CC   MODIFICATIONS:
26CC   --------------
27CC      original      : 2004    O. Aumont
28CC ----------------------------------------------------------------
29CC parameters and commons
30CC ======================
31CDIR$ NOLIST
32      USE oce_trc
33      USE trp_trc
34      USE sms
35      IMPLICIT NONE
36CDIR$ LIST
37CC-----------------------------------------------------------------
38CC local declarations
39CC ==================
40C     
41      INTEGER ji, jj, jk
42
43      REAL xcond,zdenom,zdenom1(jpi,jpj,jpk),zdenom2(jpi,jpj,jpk)
44      REAL zneg, prodca
45C     
46      REAL irondep(jpi,jpj,jpk),sidep(jpi,jpj,jpk),prodt
47      INTEGER jn
48      REAL ztraa, ztrab, ztran
49C
50CC----------------------------------------------------------------------
51CC statement functions
52CC ===================
53CDIR$ NOLIST
54#include "domzgr_substitute.h90"
55CDIR$ LIST
56C     
57C     SET HALF PRECISION CONSTANTS
58C-----------------------------
59C     
60C     Initialisation of variables used to compute deposition
61C     ------------------------------------------------------
62C     
63      irondep     = 0.
64      sidep       = 0.
65C
66C
67C     Iron and Si deposition at the surface
68C     -------------------------------------
69C
70       do jj=1,jpj
71         do ji=1,jpi
72         irondep(ji,jj,1)=(0.01*dust(ji,jj)/(55.85*rmoss)
73     &      +3E-10/raass)*rfact2/fse3t(ji,jj,1)
74         sidep(ji,jj,1)=8.8*0.075*dust(ji,jj)*rfact2/
75     &      (fse3t(ji,jj,1)*28.01*rmoss)
76         end do
77       end do
78C
79C     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION
80C     OF PHYTOPLANKTON AND DETRITUS
81C
82      zdiss=0.01
83C
84       DO jk=1,jpkm1
85        DO jj=1,jpj
86          DO ji=1,jpi
87       if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) zdiss(ji,jj,jk)=1.
88          END DO
89        END DO
90       END DO
91C
92C      Compute de different ratios for scavenging of iron
93C      --------------------------------------------------
94C
95       DO jk=1,jpk
96         DO jj=1,jpj
97           DO ji=1,jpi
98         zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)
99     $     +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn)
100C
101         zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom
102         zdenom2(ji,jj,jk)=trn(ji,jj,jk,jpgoc)*zdenom
103           END DO
104         END DO
105       END DO
106
107
108C
109C  Call optical routine to compute the PAR in the water column
110C  -----------------------------------------------------------
111C
112      CALL p4zopt
113
114
115C
116C  Call production routine to compute phytoplankton growth rate
117C  over the global ocean. Growth rates for each element is 
118C  computed (C, Si, Fe, Chl)
119C  ------------------------------------------------------------
120C
121
122      CALL p4zprod
123
124
125C
126C  Call phytoplankton mortality routines. Mortality losses for 
127C  Each elements are computed (C, Fe, Si, Chl)
128C  -----------------------------------------------------------
129C
130      CALL p4znano
131
132      CALL p4zdiat
133
134C
135C  Call zooplankton sources/sinks routines. 
136C  Each elements are computed (C, Fe, Si, Chl)
137C  -----------------------------------------------------------
138C
139      CALL p4zmicro
140
141      CALL p4zmeso
142
143C
144C     Call subroutine for computation of the vertical flux 
145C     of particulate organic matter
146C     ----------------------------------------------------
147      CALL p4zsink
148
149C
150C     Call subroutine for computation of remineralization
151C     terms of organic matter+scavenging of Fe
152C     ----------------------------------------------------
153      CALL p4zrem
154
155C
156C     Vertical loop to pre-compute concentration changes of the rapid
157C     varying tracers for preventing them to fall below 0
158C     ---------------------------------------------------------------
159C
160      DO jk = 1,jpkm1
161        DO jj = 1,jpj
162          DO ji = 1,jpi
163C     
164C     Evolution of PO4
165C     ----------------
166C     
167         zneg = trn(ji,jj,jk,jppo4)
168     &     -prorca(ji,jj,jk)-prorca2(ji,jj,jk)+denitr(ji,jj,jk)
169     &     +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2
170     &     +olimi(ji,jj,jk)+po4dep(ji,jj,jk)*rfact2
171C     
172C     Nullity test for PO4
173C     --------------------
174C     
175         xcond=(0.5+sign(0.5,zneg)) 
176         prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond
177         prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond
178         proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond
179         proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond
180         pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond
181         pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond
182C
183C     Evolution of NO3
184C     ----------------
185C
186         zneg = trn(ji,jj,jk,jpno3)
187     &     -pronew(ji,jj,jk)-pronew2(ji,jj,jk)
188     &     +po4dep(ji,jj,jk)*rfact2+onitr(ji,jj,jk)
189     &     -denitr(ji,jj,jk)*rdenit+nitdep(ji,jj,jk)*rfact2
190C
191C     Nullity test for NO3
192C     --------------------
193C
194         xcond=(0.5+sign(0.5,zneg))
195         prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond
196         prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond
197         proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond
198         proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond
199         pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond
200         pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond
201         denitr(ji,jj,jk)=denitr(ji,jj,jk)*xcond
202C
203C     Evolution of NH4
204C     ----------------
205C
206         zneg = trn(ji,jj,jk,jpnh4)
207     &     -proreg(ji,jj,jk)-proreg2(ji,jj,jk)-onitr(ji,jj,jk)
208     &     +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2
209     &     +olimi(ji,jj,jk)+denitr(ji,jj,jk)
210C
211C     Nullity test for NH4
212C     --------------------
213C
214         xcond=(0.5+sign(0.5,zneg))
215         prorca(ji,jj,jk)=prorca(ji,jj,jk)*xcond
216         prorca2(ji,jj,jk)=prorca2(ji,jj,jk)*xcond
217         proreg(ji,jj,jk)=proreg(ji,jj,jk)*xcond
218         proreg2(ji,jj,jk)=proreg2(ji,jj,jk)*xcond
219         pronew(ji,jj,jk)=pronew(ji,jj,jk)*xcond
220         pronew2(ji,jj,jk)=pronew2(ji,jj,jk)*xcond
221         onitr(ji,jj,jk)=onitr(ji,jj,jk)*xcond
222C
223C     Evolution of IRON
224C     -----------------
225C
226          zneg = trn(ji,jj,jk,jpfer)
227     &      +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk)
228     &      +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk)
229     &      +grafer(ji,jj,jk)+grafer2(ji,jj,jk)
230     &      +ofer(ji,jj,jk)-xscave(ji,jj,jk)+irondep(ji,jj,jk)
231     &      +(ironsed(ji,jj,jk)+po4dep(ji,jj,jk)*9.E-5)*rfact2
232C
233C     Nullity test for iron
234C     ---------------------
235C
236         xcond=(0.5+sign(0.5,zneg))
237         prorca4(ji,jj,jk)=prorca4(ji,jj,jk)*xcond
238         prorca5(ji,jj,jk)=prorca5(ji,jj,jk)*xcond
239C
240C     Evolution of O2
241C     ---------------
242C
243         xcond=(0.5+sign(0.5,(trn(ji,jj,jk,jpoxy)-oxymin)))
244         zneg = trn(ji,jj,jk,jpoxy)
245     &     +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk))
246     &     +(o2ut+o2nit)*(pronew(ji,jj,jk)+pronew2(ji,jj,jk))
247     &     -o2ut*olimi(ji,jj,jk)-o2ut*xcond*(grarem(ji,jj,jk)
248     &     *sigma1+grarem2(ji,jj,jk)*sigma2)-o2nit*onitr(ji,jj,jk)
249C
250C     Nullity test for oxygen
251C     -----------------------
252C
253         xcond=(0.5+sign(0.5,zneg))
254         olimi(ji,jj,jk)=olimi(ji,jj,jk)*xcond
255         onitr(ji,jj,jk)=onitr(ji,jj,jk)*xcond
256C
257          END DO
258        END DO
259      END DO
260
261      DO jk = 1,jpkm1
262        DO jj = 1,jpj
263          DO ji = 1,jpi
264C   
265C     Evolution of nanophytoplankton
266C     ------------------------------
267C     
268         zneg = trn(ji,jj,jk,jpphy)
269     &     +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk)
270     &     -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk)
271C     
272C     Nullity test for Phyto
273C     ----------------------
274C     
275         xcond=(0.5+sign(0.5,zneg))
276         tortp(ji,jj,jk)=tortp(ji,jj,jk)*xcond
277         grazp(ji,jj,jk)=grazp(ji,jj,jk)*xcond
278         grazn(ji,jj,jk)=grazn(ji,jj,jk)*xcond
279         respp(ji,jj,jk)=respp(ji,jj,jk)*xcond
280C
281C     Evolution of nanophytoplankton chlorophyll
282C     ------------------------------
283C
284         zneg = trn(ji,jj,jk,jpnch)
285     &     +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk)
286     &     -grazpch(ji,jj,jk)-graznch(ji,jj,jk)
287     &     -respnch(ji,jj,jk)
288C
289C     Nullity test for Phyto
290C     ----------------------
291C
292         xcond=(0.5+sign(0.5,zneg))
293         tortnch(ji,jj,jk)=tortnch(ji,jj,jk)*xcond
294         graznch(ji,jj,jk)=graznch(ji,jj,jk)*xcond
295         grazpch(ji,jj,jk)=grazpch(ji,jj,jk)*xcond
296         respnch(ji,jj,jk)=respnch(ji,jj,jk)*xcond
297C
298C     Evolution of biogenic Iron in Nanophytoplankton
299C     -----------------------------------------------
300C
301         zneg = trn(ji,jj,jk,jpnfe)
302     &     +prorca5(ji,jj,jk)*(1.-excret)-tortnf(ji,jj,jk)
303     &     -respnf(ji,jj,jk)-grazpf(ji,jj,jk)-graznf(ji,jj,jk)
304C
305C     Nullity test for Biogenic Iron in Nanophytoplankton
306C     ---------------------------------------------------
307C
308          xcond=(0.5+sign(0.5,zneg))
309          tortnf(ji,jj,jk)=tortnf(ji,jj,jk)*xcond
310          respnf(ji,jj,jk)=respnf(ji,jj,jk)*xcond
311          grazpf(ji,jj,jk)=grazpf(ji,jj,jk)*xcond
312          graznf(ji,jj,jk)=graznf(ji,jj,jk)*xcond
313C   
314C     Evolution of Diatoms
315C     ------------------
316C
317         zneg = trn(ji,jj,jk,jpdia)
318     &     +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk)
319     &     -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk)
320C   
321C     Nullity test for diatoms
322C     ----------------------
323C
324         xcond=(0.5+sign(0.5,zneg))
325         tortp2(ji,jj,jk)=tortp2(ji,jj,jk)*xcond
326         respp2(ji,jj,jk)=respp2(ji,jj,jk)*xcond
327         grazd(ji,jj,jk)=grazd(ji,jj,jk)*xcond
328         grazsd(ji,jj,jk)=grazsd(ji,jj,jk)*xcond
329C   
330C     Evolution of Diatoms Chlorophyll
331C     ------------------
332C
333         zneg = trn(ji,jj,jk,jpdch)
334     &     +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk)
335     &     -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk)
336C   
337C     Nullity test for diatoms
338C     ----------------------
339C
340         xcond=(0.5+sign(0.5,zneg))
341         tortdch(ji,jj,jk)=tortdch(ji,jj,jk)*xcond
342         respdch(ji,jj,jk)=respdch(ji,jj,jk)*xcond
343         grazdch(ji,jj,jk)=grazdch(ji,jj,jk)*xcond
344         grazsch(ji,jj,jk)=grazsch(ji,jj,jk)*xcond
345C
346C     Evolution of biogenic Iron in diatoms
347C     -------------------------------------
348C
349          zneg = trn(ji,jj,jk,jpdfe)
350     &     +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk)
351     &     -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk)
352C
353C     Nullity test for Biogenic Iron in diatoms
354C     -----------------------------------------
355C
356          xcond=(0.5+sign(0.5,zneg))
357          tortdf(ji,jj,jk)=tortdf(ji,jj,jk)*xcond
358          respdf(ji,jj,jk)=respdf(ji,jj,jk)*xcond
359          grazf(ji,jj,jk)=grazf(ji,jj,jk)*xcond
360          grazsf(ji,jj,jk)=grazsf(ji,jj,jk)*xcond
361C
362C     Evolution of biogenic Silica in diatoms
363C     ---------------------------------------
364C
365         zneg = trn(ji,jj,jk,jpbsi)
366     &     +prorca3(ji,jj,jk)*(1.-excret2)-tortds(ji,jj,jk)
367     &     -respds(ji,jj,jk)-grazs(ji,jj,jk)-grazss(ji,jj,jk)
368C
369C     Nullity test for Biogenic Silica in Diatoms
370C     -------------------------------------------
371C
372          xcond=(0.5+sign(0.5,zneg))
373          tortds(ji,jj,jk)=tortds(ji,jj,jk)*xcond
374          respds(ji,jj,jk)=respds(ji,jj,jk)*xcond
375          grazs(ji,jj,jk)=grazs(ji,jj,jk)*xcond
376          grazss(ji,jj,jk)=grazss(ji,jj,jk)*xcond
377          END DO
378        END DO
379      END DO
380
381      DO jk = 1,jpkm1
382        DO jj = 1,jpj
383          DO ji = 1,jpi
384C   
385C     Evolution of Zooplankton
386C     ------------------------
387C   
388         zneg = trn(ji,jj,jk,jpzoo)+epsher*
389     &     (grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk))
390     &     -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk)
391C   
392C     Nullity test for Zooplankton
393C     ----------------------------
394C   
395         xcond=(0.5+sign(0.5,zneg))
396         tortz(ji,jj,jk)=tortz(ji,jj,jk)*xcond
397         respz(ji,jj,jk)=respz(ji,jj,jk)*xcond
398         grazz(ji,jj,jk)=grazz(ji,jj,jk)*xcond
399C
400C     Evolution of Mesozooplankton
401C     ------------------------
402C
403         zneg = trn(ji,jj,jk,jpmes)
404     &     +epsher2*(grazd(ji,jj,jk)+grazn(ji,jj,jk)+grazz(ji,jj,jk)
405     &     +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk)
406     &     -respz2(ji,jj,jk)
407C
408C     Nullity test for Zooplankton
409C     ----------------------------
410C
411         xcond=(0.5+sign(0.5,zneg))
412         tortz2(ji,jj,jk)=tortz2(ji,jj,jk)*xcond
413         respz2(ji,jj,jk)=respz2(ji,jj,jk)*xcond
414          END DO
415        END DO
416      END DO
417
418      DO jk = 1,jpkm1
419        DO jj = 1,jpj
420          DO ji = 1,jpi
421C     
422C     Evolution of detritus
423C     ---------------------
424C     
425         zneg = trn(ji,jj,jk,jppoc)
426     &     -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)-grazm(ji,jj,jk)
427     &     +respz(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk)
428     &     +respp(ji,jj,jk)+tortp2(ji,jj,jk)+orem2(ji,jj,jk)
429     &     +tortz(ji,jj,jk)+tortp(ji,jj,jk)-orem(ji,jj,jk)
430     &     +(sinking(ji,jj,jk)-sinking(ji,jj,jk+1))
431     &     /fse3t(ji,jj,jk)
432C     
433C     Nullity test for POC
434C     --------------------
435C     
436         xcond=(0.5+sign(0.5,zneg))
437         grazm(ji,jj,jk)=grazm(ji,jj,jk)*xcond
438         sinking(ji,jj,jk+1)=sinking(ji,jj,jk+1)*xcond
439         orem(ji,jj,jk)=orem(ji,jj,jk)*xcond
440         xagg(ji,jj,jk)=xagg(ji,jj,jk)*xcond
441         grazpoc(ji,jj,jk)=grazpoc(ji,jj,jk)*xcond
442C   
443C     Evolution of detritus
444C     ---------------------
445C   
446         zneg = trn(ji,jj,jk,jpgoc)
447     &     +grapoc2(ji,jj,jk)+respp2(ji,jj,jk)+xagg(ji,jj,jk)
448     &     +tortz2(ji,jj,jk)+respz2(ji,jj,jk)-orem2(ji,jj,jk)
449     &     +xaggdoc2(ji,jj,jk)-grazffe(ji,jj,jk)
450     &     +(sinking2(ji,jj,jk)-sinking2(ji,jj,jk+1))
451     &     /fse3t(ji,jj,jk)
452C
453C     Nullity test on goc212
454C     ----------------------
455C
456         xcond=(0.5+sign(0.5,zneg))
457         sinking2(ji,jj,jk+1)=sinking2(ji,jj,jk+1)*xcond
458         orem2(ji,jj,jk)=orem2(ji,jj,jk)*xcond
459C
460C     Evolution of small biogenic Iron
461C     --------------------------
462C
463         zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)+rtrn)
464C
465         zneg = trn(ji,jj,jk,jpsfe)
466     &     +unass*(grazpf(ji,jj,jk)+grazsf(ji,jj,jk))
467     &     -grazpof(ji,jj,jk)-(1.-unass)*grazmf(ji,jj,jk)
468     &     +tortdf(ji,jj,jk)+respnf(ji,jj,jk)+tortnf(ji,jj,jk)
469     &     +ferat3*(tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk)
470     &     +ofer2(ji,jj,jk)-xaggfe(ji,jj,jk)
471     &     +xscave(ji,jj,jk)*zdenom1(ji,jj,jk)
472     &     +(sinkfer(ji,jj,jk)-sinkfer(ji,jj,jk+1))
473     &     /fse3t(ji,jj,jk)
474C
475C     Nullity test for biogenic iron
476C     --------------------
477C
478         xcond=(0.5+sign(0.5,zneg))
479         sinkfer(ji,jj,jk+1)=sinkfer(ji,jj,jk+1)*xcond
480         ofer(ji,jj,jk)=ofer(ji,jj,jk)*xcond
481         xaggfe(ji,jj,jk)=xaggfe(ji,jj,jk)*xcond
482         grazmf(ji,jj,jk)=grazmf(ji,jj,jk)*xcond
483C
484C     Evolution of big biogenic Iron
485C     --------------------------
486C
487         zneg = trn(ji,jj,jk,jpbfe)
488     &     +unass2*(graznf(ji,jj,jk)+grazf(ji,jj,jk)+grazfff(ji,jj,jk)
489     &     +grazpof(ji,jj,jk)+ferat3*grazz(ji,jj,jk))+ferat3*
490     &     (tortz2(ji,jj,jk)+respz2(ji,jj,jk))-ofer2(ji,jj,jk)
491     &     +respdf(ji,jj,jk)+xaggfe(ji,jj,jk)+xbactfer(ji,jj,jk)
492     &     -grazfff(ji,jj,jk)+xscave(ji,jj,jk)*zdenom2(ji,jj,jk)
493     &     +(sinkfer2(ji,jj,jk)-sinkfer2(ji,jj,jk+1))
494     &     /fse3t(ji,jj,jk)
495C
496C     Nullity test for biogenic iron
497C     --------------------
498C
499         xcond=(0.5+sign(0.5,zneg))
500         sinkfer2(ji,jj,jk+1)=sinkfer2(ji,jj,jk+1)*xcond
501         ofer2(ji,jj,jk)=ofer2(ji,jj,jk)*xcond
502         grazfff(ji,jj,jk)=grazfff(ji,jj,jk)*xcond
503C
504C     Evolution of sinking biogenic silica
505C     --------------------------
506C
507         zneg = trn(ji,jj,jk,jpdsi)
508     &     +tortds(ji,jj,jk)+grazss(ji,jj,jk)
509     &     +respds(ji,jj,jk)+grazs(ji,jj,jk)-osil(ji,jj,jk)
510     &     +(sinksil(ji,jj,jk)-sinksil(ji,jj,jk+1))
511     &     /fse3t(ji,jj,jk)
512C
513C     Nullity test for Biogenic Silica
514C     --------------------------------
515C
516          xcond=(0.5+sign(0.5,zneg))
517          sinksil(ji,jj,jk+1)=sinksil(ji,jj,jk+1)*xcond
518          osil(ji,jj,jk)=osil(ji,jj,jk)*xcond
519C     
520          END DO
521        END DO
522      END DO
523C
524C  Recompute the SMS related to zooplankton grazing
525C  ------------------------------------------------
526C
527      DO jk = 1,jpkm1
528        DO jj = 1,jpj
529          DO ji = 1,jpi
530         grarem(ji,jj,jk)=(grazp(ji,jj,jk)+grazm(ji,jj,jk)
531     &      +grazsd(ji,jj,jk))*(1.-epsher-unass)
532
533        grafer(ji,jj,jk)=(grazpf(ji,jj,jk)+grazsf(ji,jj,jk)
534     &      +grazmf(ji,jj,jk))*(1.-epsher-unass)
535     &      +(grazm(ji,jj,jk)*max((trn(ji,jj,jk,jpsfe)/
536     &      (trn(ji,jj,jk,jppoc)+rtrn)-ferat3),0.)
537     &      +grazp(ji,jj,jk)*max((trn(ji,jj,jk,jpnfe)/
538     &      (trn(ji,jj,jk,jpphy)+rtrn)-ferat3),0.)
539     &      +grazsd(ji,jj,jk)*max((trn(ji,jj,jk,jpdfe)/
540     &      (trn(ji,jj,jk,jpdia)+rtrn)-ferat3),0.))*epsher
541
542        grarem2(ji,jj,jk)=(grazd(ji,jj,jk)+grazz(ji,jj,jk)
543     &      +grazn(ji,jj,jk)+grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))
544     &      *(1.-epsher2-unass2)
545
546        grafer2(ji,jj,jk)=(grazf(ji,jj,jk)+graznf(ji,jj,jk)
547     &    +grazz(ji,jj,jk)*ferat3+grazpof(ji,jj,jk)
548     &    +grazfff(ji,jj,jk))*(1.-epsher2-unass2)
549     &    +epsher2*(grazd(ji,jj,jk)*max(
550     &    (trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn)
551     &    -ferat3),0.)+grazn(ji,jj,jk)*max(
552     &    (trn(ji,jj,jk,jpnfe)/(trn(ji,jj,jk,jpphy)+rtrn)
553     &    -ferat3),0.)+grazpoc(ji,jj,jk)*max(
554     &    (trn(ji,jj,jk,jpsfe)/(trn(ji,jj,jk,jppoc)+rtrn)
555     &    -ferat3),0.)+grazffe(ji,jj,jk)*max(
556     &    (trn(ji,jj,jk,jpbfe)/(trn(ji,jj,jk,jpgoc)+rtrn)
557     &    -ferat3),0.))
558
559        grapoc2(ji,jj,jk)=(grazd(ji,jj,jk)+grazz(ji,jj,jk)
560     &    +grazn(ji,jj,jk)+grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))*unass2
561
562        grapoc(ji,jj,jk)=(grazp(ji,jj,jk)+grazm(ji,jj,jk)
563     &      +grazsd(ji,jj,jk))*unass
564          END DO
565        END DO
566      END DO
567C     
568C     Determination of tracers concentration as a function of 
569C     biological sources and sinks
570C     --------------------------------------------------------
571C     
572      DO jk = 1,jpkm1
573        DO jj = 1,jpj
574          DO ji = 1,jpi
575C     
576C     Evolution of PO4
577C     ----------------
578C     
579          trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4)
580     &      -prorca(ji,jj,jk)-prorca2(ji,jj,jk)
581     &      +olimi(ji,jj,jk)+grarem(ji,jj,jk)*sigma1+denitr(ji,jj,jk)
582     &      +grarem2(ji,jj,jk)*sigma2+po4dep(ji,jj,jk)*rfact2
583C
584C     Evolution of NO3 and NH4
585C     ------------------------
586C
587          trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3)
588     &      -pronew(ji,jj,jk)-pronew2(ji,jj,jk)+onitr(ji,jj,jk)
589     &      -denitr(ji,jj,jk)*rdenit+po4dep(ji,jj,jk)*rfact2
590     &      +nitdep(ji,jj,jk)*rfact2
591
592          trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4)
593     &      -proreg(ji,jj,jk)-proreg2(ji,jj,jk)+olimi(ji,jj,jk)
594     &      +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2
595     &      -onitr(ji,jj,jk)+denitr(ji,jj,jk)
596
597          END DO
598        END DO
599      END DO
600
601      DO jk = 1,jpkm1
602        DO jj = 1,jpj
603          DO ji = 1,jpi
604
605C   
606C     Evolution of Phytoplankton
607C     --------------------------
608C     
609          trn(ji,jj,jk,jpphy) = trn(ji,jj,jk,jpphy)
610     &      +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk)
611     &      -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk)
612
613          trn(ji,jj,jk,jpnch) = trn(ji,jj,jk,jpnch)
614     &      +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk)
615     &      -grazpch(ji,jj,jk)-graznch(ji,jj,jk)-respnch(ji,jj,jk)
616C
617C     Evolution of Diatoms
618C     ------------------
619C
620          trn(ji,jj,jk,jpdia) = trn(ji,jj,jk,jpdia)
621     &      +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk)
622     &      -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk)
623
624          trn(ji,jj,jk,jpdch) = trn(ji,jj,jk,jpdch)
625     &      +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk)
626     &      -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk)
627          END DO
628        END DO
629      END DO
630
631      DO jk = 1,jpkm1
632        DO jj = 1,jpj
633          DO ji = 1,jpi
634C   
635C     Evolution of Zooplankton
636C     ------------------------
637C     
638          trn(ji,jj,jk,jpzoo) = trn(ji,jj,jk,jpzoo)
639     &      +epsher*(grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk))
640     &      -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk)
641C
642C     Evolution of Mesozooplankton
643C     ------------------------
644C
645          trn(ji,jj,jk,jpmes) = trn(ji,jj,jk,jpmes)
646     &      +epsher2*(grazd(ji,jj,jk)+grazz(ji,jj,jk)+grazn(ji,jj,jk)
647     &      +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk)
648     &      -respz2(ji,jj,jk)
649          END DO
650        END DO
651      END DO
652
653      DO jk = 1,jpkm1
654        DO jj = 1,jpj
655          DO ji = 1,jpi
656C   
657C     Evolution of DOC
658C     ----------------
659C     
660          trn(ji,jj,jk,jpdoc) = trn(ji,jj,jk,jpdoc)
661     &      +orem(ji,jj,jk)+excret2*prorca2(ji,jj,jk)
662     &      +excret*prorca(ji,jj,jk)-olimi(ji,jj,jk)-denitr(ji,jj,jk)
663     &      +grarem(ji,jj,jk)*(1.-sigma1)+grarem2(ji,jj,jk)
664     &      *(1.-sigma2)-xaggdoc(ji,jj,jk)-xaggdoc2(ji,jj,jk)
665          END DO
666        END DO
667      END DO
668
669      DO jk = 1,jpkm1
670        DO jj = 1,jpj
671          DO ji = 1,jpi
672C     
673C     Evolution of Detritus
674C     ---------------------
675C     
676          trn(ji,jj,jk,jppoc) = trn(ji,jj,jk,jppoc)
677     &      -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)+tortp2(ji,jj,jk)
678     &      -grazm(ji,jj,jk)+respp(ji,jj,jk)+tortz(ji,jj,jk)
679     &      +tortp(ji,jj,jk)+respz(ji,jj,jk)-orem(ji,jj,jk)
680     &      +orem2(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk)
681     &      +(sinking(ji,jj,jk)-sinking(ji,jj,jk+1))
682     &      /fse3t(ji,jj,jk)
683C   
684C     Evolution of rapid Detritus
685C     ---------------------
686C   
687          trn(ji,jj,jk,jpgoc) = trn(ji,jj,jk,jpgoc)
688     &      +grapoc2(ji,jj,jk)+respp2(ji,jj,jk)+xagg(ji,jj,jk)
689     &      +tortz2(ji,jj,jk)+respz2(ji,jj,jk)-orem2(ji,jj,jk)
690     &      -grazffe(ji,jj,jk)+xaggdoc2(ji,jj,jk)
691     &      +(sinking2(ji,jj,jk)-sinking2(ji,jj,jk+1))
692     &      /fse3t(ji,jj,jk)
693          END DO
694        END DO
695      END DO
696
697      DO jk = 1,jpkm1
698        DO jj = 1,jpj
699          DO ji = 1,jpi
700C   
701C     Evolution of O2
702C     ---------------
703C     
704         xcond=(0.5+sign(0.5,(trn(ji,jj,jk,jpoxy)-oxymin)))
705         trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy)
706     &     +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk)-olimi(ji,jj,jk)
707     &     -xcond*(grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2))
708     &     +(o2ut+o2nit)*( pronew(ji,jj,jk)+pronew2(ji,jj,jk))
709     &     -o2nit*onitr(ji,jj,jk)
710C
711          END DO
712        END DO
713      END DO
714
715      DO jk = 1,jpkm1
716        DO jj = 1,jpj
717          DO ji = 1,jpi
718C
719C     Evolution of IRON
720C     -----------------
721C
722          trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer)
723     &      +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk)
724     &      +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk)
725     &      +grafer(ji,jj,jk)+grafer2(ji,jj,jk)
726     &      +ofer(ji,jj,jk)-xscave(ji,jj,jk)+irondep(ji,jj,jk)
727     &      +(ironsed(ji,jj,jk)+po4dep(ji,jj,jk)*9E-5)*rfact2
728          END DO
729        END DO
730      END DO
731
732      DO jk = 1,jpkm1
733        DO jj = 1,jpj
734          DO ji = 1,jpi
735C
736C     Evolution of small biogenic Iron
737C     --------------------------
738C
739          zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)+rtrn)
740C
741          trn(ji,jj,jk,jpsfe) = trn(ji,jj,jk,jpsfe)
742     &     +unass*(grazpf(ji,jj,jk)+grazsf(ji,jj,jk))
743     &     -grazpof(ji,jj,jk)-(1.-unass)*grazmf(ji,jj,jk)
744     &     +tortdf(ji,jj,jk)+respnf(ji,jj,jk)+tortnf(ji,jj,jk)
745     &     +ferat3*(tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk)
746     &     +ofer2(ji,jj,jk)-xaggfe(ji,jj,jk)
747     &     +xscave(ji,jj,jk)*zdenom1(ji,jj,jk)
748     &     +(sinkfer(ji,jj,jk)-sinkfer(ji,jj,jk+1))
749     &     /fse3t(ji,jj,jk)
750C
751C     Evolution of big biogenic Iron
752C     --------------------------
753C
754          trn(ji,jj,jk,jpbfe) = trn(ji,jj,jk,jpbfe)
755     &     +unass2*(graznf(ji,jj,jk)+grazf(ji,jj,jk)+grazfff(ji,jj,jk)
756     &     +grazpof(ji,jj,jk)+grazz(ji,jj,jk)*ferat3)+ferat3*
757     &     (tortz2(ji,jj,jk)+respz2(ji,jj,jk))-ofer2(ji,jj,jk)
758     &     +respdf(ji,jj,jk)+xaggfe(ji,jj,jk)+xbactfer(ji,jj,jk)
759     &     -grazfff(ji,jj,jk)+xscave(ji,jj,jk)*zdenom2(ji,jj,jk)
760     &     +(sinkfer2(ji,jj,jk)-sinkfer2(ji,jj,jk+1))
761     &     /fse3t(ji,jj,jk)
762          END DO
763        END DO
764      END DO
765
766      DO jk = 1,jpkm1
767        DO jj = 1,jpj
768          DO ji = 1,jpi
769C
770C     Evolution of biogenic Silica
771C     ----------------------------
772C
773          trn(ji,jj,jk,jpbsi) = trn(ji,jj,jk,jpbsi)
774     &      +prorca3(ji,jj,jk)*(1.-excret2)-grazss(ji,jj,jk)
775     &      -tortds(ji,jj,jk)-respds(ji,jj,jk)-grazs(ji,jj,jk)
776C
777          silpro(ji,jj,jk)=
778     &      tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk)
779     &      +grazss(ji,jj,jk)
780C
781          END DO
782        END DO
783      END DO
784
785      DO jk = 1,jpkm1
786        DO jj = 1,jpj
787          DO ji = 1,jpi
788C
789C     Evolution of sinking biogenic silica
790C     ------------------------------------
791C
792          trn(ji,jj,jk,jpdsi)=trn(ji,jj,jk,jpdsi)
793     &      +tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk)
794     &      -osil(ji,jj,jk)+grazss(ji,jj,jk)
795     &      +(sinksil(ji,jj,jk)-sinksil(ji,jj,jk+1))
796     &      /fse3t(ji,jj,jk)
797C
798          END DO
799        END DO
800      END DO
801
802      DO jk = 1,jpkm1
803        DO jj = 1,jpj
804          DO ji = 1,jpi
805C
806C     Evolution of biogenic diatom Iron
807C     ---------------------------------
808C
809          trn(ji,jj,jk,jpdfe) = trn(ji,jj,jk,jpdfe)
810     &      +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk)
811     &      -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk)
812C
813C     Evolution of biogenic nanophytoplankton Iron
814C     --------------------------------------------
815C
816          trn(ji,jj,jk,jpnfe) = trn(ji,jj,jk,jpnfe)
817     &      +prorca5(ji,jj,jk)*(1.-excret)-graznf(ji,jj,jk)
818     &      -tortnf(ji,jj,jk)-respnf(ji,jj,jk)-grazpf(ji,jj,jk)
819C
820C     Evolution of dissolved Silica
821C     -----------------------------
822C
823          trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil)
824     &      -(1.-excret2)*prorca3(ji,jj,jk)+osil(ji,jj,jk)
825     &      +sidep(ji,jj,jk)+cotdep(ji,jj,jk)*rfact2/6.
826C
827          END DO
828        END DO
829      END DO
830C     
831C     Evolution of calcite and silicates as a function of the two tracers
832C     -------------------------------------------------------------------
833C     
834      DO  jk = 1,jpkm1
835        DO  jj = 1,jpj
836          DO  ji = 1,jpi
837C
838          prodt = prorca(ji,jj,jk)+prorca2(ji,jj,jk)
839     &      -olimi(ji,jj,jk)-grarem(ji,jj,jk)*sigma1
840     &      -grarem2(ji,jj,jk)*sigma2-denitr(ji,jj,jk)
841
842          prodca = pronew(ji,jj,jk)+pronew2(ji,jj,jk)
843     &      -onitr(ji,jj,jk)+rdenit*denitr(ji,jj,jk)
844     &      -po4dep(ji,jj,jk)*rfact2-nitdep(ji,jj,jk)*rfact2
845C     
846C     potential production of calcite and biogenic silicate
847C     ------------------------------------------------------
848C     
849          prcaca(ji,jj,jk)=caco3r*(0.5*(unass*grazp(ji,jj,jk)+
850     &      unass2*grazn(ji,jj,jk))+tortp(ji,jj,jk)+respp(ji,jj,jk))
851     &      *xlimphy(ji,jj,jk)*xlimphy(ji,jj,jk)
852C     
853C     Consumption of Total (12C)O2
854C     ----------------------------
855C     
856          trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic)
857     &      -prodt-prcaca(ji,jj,jk)+po4dep(ji,jj,jk)*rfact2*2.633
858C     
859C     Consumption of alkalinity due to ca++ uptake and increase 
860C     of alkalinity due to nitrate consumption during organic 
861C     soft tissue production
862C     ---------------------------------------------------------
863C     
864          trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal)
865     &      +rno3*prodca-2.*prcaca(ji,jj,jk)
866     &      +cotdep(ji,jj,jk)*rfact2
867          END DO
868        END DO
869      END DO
870C
871      DO  jk = 1,jpkm1
872        DO  jj = 1,jpj
873          DO  ji = 1,jpi
874C
875C     Production of calcite due to biological production
876C     --------------------------------------------------
877C     
878           trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal)
879     &        +prcaca(ji,jj,jk)+(sinkcal(ji,jj,jk)-
880     &         sinkcal(ji,jj,jk+1))/fse3t(ji,jj,jk)
881          END DO
882        END DO
883      ENDDO
884C
885#    if defined key_trc_diaadd
886       DO jj=1,jpj
887         DO ji=1,jpi
888          trc2d(ji,jj,12) = irondep(ji,jj,1)*1e3*rfact2r
889     &       *fse3t(ji,jj,1)
890         END DO
891       END DO
892#    endif
893C
894#    if defined key_trc_dia3d
895          trc3d(:,:,:,4)=etot(:,:,:)
896          trc3d(:,:,:,5)=prorca(:,:,:)*1e3*rfact2r
897          trc3d(:,:,:,6)=prorca2(:,:,:)*1e3*rfact2r
898          trc3d(:,:,:,7)=pronew(:,:,:)*1e3*rfact2r
899          trc3d(:,:,:,8)=pronew2(:,:,:)*1e3*rfact2r
900          trc3d(:,:,:,9)=prorca3(:,:,:)*1e3*rfact2r
901          trc3d(:,:,:,10)=prorca4(:,:,:)*1e3*rfact2r
902          trc3d(:,:,:,11)=prorca5(:,:,:)*1e3*rfact2r
903#    endif
904C     
905#endif
906C   
907 
908      RETURN
909      END
910
911
912
Note: See TracBrowser for help on using the repository browser.