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

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus.F90 @ 7986

Last change on this file since 7986 was 7986, checked in by marc, 7 years ago

Pulled detritus processes out of trcbio_medusa.F90
File size: 6.8 KB
RevLine 
[7986]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   !!----------------------------------------------------------------------
9#if defined key_medusa
10   !!----------------------------------------------------------------------
11   !!                                                   MEDUSA bio-model
12   !!----------------------------------------------------------------------
13
14   IMPLICIT NONE
15   PRIVATE
16     
17   PUBLIC   detritus        ! 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 detritus( jk, iball  )
28      !!-------------------------------------------------------------------
29      !!                     ***  ROUTINE detritus  ***
30      !! This called from TRC_BIO_MEDUSA and
31      !!  - Calculates detritus processes
32      !!  - Fast-sinking detritus
33      !!-------------------------------------------------------------------
34      USE bio_medusa_mod,         ONLY: fdd, fddc,                         &
35                                        f_sbenin_c, f_sbenin_fe,           &
36                                        f_sbenin_n,                        &
37                                        fun_T, fun_Q10, zdet, zdtc
38      USE detritus_fast_sink_mod, ONLY: detritus_fast_sink
39      USE dom_oce,                ONLY: mbathy, tmask
40      USE in_out_manager,         ONLY: lwp, numout
41      USE par_oce,                ONLY: jpim1, jpjm1
42      USE sms_medusa,             ONLY: jmd, jorgben, jsfd, vsed,          &
43                                        xrfn, xmd, xmdc, xthetad
44
45      !! Level
46      INTEGER, INTENT( in ) :: jk
47      !! Fast detritus ballast scheme (0 = no; 1 = yes)
48      INTEGER, INTENT( in ) :: iball
49
50      INTEGER :: ji, jj
51
52      !!------------------------------------------------------------------
53      !! Detritus remineralisation
54      !! Constant or temperature-dependent
55      !!------------------------------------------------------------------
56      DO jj = 2,jpjm1
57         DO ji = 2,jpim1
58            !! OPEN wet point IF..THEN loop
59            if (tmask(ji,jj,jk) == 1) then
60
61               !!
62               if (jmd.eq.1) then
63                  !! temperature-dependent
64                  fdd(ji,jj)  = xmd  * fun_T(ji,jj) * zdet(ji,jj)
65# if defined key_roam
66                  fddc(ji,jj) = xmdc * fun_T(ji,jj) * zdtc(ji,jj)
67# endif
68               elseif (jmd.eq.2) then
69                  !! AXY (16/05/13): add in Q10-based parameterisation
70                  !! (def in nmlst)
71                  !! temperature-dependent
72                  fdd(ji,jj)  = xmd  * fun_Q10(ji,jj) * zdet(ji,jj)
73#if defined key_roam
74                  fddc(ji,jj) = xmdc * fun_Q10(ji,jj) * zdtc(ji,jj)
75#endif
76               else
77                  !! temperature-independent
78                  fdd(ji,jj)  = xmd  * zdet(ji,jj)
79# if defined key_roam
80                  fddc(ji,jj) = xmdc * zdtc(ji,jj)
81# endif
82               endif
83               !!
84               !! AXY (22/07/09): accelerate detrital remineralisation
85               !! in the bottom box
86               if ((jk.eq.mbathy(ji,jj)) .and. jsfd.eq.1) then
87                  fdd(ji,jj)  = 1.0  * zdet(ji,jj)
88# if defined key_roam
89                  fddc(ji,jj) = 1.0  * zdtc(ji,jj)
90# endif
91               endif
92               
93# if defined key_debug_medusa
94               !! report plankton mortality and remineralisation
95               if (idf.eq.1.AND.idfval.eq.1) then
96                  IF (lwp) write (numout,*) '------------------------------'
97! I've removed the lines below, because the variables are not in this
98! routine. If these debug prints need to stay, they should probably be
99! moved - marc 27/4/17
100!                  IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2(ji,jj)
101!                  IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2(ji,jj)
102!                  IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2(ji,jj)
103!                  IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2(ji,jj)
104!                  IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2(ji,jj)
105!                  IF (lwp) write (numout,*) 'fdpn(',jk,')  = ', fdpn(ji,jj)
106!                  IF (lwp) write (numout,*) 'fdpd(',jk,')  = ', fdpd(ji,jj)
107!                  IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds(ji,jj)
108!                  IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi(ji,jj)
109!                  IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme(ji,jj)
110                  IF (lwp) write (numout,*) 'fdd(',jk,')   = ', fdd(ji,jj)
111#  if defined key_roam
112                  IF (lwp) write (numout,*) 'fddc(',jk,')  = ', fddc(ji,jj)
113#  endif
114               endif
115# endif
116            ENDIF
117         ENDDO
118      ENDDO
119
120      DO jj = 2,jpjm1
121         DO ji = 2,jpim1
122            if (tmask(ji,jj,jk) == 1) then
123               !!---------------------------------------------------------
124               !! Detritus addition to benthos
125               !! If activated, slow detritus in the bottom box will enter
126               !! the benthic pool
127               !!---------------------------------------------------------
128               !!
129               if ((jk.eq.mbathy(ji,jj)) .and. jorgben.eq.1) then
130                  !! this is the BOTTOM OCEAN BOX -> into the benthic pool!
131                  !!
132                  f_sbenin_n(ji,jj)  = (zdet(ji,jj) * vsed * 86400.)
133                  f_sbenin_fe(ji,jj) = (zdet(ji,jj) * vsed * 86400. * xrfn)
134# if defined key_roam
135                  f_sbenin_c(ji,jj)  = (zdtc(ji,jj) * vsed * 86400.)
136# else
137                  f_sbenin_c(ji,jj)  = (zdet(ji,jj) * vsed * 86400. * xthetad)
138# endif
139               endif
140
141            ENDIF
142         ENDDO
143      ENDDO
144
145      !!------------------------------------------------------------------
146      !! Fast-sinking detritus
147      !!------------------------------------------------------------------
148      CALL detritus_fast_sink( jk, iball )
149
150   END SUBROUTINE detritus
151
152#else
153   !!======================================================================
154   !!  Dummy module :                                   No MEDUSA bio-model
155   !!======================================================================
156CONTAINS
157   SUBROUTINE detritus( )                    ! Empty routine
158      WRITE(*,*) 'detritus: You should not have seen this print! error?'
159   END SUBROUTINE detritus
160#endif 
161
162   !!======================================================================
163END MODULE detritus_mod
Note: See TracBrowser for help on using the repository browser.