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 @ 8076

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

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