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.
p4zche.F90 in branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z – NEMO

source: branches/UKMO/dev_r5518_nemo2cice_prints/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90 @ 9817

Last change on this file since 9817 was 9817, checked in by dancopsey, 6 years ago

Merged in GO6 package branch up to revision 8356.

File size: 16.3 KB
Line 
1MODULE p4zche
2   !!======================================================================
3   !!                         ***  MODULE p4zche  ***
4   !! TOP :   PISCES Sea water chemistry computed following OCMIP protocol
5   !!======================================================================
6   !! History :   OPA  !  1988     (E. Maier-Reimer)  Original code
7   !!              -   !  1998     (O. Aumont)  addition
8   !!              -   !  1999     (C. Le Quere)  modification
9   !!   NEMO      1.0  !  2004     (O. Aumont)  modification
10   !!              -   !  2006     (R. Gangsto)  modification
11   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90
12   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants
13   !!----------------------------------------------------------------------
14#if defined key_pisces
15   !!----------------------------------------------------------------------
16   !!   'key_pisces'                                       PISCES bio-model
17   !!----------------------------------------------------------------------
18   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol
19   !!----------------------------------------------------------------------
20   USE oce_trc       !  shared variables between ocean and passive tracers
21   USE trc           !  passive tracers common variables
22   USE sms_pisces    !  PISCES Source Minus Sink variables
23   USE lib_mpp       !  MPP library
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   p4z_che         !
29   PUBLIC   p4z_che_alloc   !
30
31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si
32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe
33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2
34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2   ! Solubilities of O2 and CO2
35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature
36
37   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm
38
39   REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)
40   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 ) 
41
42   REAL(wp) ::   rgas   = 83.14472       ! universal gas constants
43   REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles
44
45   REAL(wp) ::   bor1   = 0.00023        ! borat constants
46   REAL(wp) ::   bor2   = 1. / 10.82
47
48   REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate
49   REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966)
50
51   REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides
52   REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 )
53
54   !                                    ! volumetric solubility constants for o2 in ml/L 
55   REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992.
56   REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure
57   REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but
58   REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2)
59   REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2
60   REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension.
61   REAL(wp) ::   ox6    = -6.24097e-3   
62   REAL(wp) ::   ox7    = -6.93498e-3 
63   REAL(wp) ::   ox8    = -6.90358e-3
64   REAL(wp) ::   ox9    = -4.29155e-3 
65   REAL(wp) ::   ox10   = -3.11680e-7 
66
67   !                                    ! coeff. for seawater pressure correction : millero 95
68   !                                    ! AGRIF doesn't like the DATA instruction
69   REAL(wp) :: devk11  = -25.5
70   REAL(wp) :: devk12  = -15.82
71   REAL(wp) :: devk13  = -29.48
72   REAL(wp) :: devk14  = -25.60
73   REAL(wp) :: devk15  = -48.76
74   !
75   REAL(wp) :: devk21  = 0.1271
76   REAL(wp) :: devk22  = -0.0219
77   REAL(wp) :: devk23  = 0.1622
78   REAL(wp) :: devk24  = 0.2324
79   REAL(wp) :: devk25  = 0.5304
80   !
81   REAL(wp) :: devk31  = 0.
82   REAL(wp) :: devk32  = 0.
83   REAL(wp) :: devk33  = 2.608E-3
84   REAL(wp) :: devk34  = -3.6246E-3
85   REAL(wp) :: devk35  = 0.
86   !
87   REAL(wp) :: devk41  = -3.08E-3
88   REAL(wp) :: devk42  = 1.13E-3
89   REAL(wp) :: devk43  = -2.84E-3
90   REAL(wp) :: devk44  = -5.13E-3
91   REAL(wp) :: devk45  = -11.76E-3
92   !
93   REAL(wp) :: devk51  = 0.0877E-3
94   REAL(wp) :: devk52  = -0.1475E-3     
95   REAL(wp) :: devk53  = 0.
96   REAL(wp) :: devk54  = 0.0794E-3     
97   REAL(wp) :: devk55  = 0.3692E-3     
98
99   !!* Substitution
100#include "top_substitute.h90"
101   !!----------------------------------------------------------------------
102   !! NEMO/TOP 3.3 , NEMO Consortium (2010)
103   !! $Id$
104   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
105   !!----------------------------------------------------------------------
106CONTAINS
107
108   SUBROUTINE p4z_che
109      !!---------------------------------------------------------------------
110      !!                     ***  ROUTINE p4z_che  ***
111      !!
112      !! ** Purpose :   Sea water chemistry computed following OCMIP protocol
113      !!
114      !! ** Method  : - ...
115      !!---------------------------------------------------------------------
116      INTEGER  ::   ji, jj, jk
117      REAL(wp) ::   ztkel, zt   , zt2   , zsal  , zsal2 , zbuf1 , zbuf2
118      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5
119      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2
120      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat
121      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1  , za2
122      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw
123      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1
124      !!---------------------------------------------------------------------
125      !
126      IF( nn_timing == 1 )  CALL timing_start('p4z_che')
127      !
128      ! Computations of chemical constants require in situ temperature
129      ! Here a quite simple formulation is used to convert
130      ! potential temperature to in situ temperature. The errors is less than
131      ! 0.04°C relative to an exact computation
132      ! ---------------------------------------------------------------------
133      DO jk = 1, jpk
134         DO jj = 1, jpj
135            DO ji = 1, jpi
136               zpres = fsdept(ji,jj,jk) / 1000.
137               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) )
138               za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 )
139               tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2
140            END DO
141         END DO
142      END DO
143      !
144      ! CHEMICAL CONSTANTS - SURFACE LAYER
145      ! ----------------------------------
146!CDIR NOVERRCHK
147      DO jj = 1, jpj
148!CDIR NOVERRCHK
149         DO ji = 1, jpi
150            !                             ! SET ABSOLUTE TEMPERATURE
151            ztkel = tempis(ji,jj,1) + 273.15
152            zt    = ztkel * 0.01
153            zt2   = zt * zt
154            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.
155            zsal2 = zsal * zsal
156            zlogt = LOG( zt )
157            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980)
158            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS
159            zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    &
160            &       + 0.0047036e-4*ztkel**2)
161            !                             ! SET SOLUBILITIES OF O2 AND CO2
162            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm)
163            chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3
164            chemc(ji,jj,3) = 57.7 - 0.118*ztkel
165            !
166         END DO
167      END DO
168
169      ! OXYGEN SOLUBILITY - DEEP OCEAN
170      ! -------------------------------
171!CDIR NOVERRCHK
172      DO jk = 1, jpk
173!CDIR NOVERRCHK
174         DO jj = 1, jpj
175!CDIR NOVERRCHK
176            DO ji = 1, jpi
177              ztkel = tempis(ji,jj,jk) + 273.15
178              zsal  = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.
179              zsal2 = zsal * zsal
180              ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature
181              ztgg2 = ztgg  * ztgg
182              ztgg3 = ztgg2 * ztgg
183              ztgg4 = ztgg3 * ztgg
184              ztgg5 = ztgg4 * ztgg
185              zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   &
186                     + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2
187              chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm)
188            END DO
189          END DO
190        END DO
191
192
193
194      ! CHEMICAL CONSTANTS - DEEP OCEAN
195      ! -------------------------------
196!CDIR NOVERRCHK
197      DO jk = 1, jpk
198!CDIR NOVERRCHK
199         DO jj = 1, jpj
200!CDIR NOVERRCHK
201            DO ji = 1, jpi
202
203               ! SET PRESSION ACCORDING TO SAUNDER (1980)
204               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) )
205               zc1 = 5.92E-3 + zplat**2 * 5.25E-3
206               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*fsdept(ji,jj,jk)))) / 4.42E-6
207               zpres = zpres / 10.0
208
209               ! SET ABSOLUTE TEMPERATURE
210               ztkel   = tempis(ji,jj,jk) + 273.15
211               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.
212               zsqrt  = SQRT( zsal )
213               zsal15  = zsqrt * zsal
214               zlogt  = LOG( ztkel )
215               ztr    = 1. / ztkel
216               zis    = 19.924 * zsal / ( 1000.- 1.005 * zsal )
217               zis2   = zis * zis
218               zisqrt = SQRT( zis )
219               ztc     = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20.
220
221               ! CHLORINITY (WOOSTER ET AL., 1969)
222               zcl     = zsal * salchl
223
224               ! TOTAL SULFATE CONCENTR. [MOLES/kg soln]
225               zst     = st1 * zcl * st2
226
227               ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln]
228               zft     = ft1 * zcl * ft2
229
230               ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990)
231               zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         &
232               &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt &
233               &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    &
234               &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         &
235               &         + LOG(1.0 - 0.001005 * zsal))
236               !
237               aphscale(ji,jj,jk) = ( 1. + zst / zcks )
238
239               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79)
240               zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   &
241               &         + LOG(1.0d0 - 0.001005d0*zsal)            &
242               &         + LOG(1.0d0 + zst/zcks))
243
244               ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE
245               zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        &
246               &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         &
247               &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   &
248               &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      & 
249               &      * zlogt + 0.053105*zsqrt*ztkel
250
251
252               ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO
253               ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale
254               zck1    = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt  &
255                  - 0.011555*zsal + 0.0001152*zsal*zsal)
256               zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      &
257                  - 0.01781*zsal + 0.0001122*zsal*zsal)
258
259               ! PKW (H2O) (DICKSON AND RILEY, 1979)
260               zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt    & 
261               &     + (118.67*ztr - 5.977 + 1.0495 * zlogt)        &
262               &     * zsqrt - 0.01615 * zsal
263
264               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER
265               !       (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983)
266               zaksp0  = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel )   &
267                  &      + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt  &
268                  &      - 0.07711*zsal + 0.0041249*zsal15
269
270               ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?)
271               zak1    = 10**(zck1)
272               zak2    = 10**(zck2)
273               zakb    = EXP( zckb  )
274               zakw    = EXP( zckw )
275               zaksp1  = 10**(zaksp0)
276
277               ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970)
278               !        (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE
279               !        IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS
280               !        TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN
281               !        DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS
282               !        MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION
283               !        WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND
284               !        & GIESKES (1970), P. 1285-1286 (THE SMALL
285               !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE
286               !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285))
287               zcpexp  = zpres /(rgas*ztkel)
288               zcpexp2 = zpres * zpres/(rgas*ztkel)
289
290               ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE
291               !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968)
292               !        (CF. BROECKER ET AL., 1982)
293
294               zbuf1  = -     ( devk11 + devk21 * ztc + devk31 * ztc * ztc )
295               zbuf2  = 0.5 * ( devk41 + devk51 * ztc )
296               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
297
298               zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc )
299               zbuf2  = 0.5 * ( devk42 + devk52 * ztc )
300               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
301
302               zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc )
303               zbuf2  = 0.5 * ( devk43 + devk53 * ztc )
304               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
305
306               zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc )
307               zbuf2  = 0.5 * ( devk44 + devk54 * ztc )
308               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
309
310
311               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE
312               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO
313               !        (P. 1285) AND BERNER (1976)
314               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc )
315               zbuf2  = 0.5 * ( devk45 + devk55 * ztc )
316               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )
317
318               ! TOTAL BORATE CONCENTR. [MOLES/L]
319               borat(ji,jj,jk) = bor1 * zcl * bor2
320
321               ! Iron and SIO3 saturation concentration from ...
322               sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6
323               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) )
324
325            END DO
326         END DO
327      END DO
328      !
329      IF( nn_timing == 1 )  CALL timing_stop('p4z_che')
330      !
331   END SUBROUTINE p4z_che
332
333
334   INTEGER FUNCTION p4z_che_alloc()
335      !!----------------------------------------------------------------------
336      !!                     ***  ROUTINE p4z_che_alloc  ***
337      !!----------------------------------------------------------------------
338      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk),   &
339      &         tempis(jpi,jpj,jpk), STAT=p4z_che_alloc )
340      !
341      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.')
342      !
343   END FUNCTION p4z_che_alloc
344
345#else
346   !!======================================================================
347   !!  Dummy module :                                   No PISCES bio-model
348   !!======================================================================
349CONTAINS
350   SUBROUTINE p4z_che( kt )                   ! Empty routine
351      INTEGER, INTENT(in) ::   kt
352      WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt
353   END SUBROUTINE p4z_che
354#endif 
355
356   !!======================================================================
357END MODULE p4zche
Note: See TracBrowser for help on using the repository browser.