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

source: branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus.F90 @ 10047

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

merge with GO6_package_branch 9385-10020 ; plus debug OMIP_DIC
File size: 9.4 KB
Line 
1MODULE detritus_mod
2   !!======================================================================
3   !!                         ***  MODULE detritus_mod  ***
4   !! Calculates slow detritus remineralisation and sinking
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, gphit, tmask
48# if defined key_vvl
49      USE dom_oce,                ONLY: e3t_n
50# endif
51      USE in_out_manager,         ONLY: lwp, numout
52      USE par_oce,                ONLY: jpim1, jpjm1
53      USE sms_medusa,             ONLY: jmd, jorgben, jsfd, vsed,          &
54                                        xrfn, xmd, xmdc, xthetad
55
56   !!* Substitution
57#  include "domzgr_substitute.h90"
58
59      !! Level
60      INTEGER, INTENT( in ) :: jk
61      !! Fast detritus ballast scheme (0 = no; 1 = yes)
62      INTEGER, INTENT( in ) :: iball
63
64      INTEGER :: ji, jj
65
66      !!------------------------------------------------------------------
67      !! Detritus remineralisation
68      !! Constant or temperature-dependent
69      !!------------------------------------------------------------------
70      DO jj = 2,jpjm1
71         DO ji = 2,jpim1
72            !! OPEN wet point IF..THEN loop
73            if (tmask(ji,jj,jk) == 1) then
74               !!
75               if (jmd.eq.1) then
76                  !! temperature-dependent
77                  fdd(ji,jj)  = xmd  * fun_T(ji,jj) * zdet(ji,jj)
78# if defined key_roam
79                  fddc(ji,jj) = xmdc * fun_T(ji,jj) * zdtc(ji,jj)
80# endif
81               elseif (jmd.eq.2) then
82                  !! AXY (16/05/13): add in Q10-based parameterisation
83                  !! (def in nmlst)
84                  !! temperature-dependent
85                  fdd(ji,jj)  = xmd  * fun_Q10(ji,jj) * zdet(ji,jj)
86#if defined key_roam
87                  fddc(ji,jj) = xmdc * fun_Q10(ji,jj) * zdtc(ji,jj)
88#endif
89               else
90                  !! temperature-independent
91                  fdd(ji,jj)  = xmd  * zdet(ji,jj)
92# if defined key_roam
93                  fddc(ji,jj) = xmdc * zdtc(ji,jj)
94# endif
95               endif
96               !!
97               !! AXY (22/07/09): accelerate detrital remineralisation
98               !! in the bottom box
99               if ((jk.eq.mbathy(ji,jj)) .and. jsfd.eq.1) then
100                  fdd(ji,jj)  = 1.0  * zdet(ji,jj)
101# if defined key_roam
102                  fddc(ji,jj) = 1.0  * zdtc(ji,jj)
103# endif
104               endif
105               
106# if defined key_debug_medusa
107               !! report plankton mortality and remineralisation
108               if (idf.eq.1.AND.idfval.eq.1) then
109                  IF (lwp) write (numout,*) '------------------------------'
110! I've removed the lines below, because the variables are not in this
111! routine. If these debug prints need to stay, they should probably be
112! moved - marc 27/4/17
113!                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2(ji,jj)
114!                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2(ji,jj)
115!                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2(ji,jj)
116!                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2(ji,jj)
117!                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2(ji,jj)
118!                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn(ji,jj)
119!                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd(ji,jj)
120!                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds(ji,jj)
121!                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi(ji,jj)
122!                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme(ji,jj)
123                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd(ji,jj)
124#  if defined key_roam
125                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc(ji,jj)
126#  endif
127               endif
128# endif
129            ENDIF
130         ENDDO
131      ENDDO
132
133      DO jj = 2,jpjm1
134         DO ji = 2,jpim1
135            if (tmask(ji,jj,jk) == 1) then
136               !!----------------------------------------------------------------------
137               !! Detritus sinking (AXY, 08/08/18)
138          !! Replaces slow-sinking done in trcsed_medusa.F90
139               !!
140               !! Uses the fslowsink variable to carry slow-sinking detritus from one
141               !! grid level to the next, variable fslowgain to "add" detritus sinking
142               !! from above and variable fslowloss to "subtract" detritus sinking out
143               !! to below; these variables appear in the differential equations of
144               !! detrital nitrogen and carbon below
145               !!----------------------------------------------------------------------
146               !!
147               fslowgain(ji,jj)  = fslowsink(ji,jj) / fse3t(ji,jj,jk)                  ! = mmol N / m3 / d
148               if (jk.lt.mbathy(ji,jj)) then
149                  fslowloss(ji,jj)  = (zdet(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol N / m3 / d
150               else
151                  fslowloss(ji,jj)  = 0.                                               ! = mmol N / m3 / d
152               endif
153               fslowsink(ji,jj) = fslowloss(ji,jj) * fse3t(ji,jj,jk)                   ! = mmol N / m2 / d
154               !!
155#  if defined key_roam
156               fslowgainc(ji,jj) = fslowsinkc(ji,jj) / fse3t(ji,jj,jk)                 ! = mmol C / m3 / d
157               if (jk.lt.mbathy(ji,jj)) then
158                  fslowlossc(ji,jj) = (zdtc(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk)  ! = mmol C / m3 / d
159               else
160                  fslowlossc(ji,jj) = 0.                                               ! = mmol C / m3 / d
161               endif
162               fslowsinkc(ji,jj) = fslowlossc(ji,jj) * fse3t(ji,jj,jk)                 ! = mmol C / m2 / d
163#  endif
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               !! Detritus addition to benthos
173               !! If activated, slow detritus in the bottom box will enter
174               !! the benthic pool
175               !!---------------------------------------------------------
176               !!
177               if ((jk.eq.mbathy(ji,jj)) .and. jorgben.eq.1) then
178                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool!
179                  !!
180                  f_sbenin_n(ji,jj)  = (zdet(ji,jj) * vsed * 86400.)
181                  f_sbenin_fe(ji,jj) = (zdet(ji,jj) * vsed * 86400. * xrfn)
182# if defined key_roam
183                  f_sbenin_c(ji,jj)  = (zdtc(ji,jj) * vsed * 86400.)
184# else
185                  f_sbenin_c(ji,jj)  = (zdet(ji,jj) * vsed * 86400. * xthetad)
186# endif
187               endif
188
189            ENDIF
190         ENDDO
191      ENDDO
192
193      !!------------------------------------------------------------------
194      !! Fast-sinking detritus
195      !!------------------------------------------------------------------
196      CALL detritus_fast_sink( jk, iball )
197
198   END SUBROUTINE detritus
199
200#else
201   !!======================================================================
202   !!  Dummy module :                                   No MEDUSA bio-model
203   !!======================================================================
204CONTAINS
205   SUBROUTINE detritus( )                    ! Empty routine
206      WRITE(*,*) 'detritus: You should not have seen this print! error?'
207   END SUBROUTINE detritus
208#endif 
209
210   !!======================================================================
211END MODULE detritus_mod
Note: See TracBrowser for help on using the repository browser.