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.
detritus.F90 in branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA – NEMO

source: branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus.F90 @ 8674

Last change on this file since 8674 was 8674, checked in by jpalmier, 7 years ago

jpalm -- merge trdtrc branch with last GO6 package branch revision
File size: 9.3 KB
Line 
1MODULE detritus_mod
2   !!======================================================================
3   !!                         ***  MODULE detritus_mod  ***
4   !! Calculates detritus processes and fast-sinking detritus
5   !!======================================================================
6   !! History :
7   !!   -   ! 2017-04 (M. Stringer)        Code taken from trcbio_medusa.F90
8   !!   -   ! 2017-08 (A. Yool)            Revise slow-sinking of detritus
9   !!----------------------------------------------------------------------
10#if defined key_medusa
11   !!----------------------------------------------------------------------
12   !!                                                   MEDUSA bio-model
13   !!----------------------------------------------------------------------
14
15   IMPLICIT NONE
16   PRIVATE
17     
18   PUBLIC   detritus        ! Called in trcbio_medusa.F90
19
20   !!----------------------------------------------------------------------
21   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
22   !! $Id$
23   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
24   !!----------------------------------------------------------------------
25
26CONTAINS
27
28   SUBROUTINE detritus( jk, iball  )
29      !!-------------------------------------------------------------------
30      !!                     ***  ROUTINE detritus  ***
31      !! This called from TRC_BIO_MEDUSA and
32      !!  - Calculates detritus processes
33      !!  - Fast-sinking detritus
34      !!-------------------------------------------------------------------
35      USE bio_medusa_mod,         ONLY: f_sbenin_c, f_sbenin_fe,           &
36                                        f_sbenin_n, fdd,                   &
37                                        idf, idfval,                       &   
38                                        fslowsink,                         &
39                                        fslowgain, fslowloss,              &
40# if defined key_roam
41                                        fslowsinkc,                        &
42                                        fslowgainc, fslowlossc,            &
43                                        fddc,                              &
44# endif
45                                        fun_T, fun_Q10, zdet, zdtc
46      USE detritus_fast_sink_mod, ONLY: detritus_fast_sink
47      USE dom_oce,                ONLY: mbathy, e3t_0, e3t_n, gphit, tmask
48      USE in_out_manager,         ONLY: lwp, numout
49      USE par_oce,                ONLY: jpim1, jpjm1
50      USE sms_medusa,             ONLY: jmd, jorgben, jsfd, vsed,          &
51                                        xrfn, xmd, xmdc, xthetad
52
53   !!* Substitution
54#  include "domzgr_substitute.h90"
55
56      !! Level
57      INTEGER, INTENT( in ) :: jk
58      !! Fast detritus ballast scheme (0 = no; 1 = yes)
59      INTEGER, INTENT( in ) :: iball
60
61      INTEGER :: ji, jj
62
63      !!------------------------------------------------------------------
64      !! Detritus remineralisation
65      !! Constant or temperature-dependent
66      !!------------------------------------------------------------------
67      DO jj = 2,jpjm1
68         DO ji = 2,jpim1
69            !! OPEN wet point IF..THEN loop
70            if (tmask(ji,jj,jk) == 1) then
71               !!
72               if (jmd.eq.1) then
73                  !! temperature-dependent
74                  fdd(ji,jj)  = xmd  * fun_T(ji,jj) * zdet(ji,jj)
75# if defined key_roam
76                  fddc(ji,jj) = xmdc * fun_T(ji,jj) * zdtc(ji,jj)
77# endif
78               elseif (jmd.eq.2) then
79                  !! AXY (16/05/13): add in Q10-based parameterisation
80                  !! (def in nmlst)
81                  !! temperature-dependent
82                  fdd(ji,jj)  = xmd  * fun_Q10(ji,jj) * zdet(ji,jj)
83#if defined key_roam
84                  fddc(ji,jj) = xmdc * fun_Q10(ji,jj) * zdtc(ji,jj)
85#endif
86               else
87                  !! temperature-independent
88                  fdd(ji,jj)  = xmd  * zdet(ji,jj)
89# if defined key_roam
90                  fddc(ji,jj) = xmdc * zdtc(ji,jj)
91# endif
92               endif
93               !!
94               !! AXY (22/07/09): accelerate detrital remineralisation
95               !! in the bottom box
96               if ((jk.eq.mbathy(ji,jj)) .and. jsfd.eq.1) then
97                  fdd(ji,jj)  = 1.0  * zdet(ji,jj)
98# if defined key_roam
99                  fddc(ji,jj) = 1.0  * zdtc(ji,jj)
100# endif
101               endif
102               
103# if defined key_debug_medusa
104               !! report plankton mortality and remineralisation
105               if (idf.eq.1.AND.idfval.eq.1) then
106                  IF (lwp) write (numout,*) '------------------------------'
107! I've removed the lines below, because the variables are not in this
108! routine. If these debug prints need to stay, they should probably be
109! moved - marc 27/4/17
110!                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2(ji,jj)
111!                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2(ji,jj)
112!                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2(ji,jj)
113!                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2(ji,jj)
114!                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2(ji,jj)
115!                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn(ji,jj)
116!                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd(ji,jj)
117!                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds(ji,jj)
118!                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi(ji,jj)
119!                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme(ji,jj)
120                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd(ji,jj)
121#  if defined key_roam
122                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc(ji,jj)
123#  endif
124               endif
125# endif
126            ENDIF
127         ENDDO
128      ENDDO
129
130      DO jj = 2,jpjm1
131         DO ji = 2,jpim1
132            if (tmask(ji,jj,jk) == 1) then
133               !!----------------------------------------------------------------------
134               !! Detritus sinking (AXY, 08/08/18)
135          !! Replaces slow-sinking done in trcsed_medusa.F90
136               !!
137               !! Uses the fslowsink variable to carry slow-sinking detritus from one
138               !! grid level to the next, variable fslowgain to "add" detritus sinking
139               !! from above and variable fslowloss to "subtract" detritus sinking out
140               !! to below; these variables appear in the differential equations of
141               !! detrital nitrogen and carbon below
142               !!----------------------------------------------------------------------
143               !!
144               fslowgain(ji,jj)  = fslowsink(ji,jj) / fse3t(ji,jj,jk)                  ! = mmol N / m3 / d
145               if (jk.lt.mbathy(ji,jj)) then
146                  fslowloss(ji,jj)  = (zdet(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol N / m3 / d
147               else
148                  fslowloss(ji,jj)  = 0.                                               ! = mmol N / m3 / d
149               endif
150               fslowsink(ji,jj) = fslowloss(ji,jj) * fse3t(ji,jj,jk)                   ! = mmol N / m2 / d
151               !!
152#  if defined key_roam
153               fslowgainc(ji,jj) = fslowsinkc(ji,jj) / fse3t(ji,jj,jk)                 ! = mmol C / m3 / d
154               if (jk.lt.mbathy(ji,jj)) then
155                  fslowlossc(ji,jj) = (zdtc(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol C / m3 / d
156               else
157                  fslowlossc(ji,jj) = 0.                                               ! = mmol C / m3 / d
158               endif
159               fslowsinkc(ji,jj) = fslowlossc(ji,jj) * fse3t(ji,jj,jk)                 ! = mmol C / m2 / d
160#  endif
161            ENDIF
162         ENDDO
163      ENDDO
164
165      DO jj = 2,jpjm1
166         DO ji = 2,jpim1
167            if (tmask(ji,jj,jk) == 1) then
168               !!---------------------------------------------------------
169               !! Detritus addition to benthos
170               !! If activated, slow detritus in the bottom box will enter
171               !! the benthic pool
172               !!---------------------------------------------------------
173               !!
174               if ((jk.eq.mbathy(ji,jj)) .and. jorgben.eq.1) then
175                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool!
176                  !!
177                  f_sbenin_n(ji,jj)  = (zdet(ji,jj) * vsed * 86400.)
178                  f_sbenin_fe(ji,jj) = (zdet(ji,jj) * vsed * 86400. * xrfn)
179# if defined key_roam
180                  f_sbenin_c(ji,jj)  = (zdtc(ji,jj) * vsed * 86400.)
181# else
182                  f_sbenin_c(ji,jj)  = (zdet(ji,jj) * vsed * 86400. * xthetad)
183# endif
184               endif
185
186            ENDIF
187         ENDDO
188      ENDDO
189
190      !!------------------------------------------------------------------
191      !! Fast-sinking detritus
192      !!------------------------------------------------------------------
193      CALL detritus_fast_sink( jk, iball )
194
195   END SUBROUTINE detritus
196
197#else
198   !!======================================================================
199   !!  Dummy module :                                   No MEDUSA bio-model
200   !!======================================================================
201CONTAINS
202   SUBROUTINE detritus( )                    ! Empty routine
203      WRITE(*,*) 'detritus: You should not have seen this print! error?'
204   END SUBROUTINE detritus
205#endif 
206
207   !!======================================================================
208END MODULE detritus_mod
Note: See TracBrowser for help on using the repository browser.