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

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

Last change on this file was 11738, checked in by marc, 5 years ago

The Dr Hook changes from my perl code.
File size: 9.5 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   USE yomhook, ONLY: lhook, dr_hook
15   USE parkind1, ONLY: jprb, jpim
16
17   IMPLICIT NONE
18   PRIVATE
19     
20   PUBLIC   plankton        ! Called in trcbio_medusa.F90
21
22   !!----------------------------------------------------------------------
23   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
24   !! $Id$
25   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27
28CONTAINS
29
30   SUBROUTINE plankton( jk )
31      !!-------------------------------------------------------------------
32      !!                     ***  ROUTINE plankton  ***
33      !! This called from TRC_BIO_MEDUSA and
34      !!  - Calculates phytoplankton growth
35      !!  - Zooplankton grazing
36      !!  - Plankton losses
37      !!-------------------------------------------------------------------
38      USE bio_medusa_mod,    ONLY: fdpd, fdpd2, fdpds, fdpds2,             &
39                                   fdpn, fdpn2, fdzme, fdzme2,             &
40                                   fdzmi, fdzmi2, fsdiss, fsin,            &
41                                   zphd, zphn, zpds, zzme, zzmi
42      USE dom_oce,           ONLY: tmask
43      USE par_oce,           ONLY: jpim1, jpjm1
44      USE phytoplankton_mod, ONLY: phytoplankton
45      USE sms_medusa,        ONLY: jmpd, jmpn, jmzme, jmzmi,               &
46                                   xkphd, xkphn, xkzme, xkzmi,             &
47                                   xmetapd, xmetapn, xmetazme, xmetazmi,   &
48                                   xmpd, xmpn, xmzme, xmzmi, xsdiss
49      USE zooplankton_mod,   ONLY: zooplankton
50
51      !! Level
52      INTEGER, INTENT( in ) :: jk
53
54      INTEGER :: ji, jj
55      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
56      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
57      REAL(KIND=jprb)               :: zhook_handle
58
59      CHARACTER(LEN=*), PARAMETER :: RoutineName='PLANKTON'
60
61      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
62
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 (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
202   END SUBROUTINE plankton
203
204#else
205   !!======================================================================
206   !!  Dummy module :                                   No MEDUSA bio-model
207   !!======================================================================
208CONTAINS
209   SUBROUTINE plankton( )                    ! Empty routine
210   INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
211   INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
212   REAL(KIND=jprb)               :: zhook_handle
213
214   CHARACTER(LEN=*), PARAMETER :: RoutineName='PLANKTON'
215
216   IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
217
218      WRITE(*,*) 'plankton: You should not have seen this print! error?'
219   IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
220   END SUBROUTINE plankton
221#endif 
222
223   !!======================================================================
224END MODULE plankton_mod
Note: See TracBrowser for help on using the repository browser.