source: branches/2016/dev_v3.20_2016_gravity_drainage/SOURCES/source_3.20/ice_carb_chem.f @ 8

Last change on this file since 8 was 4, checked in by vancop, 8 years ago

initial import /Users/ioulianikolskaia/Boulot/CODES/LIM1D/ARCHIVE/TMP/LIM1D_v3.20/

File size: 15.9 KB
Line 
1      SUBROUTINE ice_carb_chem
2
3!------------------------------------------------------------------------------!
4!                               *** ice_carb_chem ***
5!
6!     This routine re-equilibrates the chemical species of the carbonate system
7!     given two variables (DIC and Alk, or CO2 and Alk)
8!     
9!     Original code: Zeebe and Wolf-Gladrow, 2001. CO2 in Seawater:
10!                    Equilibrium, Kinetics, Isotopes.
11!       (http://www.soest.hawaii.edu/oceanography/faculty/zeebe_files/CO2_System_in_Seawater/csys.html)
12!
13!     Translation in F90: S. Moreau, P.-Y Barriat, S. Dubinkina, June 2012
14!
15!     Rewriting: M. Vancopppenolle, S. Moreau, Dec 2015
16!
17!     - Remove dummy arrays for T and S (use t_i_bio and sbr_bio instead)
18!     - change the name of the routine
19!     - remove the obsolete declarations
20
21! Present status : c_i_bio(13,*) is wrong... to be continued!!
22!   
23!------------------------------------------------------------------------------!
24
25      USE lib_fortran
26
27      INCLUDE 'type.com'
28      INCLUDE 'para.com'
29      INCLUDE 'const.com'
30      INCLUDE 'ice.com'
31      INCLUDE 'thermo.com'
32      INCLUDE 'bio.com'
33
34      EXTERNAL zgeev ! lapack (computes the eigenvalues of complex nonsymmetric matrix)
35
36       REAL(8), DIMENSION(nlay_bio) :: 
37     &    Kw,                      !: Equilibrium constants
38     &    Kh,
39     &    Kb,
40     &    Ks,
41     &    Kf,
42     &    K1,
43     &    K2
44
45       REAL(8) :: ! define local variables
46     &    h1,
47     &    ztmp,
48     &    ztmp1,
49     &    ztmp2,
50     &    ztmp3,
51     &    ztmp4,
52     &    zbor,
53     &    zT,
54     &    z1T,
55     &    zlogT,
56     &    zT2,
57     &    zT3,
58     &    ztc,
59     &    ztc2,
60     &    ztc3,
61     &    zS12,
62     &    zS,
63     &    zS32,
64     &    zS2,
65     &    zhp 
66
67       LOGICAL ::
68     &   ln_write_bio = .TRUE. 
69
70       REAL(8), DIMENSION(6) :: 
71     &    zpoly 
72
73      INTEGER(4), PARAMETER ::   ! Parameters for H+ retrieval
74     &    n_hp = 5               ! size of the polynom
75
76      REAL(8) :: 
77     &    zb5(2,0:n_hp),
78     &    zrwrk(2*n_hp)
79
80      INTEGER(4) 
81     &    zinfo
82
83!     COMPLEX(16) ::
84      DOUBLE COMPLEX ::
85     &    zA(n_hp+1,n_hp+1),
86     &    zvl(n_hp,n_hp),
87     &    zvr(n_hp,n_hp),
88     &    zwrk(3*n_hp),
89     &    zeigs(n_hp)
90
91!==============================================================================!
92
93      IF ( ln_write_bio ) THEN
94
95         WRITE(numout,*)
96         WRITE(numout,*) ' ice_carb_chem '
97         WRITE(numout,*) '~~~~~~~~~~~~~~~'
98         WRITE(numout,*)
99
100      ENDIF
101
102      CALL ice_brine
103
104      DO layer = 1, nlay_bio
105
106         !------------------------------------------------------------
107         ! 1) Physical inputs (temperature and brine salinity)
108         !------------------------------------------------------------
109
110         ! temperature factors
111         zT    = t_i_bio(layer)
112         z1t   = 1.d0/zT
113         zlogT = LOG(zT)
114         zT2   = zT*zT
115
116         ! Brine salinity factors
117         ztc  = tc_bio(layer)
118         ztc2 = ztc*ztc
119         ztc3 = ztc2 * ztc
120
121         zS12  = SQRT(sbr_bio(layer))
122         zS    = sbr_bio(layer)
123         zS32  = zS12*zS
124         zS2   = zS*zS
125
126         !----------------------------------------------------------------
127         ! 2) Equilibrium constants
128         !----------------------------------------------------------------
129         !
130         !    units: mol/kg-soln
131         !    set phflag (0:Total), (1:Free)
132
133         !--- Kw (water dissociation constant)
134         !--------------------------------------
135         !
136         !       Millero (1995)(in Dickson and Goyet (1994, Chapter 5, p.18))
137         !       K_w in mol/kg-soln.
138         !       pH-scale: total scale.
139
140         ztmp1 = -13847.26*z1T + 148.96502 - 23.6521*zlogT
141         ztmp2 = ( 118.67*z1T - 5.977 + 1.0495*zlogT)*zs12 - 0.01615*zS
142
143         ztmp = ztmp1 + ztmp2
144
145         Kw(layer)  = EXP(ztmp)
146
147         !--- Kh (Henry's solubility)
148         !----------------------------
149         !
150         !               CO2(g) <-> CO2(aq.)
151         !               Kh      = [CO2]/ p CO2
152         !
153         !   Weiss (1974)   [mol/kg/atm]
154         !
155
156         ztmp = 9345.17*z1t - 60.2409 + 23.3585*(zlogt - LOG(100.))
157         ztmp = ztmp + zS*( 0.023517 - 2.3656e-4*zT + 4.7036e-7*zT2 )
158
159         Kh(layer) = EXP(ztmp)
160
161         !--- K1 (first acidity constant)
162         !--------------------------------
163         !   [H+].[HCO3-]/[CO2] = K1
164
165         IF ( nn_carbonate .EQ. 1 ) THEN
166            !   Roy et al. (1993) IN: Dickson and Goyet (1994), Ch. 5, p. 14
167            !   pH-scale: 'total'. mol/kg-soln
168 
169            ztmp1 = 2.83655 - 2307.1266*z1t - 
170     &                       1.5529413*zlogt
171            ztmp2 = - ( 0.20760841 + 4.0484 *z1t ) * zs12
172            ztmp3 = 0.08468345*zS - 0.00654208*zS32
173            ztmp4 = LOG( 1. - 0.001005*zS )
174
175            ztmp   = ztmp1 + ztmp2 + ztmp3 + ztmp4
176 
177            K1(layer) = EXP(ztmp)
178
179         ELSE
180            !   Mehrbach et al (1973) refit by Lueker et al. (2000).
181            !   pH-scale: 'total'. mol/kg-soln
182            ztmp      = 3633.86 * z1t - 61.2172 + 9.6777*zlogt - 
183     &                  0.011555*zS + 0.0001152*zS2
184   
185            K1(layer) = 10**(-ztmp)
186
187         ENDIF
188
189        !--- K2 (second acidity constant)
190        !---------------------------------
191        !   [H+].[CO32-]/[HCO3-] = K2
192
193         IF ( nn_carbonate .EQ. 1 ) THEN
194           ! Roy et al 1993, total ph-scale mol/kg-soln
195           ztmp1 = - 9.226508 - 3351.6106*z1t - 0.2005743*zlogt
196           ztmp2 = ( -0.106901773 - 23.9722*z1t ) * zs12
197           ztmp3 = 0.1130822*zs - 8.46934e-3*zs32 + LOG(1.-1.005e-3*zS)
198   
199           ztmp = ztmp1 + ztmp2 + ztmp3
200   
201           K2(layer)  = EXP(ztmp)
202
203         ELSE
204
205           ! Mehrbach et al. (1973) refit by Lueker et al. (2000).
206           ztmp    = 471.78*z1T + 25.9290 - 
207     &               3.16967*zlogT - 
208     &               0.01781*zS + 0.0001122*zS2
209
210           K2(layer)  = 10**(-ztmp)
211
212         ENDIF
213
214         !--- KB (Boron dissociation constant)
215         !-------------------------------------
216         !  Kbor = [H+][B(OH)4-]/[B(OH)3]
217         !  Dickson (1990), IN:Dickson and Goyet, 1994, Chapter 5, p. 14)
218         !  pH-scale: 'total'. mol/kg-soln
219
220         ztmp1  =  ( -8966.90 - 2890.53*zs12 - 77.942 * zS + 
221     &             1.728*zS32 - 0.0996*zS2 )
222         ztmp2  =  148.0248 + 137.1942 * zs12 + 1.62142 * zS
223         ztmp3  = (-24.4344 - 25.085*zs12 - 0.2474*zs)*zlogT
224         
225         ztmp   = ztmp1 * z1t + ztmp2 + ztmp3 + 0.053105*zs12*zT
226
227         Kb(layer) = EXP(ztmp)
228
229      END DO ! layer
230
231      IF ( ln_write_bio ) THEN
232 
233         WRITE(numout,*)
234         WRITE(numout,*) ' Carbonate system constants '
235         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
236         WRITE(numout,*)
237         WRITE(numout,*) ' Kw :',( Kw(layer), layer=layer_00, nlay_bio )
238         WRITE(numout,*)
239         WRITE(numout,*) ' Kh :',( Kh(layer), layer=layer_00, nlay_bio )
240         WRITE(numout,*)
241         WRITE(numout,*) ' K1 :',( K1(layer), layer=layer_00, nlay_bio )
242         WRITE(numout,*)
243         WRITE(numout,*) ' K2 :',( K2(layer), layer=layer_00, nlay_bio )
244         WRITE(numout,*)
245         WRITE(numout,*) ' Kb :',( Kb(layer), layer=layer_00, nlay_bio )
246
247      ENDIF
248 
249      !------------------------------------------------------------------------
250      ! 3) Convert brine concentrations units (mmol/m3 -> mol/kg)
251      !------------------------------------------------------------------------
252      ! mmol/m3 to mol/kg
253      DO layer = 1, nlay_bio
254
255         zunit = 1000. * rhobr_bio(layer)
256
257         c_i_bio(jn_dic,layer) =
258     &      c_i_bio(jn_dic,layer) / zunit
259
260         c_i_bio(jn_alk,layer) =
261     &      c_i_bio(jn_alk,layer) / zunit
262
263      END DO
264
265      ! Alk
266
267      !------------------------------------------------------------------------
268      ! 4) Carbonate system equilibration
269      !------------------------------------------------------------------------
270
271      DO layer = 1, nlay_bio
272
273         !--- polynomial coefficients
274         !----------------------------
275         zbor = 1.*(416.*(sbr_bio(layer)/35.))* 1.e-6      ! Total boron (mol/kg), DOE94
276
277         ! Compute the coefficients of the 5th order polynom for H+
278         ! -> Check Orr et al GMD 2015 and Munhoven et al., GBC2014 for more efficient computations
279         
280         ! poly   = [p5 p4 p3 p2 p1 p0]
281         ! test = p5 h⁵ + p4 h⁴ + p3 h³ + p2 h² + p1 h¹ + p0
282
283         zpoly(1)  = - 1.                                        ! p5
284
285         zpoly(2)  = - c_i_bio(jn_alk,layer) -                   ! p4
286     &               Kb(layer) - K1(layer) 
287
288         zpoly(3)  = c_i_bio(jn_dic,layer)*K1(layer) -           ! p3
289     &               c_i_bio(jn_alk,layer)*( Kb(layer) + K1(layer) ) +
290     &               Kb(layer)*zbor + Kw(layer) - 
291     &               Kb(layer)*K1(layer) - K1(layer)*K2(layer) 
292 
293         ztmp      = c_i_bio(jn_alk,layer)*( Kb(layer)*K1(layer) + 
294     &               2.*K1(layer)*K2(layer)) - c_i_bio(jn_dic,layer)*
295     &               ( Kb(layer)*K1(layer) + K1(layer)*K2(layer) ) +
296     &               Kb(layer)*zbor*K1(layer) 
297
298         zpoly(4)  = ztmp + Kw(layer)*Kb(layer) +                ! p2
299     &               Kw(layer)*K1(layer) - 
300     &               Kb(layer)*K1(layer)*K2(layer)
301
302         ztmp     = ( 2.*c_i_bio(jn_dic,layer) - 
303     &              c_i_bio(jn_alk,layer) + zbor)*
304     &              K1(layer)*K2(layer)*Kb(layer)
305
306         zpoly(5)  = ztmp + ( Kb(layer) + K2(layer) )*           ! p1
307     &               K1(layer)*Kw(layer)
308
309         zpoly(6)  = Kw(layer)*Kb(layer)*K1(layer)*K2(layer)     ! p0
310
311         !--- find roots of the 5th degree monic polynomial
312         !--------------------------------------------------
313         zb5(1,0:n_hp) = zpoly(:)
314         zb5(2,:)      = 0.d0
315
316!        IF ( ln_write_bio ) THEN
317!           WRITE(numout,*)
318!           WRITE(numout,*) ' zb5 - 1 : ', zb5(1,0:n_hp)
319!           WRITE(numout,*) ' zb5 - 2 : ', zb5(2,0:n_hp)
320!           WRITE(numout,*)
321!           WRITE(numout,*) ' zpoly : ', zpoly
322!           WRITE(numout,*)
323!        ENDIF
324
325            ! Setup companion matrix for polynomials
326         DO i = 1, n_hp + 1
327            DO j = 1, n_hp + 1
328               IF ( j .EQ. n_hp+1 ) THEN
329                  zA(i,j) = -DCMPLX(zb5(1, n_hp+1-i),zb5(2,n_hp+1-i))
330               ELSE IF (J.EQ.I-1) THEN
331                  zA(i,j) = DCMPLX(1.d0,0.d0)
332               ELSE
333                  zA(i,j) = DCMPLX(0.d0,0.d0)
334               ENDIF
335            END DO
336         END DO
337
338!         IF ( ln_write_bio ) THEN
339!            WRITE(numout,*)
340!            WRITE(numout,*) ' zA    : ', zA
341!            WRITE(numout,*)
342!         ENDIF
343
344         ! Calculate eigenvalues of companion matrix (LAPACK)
345         ! 'N' -> left eigen vectors are not computed
346         ! 'N' -> right egien vectors are not computer
347         ! n_hp+1 -> order of the matrix A
348         ! A    -> complex matrix, dimension (LDA, N)
349         !         ->IN: complex NxN
350         !         ->OUT: overwritten
351         ! n_hp+1 -> leading dimension of A
352         ! zeigs-> computed eigen values
353         ! zvl   -> dummy (unused here) left eigenvector
354         ! n_hp + 1 -> dimension of eigen vector
355         ! zvr  -> dummy (unused here) left eigenvector
356         ! n_hp + 1 -> dimension of right eigen vector
357         ! zwrk, zrwrk ->  workarray
358         ! 3*n_hp+3 -> size of workarray
359         ! zinfo -> =0 successful work
360         CALL zgeev('N','N',n_hp+1,zA,n_hp+1,zeigs,zvl,n_hp+1,
361     &               zvr,n_hp+1,zwrk,3*n_hp+3,zrwrk,zinfo)
362
363         zhp = MAXVAL( REAL ( zeigs ) )
364             
365          ! Print eigenvalues of companion matrix (roots of the polynom)
366!        IF ( ln_write_bio ) THEN
367!           WRITE(numout,*)
368!           WRITE(numout,*) ' zinfo : ', zinfo
369!           WRITE(numout,*)
370!           WRITE(numout,*) ' zeigs :', ( zeigs(i), i = 1, n_hp )
371!           WRITE(numout,*)
372!           WRITE(numout,*) ' zhp   :', zhp
373!           WRITE(numout,*)
374!           WRITE(numout,*) ' pH      : ', -LOG10( zhp )
375!           WRITE(numout,*)
376!           WRITE(numout,*)
377!        ENDIF
378
379         !--- Retrieve carbonate system diagnostics
380         !--------------------------------------------------
381
382         zhp2                   = zhp * zhp                         ! [H+]^2
383
384         c_i_bio(jn_co2, layer) = c_i_bio(jn_dic, layer) /          ! CO2
385     &                          ( 1. + K1(layer) / zhp + 
386     &                            K1(layer)*K2(layer) / zhp2 )
387
388         CO2aq(layer)           = c_i_bio(jn_co2,layer)             !--- temporary as jn_co2 is bound to disappear
389 
390         CO32m(layer)           = c_i_bio(jn_dic,layer) /           ! CO32-
391     &                          ( 1. + zhp / K2(layer) + 
392     &                            zhp2 / K1(layer) / K2(layer) )
393
394         HCO3m(layer)           = c_i_bio(jn_dic,layer) /           ! HCO3-
395     &                          ( 1. + zhp / K1(layer) +
396     &                            K2(layer) / zhp )
397
398         pH(layer)              = -LOG10( zhp )
399
400         pCO2(layer)            = CO2aq(layer) / Kh(layer)          ! pCO2 = CO2aq / Kh
401
402      END DO ! layer
403 
404      !------------------------------------------------------------------------
405      ! 5) Convert units (mol/kg to mmol/m3), retrieve bulk concentrations
406      !------------------------------------------------------------------------
407
408      DO layer = 1, nlay_bio
409
410         ! mol/kg -> mmol/m3
411         zunit = 1000. * rhobr_bio(layer)
412
413         c_i_bio(jn_dic,layer) = c_i_bio(jn_dic,layer) * zunit !--- dont change DIC and TA, can remove
414         c_i_bio(jn_alk,layer) = c_i_bio(jn_alk,layer) * zunit !--- dont change DIC and TA, can remove
415         c_i_bio(jn_co2,layer) = c_i_bio(jn_co2,layer) * zunit
416         CO2aq(layer)          = CO2aq(layer) * zunit
417         CO32m(layer)          = CO32m(layer) * zunit
418         HCO3m(layer)          = HCO3m(layer) * zunit
419         
420         ! brine -> bulk
421         cbu_i_bio(jn_co2,layer) = c_i_bio(jn_co2,layer)*e_i_bio(layer)
422         CO2aq(layer)            = CO2aq(layer)*e_i_bio(layer)
423         CO32m(layer)            = CO32m(layer)*e_i_bio(layer)
424         HCO3m(layer)            = HCO3m(layer)*e_i_bio(layer)
425
426         ! atm-> muatm
427         pCO2(layer)           = pCO2(layer) * 1.0e6 
428
429      END DO
430
431      !------------------------------------------------------------------------
432      ! 6) Control Print
433      !------------------------------------------------------------------------
434
435      IF ( ln_write_bio ) THEN
436
437         WRITE(numout,*) 
438         WRITE(numout,*) ' ** End of ice_carb_chem '
439         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
440         WRITE(numout,*) '  At time step : ', numit
441         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ '
442         WRITE(numout,*)
443   
444   
445         DO jn = 1, ntra_bio
446
447            IF ( ( jn .EQ. jn_dic ) .OR. ( jn .EQ. jn_alk ) .OR. 
448     &           ( jn .EQ. jn_co2 ) ) THEN
449
450               WRITE(numout,*) ' Tracer :   ', biotr_i_nam(jn)
451               WRITE(numout,*) ' c_i_bio  : ', ( c_i_bio(jn,layer),
452     &                                           layer = 1, nlay_bio )
453               WRITE(numout,*) ' cbu_i_bio: ', ( cbu_i_bio(jn,layer),
454     &                                           layer = 1, nlay_bio )
455            ENDIF
456
457        END DO
458
459        WRITE(numout,*) ' CO2aq : ', 
460     &     ( CO2aq(layer), layer = 1, nlay_bio )
461        WRITE(numout,*) ' CO32- : ', 
462     &     ( CO32m(layer), layer = 1, nlay_bio )
463        WRITE(numout,*) ' HCO3- : ', 
464     &     ( HCO3m(layer), layer = 1, nlay_bio )
465        WRITE(numout,*) ' pH    : ', 
466     &     ( pH(layer), layer = 1, nlay_bio )
467        WRITE(numout,*) ' pCO2  : ', 
468     &     ( pCO2(layer), layer = 1, nlay_bio )
469   
470      ENDIF
471!
472!------------------------------------------------------------------------------!
473! 7) End of the routine
474!------------------------------------------------------------------------------!
475!
476      WRITE(numout,*)
477      WRITE(numout,*) ' End of ice_carb_chem '
478      WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
479     
480      RETURN
481
482      END
Note: See TracBrowser for help on using the repository browser.