source: branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90 @ 9292

Last change on this file since 9292 was 9292, checked in by dford, 3 years ago

Merge in changes from dev_r5518_GO6_package_asm_surf_bgc_v2.

File size: 11.0 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# endif
55                                   xkphd, xkphn, xkzme, xkzmi,             &
56                                   xmetapd, xmetapn, xmetazme, xmetazmi,   &
57                                   xmpd, xmpn, xmzme, xmzmi, xsdiss
58# if defined key_foam_medusa
59      USE zdfmxl,            ONLY: hmld
60# endif
61      USE zooplankton_mod,   ONLY: zooplankton
62
63# if defined key_foam_medusa
64   !!* Substitution
65#  include "domzgr_substitute.h90"
66# endif
67
68      !! Level
69      INTEGER, INTENT( in ) :: jk
70
71      INTEGER :: ji, jj
72
73# if defined key_foam_medusa
74      REAL(wp) :: fq0
75# endif
76
77      !!-------------------------------------------------------------------
78      !! Calculate phytoplankton growth
79      !!-------------------------------------------------------------------
80      CALL phytoplankton( jk )
81
82      !!-------------------------------------------------------------------
83      !! Calculate zooplankton grazing
84      !!-------------------------------------------------------------------
85      CALL zooplankton( jk )
86
87      !!-------------------------------------------------------------------
88      !! Miscellaneous plankton losses
89      !!-------------------------------------------------------------------
90      DO jj = 2,jpjm1
91         DO ji = 2,jpim1
92            !! OPEN wet point IF..THEN loop
93            if (tmask(ji,jj,jk) == 1) then
94               !!----------------------------------------------------------
95               !! Plankton metabolic losses
96               !! Linear loss processes assumed to be metabolic in origin
97               !!----------------------------------------------------------
98               !!
99               fdpn2(ji,jj)  = xmetapn  * zphn(ji,jj)
100               fdpd2(ji,jj)  = xmetapd  * zphd(ji,jj)
101               fdpds2(ji,jj) = xmetapd  * zpds(ji,jj)
102               fdzmi2(ji,jj) = xmetazmi * zzmi(ji,jj)
103               fdzme2(ji,jj) = xmetazme * zzme(ji,jj)
104            ENDIF
105         ENDDO
106      ENDDO
107
108      DO jj = 2,jpjm1
109         DO ji = 2,jpim1
110            if (tmask(ji,jj,jk) == 1) then
111               !!----------------------------------------------------------
112               !! Plankton mortality losses
113               !! EKP (26/02/09): phytoplankton hyperbolic mortality term
114               !! introduced
115               !! to improve performance in gyres
116               !!----------------------------------------------------------
117               !!
118               !! non-diatom phytoplankton
119               !! linear
120               if (jmpn.eq.1) fdpn(ji,jj) = xmpn * zphn(ji,jj)
121               !! quadratic
122               if (jmpn.eq.2) fdpn(ji,jj) = xmpn * zphn(ji,jj) * zphn(ji,jj)
123               !! hyperbolic
124               if (jmpn.eq.3) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
125                                            (zphn(ji,jj) /                   &
126                                             (xkphn + zphn(ji,jj)))
127               !! sigmoid
128               if (jmpn.eq.4) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
129                                            ((zphn(ji,jj) * zphn(ji,jj)) /   &
130                                             (xkphn + (zphn(ji,jj) *         &
131                                                       zphn(ji,jj))))
132            ENDIF
133         ENDDO
134      ENDDO
135
136      DO jj = 2,jpjm1
137         DO ji = 2,jpim1
138            if (tmask(ji,jj,jk) == 1) then
139               !!
140               !! diatom phytoplankton
141               !! linear
142               if (jmpd.eq.1) fdpd(ji,jj) = xmpd * zphd(ji,jj)
143               !! quadratic
144               if (jmpd.eq.2) fdpd(ji,jj) = xmpd * zphd(ji,jj) * zphd(ji,jj)
145               !! hyperbolic
146               if (jmpd.eq.3) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
147                                            (zphd(ji,jj) / (xkphd +          &
148                                                            zphd(ji,jj)))
149               !! sigmoid
150               if (jmpd.eq.4) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
151                                            ((zphd(ji,jj) * zphd(ji,jj)) /   &
152                                             (xkphd + (zphd(ji,jj) *         &
153                                                       zphd(ji,jj))))
154               fdpds(ji,jj) = fdpd(ji,jj) * fsin(ji,jj)
155            ENDIF
156         ENDDO
157      ENDDO
158
159      DO jj = 2,jpjm1
160         DO ji = 2,jpim1
161            if (tmask(ji,jj,jk) == 1) then
162               !!
163               !! microzooplankton
164               !! linear
165               if (jmzmi.eq.1) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj)
166               !! quadratic
167               if (jmzmi.eq.2) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
168                                              zzmi(ji,jj)
169               !! hyperbolic
170               if (jmzmi.eq.3) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
171                                              (zzmi(ji,jj) / (xkzmi +        &
172                                                              zzmi(ji,jj)))
173               !! sigmoid
174               if (jmzmi.eq.4) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) * &
175                  ((zzmi(ji,jj) * zzmi(ji,jj)) / (xkzmi + (zzmi(ji,jj) *     &
176                                                           zzmi(ji,jj))))
177            ENDIF
178         ENDDO
179      ENDDO
180
181      DO jj = 2,jpjm1
182         DO ji = 2,jpim1
183            if (tmask(ji,jj,jk) == 1) then
184               !!
185               !! mesozooplankton
186               !! linear
187               if (jmzme.eq.1) fdzme(ji,jj) = xmzme * zzme(ji,jj)
188               !! quadratic
189               if (jmzme.eq.2) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
190                                              zzme(ji,jj)
191               !! hyperbolic
192               if (jmzme.eq.3) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
193                                              (zzme(ji,jj) / (xkzme +        &
194                                                              zzme(ji,jj)))
195               !! sigmoid
196               if (jmzme.eq.4) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
197                                              ((zzme(ji,jj) * zzme(ji,jj)) / &
198                                               (xkzme + (zzme(ji,jj) *       &
199                                                         zzme(ji,jj))))
200            ENDIF
201         ENDDO
202      ENDDO
203
204      !! diatom frustule dissolution. This section is moved from just
205      !! below CALL to iron_chem_scav in trcbio_medusa.F90 - marc 9/5/17
206      DO jj = 2,jpjm1
207         DO ji = 2,jpim1
208            IF (tmask(ji,jj,jk) == 1) THEN
209               fsdiss(ji,jj)  = xsdiss * zpds(ji,jj)
210            ENDIF
211         ENDDO
212      ENDDO
213
214# if defined key_foam_medusa
215      !! Mixed layer averages for ocean colour assimilation
216      !!
217      DO jj = 2,jpjm1
218         DO ji = 2,jpim1
219            IF (tmask(ji,jj,jk) == 1) THEN
220               if (fdep1(ji,jj).le.hmld(ji,jj)) then
221                  !! this level is entirely in the mixed layer
222                  fq0 = 1.0
223               elseif (fsdepw(ji,jj,jk).ge.hmld(ji,jj)) then
224                  !! this level is entirely below the mixed layer
225                  fq0 = 0.0
226               else
227                  !! this level straddles the mixed layer
228                  fq0 = (hmld(ji,jj) - fsdepw(ji,jj,jk)) / fse3t(ji,jj,jk)
229               endif
230               !!
231               pgrow_avg(ji,jj) = pgrow_avg(ji,jj) +                   &
232                                  (((fprn(ji,jj) * zphn(ji,jj)) +      &
233                                    (fprd(ji,jj) * zphd(ji,jj))  ) *   &
234                                   fse3t(ji,jj,jk) * fq0)
235               ploss_avg(ji,jj) = ploss_avg(ji,jj) +                   &
236                                  ((fgmepd(ji,jj) + fdpd(ji,jj) +      &
237                                    fdpd2(ji,jj)                +      &
238                                    fgmepn(ji,jj) + fdpn(ji,jj) +      &
239                                    fdpn2(ji,jj)  + fgmipn(ji,jj) ) *  &
240                                   fse3t(ji,jj,jk) * fq0)
241               phyt_avg(ji,jj)  = phyt_avg(ji,jj)  +                   &
242                                  ((zphn(ji,jj) + zphd(ji,jj)) *       &
243                                   fse3t(ji,jj,jk) * fq0)
244            ENDIF
245         ENDDO
246      ENDDO
247# endif
248
249   END SUBROUTINE plankton
250
251#else
252   !!======================================================================
253   !!  Dummy module :                                   No MEDUSA bio-model
254   !!======================================================================
255CONTAINS
256   SUBROUTINE plankton( )                    ! Empty routine
257      WRITE(*,*) 'plankton: You should not have seen this print! error?'
258   END SUBROUTINE plankton
259#endif 
260
261   !!======================================================================
262END MODULE plankton_mod
Note: See TracBrowser for help on using the repository browser.