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.
h3cexp.F in trunk/NEMO/TOP_SRC/SMS – NEMO

source: trunk/NEMO/TOP_SRC/SMS/h3cexp.F @ 247

Last change on this file since 247 was 247, checked in by opalod, 19 years ago

CL : Add CVS Header and CeCILL licence information
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 8.0 KB
Line 
1
2CCC $Header$ 
3CCC  TOP 1.0 , LOCEAN-IPSL (2005) 
4C This software is governed by CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
5C ---------------------------------------------------------------------------
6      SUBROUTINE h3cexp
7#if defined key_passivetrc && defined key_trc_hamocc3
8CCC---------------------------------------------------------------------
9CCC
10CCC                       ROUTINE h3cexp
11CCC                     ******************
12CCC
13CC
14CC     PURPOSE.
15CC     --------
16CC          *H3CEXP* MODELS EXPORT OF BIOGENIC MATTER (POC ''SOFT
17CC                   TISSUE'' AND CACO3 PARTICLES ''HARD PARTS'')
18CC                   AND ITS DISTRIBUTION IN WATER COLUMN
19CC
20CC     METHOD.
21CC     -------
22CC          IN THE SURFACE LAYER POC IS PRODUCED ACCORDING TO
23CC     NURTRIENTS AVAILABLE AND GROWTH CONDITIONS. NUTRIENT UPTAKE
24CC     KINETICS FOLLOW MICHAELIS-MENTON FORMULATION. PROPORTIONAL
25CC     TO THE AMOUNT OF ORGANIC MATTER, CACO3 HARD PARTS ARE PRODUCED.
26CC     THE TOTAL PARTICLE AMOUNT PRODUCED, IS DISTRIBUTED IN THE WATER
27CC     COLUMN BELOW THE SURFACE LAYER.
28CC
29CC     EXTERNALS.
30CC     ----------
31CC          NONE.
32CC
33CC     REFERENCE.
34CC     ----------
35CC
36CC          BACASTOW, R., AND E. MAIER-REIMER (1985)
37CC          CIRCULATION MODEL OF THE OCEAN CARBON CYCLE.
38CC          1. DESCRIPTION OF THE MODEL, PP. 224-232.
39CC          2. COMPARISON OF THE MODEL RESULTS WITH OBSERVATIONAL DATA,
40CC          PP. 233-240.
41CC          IN: "ATMOSPHERIC CARBON DIOXIDE - ITS SOURCES, SINKS, AND
42CC          GLOBAL tranSPORT", KANDERSTEG, 2 TO 6 SEPTEMBER 1985,
43CC          COMMISSION ON ATMOSPHERIC CHEMISTRY AND GLOBAL POLLUTION,
44CC          INTERNATIONAL ASSOCIATION OF METEOROLOGY AND ATMOSPHERIC
45c PHYSICS.
46CC
47CC   MODIFICATIONS:
48CC   --------------
49CC      original      : 1999    O. Aumont
50CC      modifications : 1999    C. Le Quere
51CC                    : 2001    O. Aumont
52CC                    : 01/03   O. Aumont,EK: add sediments 
53CC                              for calcite and silicate
54CC ---------------------------------------------------------------------
55c ------
56CC parameters and commons
57CC ======================
58CDIR$ NOLIST
59      USE oce_trc
60      USE trp_trc
61      USE sms
62      USE lbclnk
63      IMPLICIT NONE
64#include "domzgr_substitute.h90"
65CDIR$ LIST
66CC----------------------------------------------------------------------
67CC local declarations
68CC ==================
69C
70      INTEGER ji, jj, jk, zkbot(jpi,jpj)
71      REAL prcaca12(jpi,jpj),silpro12(jpi,jpj)
72      REAL silcri,sister
73      REAL zgeolsil, zgeolcal
74C
75      silcri = 4.e-4*rfact/(3600.*24.*30.5)
76      prcaca12 = 0.0
77      fbod = 0.0
78      silpro12 = 0.0
79C
80C VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC
81C CACO3 PARTICLES AND POC IN THE WATER COLUMN
82C (PARTS OF NEWLY FORMED MATTER REMAINING IN THE DIFFERENT
83C LAYERS IS DETERMINED BY DMIN3, DISC3 AS DEFINED IN common.passivetrc
84c .hamocc3.h
85C ----------------------------------------------------------------------
86c --------
87C
88      DO jk = 1,jpkb
89        DO jj = 1,jpj
90          DO ji = 1,jpi
91            prcaca12(ji,jj) = prcaca12(ji,jj)+
92     &          e3t(jk)*prcaca(ji,jj,jk)*tmask(ji,jj,jk)*rfactr
93            silpro12(ji,jj) = silpro12(ji,jj)+silpro(ji,jj,jk)*
94     &          tmask(ji,jj,jk)*e3t(jk)*rfactr
95          ENDDO
96        ENDDO
97      ENDDO
98
99C
100#    if defined key_trc_p3zd
101      DO jj = 1,jpj
102        DO ji = 1,jpi
103          fbod(ji,jj) = fbod(ji,jj)+(sinking(ji,jj,11)
104     $        +nu(ji,jj,11))*tmask(ji,jj,10)*rfactr
105        ENDDO
106      ENDDO
107#    else
108      DO jk = 1,jpkb
109        DO jj = 1,jpj
110          DO ji = 1,jpi
111            fbod(ji,jj) = fbod(ji,jj)+
112     &          e3t(jk)*prorca(ji,jj,jk)*tmask(ji,jj,jk)
113     &          *rfactr
114          ENDDO
115        ENDDO
116      ENDDO
117#    endif
118C
119#    if defined key_trc_diaadd
120      DO jj = 1,jpj
121        DO ji = 1,jpi
122          trc2d(ji,jj,5) = fbod(ji,jj)*1.e3
123          trc2d(ji,jj,6) = prcaca12(ji,jj)*1.e3
124          trc2d(ji,jj,7) = silpro12(ji,jj)*1.e3
125        ENDDO
126      ENDDO 
127#    endif
128C
129      DO jk = 1,jpk
130        DO jj = 1,jpj
131          DO ji = 1,jpi
132#    if defined key_trc_p3zd
133            trn(ji,jj,jk,jpcal) = trn(ji,jj,jk,jpcal)+disc3(ji,jj,jk)*
134     &          prcaca12(ji,jj)/e3t(jk)*rdt
135            trn(ji,jj,jk,jpsil) = trn(ji,jj,jk,jpsil)+silpro12(ji,jj)*
136     &          diss3(ji,jj,jk)*1./e3t(jk)*rdt
137CC          trn(ji,jj,jk,jpsil) = min(200.e-6,trn(ji,jj,jk,jpsil))
138#    else
139            tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal)+disc3(ji,jj,jk)*
140     &                            prcaca12(ji,jj)/e3t(jk)
141            tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil)+silpro12(ji,jj)*
142     &                            diss3(ji,jj,jk)*1./e3t(jk)
143CC          sister = max(0.,silpro12(ji,jj)*diss3(ji,jj,jk)-silcri)
144CC          tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil)-
145CC   &                            sister/e3t(jk)*rfactr
146#    endif
147          ENDDO
148        ENDDO
149      ENDDO
150C
151      zkbot = jpk
152C
153      DO jk = 1,jpkm1
154        DO jj = 2,jpjm1
155          DO ji = 2,jpim1
156 
157             IF (tmask(ji,jj,jk).eq.1.and.
158     .           tmask(ji,jj,jk+1).eq.0) THEN
159C
160                  zkbot(ji,jj) = jk
161C
162              ENDIF
163
164             ENDDO
165         ENDDO
166      ENDDO
167C
168C
169C     Initialization
170      zgeolcal = 0.
171      zgeolsil = 0.
172
173C
174C     sedlam --> sedlam/100 for silicate and calcite
175C
176        DO jj = 2,jpjm1
177          DO ji = 2,jpim1
178
179#            if defined key_trc_p3zd
180             trn(ji,jj,zkbot(ji,jj),jpcal) =
181     .          trn(ji,jj,zkbot(ji,jj),jpcal) +
182     .               sedlam/100.
183     .               *sedcal(ji,jj)*rdt/fse3t(ji,jj,zkbot(ji,jj))
184             trn(ji,jj,zkbot(ji,jj),jpsil) =
185     .          trn(ji,jj,zkbot(ji,jj),jpsil) +
186     .               sedlam/100.
187     .               *sedsil(ji,jj)*rdt/fse3t(ji,jj,zkbot(ji,jj))
188#            elif defined key_trc_hamocc3 && ! defined key_trc_p3zd
189             tra(ji,jj,zkbot(ji,jj),jpcal) =
190     .          tra(ji,jj,zkbot(ji,jj),jpcal) +
191     .               sedlam/100.
192     .               *sedcal(ji,jj)/fse3t(ji,jj,zkbot(ji,jj))
193             tra(ji,jj,zkbot(ji,jj),jpsil) =
194     .          tra(ji,jj,zkbot(ji,jj),jpsil) +
195     .               sedlam/100.
196     .               *sedsil(ji,jj)/fse3t(ji,jj,zkbot(ji,jj))
197#            endif
198
199             zgeolcal = zgeolcal + sedlostcal*sedcal(ji,jj)*
200     .                             e1t(ji,jj)*e2t(ji,jj)
201             sedcal(ji,jj) = sedcal(ji,jj)  +
202     .                       discl(ji,jj)*prcaca12(ji,jj)*rdt -
203     .                       sedlam/100.*sedcal(ji,jj)*rdt -
204     .                       sedlostcal*sedcal(ji,jj)*rdt
205
206             zgeolsil = zgeolsil + sedlostsil*sedsil(ji,jj)*
207     .                             e1t(ji,jj)*e2t(ji,jj)
208             sedsil(ji,jj) = sedsil(ji,jj)  +
209     .                       dissl(ji,jj)*silpro12(ji,jj)*rdt -
210     .                       sedlam/100.*sedsil(ji,jj)*rdt - 
211     .                       sedlostsil*sedsil(ji,jj)*rdt
212
213C
214             ENDDO
215         ENDDO
216
217        DO jj = 2,jpjm1
218          DO ji = 2,jpim1
219
220#            if defined key_trc_p3zd
221             trn(ji,jj,1,jpcal) = trn(ji,jj,1,jpcal) + zgeolcal*rdt*
222     .                            cmask(ji,jj)/areacot/fse3t(ji,jj,1)
223             trn(ji,jj,1,jpsil) = trn(ji,jj,1,jpsil) + zgeolsil*rdt*
224     .                            cmask(ji,jj)/areacot/fse3t(ji,jj,1)
225#            elif defined key_trc_hamocc3 && ! defined key_trc_p3zd
226             tra(ji,jj,1,jpcal) = tra(ji,jj,1,jpcal) + zgeolcal*
227     .                            cmask(ji,jj)/areacot/fse3t(ji,jj,1)
228             tra(ji,jj,1,jpsil) = tra(ji,jj,1,jpsil) + zgeolsil*
229     .                            cmask(ji,jj)/areacot/fse3t(ji,jj,1)
230#            endif
231
232             ENDDO
233         ENDDO
234C
235         CALL lbc_lnk(sedcal,'T',1)
236         CALL lbc_lnk(sedsil,'T',1)
237
238C Oa & Ek: diagnostics depending on jpdia2d
239C          left as example
240#     if defined key_trc_diaadd
241           do jj=1,jpj
242             do ji=1,jpi
243              trc2d(ji,jj,12)=sedcal(ji,jj)
244              trc2d(ji,jj,13)=sedsil(ji,jj)
245             end do
246           end do
247#     endif
248
249#endif
250
251      RETURN
252      END
Note: See TracBrowser for help on using the repository browser.