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 @ 186

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

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