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

Last change on this file was 10149, checked in by frrh, 2 years ago

Met Office GMED ticket 379: Merged David Ford's MEDUSA assimilation changes
using command:

svn merge -r 10054:10141 svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/UKMO/dev_r5518_GO6_package_asm_3d_bgc_v3

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