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

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

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