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

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

nemo_v1_update_028 : CT : add missing headers

  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 14.1 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
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
36#include "domzgr_substitute.h90"
37CDIR$ LIST
38CC-----------------------------------------------------------------
39CC local declarations
40CC ==================
41C     
42      INTEGER ji, jj, jk, jn
43
44      REAL zdenom,zdenom1(jpi,jpj,jpk),zdenom2(jpi,jpj,jpk)
45      REAL prodca,ztemp
46C     
47      REAL prodt
48      REAL zfracal(jpi,jpj,jpk)
49C
50C     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION
51C     OF PHYTOPLANKTON AND DETRITUS
52C
53      zdiss=0.01
54C
55      DO jk=1,jpkm1
56        DO jj=1,jpj
57          DO ji=1,jpi
58       if (fsdepw(ji,jj,jk+1).le.hmld(ji,jj)) zdiss(ji,jj,jk)=1.
59          END DO
60        END DO
61      END DO
62C
63C      Compute de different ratios for scavenging of iron
64C      --------------------------------------------------
65C
66       DO jk=1,jpk
67         DO jj=1,jpj
68           DO ji=1,jpi
69         zdenom=1./(trn(ji,jj,jk,jppoc)+trn(ji,jj,jk,jpgoc)
70     $     +trn(ji,jj,jk,jpdsi)+trn(ji,jj,jk,jpcal)+rtrn)
71C
72         zdenom1(ji,jj,jk)=trn(ji,jj,jk,jppoc)*zdenom
73         zdenom2(ji,jj,jk)=trn(ji,jj,jk,jpgoc)*zdenom
74           END DO
75         END DO
76       END DO
77C
78C     Compute the fraction of nanophytoplankton that is made
79C     of calcifiers
80C     ------------------------------------------------------
81C
82       DO jk=1,jpkm1
83         DO jj=1,jpj
84           DO ji=1,jpi
85       ztemp=max(0.,tn(ji,jj,jk))
86       zfracal(ji,jj,jk)=caco3r*xlimphy(ji,jj,jk)*max(0.0001
87     &   ,ztemp/(2.+ztemp))*max(1.,trn(ji,jj,jk,jpphy)*1E6/2.)
88       zfracal(ji,jj,jk)=min(0.8,zfracal(ji,jj,jk))
89       zfracal(ji,jj,jk)=max(0.01,zfracal(ji,jj,jk))
90           END DO
91         END DO
92       END DO
93
94C
95C  Call optical routine to compute the PAR in the water column
96C  -----------------------------------------------------------
97C
98      CALL p4zopt
99C
100C  Call routine to compute the co-limitations by the various
101C  nutrients
102C  ---------------------------------------------------------
103C
104      CALL p4zlim
105C
106C  Call production routine to compute phytoplankton growth rate
107C  over the global ocean. Growth rates for each element is 
108C  computed (C, Si, Fe, Chl)
109C  ------------------------------------------------------------
110C
111      CALL p4zprod
112C
113C  Call phytoplankton mortality routines. Mortality losses for 
114C  Each elements are computed (C, Fe, Si, Chl)
115C  -----------------------------------------------------------
116C
117      CALL p4znano
118      CALL p4zdiat
119C
120C  Call zooplankton sources/sinks routines. 
121C  Each elements are computed (C, Fe, Si, Chl)
122C  -----------------------------------------------------------
123C
124      CALL p4zmicro
125      CALL p4zmeso
126C
127C     Call subroutine for computation of the vertical flux 
128C     of particulate organic matter
129C     ----------------------------------------------------
130C
131      CALL p4zsink
132C
133C     Call subroutine for computation of remineralization
134C     terms of organic matter+scavenging of Fe
135C     ----------------------------------------------------
136      CALL p4zrem
137C     
138C     Determination of tracers concentration as a function of 
139C     biological sources and sinks
140C     --------------------------------------------------------
141C     
142      DO jk = 1,jpkm1
143        DO jj = 1,jpj
144          DO ji = 1,jpi
145C     
146C     Evolution of PO4
147C     ----------------
148C     
149          trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4)
150     &      -prorca(ji,jj,jk)-prorca2(ji,jj,jk)
151     &      +olimi(ji,jj,jk)+grarem(ji,jj,jk)*sigma1+denitr(ji,jj,jk)
152     &      +grarem2(ji,jj,jk)*sigma2
153C
154C     Evolution of NO3 and NH4
155C     ------------------------
156C
157          trn(ji,jj,jk,jpno3) = trn(ji,jj,jk,jpno3)
158     &      -pronew(ji,jj,jk)-pronew2(ji,jj,jk)+onitr(ji,jj,jk)
159     &      -denitr(ji,jj,jk)*rdenit
160
161          trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4)
162     &      -proreg(ji,jj,jk)-proreg2(ji,jj,jk)+olimi(ji,jj,jk)
163     &      +grarem(ji,jj,jk)*sigma1+grarem2(ji,jj,jk)*sigma2
164     &      -onitr(ji,jj,jk)+denitr(ji,jj,jk)
165
166          END DO
167        END DO
168      END DO
169
170      DO jk = 1,jpkm1
171        DO jj = 1,jpj
172          DO ji = 1,jpi
173
174C   
175C     Evolution of Phytoplankton
176C     --------------------------
177C     
178          trn(ji,jj,jk,jpphy) = trn(ji,jj,jk,jpphy)
179     &      +prorca(ji,jj,jk)*(1.-excret)-tortp(ji,jj,jk)
180     &      -grazp(ji,jj,jk)-grazn(ji,jj,jk)-respp(ji,jj,jk)
181
182          trn(ji,jj,jk,jpnch) = trn(ji,jj,jk,jpnch)
183     &      +prorca6(ji,jj,jk)*(1.-excret)-tortnch(ji,jj,jk)
184     &      -grazpch(ji,jj,jk)-graznch(ji,jj,jk)-respnch(ji,jj,jk)
185C
186C     Evolution of Diatoms
187C     ------------------
188C
189          trn(ji,jj,jk,jpdia) = trn(ji,jj,jk,jpdia)
190     &      +prorca2(ji,jj,jk)*(1.-excret2)-tortp2(ji,jj,jk)
191     &      -respp2(ji,jj,jk)-grazd(ji,jj,jk)-grazsd(ji,jj,jk)
192
193          trn(ji,jj,jk,jpdch) = trn(ji,jj,jk,jpdch)
194     &      +prorca7(ji,jj,jk)*(1.-excret2)-tortdch(ji,jj,jk)
195     &      -respdch(ji,jj,jk)-grazdch(ji,jj,jk)-grazsch(ji,jj,jk)
196          END DO
197        END DO
198      END DO
199
200      DO jk = 1,jpkm1
201        DO jj = 1,jpj
202          DO ji = 1,jpi
203C   
204C     Evolution of Zooplankton
205C     ------------------------
206C     
207          trn(ji,jj,jk,jpzoo) = trn(ji,jj,jk,jpzoo)
208     &      +epsher*(grazp(ji,jj,jk)+grazm(ji,jj,jk)+grazsd(ji,jj,jk))
209     &      -grazz(ji,jj,jk)-tortz(ji,jj,jk)-respz(ji,jj,jk)
210C
211C     Evolution of Mesozooplankton
212C     ------------------------
213C
214          trn(ji,jj,jk,jpmes) = trn(ji,jj,jk,jpmes)
215     &      +epsher2*(grazd(ji,jj,jk)+grazz(ji,jj,jk)+grazn(ji,jj,jk)
216     &      +grazpoc(ji,jj,jk)+grazffe(ji,jj,jk))-tortz2(ji,jj,jk)
217     &      -respz2(ji,jj,jk)
218          END DO
219        END DO
220      END DO
221
222      DO jk = 1,jpkm1
223        DO jj = 1,jpj
224          DO ji = 1,jpi
225C   
226C     Evolution of DOC
227C     ----------------
228C     
229          trn(ji,jj,jk,jpdoc) = trn(ji,jj,jk,jpdoc)
230     &      +orem(ji,jj,jk)+excret2*prorca2(ji,jj,jk)
231     &      +excret*prorca(ji,jj,jk)-olimi(ji,jj,jk)-denitr(ji,jj,jk)
232     &      +grarem(ji,jj,jk)*(1.-sigma1)+grarem2(ji,jj,jk)
233     &      *(1.-sigma2)-xaggdoc(ji,jj,jk)-xaggdoc2(ji,jj,jk)
234          END DO
235        END DO
236      END DO
237
238      DO jk = 1,jpkm1
239        DO jj = 1,jpj
240          DO ji = 1,jpi
241C     
242C     Evolution of Detritus
243C     ---------------------
244C     
245          trn(ji,jj,jk,jppoc) = trn(ji,jj,jk,jppoc)
246     &     -grazpoc(ji,jj,jk)+grapoc(ji,jj,jk)-grazm(ji,jj,jk)
247     &     +respz(ji,jj,jk)-xagg(ji,jj,jk)+xaggdoc(ji,jj,jk)
248     &     +(1.-0.5*zfracal(ji,jj,jk))*(tortp(ji,jj,jk)
249     &     +respp(ji,jj,jk))+0.5*tortp2(ji,jj,jk)
250     &     +orem2(ji,jj,jk)+tortz(ji,jj,jk)-orem(ji,jj,jk)
251C   
252C     Evolution of rapid Detritus
253C     ---------------------
254C   
255          trn(ji,jj,jk,jpgoc) = trn(ji,jj,jk,jpgoc)
256     &     +grapoc2(ji,jj,jk)+respp2(ji,jj,jk)+xagg(ji,jj,jk)
257     &     +tortz2(ji,jj,jk)+respz2(ji,jj,jk)-orem2(ji,jj,jk)
258     &     +0.5*zfracal(ji,jj,jk)*(respp(ji,jj,jk)+tortp(ji,jj,jk))
259     &     +0.5*tortp2(ji,jj,jk)+xaggdoc2(ji,jj,jk)-grazffe(ji,jj,jk)
260C
261          END DO
262        END DO
263      END DO
264
265      DO jk = 1,jpkm1
266        DO jj = 1,jpj
267          DO ji = 1,jpi
268C   
269C     Evolution of O2
270C     ---------------
271C     
272         trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy)
273     &     +o2ut*(proreg(ji,jj,jk)+proreg2(ji,jj,jk)-olimi(ji,jj,jk)
274     &     -grarem(ji,jj,jk)*sigma1-grarem2(ji,jj,jk)*sigma2)
275     &     +(o2ut+o2nit)*( pronew(ji,jj,jk)+pronew2(ji,jj,jk))
276     &     -o2nit*onitr(ji,jj,jk)
277C
278          END DO
279        END DO
280      END DO
281 
282
283      DO jk = 1,jpkm1
284        DO jj = 1,jpj
285          DO ji = 1,jpi
286C
287C     Evolution of IRON
288C     -----------------
289C
290          trn(ji,jj,jk,jpfer) = trn(ji,jj,jk,jpfer)
291     &      +(excret-1.)*prorca5(ji,jj,jk)-xaggdfe(ji,jj,jk)
292     &      +(excret2-1.)*prorca4(ji,jj,jk)-xbactfer(ji,jj,jk)
293     &      +grafer(ji,jj,jk)+grafer2(ji,jj,jk)
294     &      +ofer(ji,jj,jk)-xscave(ji,jj,jk)
295C
296          END DO
297        END DO
298      END DO
299
300      DO jk = 1,jpkm1
301        DO jj = 1,jpj
302          DO ji = 1,jpi
303C
304C     Evolution of small biogenic Iron
305C     --------------------------
306C
307          trn(ji,jj,jk,jpsfe) = trn(ji,jj,jk,jpsfe)
308     &     +unass*(grazpf(ji,jj,jk)+grazsf(ji,jj,jk))
309     &     -grazpof(ji,jj,jk)-(1.-unass)*grazmf(ji,jj,jk)
310     &     +(1.-0.5*zfracal(ji,jj,jk))*(tortnf(ji,jj,jk)
311     &     +respnf(ji,jj,jk))+0.5*tortdf(ji,jj,jk)+ferat3*
312     &     (tortz(ji,jj,jk)+respz(ji,jj,jk))-ofer(ji,jj,jk)
313     &     +ofer2(ji,jj,jk)-xaggfe(ji,jj,jk)
314     &     +xscave(ji,jj,jk)*zdenom1(ji,jj,jk)
315C
316C     Evolution of big biogenic Iron
317C     --------------------------
318C
319          trn(ji,jj,jk,jpbfe) = trn(ji,jj,jk,jpbfe)
320     &     +unass2*(graznf(ji,jj,jk)+grazf(ji,jj,jk)+grazfff(ji,jj,jk)
321     &     +grazpof(ji,jj,jk)+ferat3*grazz(ji,jj,jk))+ferat3*
322     &     (tortz2(ji,jj,jk)+respz2(ji,jj,jk))-ofer2(ji,jj,jk)
323     &     +0.5*zfracal(ji,jj,jk)*(respnf(ji,jj,jk)+tortnf(ji,jj,jk))
324     &     +0.5*tortdf(ji,jj,jk)+respdf(ji,jj,jk)+xaggfe(ji,jj,jk)
325     &     +xbactfer(ji,jj,jk)-grazfff(ji,jj,jk)+xscave(ji,jj,jk)
326     &     *zdenom2(ji,jj,jk)
327          END DO
328        END DO
329      END DO
330
331      DO jk = 1,jpkm1
332        DO jj = 1,jpj
333          DO ji = 1,jpi
334C
335C     Evolution of biogenic Silica
336C     ----------------------------
337C
338          trn(ji,jj,jk,jpbsi) = trn(ji,jj,jk,jpbsi)
339     &      +prorca3(ji,jj,jk)*(1.-excret2)-grazss(ji,jj,jk)
340     &      -tortds(ji,jj,jk)-respds(ji,jj,jk)-grazs(ji,jj,jk)
341C
342          END DO
343        END DO
344      END DO
345
346      DO jk = 1,jpkm1
347        DO jj = 1,jpj
348          DO ji = 1,jpi
349C
350C     Evolution of sinking biogenic silica
351C     ------------------------------------
352C
353          trn(ji,jj,jk,jpdsi)=trn(ji,jj,jk,jpdsi)
354     &      +tortds(ji,jj,jk)+respds(ji,jj,jk)+grazs(ji,jj,jk)
355     &      -osil(ji,jj,jk)+grazss(ji,jj,jk)
356C
357          END DO
358        END DO
359      END DO
360
361      DO jk = 1,jpkm1
362        DO jj = 1,jpj
363          DO ji = 1,jpi
364C
365C     Evolution of biogenic diatom Iron
366C     ---------------------------------
367C
368          trn(ji,jj,jk,jpdfe) = trn(ji,jj,jk,jpdfe)
369     &      +prorca4(ji,jj,jk)*(1.-excret2)-grazsf(ji,jj,jk)
370     &      -tortdf(ji,jj,jk)-respdf(ji,jj,jk)-grazf(ji,jj,jk)
371C
372C     Evolution of biogenic nanophytoplankton Iron
373C     --------------------------------------------
374C
375          trn(ji,jj,jk,jpnfe) = trn(ji,jj,jk,jpnfe)
376     &      +prorca5(ji,jj,jk)*(1.-excret)-graznf(ji,jj,jk)
377     &      -tortnf(ji,jj,jk)-respnf(ji,jj,jk)-grazpf(ji,jj,jk)
378C
379C     Evolution of dissolved Silica
380C     -----------------------------
381C
382          trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil)
383     &      -(1.-excret2)*prorca3(ji,jj,jk)+osil(ji,jj,jk)
384C
385          END DO
386        END DO
387      END DO
388C     
389C     Evolution of calcite and silicates as a function of the two tracers
390C     -------------------------------------------------------------------
391C     
392      DO  jk = 1,jpkm1
393        DO  jj = 1,jpj
394          DO  ji = 1,jpi
395C
396          prodt = prorca(ji,jj,jk)+prorca2(ji,jj,jk)
397     &      -olimi(ji,jj,jk)-grarem(ji,jj,jk)*sigma1
398     &      -grarem2(ji,jj,jk)*sigma2-denitr(ji,jj,jk)
399
400          prodca = pronew(ji,jj,jk)+pronew2(ji,jj,jk)
401     &      -onitr(ji,jj,jk)+rdenit*denitr(ji,jj,jk)
402C     
403C     potential production of calcite and biogenic silicate
404C     ------------------------------------------------------
405C     
406          prcaca(ji,jj,jk)=
407     &      zfracal(ji,jj,jk)*(0.5*(unass*grazp(ji,jj,jk)+
408     &      unass2*grazn(ji,jj,jk))+tortp(ji,jj,jk)+respp(ji,jj,jk))
409C     
410C     Consumption of Total (12C)O2
411C     ----------------------------
412C     
413          trn(ji,jj,jk,jpdic) = trn(ji,jj,jk,jpdic)
414     &      -prodt-prcaca(ji,jj,jk)
415C     
416C     Consumption of alkalinity due to ca++ uptake and increase 
417C     of alkalinity due to nitrate consumption during organic 
418C     soft tissue production
419C     ---------------------------------------------------------
420C     
421          trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal)
422     &      +rno3*prodca-2.*prcaca(ji,jj,jk)
423          END DO
424        END DO
425      END DO
426C
427      DO  jk = 1,jpkm1
428        DO  jj = 1,jpj
429          DO  ji = 1,jpi
430C
431C     Production of calcite due to biological production
432C     --------------------------------------------------
433C     
434           trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal)
435     &        +prcaca(ji,jj,jk)
436          END DO
437        END DO
438      ENDDO
439C
440C
441C     Loop to test if tracers concentrations fall below 0.
442C     ----------------------------------------------------
443C
444C
445      znegtr(:,:,:) = 1.
446C
447      DO jn = 1,jptra
448        DO jk = 1,jpk
449          DO jj = 1,jpj
450            DO ji = 1,jpi
451              if (trn(ji,jj,jk,jn).lt.0.) then
452               znegtr(ji,jj,jk)=0.
453              endif
454            END DO
455          END DO
456        END DO
457      END DO
458C
459      DO jn = 1,jptra
460         trn(:,:,:,jn) = trb(:,:,:,jn)+
461     &     znegtr(:,:,:)*(trn(:,:,:,jn)-trb(:,:,:,jn))
462      END DO
463C
464#    if defined key_trc_dia3d
465          trc3d(:,:,:,4)=etot(:,:,:)
466          trc3d(:,:,:,5)=prorca(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
467          trc3d(:,:,:,6)=prorca2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
468          trc3d(:,:,:,7)=pronew(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
469          trc3d(:,:,:,8)=pronew2(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
470          trc3d(:,:,:,9)=prorca3(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
471          trc3d(:,:,:,10)=prorca4(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
472          trc3d(:,:,:,11)=prorca5(:,:,:)*znegtr(:,:,:)*1e3*rfact2r
473#    endif
474C     
475#endif
476C     
477      RETURN
478      END
Note: See TracBrowser for help on using the repository browser.