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.
plankton.F90 in branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/UKMO/dev_r5518_GO6_package_FOAMv14/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90

Last change on this file was 13316, checked in by dford, 4 years ago

Allow nitrogen balancing when assimilating 3D chlorophyll data. See Met Office utils ticket 346.

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