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/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/TOP_SRC/MEDUSA/plankton.F90 @ 10045

Last change on this file since 10045 was 10045, checked in by jpalmier, 6 years ago

Andrew's changes to add the OMIP double_DIC (activated with key_omip_dic)

File size: 8.7 KB
Line 
1MODULE plankton_mod
2   !!======================================================================
3   !!                         ***  MODULE plankton_mod  ***
4   !! Calculates phytoplankton and zooplankton terms
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                                   zphd, zphn, zpds, zzme, zzmi
39      USE dom_oce,           ONLY: tmask
40      USE par_oce,           ONLY: jpim1, jpjm1
41      USE phytoplankton_mod, ONLY: phytoplankton
42      USE sms_medusa,        ONLY: jmpd, jmpn, jmzme, jmzmi,               &
43                                   xkphd, xkphn, xkzme, xkzmi,             &
44                                   xmetapd, xmetapn, xmetazme, xmetazmi,   &
45                                   xmpd, xmpn, xmzme, xmzmi, xsdiss
46      USE zooplankton_mod,   ONLY: zooplankton
47
48      !! Level
49      INTEGER, INTENT( in ) :: jk
50
51      INTEGER :: ji, jj
52
53      !!-------------------------------------------------------------------
54      !! Calculate phytoplankton growth
55      !!-------------------------------------------------------------------
56      CALL phytoplankton( jk )
57
58      !!-------------------------------------------------------------------
59      !! Calculate zooplankton grazing
60      !!-------------------------------------------------------------------
61      CALL zooplankton( jk )
62
63      !!-------------------------------------------------------------------
64      !! Miscellaneous plankton losses
65      !!-------------------------------------------------------------------
66      DO jj = 2,jpjm1
67         DO ji = 2,jpim1
68            !! OPEN wet point IF..THEN loop
69            if (tmask(ji,jj,jk) == 1) then
70               !!----------------------------------------------------------
71               !! Plankton metabolic losses
72               !! Linear loss processes assumed to be metabolic in origin
73               !!----------------------------------------------------------
74               !!
75               fdpn2(ji,jj)  = xmetapn  * zphn(ji,jj)
76               fdpd2(ji,jj)  = xmetapd  * zphd(ji,jj)
77               fdpds2(ji,jj) = xmetapd  * zpds(ji,jj)
78               fdzmi2(ji,jj) = xmetazmi * zzmi(ji,jj)
79               fdzme2(ji,jj) = xmetazme * zzme(ji,jj)
80            ENDIF
81         ENDDO
82      ENDDO
83
84      DO jj = 2,jpjm1
85         DO ji = 2,jpim1
86            if (tmask(ji,jj,jk) == 1) then
87               !!----------------------------------------------------------
88               !! Plankton mortality losses
89               !! EKP (26/02/09): phytoplankton hyperbolic mortality term
90               !! introduced
91               !! to improve performance in gyres
92               !!----------------------------------------------------------
93               !!
94               !! non-diatom phytoplankton
95               !! linear
96               if (jmpn.eq.1) fdpn(ji,jj) = xmpn * zphn(ji,jj)
97               !! quadratic
98               if (jmpn.eq.2) fdpn(ji,jj) = xmpn * zphn(ji,jj) * zphn(ji,jj)
99               !! hyperbolic
100               if (jmpn.eq.3) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
101                                            (zphn(ji,jj) /                   &
102                                             (xkphn + zphn(ji,jj)))
103               !! sigmoid
104               if (jmpn.eq.4) fdpn(ji,jj) = xmpn * zphn(ji,jj) *             &
105                                            ((zphn(ji,jj) * zphn(ji,jj)) /   &
106                                             (xkphn + (zphn(ji,jj) *         &
107                                                       zphn(ji,jj))))
108            ENDIF
109         ENDDO
110      ENDDO
111
112      DO jj = 2,jpjm1
113         DO ji = 2,jpim1
114            if (tmask(ji,jj,jk) == 1) then
115               !!
116               !! diatom phytoplankton
117               !! linear
118               if (jmpd.eq.1) fdpd(ji,jj) = xmpd * zphd(ji,jj)
119               !! quadratic
120               if (jmpd.eq.2) fdpd(ji,jj) = xmpd * zphd(ji,jj) * zphd(ji,jj)
121               !! hyperbolic
122               if (jmpd.eq.3) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
123                                            (zphd(ji,jj) / (xkphd +          &
124                                                            zphd(ji,jj)))
125               !! sigmoid
126               if (jmpd.eq.4) fdpd(ji,jj) = xmpd * zphd(ji,jj) *             &
127                                            ((zphd(ji,jj) * zphd(ji,jj)) /   &
128                                             (xkphd + (zphd(ji,jj) *         &
129                                                       zphd(ji,jj))))
130               fdpds(ji,jj) = fdpd(ji,jj) * fsin(ji,jj)
131            ENDIF
132         ENDDO
133      ENDDO
134
135      DO jj = 2,jpjm1
136         DO ji = 2,jpim1
137            if (tmask(ji,jj,jk) == 1) then
138               !!
139               !! microzooplankton
140               !! linear
141               if (jmzmi.eq.1) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj)
142               !! quadratic
143               if (jmzmi.eq.2) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
144                                              zzmi(ji,jj)
145               !! hyperbolic
146               if (jmzmi.eq.3) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) *          &
147                                              (zzmi(ji,jj) / (xkzmi +        &
148                                                              zzmi(ji,jj)))
149               !! sigmoid
150               if (jmzmi.eq.4) fdzmi(ji,jj) = xmzmi * zzmi(ji,jj) * &
151                  ((zzmi(ji,jj) * zzmi(ji,jj)) / (xkzmi + (zzmi(ji,jj) *     &
152                                                           zzmi(ji,jj))))
153            ENDIF
154         ENDDO
155      ENDDO
156
157      DO jj = 2,jpjm1
158         DO ji = 2,jpim1
159            if (tmask(ji,jj,jk) == 1) then
160               !!
161               !! mesozooplankton
162               !! linear
163               if (jmzme.eq.1) fdzme(ji,jj) = xmzme * zzme(ji,jj)
164               !! quadratic
165               if (jmzme.eq.2) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
166                                              zzme(ji,jj)
167               !! hyperbolic
168               if (jmzme.eq.3) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
169                                              (zzme(ji,jj) / (xkzme +        &
170                                                              zzme(ji,jj)))
171               !! sigmoid
172               if (jmzme.eq.4) fdzme(ji,jj) = xmzme * zzme(ji,jj) *          &
173                                              ((zzme(ji,jj) * zzme(ji,jj)) / &
174                                               (xkzme + (zzme(ji,jj) *       &
175                                                         zzme(ji,jj))))
176            ENDIF
177         ENDDO
178      ENDDO
179
180      !! diatom frustule dissolution. This section is moved from just
181      !! below CALL to iron_chem_scav in trcbio_medusa.F90 - marc 9/5/17
182      DO jj = 2,jpjm1
183         DO ji = 2,jpim1
184            IF (tmask(ji,jj,jk) == 1) THEN
185               fsdiss(ji,jj)  = xsdiss * zpds(ji,jj)
186            ENDIF
187         ENDDO
188      ENDDO
189
190   END SUBROUTINE plankton
191
192#else
193   !!======================================================================
194   !!  Dummy module :                                   No MEDUSA bio-model
195   !!======================================================================
196CONTAINS
197   SUBROUTINE plankton( )                    ! Empty routine
198      WRITE(*,*) 'plankton: You should not have seen this print! error?'
199   END SUBROUTINE plankton
200#endif 
201
202   !!======================================================================
203END MODULE plankton_mod
Note: See TracBrowser for help on using the repository browser.