source: branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_3dnitbal/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90 @ 11990

Last change on this file since 11990 was 11990, checked in by dford, 8 months ago

Get the nitrogen balancing working with 3D chlorophyll increments.

File size: 11.6 KB
Line 
1MODULE plankton_mod
2   !!======================================================================
3   !!                         ***  MODULE plankton_mod  ***
4   !! Calculate the carbon chemistry for the whole ocean
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   plankton        ! Called in trcbio_medusa.F90
18
19   !!----------------------------------------------------------------------
20   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
21   !! $Id$
22   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
23   !!----------------------------------------------------------------------
24
25CONTAINS
26
27   SUBROUTINE plankton( jk )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE plankton  ***
30      !! This called from TRC_BIO_MEDUSA and
31      !!  - Calculates phytoplankton growth
32      !!  - Zooplankton grazing
33      !!  - Plankton losses
34      !!-------------------------------------------------------------------
35      USE bio_medusa_mod,    ONLY: fdpd, fdpd2, fdpds, fdpds2,             &
36                                   fdpn, fdpn2, fdzme, fdzme2,             &
37                                   fdzmi, fdzmi2, fsdiss, fsin,            &
38# if defined key_foam_medusa
39                                   fdep1, fprn, fprd,                      &
40                                   fgmepd, fgmepn, fgmipn,                 &
41# endif
42                                   zphd, zphn, zpds, zzme, zzmi
43# if defined key_foam_medusa
44      USE dom_oce,           ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask
45      USE par_kind,          ONLY: wp
46# else
47      USE dom_oce,           ONLY: tmask
48# endif
49      USE par_oce,           ONLY: jpim1, jpjm1
50      USE phytoplankton_mod, ONLY: phytoplankton
51      USE sms_medusa,        ONLY: jmpd, jmpn, jmzme, jmzmi,               &
52# if defined key_foam_medusa
53                                   pgrow_avg, ploss_avg, phyt_avg,         &
54                                   pgrow_avg_3d, ploss_avg_3d, phyt_avg_3d, &
55# endif
56                                   xkphd, xkphn, xkzme, xkzmi,             &
57                                   xmetapd, xmetapn, xmetazme, xmetazmi,   &
58                                   xmpd, xmpn, xmzme, xmzmi, xsdiss
59# if defined key_foam_medusa
60      USE zdfmxl,            ONLY: hmld
61# endif
62      USE zooplankton_mod,   ONLY: zooplankton
63
64# if defined key_foam_medusa
65   !!* Substitution
66#  include "domzgr_substitute.h90"
67# endif
68
69      !! Level
70      INTEGER, INTENT( in ) :: jk
71
72      INTEGER :: ji, jj
73
74# if defined key_foam_medusa
75      REAL(wp) :: fq0
76# endif
77
78      !!-------------------------------------------------------------------
79      !! Calculate phytoplankton growth
80      !!-------------------------------------------------------------------
81      CALL phytoplankton( jk )
82
83      !!-------------------------------------------------------------------
84      !! Calculate zooplankton grazing
85      !!-------------------------------------------------------------------
86      CALL zooplankton( jk )
87
88      !!-------------------------------------------------------------------
89      !! Miscellaneous plankton losses
90      !!-------------------------------------------------------------------
91      DO jj = 2,jpjm1
92         DO ji = 2,jpim1
93            !! OPEN wet point IF..THEN loop
94            if (tmask(ji,jj,jk) == 1) then
95               !!----------------------------------------------------------
96               !! Plankton metabolic losses
97               !! Linear loss processes assumed to be metabolic in origin
98               !!----------------------------------------------------------
99               !!
100               fdpn2(ji,jj)  = xmetapn  * zphn(ji,jj)
101               fdpd2(ji,jj)  = xmetapd  * zphd(ji,jj)
102               fdpds2(ji,jj) = xmetapd  * zpds(ji,jj)
103               fdzmi2(ji,jj) = xmetazmi * zzmi(ji,jj)
104               fdzme2(ji,jj) = xmetazme * zzme(ji,jj)
105            ENDIF
106         ENDDO
107      ENDDO
108
109      DO jj = 2,jpjm1
110         DO ji = 2,jpim1
111            if (tmask(ji,jj,jk) == 1) then
112               !!----------------------------------------------------------
113               !! Plankton mortality losses
114               !! EKP (26/02/09): phytoplankton hyperbolic mortality term
115               !! introduced
116               !! to improve performance in gyres
117               !!----------------------------------------------------------
118               !!
119               !! non-diatom phytoplankton
120               !! linear
121               if (jmpn.eq.1) fdpn(ji,jj) = xmpn * zphn(ji,jj)
122               !! quadratic
123               if (jmpn.eq.2) fdpn(ji,jj) = xmpn * zphn(ji,jj) * zphn(ji,jj)
124               !! hyperbolic
125               if (jmpn.eq.3) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
126                                            (zphn(ji,jj) /                   &
127                                             (xkphn + zphn(ji,jj)))
128               !! sigmoid
129               if (jmpn.eq.4) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
130                                            ((zphn(ji,jj) * zphn(ji,jj)) /   &
131                                             (xkphn + (zphn(ji,jj) *         &
132                                                       zphn(ji,jj))))
133            ENDIF
134         ENDDO
135      ENDDO
136
137      DO jj = 2,jpjm1
138         DO ji = 2,jpim1
139            if (tmask(ji,jj,jk) == 1) then
140               !!
141               !! diatom phytoplankton
142               !! linear
143               if (jmpd.eq.1) fdpd(ji,jj) = xmpd * zphd(ji,jj)
144               !! quadratic
145               if (jmpd.eq.2) fdpd(ji,jj) = xmpd * zphd(ji,jj) * zphd(ji,jj)
146               !! hyperbolic
147               if (jmpd.eq.3) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
148                                            (zphd(ji,jj) / (xkphd +          &
149                                                            zphd(ji,jj)))
150               !! sigmoid
151               if (jmpd.eq.4) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
152                                            ((zphd(ji,jj) * zphd(ji,jj)) /   &
153                                             (xkphd + (zphd(ji,jj) *         &
154                                                       zphd(ji,jj))))
155               fdpds(ji,jj) = fdpd(ji,jj) * fsin(ji,jj)
156            ENDIF
157         ENDDO
158      ENDDO
159
160      DO jj = 2,jpjm1
161         DO ji = 2,jpim1
162            if (tmask(ji,jj,jk) == 1) then
163               !!
164               !! microzooplankton
165               !! linear
166               if (jmzmi.eq.1) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj)
167               !! quadratic
168               if (jmzmi.eq.2) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
169                                              zzmi(ji,jj)
170               !! hyperbolic
171               if (jmzmi.eq.3) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
172                                              (zzmi(ji,jj) / (xkzmi +        &
173                                                              zzmi(ji,jj)))
174               !! sigmoid
175               if (jmzmi.eq.4) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) * &
176                  ((zzmi(ji,jj) * zzmi(ji,jj)) / (xkzmi + (zzmi(ji,jj) *     &
177                                                           zzmi(ji,jj))))
178            ENDIF
179         ENDDO
180      ENDDO
181
182      DO jj = 2,jpjm1
183         DO ji = 2,jpim1
184            if (tmask(ji,jj,jk) == 1) then
185               !!
186               !! mesozooplankton
187               !! linear
188               if (jmzme.eq.1) fdzme(ji,jj) = xmzme * zzme(ji,jj)
189               !! quadratic
190               if (jmzme.eq.2) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
191                                              zzme(ji,jj)
192               !! hyperbolic
193               if (jmzme.eq.3) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
194                                              (zzme(ji,jj) / (xkzme +        &
195                                                              zzme(ji,jj)))
196               !! sigmoid
197               if (jmzme.eq.4) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
198                                              ((zzme(ji,jj) * zzme(ji,jj)) / &
199                                               (xkzme + (zzme(ji,jj) *       &
200                                                         zzme(ji,jj))))
201            ENDIF
202         ENDDO
203      ENDDO
204
205      !! diatom frustule dissolution. This section is moved from just
206      !! below CALL to iron_chem_scav in trcbio_medusa.F90 - marc 9/5/17
207      DO jj = 2,jpjm1
208         DO ji = 2,jpim1
209            IF (tmask(ji,jj,jk) == 1) THEN
210               fsdiss(ji,jj)  = xsdiss * zpds(ji,jj)
211            ENDIF
212         ENDDO
213      ENDDO
214
215# if defined key_foam_medusa
216      !! Mixed layer averages for ocean colour assimilation
217      !!
218      DO jj = 2,jpjm1
219         DO ji = 2,jpim1
220            IF (tmask(ji,jj,jk) == 1) THEN
221               if (fdep1(ji,jj).le.hmld(ji,jj)) then
222                  !! this level is entirely in the mixed layer
223                  fq0 = 1.0
224               elseif (fsdepw(ji,jj,jk).ge.hmld(ji,jj)) then
225                  !! this level is entirely below the mixed layer
226                  fq0 = 0.0
227               else
228                  !! this level straddles the mixed layer
229                  fq0 = (hmld(ji,jj) - fsdepw(ji,jj,jk)) / fse3t(ji,jj,jk)
230               endif
231               !!
232               pgrow_avg(ji,jj) = pgrow_avg(ji,jj) +                   &
233                                  (((fprn(ji,jj) * zphn(ji,jj)) +      &
234                                    (fprd(ji,jj) * zphd(ji,jj))  ) *   &
235                                   fse3t(ji,jj,jk) * fq0)
236               ploss_avg(ji,jj) = ploss_avg(ji,jj) +                   &
237                                  ((fgmepd(ji,jj) + fdpd(ji,jj) +      &
238                                    fdpd2(ji,jj)                +      &
239                                    fgmepn(ji,jj) + fdpn(ji,jj) +      &
240                                    fdpn2(ji,jj)  + fgmipn(ji,jj) ) *  &
241                                   fse3t(ji,jj,jk) * fq0)
242               phyt_avg(ji,jj)  = phyt_avg(ji,jj)  +                   &
243                                  ((zphn(ji,jj) + zphd(ji,jj)) *       &
244                                   fse3t(ji,jj,jk) * fq0)
245               !!
246               pgrow_avg_3d(ji,jj,jk) = (fprn(ji,jj) * zphn(ji,jj)) +  &
247                                        (fprd(ji,jj) * zphd(ji,jj))
248               ploss_avg_3d(ji,jj,jk) = fgmepd(ji,jj) + fdpd(ji,jj) +  &
249                                        fdpd2(ji,jj)                +  &
250                                        fgmepn(ji,jj) + fdpn(ji,jj) +  &
251                                        fdpn2(ji,jj)  + fgmipn(ji,jj)
252               phyt_avg_3d(ji,jj,jk)  = zphn(ji,jj) + zphd(ji,jj)
253            ENDIF
254         ENDDO
255      ENDDO
256# endif
257
258   END SUBROUTINE plankton
259
260#else
261   !!======================================================================
262   !!  Dummy module :                                   No MEDUSA bio-model
263   !!======================================================================
264CONTAINS
265   SUBROUTINE plankton( )                    ! Empty routine
266      WRITE(*,*) 'plankton: You should not have seen this print! error?'
267   END SUBROUTINE plankton
268#endif 
269
270   !!======================================================================
271END MODULE plankton_mod
Note: See TracBrowser for help on using the repository browser.