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

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

nemo_v1_update_027 : CE + RB + CT : update of SMS routines

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