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

Last change on this file since 719 was 719, checked in by ctlod, 17 years ago

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