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

source: branches/NERC/dev_r5107_NOC_MEDUSA/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcdms_medusa.F90 @ 5710

Last change on this file since 5710 was 5710, checked in by acc, 9 years ago

Branch NERC/dev_r5107_NOC_MEDUSA. Removed SVN keyword updating and cleared existing expansions.

File size: 9.1 KB
RevLine 
[5707]1MODULE trcdms_medusa
2   !!======================================================================
3   !!                         ***  MODULE trcdms_medusa  ***
4   !! TOP :   MEDUSA
5   !!======================================================================
6   !! History :
7   !!  -   !  2014-08  (J. Palmiéri - A. Yool)    added for UKESM1 project
8   !!----------------------------------------------------------------------
9#if defined key_medusa && defined key_roam
10   !!----------------------------------------------------------------------
11   !!                                        MEDUSA DMS surface concentration
12   !!----------------------------------------------------------------------
13   !!   trc_dms_medusa        : 
14   !!----------------------------------------------------------------------
15      USE oce_trc
16      USE trc
17      USE sms_medusa
18      USE lbclnk
19      USE prtctl_trc      ! Print control for debugging
20      USE in_out_manager  ! I/O manager
21
22      IMPLICIT NONE
23      PRIVATE
24
25      PUBLIC   trc_dms_medusa    ! called in trc_bio_medusa
26
27   !!* Substitution
28#  include "domzgr_substitute.h90"
29   !!----------------------------------------------------------------------
30   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
[5710]31   !! $Id$
[5707]32   !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
33   !!----------------------------------------------------------------------
34
35
36CONTAINS
37
38!=======================================================================
39!
40   SUBROUTINE trc_dms_medusa( chn, chd, mld, xqsr, xdin,   &  !! inputs
41     &  dms_surf, dms_andr, dms_simo, dms_aran, dms_hall )    !! outputs
42!     
43!=======================================================================
44      !!
45      !! Title  : Calculates DMS ocean surface concentration
46      !! Author : Julien Palmiéri and Andrew Yool
47      !! Date   : 08/08/14
48      !!
49      !! DMS module is called in trc_bio's huge jk,jj,ji loop
50      !! --> DMS concentration is calculated in a specific cell
51      !! (no need of ji,jj,jk)
52      !!
53      !! AXY (13/03/15): amend to include all four schemes tested
54      !!                 during winter/spring 2015; these are:
55      !!
56      !!                 1. Anderson et al. (2001); this uses fields
57      !!                    of surface chl, irradiance and nutrients
58      !!                    to empirically estimate DMS via a broken
59      !!                    stick approach
60      !!
61      !!                 2. Simo & Dachs (2002); this uses fields of
62      !!                    surface chl and mixed layer depth
63      !!
64      !!                 3. Aranami & Tsunogai (2004); this is an
65      !!                    embellishment of Simo & Dachs
66      !!
67      !!                 4. Halloran et al. (2010); this is an
68      !!                    alternative embellishment of Sim & Dachs
69      !!                    and is included because it is formally
70      !!                    published (and different from the above)
71      !!
72!=======================================================================
73
74      IMPLICIT NONE
75!
76      REAL(wp), INTENT( in )    :: chn                  !! non-diatom chlorophyll    (mg/m3)
77      REAL(wp), INTENT( in )    :: chd                  !! diatom chlorophyll        (mg/m3)
78      REAL(wp), INTENT( in )    :: mld                  !! mix layer depth           (m)
79      REAL(wp), INTENT( in )    :: xqsr                 !! surface irradiance        (W/m2)
80      REAL(wp), INTENT( in )    :: xdin                 !! surface DIN               (mmol N/m3)
81      REAL(wp), INTENT( inout ) :: dms_surf             !! DMS surface concentration (mol/m3)
82      REAL(wp), INTENT( inout ) :: dms_andr             !! DMS surface concentration (mol/m3)
83      REAL(wp), INTENT( inout ) :: dms_simo             !! DMS surface concentration (mol/m3)
84      REAL(wp), INTENT( inout ) :: dms_aran             !! DMS surface concentration (mol/m3)
85      REAL(wp), INTENT( inout ) :: dms_hall             !! DMS surface concentration (mol/m3)
86!
87      REAL(wp) :: CHL, cmr, sw_dms
88      REAL(wp) :: Jterm, Qterm
89      !! temporary variables
90      REAL(wp) ::    fq1,fq2,fq3
91!
92!! IJT (30/03/13): DMS calc needs this
93!! Julien : in Simo & Dachs, GBC, 2002, DMS is derived from
94!!          CHL/MLD ratio in mg/m4 (i.e. CHL is in mg/m3
95!!          MLD in m).
96!!          In MEDUSA, we already have CHL in mg/m3 for both
97!!          Diatoms and non-diatoms (zchn,zchd); and mld from
98!!          NEMO (hmld) in m.
99      CHL = 0.0
100!!
101!!            CHL = mask * TT(I,J,1,PHYTO_TRACER) &
102!!     &       * c2n_p * mw_carbon / CCHL_P(I,J,1,1)
103      CHL = chn+chd                                 !! mg/m3
104!!
105!! ------------------------------------------------
106!!  Calculate the DMS concentration in nM (nanomol/litre)
107!!   from Simo & Dachs, GBC, 2002, modified to be positive-definite
108!!   for MLD>182.536m, using DMS=90./MLD (Aranami & Tsunogai, JGR, 2004)
109!!   Multiply by 1.0E-6 to convert nM to (mol/m3)
110!!       cmr = fm(i,1)*chl/mld(i)
111!!       IF (cmr .lt. 0.02) THEN
112!!         IF (mld(i) .le. 182.536) THEN
113!!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(-LOG(mld(i)) + 5.7)
114!!         ELSE
115!!           csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(90./mld(i))
116!!         ENDIF
117!!       ELSE
118!!         csurf(i,astf_dms) = 1.0e-6*fm(i,1)*(55.8*cmr + 0.6)
119!!       ENDIF
120!!
121        cmr      = CHL / mld
122!       sw_dms   = 0.5 + SIGN( 0.5, cmr - 0.02 )
123!! Jpalm (11-08-2014)
124!! Explanation about the SIGN function :
125!! not easy to read, but maybe "more elegant and efficient")
126!! here for example:
127!! sw_dms = 1 if cmr is greater than 0.02,
128!!          0 if cmr lower than 0.02
129!! then
130!! if cmr < 0.02
131!!  dms_surf =  1.0e-6 * 90.0 / mld
132!!       or  =  1.0e-6 * 5.7 - LOG(mld)
133!! and if cmr > 0.02
134!!  dms_surf = 1.0e-6 * ( 55.8 * cmr + 0.6 )
135!! what is equivalent to the IF loops formulations.
136!! difference is on the stresholds between mld = 182.536m
137!! (strange value...)
138!! and the Max function... that stay uncertain.
139!!
140!        dms_surf = 1.0e-6 * ( sw_dms *             &
141!     &  ( 55.8 * cmr + 0.6 ) + ( 1.0 - sw_dms ) *  &
142!     &  ( MAX( 90.0 / mld, 5.7 - LOG(mld) ) ) )
143!
144! AXY (12/01/15): the DMS equation donated by the UKMO does not match
145!                 that reported in Halloran et al. (2010); amend the
146!                 equations appropriately
147!
148        if (cmr .lt. 0.02) then
149           dms_surf = (-1.0 * log(mld)) + 5.7
150        else
151           dms_surf = (55.8 * cmr) + 0.6
152        endif
153!   
154        if (mld > 182.5) then
155           dms_surf = (90.0 / mld)
156        endif
157!     
158        dms_surf = 1.0e-6 * dms_surf
159
160!
161!=======================================================================
162!
163! AXY (13/03/15): per remarks above, the following calculations estimate
164!                 DMS using all of the schemes examined for UKESM1
165!
166! AXY (13/03/15): Anderson et al. (2001)
167        Jterm = xqsr + 1.0e-6
168        !! this next line makes a hard-coded assumption about the
169        !! half-saturation constant of MEDUSA (which should be
170        !! done properly; perhaps even scaled with the proportion
171        !! of diatoms and non-diatoms)
172        Qterm = xdin / (xdin + 0.5)
173        fq1 = log10(CHL * Jterm * Qterm)
174        if (fq1 > 1.72) then
175           dms_andr = (8.24 * (fq1 - 1.72)) + 2.29
176        else
177           dms_andr = 2.29
178        endif
179        dms_andr = 1.0e-6 * dms_andr
180!
181! AXY (13/03/15): Simo & Dachs (2002)
182        cmr = CHL / mld
183        fq1 = (-1 * log(mld)) + 5.7
184        fq2 = (55.8 * cmr) + 0.6
185        if (cmr < 0.02) then
186           dms_simo = fq1
187        else
188           dms_simo = fq2
189        endif
190        dms_simo = 1.0e-6 * dms_simo
191!           
192! AXY (13/03/15): Aranami & Tsunogai (2004)
193        cmr = CHL / mld
194        fq1 = 60.0 / mld
195        fq2 = (55.8 * cmr) + 0.6
196        if (cmr < 0.02) then
197           dms_aran = fq1
198        else
199           dms_aran = fq2
200        endif
201        dms_aran = 1.0e-6 * dms_aran
202!       
203! AXY (13/03/15): Halloran et al. (2010)
204        cmr = CHL / mld
205        fq1 = (-1 * log(mld)) + 5.7
206        fq2 = (55.8 * cmr) + 0.6
207        fq3 = (90.0 / mld)
208        if (cmr < 0.02) then
209           dms_hall = fq1
210        else
211           dms_hall = fq2
212        endif
213        if (mld > 182.5) then
214           dms_hall = fq3
215        endif
216        dms_hall = 1.0e-6 * dms_hall
217
218  END SUBROUTINE trc_dms_medusa
219
220
221!=======================================================================
222!=======================================================================
223!=======================================================================
224
225#else
226   !!======================================================================
227   !!  Dummy module :                                   No MEDUSA bio-model
228   !!======================================================================
229
230CONTAINS
231
232!=======================================================================
233!
234   SUBROUTINE trc_dms_medusa( kt )                                        !! EMPTY Routine
235!     
236!
237      INTEGER, INTENT( in ) ::   kt
238!
239
240      WRITE(*,*) 'trc_dms_medusa: You should not have seen this print! error?'
241
242   END SUBROUTINE trc_dms_medusa
243#endif
244
245   !!======================================================================
246END MODULE  trcdms_medusa
247
248
Note: See TracBrowser for help on using the repository browser.