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

source: trunk/NEMO/TOP_SRC/SMS/h3clys.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.9 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 ---------------------------------------------------------------------------
6CCC $Header$
7CDIR$ LIST
8       SUBROUTINE h3clys
9#if defined key_passivetrc && defined key_trc_hamocc3
10CCC---------------------------------------------------------------------
11CCC
12CCC                       ROUTINE h3clys
13CCC                     ******************
14CCC
15CCC
16CCC     PURPOSE.
17CCC     --------
18CCC          *H3CLYS*  CALCULATES DEGREE OF CACO3 SATURATION IN THE WATER
19CCC                    COLUMN, DISSOLUTION/PRECIPITATION OF CACO3 AND LOSS
20CCC                    OF CACO3 TO THE CACO3 SEDIMENT POOL.
21CCC
22CC
23CC     METHOD.
24CC     -------
25CC          [H+] AND [CO3--] FOR THE ACTUAL TIME STEP ARE CALCULATED
26CC     BY NEWTON-RAPHSON ITERATION (E.G. SCARBOROUGH, 1958).
27CC
28CC     EXTERNALS.
29CC     ----------
30CC          NONE.
31CC
32CC     REFERENCE.
33CC     ----------
34CC
35CC          SCARBOROUGH, J. (1958) NUMERICAL MATHEMATICAL ANALYSIS.
36CC          OXFORD UNIVERSITY PRESS, LONDON, 4TH ED., 576 PP..
37CC
38CC*     VARIABLE           TYPE    PURPOSE.
39CC      --------           ----    --------
40CC 
41CC      *NYEAR*            INTEGER COUNTS TIMESTEPS (YEARS) OF INTEGRATION
42CC                           (INTEGER, INPUT)
43CC      *CONVEG*           REAL    CHECK FOR CONVERGENCE OF NEWTON-RAPHSON
44CC                                 METHOD
45CC      *KITTER*           INTEGER SETS UPPER LIMIT FOR NUMBER OF ITERATIONS
46CC                                 TO DETERMINE [CO3--] AND [H+]
47CC      *AKW*              REAL    APPROXIMATE VALUE OF IONIC PRODUCT OF
48CC                                 WATER
49CC      *H*                REAL    [H+], DUMMY VARIABLE
50CC      *R*                REAL    [CO3--] [MOLE/L], DUMMY VARIABLE
51CC      *ALKA*             REAL    GIVEN ALKALINITY [EQV/L], DUMMY VARIABLE
52CC      *C*                REAL    GIVEN [SUM(12C)O2] [MOLE/L], DUMMY VARIABLE
53CC      *A*                REAL    ALKALINITY [EQV/L] AS FUNCTION OF [CO3--]
54CC                                 AND [H+], DUMMY VARIABLE
55CC      *DELCO3*           REAL    DEVIATION OF ACTUAL CACO3 CONCENTRATION FROM
56CC                                 SATURATION VALUE
57CC      *UNDSAT*           REAL    UNDERSATURATION OF CACO3 (E.G. 3.=THREEFOLD)
58CC      *EXCESS*           REAL    EXCESS OF CACO3 (E.G. 3.=THREEFOLD)
59CC      *DISPOT*           REAL    FRACTION CACO3 (12C) THAT IS DISSOLVED
60CC      *EXCE14*           REAL    SUPERSATURATION IN CA(14C)O3 (E.G. 3.=
61CC                                 THREEFOLD)
62CC      *DISP14*           REAL    FRACTION CACO3 (14C) THAT IS DISSOLVED
63CC      *EXCE13*           REAL    SUPERSATURATION IN CA(13C)O3 (E.G. 3.=
64CC                                 THREEFOLD)
65CC      *DISP13*           REAL    FRACTION CACO3 (13C) THAT IS DISSOLVED
66CC      *SEDLOS*           REAL    FRACTION OF CACO3 IN THE BOTTOM WATER LAYER
67CC                                 LOST TO THE CACO3 SEDIMENT POOL
68CC      *SEDLOI*           REAL    FRACTION OF CACO3 IN THE BOTTOM WATER LAYER
69CC                                 WHICH REMAINS IN THE WATER COLUMN
70CC
71CC   MODIFICATIONS:
72CC   --------------
73CC      original      : 1988-07 E. MAIER-REIMER      MPI HAMBURG
74CC      additions     : 1998    O. Aumont
75CC      modifications : 1999    C. Le Quere
76CC ---------------------------------------------------------------------------
77CC parameters and commons
78CC ======================
79CDIR$ NOLIST
80      USE oce_trc
81      USE trp_trc
82      USE sms
83      IMPLICIT NONE
84CDIR$ LIST
85CC----------------------------------------------------------------------
86CC local declarations
87CC ==================
88C
89      INTEGER ji, jj, jk, jn
90      INTEGER kitter
91      REAL bot, alka
92      REAL r, a, c
93      REAL delco3, excess, dispot
94      REAL h,remco3,ah2
95      REAL conveg, bicarb, caralk
96C
97C ------------------------------------------------------------------
98C
99C* 1. SET HALF PRECISION CONSTANTS
100C --------------------------------
101C
102      zero = 0.
103C
104C ===========================================================
105C* 2. ITERATION TO DETERMINE [CO3--] AND [H+]
106C     (NEWTON-RAPHSON METHOD:
107C     THE VALUES OF [SUM(CO2)] AND [ALK] ARE GIVEN,
108C     DESIRED ROOTS OF [CO3--] AND [H+] FOR THAT PAIR
109C     ARE DETERMINED BY SOLVING NUMERICALLY THE SYSTEM
110C     OF THE TWO NONLINEAR EQUATIONS
111C     1) [ALK]GIVEN      - [ALK]([CO3--],[H+])      = 0 (=F)
112C     2) [SUM(CO2)]GIVEN - [SUM(CO2)]([CO3--],[H+]) = 0 (=GG)
113C ===========================================================
114C
115C
116C* 2.1  SET MAX. NUMBER OF ITERATIONS
117C --------------------------------------
118C
119      kitter = 15
120C
121C* 2.2  SET DAMPING PARAMETERS FOR CORRECTIONS OF [CO3--]
122C       AND [H+]
123C -------------------------------------------------------
124C
125C
126C 2.3 INITIALISATION OF [HI+], and [CO3--]
127C ----------------------------------------
128C
129      DO jk=1,jpkm1
130        DO jj=1,jpj
131          DO ji=1,jpi
132            caralk = trn(ji,jj,jk,jptal)-
133     &          borat(ji,jj,jk)/(1.+1E-8/akb3(ji,jj,jk))
134            co3(ji,jj,jk) = caralk-trn(ji,jj,jk,jpdic)
135     &          +(1.-tmask(ji,jj,jk))*.5e-3
136            bicarb = (2.*trn(ji,jj,jk,jpdic)-caralk)
137            hi(ji,jj,jk) = ak23(ji,jj,jk)*bicarb/co3(ji,jj,jk)
138          END DO
139        END DO
140      END DO
141C
142C* 2.4  BEGIN OF ITERATION
143C ------------------------
144C
145      DO jn = 1,kitter
146C
147C* 2.5  COMPUTE [CO3--] and [H+] CONCENTRATIONS
148C -------------------------------------------
149C
150        rconvs=0.
151        DO jk = 1,jpkm1
152          DO jj=1,jpj
153            DO ji = 1, jpi
154C
155C* 2.6  SET DUMMY VARIABLE FOR TOTAL BORATE
156C -----------------------------------------
157C
158              bot = borat(ji,jj,jk)
159C
160C* 2.7  SET DUMMY VARIABLE FOR [H+], AND [CO3--]
161C ----------------------------------------------
162C
163              h = hi(ji,jj,jk)+(1.-tmask(ji,jj,jk))*1.e-9
164              h = amax1(hi(ji,jj,jk),1.E-10)
165              r = co3(ji,jj,jk)+(1.-tmask(ji,jj,jk))*.5e-3
166C
167C* 2.8  SET DUMMY VARIABLE FOR [ALK]GIVEN AND
168C       [SUM(CO2)]GIVEN
169C -------------------------------------------
170C
171              alka = trn(ji,jj,jk,jptal) 
172              c = trn(ji,jj,jk,jpdic) 
173C
174C* 2.9 CALCULATE [ALK]([CO3--], [HCO3-])
175C ------------------------------------
176C
177              a=alka-
178     &            (akw3(ji,jj,jk)/h-h+bot/(1.+h/akb3(ji,jj,jk)))
179C
180C* 2.10 CALCULATE [H+] and [CO3--]
181C -----------------------------------------
182C
183              ah2=sqrt((c-a)**2+4.*(a*ak23(ji,jj,jk)/ak13(ji,jj,jk))
184     &            *(2*c-a))
185              ah2=0.5*ak13(ji,jj,jk)/a*((c-a)+ah2)
186              co3(ji,jj,jk) = a/(2.+ah2/ak23(ji,jj,jk))
187C
188C* 2.11 CONTROL VARIABLE TO CHECK CONVERGENCE
189C -------------------------------------------
190C
191c
192              conveg=((ah2-hi(ji,jj,jk))/hi(ji,jj,jk))**2
193     $            *tmask(ji,jj,jk)
194              rconvs = rconvs+conveg
195              hi(ji,jj,jk)  = ah2
196            ENDDO
197          ENDDO
198        END DO
199C
200C
201C  2.12 CHECK CONVERGENCE
202C  ----------------------
203C
204        IF (rconvs.LE.1.E-2) EXIT
205C
206      END DO
207C
208C     ---------------------------------------------------------
209C*    3. CALCULATE DEGREE OF CACO3 SATURATION AND CORRESPONDING
210C        DISSOLOUTION AND PRECIPITATION OF CACO3 (BE AWARE OF
211C        MGCO3)
212C     ---------------------------------------------------------
213C
214      DO jk = 2,jpkm1
215        DO jj = 1,jpj
216          DO ji = 1, jpi
217C
218C* 3.1  DEVIATION OF [CO3--] FROM SATURATION VALUE
219C ------------------------------------------------
220C
221            delco3 = co3(ji,jj,jk)-aksp(ji,jj,jk)/calcon
222C
223C* 3.2  SET DEGREE OF UNDER-/SUPERSATURATION
224C ------------------------------------------
225C
226            excess = amax1(zero,delco3)
227C
228C* 3.3  AMOUNT CACO3 (12C) THAT RE-ENTERS SOLUTION
229C       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE
230C       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION)
231C --------------------------------------------------------------
232C
233            dispot = trn(ji,jj,jk,jpcal)*amin1(1.,
234     &          (1.-delco3/(dispo0+abs(delco3))) )
235#    if defined key_off_degrad
236     &          *facvol(ji,jj,jk)
237#    endif
238C
239C* 3.5  CHANGE OF PARTICULATE CACO3 AND TOTAL INORGANIC 14C
240C       IN THE WATER COLUMN DUE TO CACO3 DISSOLUTION/PRECIP.
241C ----------------------------------------------------------
242C
243            cristl = spocri
244#    if defined key_off_degrad
245     &          *facvol(ji,jj,jk)
246#    endif
247C* 3.8  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3],
248C       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION
249C -----------------------------------------------------------
250C
251            remco3=(dispot-excess*cristl)/rmoss
252            co3(ji,jj,jk) = co3(ji,jj,jk)
253     &          +remco3*rfact
254            tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal)+
255     &          2.*remco3
256            tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal)-
257     &          remco3
258            tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic)+
259     &          remco3
260#    if defined key_trc_biohamocc13
261            tra(ji,jj,jk,jp13c) = tra(ji,jj,jk,jp13c)+pdb*
262     &          remco3
263#    endif
264C
265C
266          ENDDO
267        ENDDO
268      END DO
269C
270#endif
271      RETURN
272      END
273
Note: See TracBrowser for help on using the repository browser.