- Timestamp:
- 2016-11-30T17:56:53+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_merge_2016/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90
r6945 r7403 11 11 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 12 12 !! ! 2011-02 (J. Simeon, J.Orr ) update O2 solubility constants 13 !!---------------------------------------------------------------------- 14 #if defined key_pisces 15 !!---------------------------------------------------------------------- 16 !! 'key_pisces' PISCES bio-model 13 !! 3.6 ! 2016-03 (O. Aumont) Change chemistry to MOCSY standards 17 14 !!---------------------------------------------------------------------- 18 15 !! p4z_che : Sea water chemistry computed following OCMIP protocol … … 22 19 USE sms_pisces ! PISCES Source Minus Sink variables 23 20 USE lib_mpp ! MPP library 21 USE eosbn2, ONLY : neos 24 22 25 23 IMPLICIT NONE 26 24 PRIVATE 27 25 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 26 PUBLIC p4z_che ! 27 PUBLIC p4z_che_alloc ! 28 PUBLIC ahini_for_at ! 29 PUBLIC solve_at_general ! 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(:,:,:,:) :: fesol ! solubility of Fe 35 36 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tempis ! In situ temperature 37 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: salinprac ! Practical salinity 38 39 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akb3 !: ??? 40 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akw3 !: ??? 41 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: akf3 !: ??? 42 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aks3 !: ??? 43 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak1p3 !: ??? 44 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak2p3 !: ??? 45 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ak3p3 !: ??? 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: aksi3 !: ??? 47 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 48 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: fluorid !: ??? 49 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: sulfat !: ??? 50 51 !!* Variable for chemistry of the CO2 cycle 36 52 37 53 REAL(wp), PUBLIC :: atcox = 0.20946 ! units atm 38 54 39 REAL(wp) :: salchl = 1. / 1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969)40 55 REAL(wp) :: o2atm = 1. / ( 1000. * 0.20946 ) 41 56 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 57 REAL(wp) :: rgas = 83.14472 ! universal gas constants 58 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 66 59 67 60 ! ! coeff. for seawater pressure correction : millero 95 68 61 ! ! 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 62 REAL(wp) :: devk10 = -25.5 63 REAL(wp) :: devk11 = -15.82 64 REAL(wp) :: devk12 = -29.48 65 REAL(wp) :: devk13 = -20.02 66 REAL(wp) :: devk14 = -18.03 67 REAL(wp) :: devk15 = -9.78 68 REAL(wp) :: devk16 = -48.76 69 REAL(wp) :: devk17 = -14.51 70 REAL(wp) :: devk18 = -23.12 71 REAL(wp) :: devk19 = -26.57 72 REAL(wp) :: devk110 = -29.48 74 73 ! 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 74 REAL(wp) :: devk20 = 0.1271 75 REAL(wp) :: devk21 = -0.0219 76 REAL(wp) :: devk22 = 0.1622 77 REAL(wp) :: devk23 = 0.1119 78 REAL(wp) :: devk24 = 0.0466 79 REAL(wp) :: devk25 = -0.0090 80 REAL(wp) :: devk26 = 0.5304 81 REAL(wp) :: devk27 = 0.1211 82 REAL(wp) :: devk28 = 0.1758 83 REAL(wp) :: devk29 = 0.2020 84 REAL(wp) :: devk210 = 0.1622 80 85 ! 86 REAL(wp) :: devk30 = 0. 81 87 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. 88 REAL(wp) :: devk32 = 2.608E-3 89 REAL(wp) :: devk33 = -1.409e-3 90 REAL(wp) :: devk34 = 0.316e-3 91 REAL(wp) :: devk35 = -0.942e-3 92 REAL(wp) :: devk36 = 0. 93 REAL(wp) :: devk37 = -0.321e-3 94 REAL(wp) :: devk38 = -2.647e-3 95 REAL(wp) :: devk39 = -3.042e-3 96 REAL(wp) :: devk310 = -2.6080e-3 86 97 ! 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 98 REAL(wp) :: devk40 = -3.08E-3 99 REAL(wp) :: devk41 = 1.13E-3 100 REAL(wp) :: devk42 = -2.84E-3 101 REAL(wp) :: devk43 = -5.13E-3 102 REAL(wp) :: devk44 = -4.53e-3 103 REAL(wp) :: devk45 = -3.91e-3 104 REAL(wp) :: devk46 = -11.76e-3 105 REAL(wp) :: devk47 = -2.67e-3 106 REAL(wp) :: devk48 = -5.15e-3 107 REAL(wp) :: devk49 = -4.08e-3 108 REAL(wp) :: devk410 = -2.84e-3 92 109 ! 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 110 REAL(wp) :: devk50 = 0.0877E-3 111 REAL(wp) :: devk51 = -0.1475E-3 112 REAL(wp) :: devk52 = 0. 113 REAL(wp) :: devk53 = 0.0794E-3 114 REAL(wp) :: devk54 = 0.09e-3 115 REAL(wp) :: devk55 = 0.054e-3 116 REAL(wp) :: devk56 = 0.3692E-3 117 REAL(wp) :: devk57 = 0.0427e-3 118 REAL(wp) :: devk58 = 0.09e-3 119 REAL(wp) :: devk59 = 0.0714e-3 120 REAL(wp) :: devk510 = 0.0 121 ! 122 ! General parameters 123 REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 124 REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp 125 126 ! Maximum number of iterations for each method 127 INTEGER, PARAMETER :: jp_maxniter_atgen = 20 128 129 ! Bookkeeping variables for each method 130 ! - SOLVE_AT_GENERAL 131 INTEGER :: niter_atgen = jp_maxniter_atgen 98 132 99 133 !!---------------------------------------------------------------------- … … 113 147 !!--------------------------------------------------------------------- 114 148 INTEGER :: ji, jj, jk 115 REAL(wp) :: ztkel, zt , zt2, zsal , zsal2 , zbuf1 , zbuf2149 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 116 150 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 117 151 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 118 152 REAL(wp) :: zsqrt, ztr , zlogt , zcek1, zc1, zplat 119 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1 153 REAL(wp) :: zis , zis2 , zsal15, zisqrt, za1, za2 120 154 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 155 REAL(wp) :: zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 121 156 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 157 REAL(wp) :: total2free, free2SWS, total2SWS, SWS2total 158 122 159 !!--------------------------------------------------------------------- 123 160 ! 124 161 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 162 ! 163 ! Computation of chemical constants require practical salinity 164 ! Thus, when TEOS08 is used, absolute salinity is converted to 165 ! practical salinity 166 ! ------------------------------------------------------------- 167 IF (neos == -1) THEN 168 salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 169 ELSE 170 salinprac(:,:,:) = tsn(:,:,:,jp_sal) 171 ENDIF 172 125 173 ! 126 174 ! Computations of chemical constants require in situ temperature … … 133 181 DO ji = 1, jpi 134 182 zpres = gdept_n(ji,jj,jk) / 1000. 135 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * ( tsn(ji,jj,jk,jp_sal) - 35.0) )183 za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 136 184 za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 137 185 tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 … … 142 190 ! CHEMICAL CONSTANTS - SURFACE LAYER 143 191 ! ---------------------------------- 192 !CDIR NOVERRCHK 144 193 DO jj = 1, jpj 194 !CDIR NOVERRCHK 145 195 DO ji = 1, jpi 146 196 ! ! SET ABSOLUTE TEMPERATURE 147 197 ztkel = tempis(ji,jj,1) + 273.15 148 198 zt = ztkel * 0.01 149 zt2 = zt * zt 150 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 151 zsal2 = zsal * zsal 152 zlogt = LOG( zt ) 199 zsal = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 153 200 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 154 201 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 155 202 zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel & 156 203 & + 0.0047036e-4*ztkel**2) 157 ! ! SET SOLUBILITIES OF O2 AND CO2 158 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 204 chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 159 205 chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 160 206 chemc(ji,jj,3) = 57.7 - 0.118*ztkel … … 165 211 ! OXYGEN SOLUBILITY - DEEP OCEAN 166 212 ! ------------------------------- 213 !CDIR NOVERRCHK 167 214 DO jk = 1, jpk 215 !CDIR NOVERRCHK 168 216 DO jj = 1, jpj 217 !CDIR NOVERRCHK 169 218 DO ji = 1, jpi 170 219 ztkel = tempis(ji,jj,jk) + 273.15 171 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35.220 zsal = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 172 221 zsal2 = zsal * zsal 173 222 ztgg = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature … … 176 225 ztgg4 = ztgg3 * ztgg 177 226 ztgg5 = ztgg4 * ztgg 178 zoxy = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5 & 179 + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) + ox10 * zsal2 227 228 zoxy = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3 & 229 & + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3 & 230 & - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 ) & 231 & - 3.11680e-7 * zsal2 180 232 chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox ! mol/(L atm) 181 233 END DO … … 187 239 ! CHEMICAL CONSTANTS - DEEP OCEAN 188 240 ! ------------------------------- 241 !CDIR NOVERRCHK 189 242 DO jk = 1, jpk 243 !CDIR NOVERRCHK 190 244 DO jj = 1, jpj 245 !CDIR NOVERRCHK 191 246 DO ji = 1, jpi 192 247 … … 199 254 ! SET ABSOLUTE TEMPERATURE 200 255 ztkel = tempis(ji,jj,jk) + 273.15 201 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35.256 zsal = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 202 257 zsqrt = SQRT( zsal ) 203 258 zsal15 = zsqrt * zsal … … 210 265 211 266 ! CHLORINITY (WOOSTER ET AL., 1969) 212 zcl = zsal * salchl267 zcl = zsal / 1.80655 213 268 214 269 ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 215 zst = st1 * zcl * st2270 zst = 0.14 * zcl /96.062 216 271 217 272 ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 218 zft = ft1 * zcl * ft2273 zft = 0.000067 * zcl /18.9984 219 274 220 275 ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) … … 224 279 & - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2 & 225 280 & + LOG(1.0 - 0.001005 * zsal)) 226 !227 aphscale(ji,jj,jk) = ( 1. + zst / zcks )228 281 229 282 ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) … … 239 292 & * zlogt + 0.053105*zsqrt*ztkel 240 293 241 242 294 ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO 243 295 ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale … … 247 299 - 0.01781*zsal + 0.0001122*zsal*zsal) 248 300 249 ! PKW (H2O) (DICKSON AND RILEY, 1979) 250 zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt & 251 & + (118.67*ztr - 5.977 + 1.0495 * zlogt) & 252 & * zsqrt - 0.01615 * zsal 301 ! PKW (H2O) (MILLERO, 1995) from composite data 302 zckw = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr & 303 - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 304 305 ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 306 zck1p = -4576.752*ztr + 115.540 - 18.453*zlogt & 307 & + (-106.736*ztr + 0.69171) * zsqrt & 308 & + (-0.65643*ztr - 0.01844) * zsal 309 310 zck2p = -8814.715*ztr + 172.1033 - 27.927*zlogt & 311 & + (-160.340*ztr + 1.3566)*zsqrt & 312 & + (0.37335*ztr - 0.05778)*zsal 313 314 zck3p = -3070.75*ztr - 18.126 & 315 & + (17.27039*ztr + 2.81197) * zsqrt & 316 & + (-44.99486*ztr - 0.09984) * zsal 317 318 ! CONSTANT FOR SILICATE, MILLERO (1995) 319 zcksi = -8904.2*ztr + 117.400 - 19.334*zlogt & 320 & + (-458.79*ztr + 3.5913) * zisqrt & 321 & + (188.74*ztr - 1.5998) * zis & 322 & + (-12.1652*ztr + 0.07871) * zis2 & 323 & + LOG(1.0 - 0.001005*zsal) 253 324 254 325 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER … … 258 329 & - 0.07711*zsal + 0.0041249*zsal15 259 330 331 ! CONVERT FROM DIFFERENT PH SCALES 332 total2free = 1.0/(1.0 + zst/zcks) 333 free2SWS = 1. + zst/zcks + zft/(zckf*total2free) 334 total2SWS = total2free * free2SWS 335 SWS2total = 1.0 / total2SWS 336 260 337 ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 261 zak1 = 10**(zck1) 262 zak2 = 10**(zck2) 263 zakb = EXP( zckb )338 zak1 = 10**(zck1) * total2SWS 339 zak2 = 10**(zck2) * total2SWS 340 zakb = EXP( zckb ) * total2SWS 264 341 zakw = EXP( zckw ) 265 342 zaksp1 = 10**(zaksp0) 343 zak1p = exp( zck1p ) 344 zak2p = exp( zck2p ) 345 zak3p = exp( zck3p ) 346 zaksi = exp( zcksi ) 347 zckf = zckf * total2SWS 266 348 267 349 ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) … … 275 357 ! FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 276 358 ! SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 277 zcpexp = zpres / (rgas*ztkel)278 zcpexp2 = zpres * z pres/(rgas*ztkel)359 zcpexp = zpres / (rgas*ztkel) 360 zcpexp2 = zpres * zcpexp 279 361 280 362 ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE … … 282 364 ! (CF. BROECKER ET AL., 1982) 283 365 284 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 366 zbuf1 = - ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 367 zbuf2 = 0.5 * ( devk40 + devk50 * ztc ) 368 ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 369 370 zbuf1 = - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 285 371 zbuf2 = 0.5 * ( devk41 + devk51 * ztc ) 286 ak 13(ji,jj,jk) = zak1* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )372 ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 287 373 288 374 zbuf1 = - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 289 375 zbuf2 = 0.5 * ( devk42 + devk52 * ztc ) 290 ak 23(ji,jj,jk) = zak2* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )376 akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 291 377 292 378 zbuf1 = - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 293 379 zbuf2 = 0.5 * ( devk43 + devk53 * ztc ) 294 ak b3(ji,jj,jk) = zakb* EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 )380 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 295 381 296 382 zbuf1 = - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 297 383 zbuf2 = 0.5 * ( devk44 + devk54 * ztc ) 298 akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 299 384 aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 385 386 zbuf1 = - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 387 zbuf2 = 0.5 * ( devk45 + devk55 * ztc ) 388 akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 389 390 zbuf1 = - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 391 zbuf2 = 0.5 * ( devk47 + devk57 * ztc ) 392 ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 393 394 zbuf1 = - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 395 zbuf2 = 0.5 * ( devk48 + devk58 * ztc ) 396 ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 397 398 zbuf1 = - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 399 zbuf2 = 0.5 * ( devk49 + devk59 * ztc ) 400 ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 401 402 zbuf1 = - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 403 zbuf2 = 0.5 * ( devk410 + devk510 * ztc ) 404 aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 405 406 ! CONVERT FROM DIFFERENT PH SCALES 407 total2free = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 408 free2SWS = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 409 total2SWS = total2free * free2SWS 410 SWS2total = 1.0 / total2SWS 411 412 ! Convert to total scale 413 ak13(ji,jj,jk) = ak13(ji,jj,jk) * SWS2total 414 ak23(ji,jj,jk) = ak23(ji,jj,jk) * SWS2total 415 akb3(ji,jj,jk) = akb3(ji,jj,jk) * SWS2total 416 akw3(ji,jj,jk) = akw3(ji,jj,jk) * SWS2total 417 ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 418 ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 419 ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 420 aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 421 akf3(ji,jj,jk) = akf3(ji,jj,jk) / total2free 300 422 301 423 ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE 302 424 ! AS FUNCTION OF PRESSURE FOLLOWING MILLERO 303 425 ! (P. 1285) AND BERNER (1976) 304 zbuf1 = - ( devk1 5 + devk25 * ztc + devk35* ztc * ztc )305 zbuf2 = 0.5 * ( devk4 5 + devk55* ztc )426 zbuf1 = - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 427 zbuf2 = 0.5 * ( devk46 + devk56 * ztc ) 306 428 aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 307 429 308 ! TOTAL BORATE CONCENTR. [MOLES/L] 309 borat(ji,jj,jk) = bor1 * zcl * bor2 430 ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 431 borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 432 sulfat(ji,jj,jk) = zst 433 fluorid(ji,jj,jk) = zft 310 434 311 435 ! Iron and SIO3 saturation concentration from ... 312 436 sio3eq(ji,jj,jk) = EXP( LOG( 10.) * ( 6.44 - 968. / ztkel ) ) * 1.e-6 313 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) ) 314 437 fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 438 439 ! Liu and Millero (1999) only valid 5 - 50 degC 440 ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 441 fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 442 fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 443 fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 444 fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 445 fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 315 446 END DO 316 447 END DO … … 321 452 END SUBROUTINE p4z_che 322 453 454 SUBROUTINE ahini_for_at(p_hini) 455 !!--------------------------------------------------------------------- 456 !! *** ROUTINE ahini_for_at *** 457 !! 458 !! Subroutine returns the root for the 2nd order approximation of the 459 !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic 460 !! polynomial) around the local minimum, if it exists. 461 !! Returns * 1E-03_wp if p_alkcb <= 0 462 !! * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 463 !! * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 464 !! and the 2nd order approximation does not have 465 !! a solution 466 !!--------------------------------------------------------------------- 467 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini 468 INTEGER :: ji, jj, jk 469 REAL(wp) :: zca1, zba1 470 REAL(wp) :: zd, zsqrtd, zhmin 471 REAL(wp) :: za2, za1, za0 472 REAL(wp) :: p_dictot, p_bortot, p_alkcb 473 474 IF( nn_timing == 1 ) CALL timing_start('ahini_for_at') 475 ! 476 DO jk = 1, jpk 477 DO jj = 1, jpj 478 DO ji = 1, jpi 479 p_alkcb = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 480 p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 481 p_bortot = borat(ji,jj,jk) 482 IF (p_alkcb <= 0.) THEN 483 p_hini(ji,jj,jk) = 1.e-3 484 ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 485 p_hini(ji,jj,jk) = 1.e-10_wp 486 ELSE 487 zca1 = p_dictot/( p_alkcb + rtrn ) 488 zba1 = p_bortot/ (p_alkcb + rtrn ) 489 ! Coefficients of the cubic polynomial 490 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 491 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1) & 492 & + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 493 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 494 ! Taylor expansion around the minimum 495 zd = za2*za2 - 3.*za1 ! Discriminant of the quadratic equation 496 ! for the minimum close to the root 497 498 IF(zd > 0.) THEN ! If the discriminant is positive 499 zsqrtd = SQRT(zd) 500 IF(za2 < 0) THEN 501 zhmin = (-za2 + zsqrtd)/3. 502 ELSE 503 zhmin = -za1/(za2 + zsqrtd) 504 ENDIF 505 p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 506 ELSE 507 p_hini(ji,jj,jk) = 1.e-7 508 ENDIF 509 ! 510 ENDIF 511 END DO 512 END DO 513 END DO 514 ! 515 IF( nn_timing == 1 ) CALL timing_stop('ahini_for_at') 516 ! 517 END SUBROUTINE ahini_for_at 518 519 !=============================================================================== 520 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 521 522 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 523 ! contributions to total alkalinity (the infimum and the supremum), i.e 524 ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 525 526 ! Argument variables 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 528 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 529 530 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 531 & - fluorid(:,:,:) 532 p_alknw_sup(:,:,:) = (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) & 533 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 534 535 END SUBROUTINE anw_infsup 536 537 538 SUBROUTINE solve_at_general( p_hini, zhi ) 539 540 ! Universal pH solver that converges from any given initial value, 541 ! determines upper an lower bounds for the solution if required 542 543 ! Argument variables 544 !-------------------- 545 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini 546 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi 547 548 ! Local variables 549 !----------------- 550 INTEGER :: ji, jj, jk, jn 551 REAL(wp) :: zh_ini, zh, zh_prev, zh_lnfactor 552 REAL(wp) :: zdelta, zh_delta 553 REAL(wp) :: zeqn, zdeqndh, zalka 554 REAL(wp) :: aphscale 555 REAL(wp) :: znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 556 REAL(wp) :: znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 557 REAL(wp) :: znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 558 REAL(wp) :: znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 559 REAL(wp) :: znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 560 REAL(wp) :: znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 561 REAL(wp) :: zalk_wat, zdalk_wat 562 REAL(wp) :: zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 563 LOGICAL :: l_exitnow 564 REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 565 REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 566 567 IF( nn_timing == 1 ) CALL timing_start('solve_at_general') 568 ! Allocate temporary workspace 569 CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 570 CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 571 572 CALL anw_infsup( zalknw_inf, zalknw_sup ) 573 574 rmask(:,:,:) = tmask(:,:,:) 575 zhi(:,:,:) = 0. 576 577 ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 578 DO jk = 1, jpk 579 DO jj = 1, jpj 580 DO ji = 1, jpi 581 IF (rmask(ji,jj,jk) == 1.) THEN 582 p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 583 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 584 zh_ini = p_hini(ji,jj,jk) 585 586 zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 587 588 IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 589 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 590 ELSE 591 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 592 ENDIF 593 594 zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 595 596 IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 597 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 598 ELSE 599 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 600 ENDIF 601 602 zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 603 ENDIF 604 END DO 605 END DO 606 END DO 607 608 zeqn_absmin(:,:,:) = HUGE(1._wp) 609 610 DO jn = 1, jp_maxniter_atgen 611 DO jk = 1, jpk 612 DO jj = 1, jpj 613 DO ji = 1, jpi 614 IF (rmask(ji,jj,jk) == 1.) THEN 615 zfact = rhop(ji,jj,jk) / 1000. + rtrn 616 p_alktot = trb(ji,jj,jk,jptal) / zfact 617 zdic = trb(ji,jj,jk,jpdic) / zfact 618 zbot = borat(ji,jj,jk) 619 zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 620 zsit = trb(ji,jj,jk,jpsil) / zfact 621 zst = sulfat (ji,jj,jk) 622 zft = fluorid(ji,jj,jk) 623 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 624 zh = zhi(ji,jj,jk) 625 zh_prev = zh 626 627 ! H2CO3 - HCO3 - CO3 : n=2, m=0 628 znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 629 zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 630 zalk_dic = zdic * (znumer_dic/zdenom_dic) 631 zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh & 632 *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 633 zdalk_dic = -zdic*(zdnumer_dic/zdenom_dic**2) 634 635 636 ! B(OH)3 - B(OH)4 : n=1, m=0 637 znumer_bor = akb3(ji,jj,jk) 638 zdenom_bor = akb3(ji,jj,jk) + zh 639 zalk_bor = zbot * (znumer_bor/zdenom_bor) 640 zdnumer_bor = akb3(ji,jj,jk) 641 zdalk_bor = -zbot*(zdnumer_bor/zdenom_bor**2) 642 643 644 ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 645 znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 646 & + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 647 zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 648 & + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 649 zalk_po4 = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 650 zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 651 & + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 652 & + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk) & 653 & + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) & 654 & + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 655 zdalk_po4 = -zpt * (zdnumer_po4/zdenom_po4**2) 656 657 ! H4SiO4 - H3SiO4 : n=1, m=0 658 znumer_sil = aksi3(ji,jj,jk) 659 zdenom_sil = aksi3(ji,jj,jk) + zh 660 zalk_sil = zsit * (znumer_sil/zdenom_sil) 661 zdnumer_sil = aksi3(ji,jj,jk) 662 zdalk_sil = -zsit * (zdnumer_sil/zdenom_sil**2) 663 664 ! HSO4 - SO4 : n=1, m=1 665 aphscale = 1.0 + zst/aks3(ji,jj,jk) 666 znumer_so4 = aks3(ji,jj,jk) * aphscale 667 zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 668 zalk_so4 = zst * (znumer_so4/zdenom_so4 - 1.) 669 zdnumer_so4 = aks3(ji,jj,jk) 670 zdalk_so4 = -zst * (zdnumer_so4/zdenom_so4**2) 671 672 ! HF - F : n=1, m=1 673 znumer_flu = akf3(ji,jj,jk) 674 zdenom_flu = akf3(ji,jj,jk) + zh 675 zalk_flu = zft * (znumer_flu/zdenom_flu - 1.) 676 zdnumer_flu = akf3(ji,jj,jk) 677 zdalk_flu = -zft * (zdnumer_flu/zdenom_flu**2) 678 679 ! H2O - OH 680 aphscale = 1.0 + zst/aks3(ji,jj,jk) 681 zalk_wat = akw3(ji,jj,jk)/zh - zh/aphscale 682 zdalk_wat = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 683 684 ! CALCULATE [ALK]([CO3--], [HCO3-]) 685 zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil & 686 & + zalk_so4 + zalk_flu & 687 & + zalk_wat - p_alktot 688 689 zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil & 690 & + zalk_so4 + zalk_flu + zalk_wat) 691 692 zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 693 & + zdalk_so4 + zdalk_flu + zdalk_wat 694 695 ! Adapt bracketing interval 696 IF(zeqn > 0._wp) THEN 697 zh_min(ji,jj,jk) = zh_prev 698 ELSEIF(zeqn < 0._wp) THEN 699 zh_max(ji,jj,jk) = zh_prev 700 ENDIF 701 702 IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 703 ! if the function evaluation at the current point is 704 ! not decreasing faster than with a bisection step (at least linearly) 705 ! in absolute value take one bisection step on [ph_min, ph_max] 706 ! ph_new = (ph_min + ph_max)/2d0 707 ! 708 ! In terms of [H]_new: 709 ! [H]_new = 10**(-ph_new) 710 ! = 10**(-(ph_min + ph_max)/2d0) 711 ! = SQRT(10**(-(ph_min + phmax))) 712 ! = SQRT(zh_max * zh_min) 713 zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 714 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 715 ELSE 716 ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 717 ! = -zdeqndh * LOG(10) * [H] 718 ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 719 ! 720 ! pH_new = pH_old + \deltapH 721 ! 722 ! [H]_new = 10**(-pH_new) 723 ! = 10**(-pH_old - \Delta pH) 724 ! = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 725 ! = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 726 ! = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 727 728 zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 729 730 IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 731 zh = zh_prev*EXP(zh_lnfactor) 732 ELSE 733 zh_delta = zh_lnfactor*zh_prev 734 zh = zh_prev + zh_delta 735 ENDIF 736 737 IF( zh < zh_min(ji,jj,jk) ) THEN 738 ! if [H]_new < [H]_min 739 ! i.e., if ph_new > ph_max then 740 ! take one bisection step on [ph_prev, ph_max] 741 ! ph_new = (ph_prev + ph_max)/2d0 742 ! In terms of [H]_new: 743 ! [H]_new = 10**(-ph_new) 744 ! = 10**(-(ph_prev + ph_max)/2d0) 745 ! = SQRT(10**(-(ph_prev + phmax))) 746 ! = SQRT([H]_old*10**(-ph_max)) 747 ! = SQRT([H]_old * zh_min) 748 zh = SQRT(zh_prev * zh_min(ji,jj,jk)) 749 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 750 ENDIF 751 752 IF( zh > zh_max(ji,jj,jk) ) THEN 753 ! if [H]_new > [H]_max 754 ! i.e., if ph_new < ph_min, then 755 ! take one bisection step on [ph_min, ph_prev] 756 ! ph_new = (ph_prev + ph_min)/2d0 757 ! In terms of [H]_new: 758 ! [H]_new = 10**(-ph_new) 759 ! = 10**(-(ph_prev + ph_min)/2d0) 760 ! = SQRT(10**(-(ph_prev + ph_min))) 761 ! = SQRT([H]_old*10**(-ph_min)) 762 ! = SQRT([H]_old * zhmax) 763 zh = SQRT(zh_prev * zh_max(ji,jj,jk)) 764 zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 765 ENDIF 766 ENDIF 767 768 zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 769 770 ! Stop iterations once |\delta{[H]}/[H]| < rdel 771 ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 772 ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 773 774 ! Alternatively: 775 ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 776 ! ~ 1/LOG(10) * |\Delta [H]|/[H] 777 ! < 1/LOG(10) * rdel 778 779 ! Hence |zeqn/(zdeqndh*zh)| < rdel 780 781 ! rdel <-- pp_rdel_ah_target 782 l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 783 784 IF(l_exitnow) THEN 785 rmask(ji,jj,jk) = 0. 786 ENDIF 787 788 zhi(ji,jj,jk) = zh 789 790 IF(jn >= jp_maxniter_atgen) THEN 791 zhi(ji,jj,jk) = -1._wp 792 ENDIF 793 794 ENDIF 795 END DO 796 END DO 797 END DO 798 END DO 799 ! 800 CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 801 CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 802 803 804 IF( nn_timing == 1 ) CALL timing_stop('solve_at_general') 805 806 807 END SUBROUTINE solve_at_general 323 808 324 809 INTEGER FUNCTION p4z_che_alloc() … … 326 811 !! *** ROUTINE p4z_che_alloc *** 327 812 !!---------------------------------------------------------------------- 328 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), & 329 & tempis(jpi,jpj,jpk), STAT=p4z_che_alloc ) 813 INTEGER :: ierr(3) ! Local variables 814 !!---------------------------------------------------------------------- 815 816 ierr(:) = 0 817 818 ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) 819 820 ALLOCATE( akb3(jpi,jpj,jpk) , tempis(jpi, jpj, jpk), & 821 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 822 & aks3(jpi,jpj,jpk) , akf3(jpi,jpj,jpk) , & 823 & ak1p3(jpi,jpj,jpk) , ak2p3(jpi,jpj,jpk) , & 824 & ak3p3(jpi,jpj,jpk) , aksi3(jpi,jpj,jpk) , & 825 & fluorid(jpi,jpj,jpk) , sulfat(jpi,jpj,jpk) , & 826 & salinprac(jpi,jpj,jpk), STAT=ierr(2) ) 827 828 ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) ) 829 830 !* Variable for chemistry of the CO2 cycle 831 p4z_che_alloc = MAXVAL( ierr ) 330 832 ! 331 833 IF( p4z_che_alloc /= 0 ) CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') … … 333 835 END FUNCTION p4z_che_alloc 334 836 335 #else336 837 !!====================================================================== 337 !! Dummy module : No PISCES bio-model 338 !!====================================================================== 339 CONTAINS 340 SUBROUTINE p4z_che( kt ) ! Empty routine 341 INTEGER, INTENT(in) :: kt 342 WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 343 END SUBROUTINE p4z_che 344 #endif 345 346 !!====================================================================== 347 END MODULE p4zche 838 END MODULE p4zche
Note: See TracChangeset
for help on using the changeset viewer.
