chem/module_isrpia.F

   1 module module_isrpia
   2
   3 use module_data_isrpia
   4 CONTAINS
   5 !=======================================================================
   6 !
   7 ! *** This module calculates the thermodynamic equilibrium based on
   8 !     ISORROPIA
   9 ! *** Modified to make it WRF compatible by Rainer Schmitz, 23.12.2007
  10 ! *** AireChile, Department of Geophysics, University of Chile
  11 !
  12 !
  13
  14 !=======================================================================
  15 !
  16 ! *** ISORROPIA CODE
  17 ! *** SUBROUTINE ISOROPIA
  18 ! *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA
  19 !     THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSION 1.1 and above)
  20 !
  21 ! ======================== ARGUMENTS / USAGE ===========================
  22 !
  23 !  INPUT:
  24 !  1. [WI]
  25 !     DOUBLE PRECISION array of length [5].
  26 !     Concentrations, expressed in moles/m3. Depending on the type of
  27 !     problem solved (specified in CNTRL(1)), WI contains either
  28 !     GAS+AEROSOL or AEROSOL only concentratios.
  29 !     WI(1) - sodium
  30 !     WI(2) - sulfate
  31 !     WI(3) - ammonium
  32 !     WI(4) - nitrate
  33 !     WI(5) - chloride
  34 !
  35 !  2. [RHI]
  36 !     DOUBLE PRECISION variable.
  37 !     Ambient relative humidity expressed on a (0,1) scale.
  38 !
  39 !  3. [TEMPI]
  40 !     DOUBLE PRECISION variable.
  41 !     Ambient temperature expressed in Kelvins.
  42 !
  43 !  4. [CNTRL]
  44 !     DOUBLE PRECISION array of length [2].
  45 !     Parameters that control the type of problem solved.
  46 !
  47 !     CNTRL(1): Defines the type of problem solved.
  48 !     0 - Forward problem is solved. In this case, array WI contains
  49 !         GAS and AEROSOL concentrations together.
  50 !     1 - Reverse problem is solved. In this case, array WI contains
  51 !         AEROSOL concentrations only.
  52 !
  53 !     CNTRL(2): Defines the state of the aerosol
  54 !     0 - The aerosol can have both solid+liquid phases (deliquescent)
  55 !     1 - The aerosol is in only liquid state (metastable aerosol)
  56 !
  57 !  OUTPUT:
  58 !  1. [WT]
  59 !     DOUBLE PRECISION array of length [5].
  60 !     Total concentrations (GAS+AEROSOL) of species, expressed in moles/m3.
  61 !     If the foreward probelm is solved (CNTRL(1)=0), array WT is
  62 !     identical to array WI.
  63 !     WT(1) - total sodium
  64 !     WT(2) - total sulfate
  65 !     WT(3) - total ammonium
  66 !     WT(4) - total nitrate
  67 !     WT(5) - total chloride
  68 !
  69 !  2. [GAS]
  70 !     DOUBLE PRECISION array of length [03].
  71 !     Gaseous species concentrations, expressed in moles/m3.
  72 !     GAS(1) - NH3
  73 !     GAS(2) - HNO3
  74 !     GAS(3) - HCl
  75 !
  76 !  3. [AERLIQ]
  77 !     DOUBLE PRECISION array of length [11].
  78 !     Liquid aerosol species concentrations, expressed in moles/m3.
  79 !     AERLIQ(01) - H+(aq)
  80 !     AERLIQ(02) - Na+(aq)
  81 !     AERLIQ(03) - NH4+(aq)
  82 !     AERLIQ(04) - Cl-(aq)
  83 !     AERLIQ(05) - SO4--(aq)
  84 !     AERLIQ(06) - HSO4-(aq)
  85 !     AERLIQ(07) - NO3-(aq)
  86 !     AERLIQ(08) - H2O
  87 !     AERLIQ(09) - NH3(aq) (undissociated)
  88 !     AERLIQ(10) - HNCl(aq) (undissociated)
  89 !     AERLIQ(11) - HNO3(aq) (undissociated)
  90 !     AERLIQ(12) - OH-(aq)
  91 !
  92 !  4. [AERSLD]
  93 !     DOUBLE PRECISION array of length [09].
  94 !     Solid aerosol species concentrations, expressed in moles/m3.
  95 !     AERSLD(01) - NaNO3(s)
  96 !     AERSLD(02) - NH4NO3(s)
  97 !     AERSLD(03) - NaCl(s)
  98 !     AERSLD(04) - NH4Cl(s)
  99 !     AERSLD(05) - Na2SO4(s)
 100 !     AERSLD(06) - (NH4)2SO4(s)
 101 !     AERSLD(07) - NaHSO4(s)
 102 !     AERSLD(08) - NH4HSO4(s)
 103 !     AERSLD(09) - (NH4)4H(SO4)2(s)
 104 !
 105 !  5. [SCASI]
 106 !     CHARACTER*15 variable.
 107 !     Returns the subcase which the input corresponds to.
 108 !
 109 !  6. [OTHER]
 110 !     DOUBLE PRECISION array of length [6].
 111 !     Returns solution information.
 112 !
 113 !     OTHER(1): Shows if aerosol water exists.
 114 !     0 - Aerosol is WET
 115 !     1 - Aerosol is DRY
 116 !
 117 !     OTHER(2): Aerosol Sulfate ratio, defined as (in moles/m3) :
 118 !               (total ammonia + total Na) / (total sulfate)
 119 !
 120 !     OTHER(3): Sulfate ratio based on aerosol properties that defines
 121 !               a sulfate poor system:
 122 !               (aerosol ammonia + aerosol Na) / (aerosol sulfate)
 123 !
 124 !     OTHER(4): Aerosol sodium ratio, defined as (in moles/m3) :
 125 !               (total Na) / (total sulfate)
 126 !
 127 !     OTHER(5): Ionic strength of the aqueous aerosol (if it exists).
 128 !
 129 !     OTHER(6): Total number of calls to the activity coefficient
 130 !               calculation subroutine.
 131 !
 132 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 133 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 134 ! *** WRITTEN BY ATHANASIOS NENES
 135 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 136 !
 137 !=======================================================================
 138 !
 139       SUBROUTINE ISOROPIA (WI, RHI, TEMPI,  CNTRL, &
 140                           WT, GAS, AERLIQ, AERSLD, SCASI, OTHER)
 141         implicit none
 142
 143       INTEGER,PARAMETER::NCTRL=2,NOTHER=6
 144       CHARACTER SCASI*15
 145       REAL(KIND=8) WI(NCOMP), WT(NCOMP), RHI, TEMPI,  GAS(NGASAQ),  &
 146            AERSLD(NSLDS), AERLIQ(NIONS+NGASAQ+2), CNTRL(NCTRL), OTHER(NOTHER)
 147       INTEGER I
 148 !
 149 ! *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ******************************
 150 !
 151       IPROB   = NINT(CNTRL(1))
 152 !
 153 ! *** AEROSOL STATE (0=SOLID+LIQUID, 1=METASTABLE) **********************
 154 !
 155       METSTBL = NINT(CNTRL(2))
 156 !
 157 ! *** SOLVE FOREWARD PROBLEM ********************************************
 158 !
 159 50    IF (IPROB.EQ.0) THEN
 160          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 161             CALL INIT1 (WI, RHI, TEMPI)
 162          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 163             CALL ISRP1F (WI, RHI, TEMPI)
 164          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 165             CALL ISRP2F (WI, RHI, TEMPI)
 166          ELSE
 167             CALL ISRP3F (WI, RHI, TEMPI)
 168          ENDIF
 169 !
 170 ! *** SOLVE REVERSE PROBLEM *********************************************
 171 !
 172       ELSE
 173          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 174             CALL INIT1 (WI, RHI, TEMPI)
 175          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 176             CALL ISRP1R (WI, RHI, TEMPI)
 177          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 178             CALL ISRP2R (WI, RHI, TEMPI)
 179          ELSE
 180             CALL ISRP3R (WI, RHI, TEMPI)
 181          ENDIF
 182       ENDIF
 183 !
 184 ! *** ADJUST MASS BALANCE ***********************************************
 185 !
 186       IF (NADJ.EQ.1) CALL ADJUST (WI)
 187 !ccC
 188 !ccC *** IF METASTABLE AND NO WATER - RESOLVE AS NORMAL ********************
 189 !ccC
 190 !cc      IF (WATER.LE.TINY .AND. METSTBL.EQ.1) THEN
 191 !cc         METSTBL = 0
 192 !cc         GOTO 50
 193 !cc      ENDIF
 194 !C
 195 ! *** SAVE RESULTS TO ARRAYS (units = mole/m3) ****************************
 196 !
 197       GAS(1) = GNH3                ! Gaseous aerosol species
 198       GAS(2) = GHNO3
 199       GAS(3) = GHCL
 200 !
 201       DO 10 I=1,NIONS              ! Liquid aerosol species
 202          AERLIQ(I) = MOLAL(I)
 203   10  CONTINUE
 204       DO 20 I=1,NGASAQ
 205          AERLIQ(NIONS+1+I) = GASAQ(I)
 206   20  CONTINUE
 207       AERLIQ(NIONS+1)        = WATER*1.0D3/18.0D0
 208       AERLIQ(NIONS+NGASAQ+2) = COH
 209 !
 210       AERSLD(1) = CNANO3           ! Solid aerosol species
 211       AERSLD(2) = CNH4NO3
 212       AERSLD(3) = CNACL
 213       AERSLD(4) = CNH4CL
 214       AERSLD(5) = CNA2SO4
 215       AERSLD(6) = CNH42S4
 216       AERSLD(7) = CNAHSO4
 217       AERSLD(8) = CNH4HS4
 218       AERSLD(9) = CLC
 219
 220       IF(WATER.LE.TINY) THEN       ! Dry flag
 221         OTHER(1) = 1.d0
 222       ELSE
 223         OTHER(1) = 0.d0
 224       ENDIF
 225
 226       OTHER(2) = SULRAT            ! Other stuff
 227       OTHER(3) = SULRATW
 228       OTHER(4) = SODRAT
 229       OTHER(5) = IONIC
 230       OTHER(6) = ICLACT
 231
 232       SCASI = SCASE
 233
 234       WT(1) = WI(1)                ! Total gas+aerosol phase
 235       WT(2) = WI(2)
 236       WT(3) = WI(3)
 237       WT(4) = WI(4)
 238       WT(5) = WI(5)
 239       IF (IPROB.GT.0 .AND. WATER.GT.TINY) THEN
 240          WT(3) = WT(3) + GNH3
 241          WT(4) = WT(4) + GHNO3
 242          WT(5) = WT(5) + GHCL
 243       ENDIF
 244
 245       RETURN
 246
 247 ! *** END OF SUBROUTINE ISOROPIA ******************************************
 248
 249    END SUBROUTINE ISOROPIA
 250
 251
 252
 253 !=======================================================================
 254
 255 ! *** ISORROPIA CODE
 256 ! *** SUBROUTINE SETPARM
 257 ! *** THIS SUBROUTINE REDEFINES THE SOLUTION PARAMETERS OF ISORROPIA
 258 !
 259 ! ======================== ARGUMENTS / USAGE ===========================
 260 !
 261 ! *** NOTE: IF NEGATIVE VALUES ARE GIVEN FOR A PARAMETER, IT IS
 262 !     IGNORED AND THE CURRENT VALUE IS USED INSTEAD.
 263 !
 264 !  INPUT:
 265 !  1. [WFTYPI]
 266 !     INTEGER variable.
 267 !     Defines the type of weighting algorithm for the solution in Mutual
 268 !     Deliquescence Regions (MDR's):
 269 !     0 - MDR's are assumed dry. This is equivalent to the approach
 270 !         used by SEQUILIB.
 271 !     1 - The solution is assumed "half" dry and "half" wet throughout
 272 !         the MDR.
 273 !     2 - The solution is a relative-humidity weighted mean of the
 274 !         dry and wet solutions (as defined in Nenes et al., 1998)
 275 !
 276 !  2. [IACALCI]
 277 !     INTEGER variable.
 278 !     Method of activity coefficient calculation:
 279 !     0 - Calculate coefficients during runtime
 280 !     1 - Use precalculated tables
 281 !
 282 !  3. [EPSI]
 283 !     DOUBLE PRECITION variable.
 284 !     Defines the convergence criterion for all iterative processes
 285 !     in ISORROPIA, except those for activity coefficient calculations
 286 !     (EPSACTI controls that).
 287 !
 288 !  4. [MAXITI]
 289 !     INTEGER variable.
 290 !     Defines the maximum number of iterations for all iterative
 291 !     processes in ISORROPIA, except for activity coefficient calculations
 292 !     (NSWEEPI controls that).
 293 !
 294 !  5. [NSWEEPI]
 295 !     INTEGER variable.
 296 !     Defines the maximum number of iterations for activity coefficient
 297 !     calculations.
 298 !
 299 !  6. [EPSACTI]
 300 !     DOUBLE PRECISION variable.
 301 !     Defines the convergence criterion for activity coefficient
 302 !     calculations.
 303 !
 304 !  7. [NDIV]
 305 !     INTEGER variable.
 306 !     Defines the number of subdivisions needed for the initial root
 307 !     tracking for the bisection method. Usually this parameter should
 308 !     not be altered, but is included for completeness.
 309 !
 310 !  8. [NADJ]
 311 !     INTEGER variable.
 312 !     Forces the solution obtained to satisfy total mass balance
 313 !     to machine precision
 314 !     0 - No adjustment done (default)
 315 !     1 - Do adjustment
 316 !
 317 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 318 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 319 ! *** WRITTEN BY ATHANASIOS NENES
 320 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 321 !
 322 !=======================================================================
 323 !
 324    SUBROUTINE SETPARM (WFTYPI,  IACALCI, EPSI, MAXITI, NSWEEPI, &
 325         EPSACTI, NDIVI, NADJI)
 326      implicit none
 327
 328      REAL(KIND=8) EPSI, EPSACTI
 329      INTEGER  WFTYPI, IACALCI, MAXITI, NSWEEPI, NDIVI, NADJI
 330 !
 331 ! *** SETUP SOLUTION PARAMETERS *****************************************
 332 !
 333       IF (WFTYPI .GE. 0)   WFTYP  = WFTYPI
 334       IF (IACALCI.GE. 0)   IACALC = IACALCI
 335       IF (EPSI   .GE.ZERO) EPS    = EPSI
 336       IF (MAXITI .GT. 0)   MAXIT  = MAXITI
 337       IF (NSWEEPI.GT. 0)   NSWEEP = NSWEEPI
 338       IF (EPSACTI.GE.ZERO) EPSACT = EPSACTI
 339       IF (NDIVI  .GT. 0)   NDIV   = NDIVI
 340       IF (NADJI  .GE. 0)   NADJ   = NADJI
 341 !
 342 ! *** END OF SUBROUTINE SETPARM *****************************************
 343 !
 344       RETURN
 345     END SUBROUTINE SETPARM
 346
 347
 348
 349
 350 !=======================================================================
 351 !
 352 ! *** ISORROPIA CODE
 353 ! *** SUBROUTINE GETPARM
 354 ! *** THIS SUBROUTINE OBTAINS THE CURRENT VAULES OF THE SOLUTION
 355 !     PARAMETERS OF ISORROPIA
 356 !
 357 ! ======================== ARGUMENTS / USAGE ===========================
 358 !
 359 ! *** THE PARAMETERS ARE THOSE OF SUBROUTINE SETPARM
 360 !
 361 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 362 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 363 ! *** WRITTEN BY ATHANASIOS NENES
 364 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 365 !
 366 !=======================================================================
 367 !
 368       SUBROUTINE GETPARM (WFTYPI,  IACALCI, EPSI, MAXITI, NSWEEPI, &
 369                          EPSACTI, NDIVI, NADJI)
 370      implicit none
 371      REAL(KIND=8) EPSI, EPSACTI
 372      INTEGER  WFTYPI, IACALCI, MAXITI, NSWEEPI, NDIVI, NADJI
 373 !
 374 ! *** GET SOLUTION PARAMETERS *******************************************
 375 !
 376       WFTYPI  = WFTYP
 377       IACALCI = IACALC
 378       EPSI    = EPS
 379       MAXITI  = MAXIT
 380       NSWEEPI = NSWEEP
 381       EPSACTI = EPSACT
 382       NDIVI   = NDIV
 383       NADJI   = NADJ
 384 !
 385 ! *** END OF SUBROUTINE GETPARM *****************************************
 386
 387       RETURN
 388     END SUBROUTINE GETPARM
 389 !
 390 !=======================================================================
 391 !
 392 ! *** ISORROPIA !ODE
 393 ! *** SUBROUTINE INIT1
 394 ! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM
 395 !     SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP1)
 396 !
 397 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 398 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 399 ! *** WRITTEN BY ATHANASIOS NENES
 400 ! *** UPDATED BY !HRISTOS FOUNTOUKIS
 401 !
 402 !=======================================================================
 403 !
 404       SUBROUTINE INIT1 (WI, RHI, TEMPI)
 405         implicit none
 406       REAL(KIND=8) WI(NCOMP),RHI,TEMPI
 407       REAL(KIND=8) T0, T0T, COEF, TCF
 408       INTEGER IRH
 409       REAL      IC,GII,GI0,XX
 410       REAL,PARAMETER::LN10=2.3025851
 411       INTEGER I
 412 !
 413 ! *** SAVE INPUT VARIABLES IN COMMON BLOCK ******************************
 414 !
 415       IF (IPROB.EQ.0) THEN                 ! FORWARD CALCULATION
 416          DO 10 I=1,NCOMP
 417             W(I) = MAX(WI(I), TINY)
 418 10       CONTINUE
 419       ELSE
 420          DO 15 I=1,NCOMP                   ! REVERSE CALCULATION
 421             WAER(I) = MAX(WI(I), TINY)
 422             W(I)    = ZERO
 423 15       CONTINUE
 424       ENDIF
 425       RH      = RHI
 426       TEMP    = TEMPI
 427 !
 428 ! *** CALCULATE EQUILIBRIUM CONSTANTS ***********************************
 429 !
 430       XK1  = 1.015e-2  ! HSO4(aq)         <==> H(aq)     + SO4(aq)
 431       XK21 = 57.639    ! NH3(g)           <==> NH3(aq)
 432       XK22 = 1.805e-5  ! NH3(aq)          <==> NH4(aq)   + OH(aq)
 433       XK7  = 1.817     ! (NH4)2SO4(s)     <==> 2*NH4(aq) + SO4(aq)
 434       XK12 = 1.382e2   ! NH4HSO4(s)       <==> NH4(aq)   + HSO4(aq)
 435       XK13 = 29.268    ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq)
 436       XKW  = 1.010e-14 ! H2O              <==> H(aq)     + OH(aq)
 437
 438       IF (INT(TEMP) .NE. 298) THEN   ! FOR T != 298K or 298.15K
 439          T0  = 298.15
 440          T0T = T0/TEMP
 441          COEF= 1.0+LOG(T0T)-T0T
 442          XK1 = XK1 *EXP(  8.85*(T0T-1.0) + 25.140*COEF)
 443          XK21= XK21*EXP( 13.79*(T0T-1.0) -  5.393*COEF)
 444          XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF)
 445          XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF)
 446          XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF)
 447          XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF)
 448          XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF)
 449       ENDIF
 450       XK2 = XK21*XK22
 451 !
 452 ! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ********
 453 !
 454       DRH2SO4  = 0.0000D0
 455       DRNH42S4 = 0.7997D0
 456       DRNH4HS4 = 0.4000D0
 457       DRLC     = 0.6900D0
 458       IF (INT(TEMP) .NE. 298) THEN
 459          T0       = 298.15d0
 460          TCF      = 1.0/TEMP - 1.0/T0
 461          DRNH42S4 = DRNH42S4*EXP( 80.*TCF)
 462          DRNH4HS4 = DRNH4HS4*EXP(384.*TCF)
 463          DRLC     = DRLC    *EXP(186.*TCF)
 464       ENDIF
 465 !
 466 ! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES ****************
 467 !
 468       DRMLCAB = 0.3780D0              ! (NH4)3H(SO4)2 & NH4HSO4
 469       DRMLCAS = 0.6900D0              ! (NH4)3H(SO4)2 & (NH4)2SO4
 470 !CC      IF (INT(TEMP) .NE. 298) THEN      ! For the time being.
 471 !CC         T0       = 298.15d0
 472 !CC         TCF      = 1.0/TEMP - 1.0/T0
 473 !CC         DRMLCAB  = DRMLCAB*EXP(507.506*TCF)
 474 !CC         DRMLCAS  = DRMLCAS*EXP(133.865*TCF)
 475 !CC      ENDIF
 476 !
 477 ! *** LIQUID PHASE ******************************************************
 478 !
 479       CHNO3  = ZERO
 480       CHCL   = ZERO
 481       CH2SO4 = ZERO
 482       COH    = ZERO
 483       WATER  = TINY
 484
 485       DO 20 I=1,NPAIR
 486          MOLALR(I)=ZERO
 487          GAMA(I)  =0.1
 488          GAMIN(I) =GREAT
 489          GAMOU(I) =GREAT
 490          M0(I)    =1d5
 491  20   CONTINUE
 492
 493       DO 30 I=1,NPAIR
 494          GAMA(I) = 0.1d0
 495  30   CONTINUE
 496
 497       DO 40 I=1,NIONS
 498          MOLAL(I)=ZERO
 499 40    CONTINUE
 500       COH = ZERO
 501
 502       DO 50 I=1,NGASAQ
 503          GASAQ(I)=ZERO
 504 50    CONTINUE
 505 !
 506 ! *** SOLID PHASE *******************************************************
 507 !
 508       CNH42S4= ZERO
 509       CNH4HS4= ZERO
 510       CNACL  = ZERO
 511       CNA2SO4= ZERO
 512       CNANO3 = ZERO
 513       CNH4NO3= ZERO
 514       CNH4CL = ZERO
 515       CNAHSO4= ZERO
 516       CLC    = ZERO
 517 !
 518 ! *** GAS PHASE *********************************************************
 519 !
 520       GNH3   = ZERO
 521       GHNO3  = ZERO
 522       GHCL   = ZERO
 523 !
 524 ! *** CALCULATE ZSR PARAMETERS ******************************************
 525 !
 526       IRH    = MIN (INT(RH*NZSR+0.5),NZSR)  ! Position in ZSR arrays
 527       IRH    = MAX (IRH, 1)
 528 !
 529 !      M0(01) = AWSC(IRH)      ! NACl
 530 !      IF (M0(01) .LT. 100.0) THEN
 531 !         IC = M0(01)
 532 !         CALL KMTAB(IC,298.0,     GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 533 !         CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 534 !         M0(01) = M0(01)*EXP(LN10*(GI0-GII))
 535 !      ENDIF
 536 !
 537 !      M0(02) = AWSS(IRH)      ! (NA)2SO4
 538 !      IF (M0(02) .LT. 100.0) THEN
 539 !         IC = 3.0*M0(02)
 540 !         CALL KMTAB(IC,298.0,     XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 541 !         CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 542 !         M0(02) = M0(02)*EXP(LN10*(GI0-GII))
 543 !      ENDIF
 544 !
 545 !      M0(03) = AWSN(IRH)      ! NANO3
 546 !      IF (M0(03) .LT. 100.0) THEN
 547 !         IC = M0(03)
 548 !         CALL KMTAB(IC,298.0,     XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 549 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX)
 550 !         M0(03) = M0(03)*EXP(LN10*(GI0-GII))
 551 !      ENDIF
 552 !
 553       M0(04) = AWAS(IRH)      ! (NH4)2SO4
 554 !      IF (M0(04) .LT. 100.0) THEN
 555 !         IC = 3.0*M0(04)
 556 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX)
 557 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX)
 558 !         M0(04) = M0(04)*EXP(LN10*(GI0-GII))
 559 !      ENDIF
 560 !
 561 !      M0(05) = AWAN(IRH)      ! NH4NO3
 562 !      IF (M0(05) .LT. 100.0) THEN
 563 !         IC     = M0(05)
 564 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX)
 565 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX)
 566 !         M0(05) = M0(05)*EXP(LN10*(GI0-GII))
 567 !      ENDIF
 568 !
 569 !      M0(06) = AWAC(IRH)      ! NH4CL
 570 !      IF (M0(06) .LT. 100.0) THEN
 571 !         IC = M0(06)
 572 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX)
 573 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX)
 574 !         M0(06) = M0(06)*EXP(LN10*(GI0-GII))
 575 !      ENDIF
 576 !
 577       M0(07) = AWSA(IRH)      ! 2H-SO4
 578 !      IF (M0(07) .LT. 100.0) THEN
 579 !         IC = 3.0*M0(07)
 580 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX)
 581 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX)
 582 !         M0(07) = M0(07)*EXP(LN10*(GI0-GII))
 583 !      ENDIF
 584 !
 585       M0(08) = AWSA(IRH)      ! H-HSO4
 586 !CC      IF (M0(08) .LT. 100.0) THEN     ! These are redundant, because M0(8) is not used
 587 !CC         IC = M0(08)
 588 !CC         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
 589 !CC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
 590 !CCCCC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX)
 591 !CC         M0(08) = M0(08)*EXP(LN10*(GI0-GII))
 592 !CC      ENDIF
 593 !
 594       M0(09) = AWAB(IRH)      ! NH4HSO4
 595 !      IF (M0(09) .LT. 100.0) THEN
 596 !         IC = M0(09)
 597 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX)
 598 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX)
 599 !         M0(09) = M0(09)*EXP(LN10*(GI0-GII))
 600 !      ENDIF
 601 !
 602 !      M0(12) = AWSB(IRH)      ! NAHSO4
 603 !      IF (M0(12) .LT. 100.0) THEN
 604 !         IC = M0(12)
 605 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0)
 606 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII)
 607 !         M0(12) = M0(12)*EXP(LN10*(GI0-GII))
 608 !      ENDIF
 609 !
 610       M0(13) = AWLC(IRH)      ! (NH4)3H(SO4)2
 611 !      IF (M0(13) .LT. 100.0) THEN
 612 !         IC     = 4.0*M0(13)
 613 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
 614 !         G130   = 0.2*(3.0*GI0+2.0*GII)
 615 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
 616 !         G13I   = 0.2*(3.0*GI0+2.0*GII)
 617 !         M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I))
 618 !      ENDIF
 619 !
 620 ! *** OTHER INITIALIZATIONS *********************************************
 621 !
 622       ICLACT  = 0
 623       CALAOU  = .TRUE.
 624       CALAIN  = .TRUE.
 625       FRST    = .TRUE.
 626       SCASE   = 'xx'
 627       SULRATW = 2.D0
 628       SODRAT  = ZERO
 629       NOFER   = 0
 630       STKOFL  =.FALSE.
 631       DO 60 I=1,NERRMX
 632          ERRSTK(I) =-999
 633          ERRMSG(I) = 'MESSAGE N/A'
 634    60 CONTINUE
 635 !
 636 ! *** END OF SUBROUTINE INIT1 *******************************************
 637 !
 638   END SUBROUTINE INIT1
 639
 640
 641
 642
 643
 644
 645
 646
 647
 648
 649
 650
 651
 652
 653
 654
 655 !
 656 ! *** ISORROPIA CODE
 657 ! *** SUBROUTINE ISOPLUS
 658 ! *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA-PLUS
 659 !     THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSION 1.0)
 660 !
 661 ! *** NOTE: THIS SUBROUTINE IS INCLUDED FOR BACKWARD COMPATABILITY ONLY.
 662 !     A PROGRAMMER SHOULD USE THE MORE COMPLETE SUBROUTINE ISOROPIA INSTEAD
 663 !
 664 ! ======================== ARGUMENTS / USAGE ===========================
 665 !
 666 !  INPUT:
 667 !  1. [WI]
 668 !     DOUBLE PRECISION array of length [5].
 669 !     Concentrations, expressed in moles/m3. Depending on the type of
 670 !     problem solved, WI contains either GAS+AEROSOL or AEROSOL only
 671 !     concentratios.
 672 !     WI(1) - sodium
 673 !     WI(2) - sulfate
 674 !     WI(3) - ammonium
 675 !     WI(4) - nitrate
 676 !     WI(5) - chloride
 677 !
 678 !  2. [RHI]
 679 !     DOUBLE PRECISION variable.
 680 !     Ambient relative humidity expressed in a (0,1) scale.
 681 !
 682 !  3. [TEMPI]
 683 !     DOUBLE PRECISION variable.
 684 !     Ambient temperature expressed in Kelvins.
 685 !
 686 !  4. [IPROB]
 687 !     INTEGER variable.
 688 !     The type of problem solved.
 689 !     IPROB = 0  - Forward problem is solved. In this case, array WI
 690 !                  contains GAS and AEROSOL concentrations together.
 691 !     IPROB = 1  - Reverse problem is solved. In this case, array WI
 692 !                  contains AEROSOL concentrations only.
 693 !
 694 !  OUTPUT:
 695 !  1. [GAS]
 696 !     DOUBLE PRECISION array of length [03].
 697 !     Gaseous species concentrations, expressed in moles/m3.
 698 !     GAS(1) - NH3
 699 !     GAS(2) - HNO3
 700 !     GAS(3) - HCl
 701 !
 702 !  2. [AERLIQ]
 703 !     DOUBLE PRECISION array of length [11].
 704 !     Liquid aerosol species concentrations, expressed in moles/m3.
 705 !     AERLIQ(01) - H+(aq)
 706 !     AERLIQ(02) - Na+(aq)
 707 !     AERLIQ(03) - NH4+(aq)
 708 !     AERLIQ(04) - Cl-(aq)
 709 !     AERLIQ(05) - SO4--(aq)
 710 !     AERLIQ(06) - HSO4-(aq)
 711 !     AERLIQ(07) - NO3-(aq)
 712 !     AERLIQ(08) - H2O
 713 !     AERLIQ(09) - NH3(aq) (undissociated)
 714 !     AERLIQ(10) - HNCl(aq) (undissociated)
 715 !     AERLIQ(11) - HNO3(aq) (undissociated)
 716 !
 717 !  3. [AERSLD]
 718 !     DOUBLE PRECISION array of length [09].
 719 !     Solid aerosol species concentrations, expressed in moles/m3.
 720 !     AERSLD(01) - NaNO3(s)
 721 !     AERSLD(02) - NH4NO3(s)
 722 !     AERSLD(03) - NaCl(s)
 723 !     AERSLD(04) - NH4Cl(s)
 724 !     AERSLD(05) - Na2SO4(s)
 725 !     AERSLD(06) - (NH4)2SO4(s)
 726 !     AERSLD(07) - NaHSO4(s)
 727 !     AERSLD(08) - NH4HSO4(s)
 728 !     AERSLD(09) - (NH4)4H(SO4)2(s)
 729 !
 730 !  4. [DRY]
 731 !     LOGICAL variable.
 732 !     Contains information about the physical state of the system.
 733 !     .TRUE. - There is no aqueous phase present
 734 !     .FALSE.- There is an aqueous phase present
 735 !
 736 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 737 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 738 ! *** WRITTEN BY ATHANASIOS NENES
 739 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 740 !
 741 !=======================================================================
 742 !
 743   SUBROUTINE ISOPLUS (WI,  RHI,    TEMPI,  IPROBI,  &
 744                         GAS, AERLIQ, AERSLD, DRYI   )
 745 !      implicit none
 746         implicit none
 747       REAL(KIND=8) WI(NCOMP), GAS(NGASAQ), AERLIQ(NIONS+NGASAQ+1), &
 748                AERSLD(NSLDS)
 749       REAL(KIND=8) RHI, TEMPI
 750       INTEGER IPROBI
 751       LOGICAL   DRYI
 752       INTEGER I
 753 !
 754 ! *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ******************************
 755 !
 756       IPROB = IPROBI
 757 !
 758 ! *** SOLVE FOREWARD PROBLEM ********************************************
 759 !
 760       IF (IPROB.EQ.0) THEN
 761          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 762             CALL INIT1 (WI, RHI, TEMPI)
 763          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 764             CALL ISRP1F (WI, RHI, TEMPI)
 765          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 766             CALL ISRP2F (WI, RHI, TEMPI)
 767          ELSE
 768             CALL ISRP3F (WI, RHI, TEMPI)
 769          ENDIF
 770 !
 771 ! *** SOLVE REVERSE PROBLEM *********************************************
 772 !
 773       ELSE
 774          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 775             CALL INIT1 (WI, RHI, TEMPI)
 776          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 777             CALL ISRP1R (WI, RHI, TEMPI)
 778          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 779             CALL ISRP2R (WI, RHI, TEMPI)
 780          ELSE
 781             CALL ISRP3R (WI, RHI, TEMPI)
 782          ENDIF
 783       ENDIF
 784 !
 785 ! *** SAVE RESULTS TO ARRAYS (units = mole/m3, kg/m3 for water) *********
 786 !
 787       GAS(1) = GNH3
 788       GAS(2) = GHNO3
 789       GAS(3) = GHCL
 790 !
 791       DO 10 I=1,NIONS
 792          AERLIQ(I) = MOLAL(I)
 793   10  CONTINUE
 794       AERLIQ(NIONS+1) = WATER*1.0D3/18.0D0
 795       DO 20 I=1,NGASAQ
 796          AERLIQ(NIONS+1+I) = GASAQ(I)
 797   20  CONTINUE
 798 !
 799       AERSLD(1) = CNANO3
 800       AERSLD(2) = CNH4NO3
 801       AERSLD(3) = CNACL
 802       AERSLD(4) = CNH4CL
 803       AERSLD(5) = CNA2SO4
 804       AERSLD(6) = CNH42S4
 805       AERSLD(7) = CNAHSO4
 806       AERSLD(8) = CNH4HS4
 807       AERSLD(9) = CLC
 808 !
 809       DRYI = WATER.LE.TINY
 810 !
 811       RETURN
 812 !
 813 ! *** END OF SUBROUTINE ISOPLUS ******************************************
 814 !
 815     END SUBROUTINE ISOPLUS
 816
 817
 818
 819
 820 !=======================================================================
 821 !
 822 ! *** ISORROPIA CODE
 823 ! *** SUBROUTINE ISRPIA
 824 ! *** THIS SUBROUTINE IS THE MASTER ROUTINE FOR THE ISORROPIA-PLUS
 825 !     THERMODYNAMIC EQUILIBRIUM AEROSOL MODEL (VERSIONS 0.x)
 826 !
 827 ! *** NOTE: THIS SUBROUTINE IS INCLUDED FOR BACKWARD COMPATABILITY ONLY.
 828 !     A PROGRAMMER SHOULD USE THE MORE COMPLETE SUBROUTINE ISOROPIA INSTEAD
 829 !
 830 !
 831 !     DEPENDING ON THE INPUT VALUES PROVIDED, THE FOLLOWING MODEL
 832 !     SUBVERSIONS ARE CALLED:
 833 !
 834 !     FOREWARD PROBLEM (IPROB=0):
 835 !     Na      SO4      NH4       NO3      CL       SUBROUTINE CALLED
 836 !     ----    ----     ----      ----     ----     -----------------
 837 !     0.0     >0.0     >0.0       0.0      0.0     SUBROUTINE ISRP1F
 838 !     0.0     >0.0     >0.0      >0.0      0.0     SUBROUTINE ISRP2F
 839 !     >0.0    >0.0     >0.0      >0.0     >0.0     SUBROUTINE ISRP3F
 840 !
 841 !     REVERSE PROBLEM (IPROB=1):
 842 !     Na      SO4      NH4       NO3      CL       SUBROUTINE CALLED
 843 !     ----    ----     ----      ----     ----     -----------------
 844 !     0.0     >0.0     >0.0       0.0      0.0     SUBROUTINE ISRP1R
 845 !     0.0     >0.0     >0.0      >0.0      0.0     SUBROUTINE ISRP2R
 846 !     >0.0    >0.0     >0.0      >0.0     >0.0     SUBROUTINE ISRP3R
 847 !
 848 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 849 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 850 ! *** WRITTEN BY ATHANASIOS NENES
 851 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 852 !
 853 !=======================================================================
 854 !
 855       SUBROUTINE ISRPIA (WI, RHI, TEMPI, IPROBI)
 856 !      implicit none
 857        implicit none
 858       REAL(KIND=8) WI(NCOMP),RHI,TEMPI
 859       INTEGER IPROBI,IPROB
 860 !
 861 ! *** PROBLEM TYPE (0=FOREWARD, 1=REVERSE) ******************************
 862 !
 863       IPROB = IPROBI
 864 !
 865 ! *** SOLVE FOREWARD PROBLEM ********************************************
 866 !
 867       IF (IPROB.EQ.0) THEN
 868          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 869             CALL INIT1 (WI, RHI, TEMPI)
 870          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 871             CALL ISRP1F (WI, RHI, TEMPI)
 872          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 873             CALL ISRP2F (WI, RHI, TEMPI)
 874          ELSE
 875             CALL ISRP3F (WI, RHI, TEMPI)
 876          ENDIF
 877 !
 878 ! *** SOLVE REVERSE PROBLEM *********************************************
 879 !
 880       ELSE
 881          IF (WI(1)+WI(2)+WI(3)+WI(4)+WI(5) .LE. TINY) THEN ! Everything=0
 882             CALL INIT1 (WI, RHI, TEMPI)
 883          ELSE IF (WI(1)+WI(4)+WI(5) .LE. TINY) THEN        ! Na,Cl,NO3=0
 884             CALL ISRP1R (WI, RHI, TEMPI)
 885          ELSE IF (WI(1)+WI(5) .LE. TINY) THEN              ! Na,Cl=0
 886             CALL ISRP2R (WI, RHI, TEMPI)
 887          ELSE
 888             CALL ISRP3R (WI, RHI, TEMPI)
 889          ENDIF
 890       ENDIF
 891 !
 892 ! *** SETUP 'DRY' FLAG ***************************************************
 893 !
 894       DRYF = WATER.LE.TINY
 895 !
 896 ! *** FIND TOTALS *******************************************************
 897 !
 898       IF (IPROB.EQ.0) THEN
 899          CONTINUE
 900       ELSE
 901          W(1) = WAER(1)
 902          W(2) = WAER(2)
 903          W(3) = WAER(3)
 904          W(4) = WAER(4)
 905          W(5) = WAER(5)
 906 !
 907          IF (.NOT.DRYF) THEN
 908             W(3) = W(3) + GNH3
 909             W(4) = W(4) + GHNO3
 910             W(5) = W(5) + GHCL
 911          ENDIF
 912       ENDIF
 913 !
 914       RETURN
 915 !
 916 ! *** END OF SUBROUTINE ISRPIA *******************************************
 917 !
 918     END SUBROUTINE ISRPIA
 919
 920 !=======================================================================
 921 !
 922 ! *** ISORROPIA CODE
 923 ! *** FUNCTION GETASR
 924 ! *** CALCULATES THE LIMITING NH4+/SO4 RATIO OF A SULFATE POOR SYSTEM
 925 !     (i.e. SULFATE RATIO = 2.0) FOR GIVEN SO4 LEVEL AND RH
 926 !
 927 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 928 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 929 ! *** WRITTEN BY ATHANASIOS NENES
 930 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 931 !
 932 !=======================================================================
 933 !
 934       REAL(KIND=8) FUNCTION GETASR (SO4I, RHI)
 935       PARAMETER (NSO4S=14, NRHS=20, NASRD=NSO4S*NRHS)
 936       COMMON /ASRC/ ASRAT(NASRD), ASSO4(NSO4S)
 937       DOUBLE PRECISION SO4I, RHI
 938 !CC
 939 !CC *** SOLVE USING FULL COMPUTATIONS, NOT LOOK-UP TABLES **************
 940 !CC
 941 !CC         W(2) = WAER(2)
 942 !CC         W(3) = WAER(2)*2.0001D0
 943 !CC         CALL CALCA2
 944 !CC         SULRATW = MOLAL(3)/WAER(2)
 945 !CC         CALL INIT1 (WI, RHI, TEMPI)   ! Re-initialize COMMON BLOCK
 946 !
 947 ! *** CALCULATE INDICES ************************************************
 948 !
 949       RAT    = SO4I/1.E-9
 950       A1     = INT(ALOG10(RAT))                   ! Magnitude of RAT
 951       IA1    = INT(RAT/2.5/10.0**A1)
 952
 953       INDS   = 4.0*A1 + MIN(IA1,4)
 954       INDS   = MIN(MAX(0, INDS), NSO4S-1) + 1     ! SO4 component of IPOS
 955
 956       INDR   = INT(99.0-RHI*100.0) + 1
 957       INDR   = MIN(MAX(1, INDR), NRHS)            ! RH component of IPOS
 958 !
 959 ! *** GET VALUE AND RETURN *********************************************
 960 !
 961       INDSL  = INDS
 962       INDSH  = MIN(INDSL+1, NSO4S)
 963       IPOSL  = (INDSL-1)*NRHS + INDR              ! Low position in array
 964       IPOSH  = (INDSH-1)*NRHS + INDR              ! High position in array
 965
 966       WF     = (SO4I-ASSO4(INDSL))/(ASSO4(INDSH)-ASSO4(INDSL) + 1e-7)
 967       WF     = MIN(MAX(WF, 0.0), 1.0)
 968
 969       GETASR = WF*ASRAT(IPOSH) + (1.0-WF)*ASRAT(IPOSL)
 970 !
 971 ! *** END OF FUNCTION GETASR *******************************************
 972 !
 973       RETURN
 974     END FUNCTION GETASR
 975
 976
 977
 978
 979
 980
 981
 982
 983 !=======================================================================
 984 !
 985 ! *** ISORROPIA CODE
 986 ! *** SUBROUTINE INIT2
 987 ! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM,
 988 !     NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE ISRP2)
 989 !
 990 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
 991 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
 992 ! *** WRITTEN BY ATHANASIOS NENES
 993 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
 994 !
 995 !=======================================================================
 996 !
 997       SUBROUTINE INIT2 (WI, RHI, TEMPI)
 998       implicit none
 999       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
1000       REAL(KIND=8) T0, T0T, COEF, TCF
1001       INTEGER IRH
1002       REAL      IC,GII,GI0,XX,LN10
1003       PARAMETER (LN10=2.3025851)
1004       INTEGER I
1005 !
1006 ! *** SAVE INPUT VARIABLES IN COMMON BLOCK ******************************
1007 !
1008       IF (IPROB.EQ.0) THEN                 ! FORWARD CALCULATION
1009          DO 10 I=1,NCOMP
1010             W(I) = MAX(WI(I), TINY)
1011 10       CONTINUE
1012       ELSE
1013          DO 15 I=1,NCOMP                   ! REVERSE CALCULATION
1014             WAER(I) = MAX(WI(I), TINY)
1015             W(I)    = ZERO
1016 15       CONTINUE
1017       ENDIF
1018       RH      = RHI
1019       TEMP    = TEMPI
1020 !
1021 ! *** CALCULATE EQUILIBRIUM CONSTANTS ***********************************
1022 !
1023       XK1  = 1.015e-2  ! HSO4(aq)         <==> H(aq)     + SO4(aq)
1024       XK21 = 57.639    ! NH3(g)           <==> NH3(aq)
1025       XK22 = 1.805e-5  ! NH3(aq)          <==> NH4(aq)   + OH(aq)
1026       XK4  = 2.511e6   ! HNO3(g)          <==> H(aq)     + NO3(aq) ! ISORR
1027 !CC      XK4  = 3.638e6   ! HNO3(g)          <==> H(aq)     + NO3(aq) ! SEQUIL
1028       XK41 = 2.100e5   ! HNO3(g)          <==> HNO3(aq)
1029       XK7  = 1.817     ! (NH4)2SO4(s)     <==> 2*NH4(aq) + SO4(aq)
1030       XK10 = 5.746e-17 ! NH4NO3(s)        <==> NH3(g)    + HNO3(g) ! ISORR
1031 !CC      XK10 = 2.985e-17 ! NH4NO3(s)        <==> NH3(g)    + HNO3(g) ! SEQUIL
1032       XK12 = 1.382e2   ! NH4HSO4(s)       <==> NH4(aq)   + HSO4(aq)
1033       XK13 = 29.268    ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq)
1034       XKW  = 1.010e-14 ! H2O              <==> H(aq)     + OH(aq)
1035 !
1036       IF (INT(TEMP) .NE. 298) THEN   ! FOR T != 298K or 298.15K
1037          T0  = 298.15D0
1038          T0T = T0/TEMP
1039          COEF= 1.0+LOG(T0T)-T0T
1040          XK1 = XK1 *EXP(  8.85*(T0T-1.0) + 25.140*COEF)
1041          XK21= XK21*EXP( 13.79*(T0T-1.0) -  5.393*COEF)
1042          XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF)
1043          XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR
1044 !CC         XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL
1045          XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF)
1046          XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF)
1047          XK10= XK10*EXP(-74.38*(T0T-1.0) +  6.120*COEF) ! ISORR
1048 !CC         XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL
1049          XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF)
1050          XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF)
1051          XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF)
1052       ENDIF
1053       XK2  = XK21*XK22
1054       XK42 = XK4/XK41
1055 !
1056 ! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ********
1057 !
1058       DRH2SO4  = ZERO
1059       DRNH42S4 = 0.7997D0
1060       DRNH4HS4 = 0.4000D0
1061       DRNH4NO3 = 0.6183D0
1062       DRLC     = 0.6900D0
1063       IF (INT(TEMP) .NE. 298) THEN
1064          T0       = 298.15D0
1065          TCF      = 1.0/TEMP - 1.0/T0
1066          DRNH4NO3 = DRNH4NO3*EXP(852.*TCF)
1067          DRNH42S4 = DRNH42S4*EXP( 80.*TCF)
1068          DRNH4HS4 = DRNH4HS4*EXP(384.*TCF)
1069          DRLC     = DRLC    *EXP(186.*TCF)
1070          DRNH4NO3 = MIN (DRNH4NO3,DRNH42S4) ! ADJUST FOR DRH CROSSOVER AT T<271K
1071       ENDIF
1072 !
1073 ! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES ****************
1074 !
1075       DRMLCAB = 0.3780D0              ! (NH4)3H(SO4)2 & NH4HSO4
1076       DRMLCAS = 0.6900D0              ! (NH4)3H(SO4)2 & (NH4)2SO4
1077       DRMASAN = 0.6000D0              ! (NH4)2SO4     & NH4NO3
1078 !CC      IF (INT(TEMP) .NE. 298) THEN    ! For the time being
1079 !CC         T0       = 298.15d0
1080 !CC         TCF      = 1.0/TEMP - 1.0/T0
1081 !CC         DRMLCAB  = DRMLCAB*EXP( 507.506*TCF)
1082 !CC         DRMLCAS  = DRMLCAS*EXP( 133.865*TCF)
1083 !CC         DRMASAN  = DRMASAN*EXP(1269.068*TCF)
1084 !CC      ENDIF
1085 !
1086 ! *** LIQUID PHASE ******************************************************
1087 !
1088       CHNO3  = ZERO
1089       CHCL   = ZERO
1090       CH2SO4 = ZERO
1091       COH    = ZERO
1092       WATER  = TINY
1093
1094       DO 20 I=1,NPAIR
1095          MOLALR(I)=ZERO
1096          GAMA(I)  =0.1
1097          GAMIN(I) =GREAT
1098          GAMOU(I) =GREAT
1099          M0(I)    =1d5
1100  20   CONTINUE
1101
1102       DO 30 I=1,NPAIR
1103          GAMA(I) = 0.1d0
1104  30   CONTINUE
1105
1106       DO 40 I=1,NIONS
1107          MOLAL(I)=ZERO
1108 40    CONTINUE
1109       COH = ZERO
1110
1111       DO 50 I=1,NGASAQ
1112          GASAQ(I)=ZERO
1113 50    CONTINUE
1114 !
1115 ! *** SOLID PHASE *******************************************************
1116 !
1117       CNH42S4= ZERO
1118       CNH4HS4= ZERO
1119       CNACL  = ZERO
1120       CNA2SO4= ZERO
1121       CNANO3 = ZERO
1122       CNH4NO3= ZERO
1123       CNH4CL = ZERO
1124       CNAHSO4= ZERO
1125       CLC    = ZERO
1126 !
1127 ! *** GAS PHASE *********************************************************
1128 !
1129       GNH3   = ZERO
1130       GHNO3  = ZERO
1131       GHCL   = ZERO
1132 !
1133 ! *** CALCULATE ZSR PARAMETERS ******************************************
1134 !
1135       IRH    = MIN (INT(RH*NZSR+0.5),NZSR)  ! Position in ZSR arrays
1136       IRH    = MAX (IRH, 1)
1137 !
1138 !      M0(01) = AWSC(IRH)      ! NACl
1139 !      IF (M0(01) .LT. 100.0) THEN
1140 !         IC = M0(01)
1141 !         CALL KMTAB(IC,298.0,     GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1142 !         CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1143 !         M0(01) = M0(01)*EXP(LN10*(GI0-GII))
1144 !      ENDIF
1145 !
1146 !      M0(02) = AWSS(IRH)      ! (NA)2SO4
1147 !      IF (M0(02) .LT. 100.0) THEN
1148 !         IC = 3.0*M0(02)
1149 !         CALL KMTAB(IC,298.0,     XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1150 !         CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1151 !         M0(02) = M0(02)*EXP(LN10*(GI0-GII))
1152 !      ENDIF
1153 !
1154 !      M0(03) = AWSN(IRH)      ! NANO3
1155 !      IF (M0(03) .LT. 100.0) THEN
1156 !         IC = M0(03)
1157 !         CALL KMTAB(IC,298.0,     XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1158 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1159 !         M0(03) = M0(03)*EXP(LN10*(GI0-GII))
1160 !      ENDIF
1161 !
1162       M0(04) = AWAS(IRH)      ! (NH4)2SO4
1163 !      IF (M0(04) .LT. 100.0) THEN
1164 !         IC = 3.0*M0(04)
1165 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX)
1166 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX)
1167 !         M0(04) = M0(04)*EXP(LN10*(GI0-GII))
1168 !      ENDIF
1169 !
1170       M0(05) = AWAN(IRH)      ! NH4NO3
1171 !      IF (M0(05) .LT. 100.0) THEN
1172 !         IC     = M0(05)
1173 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX)
1174 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX)
1175 !         M0(05) = M0(05)*EXP(LN10*(GI0-GII))
1176 !      ENDIF
1177 !
1178 !      M0(06) = AWAC(IRH)      ! NH4CL
1179 !      IF (M0(06) .LT. 100.0) THEN
1180 !         IC = M0(06)
1181 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX)
1182 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX)
1183 !         M0(06) = M0(06)*EXP(LN10*(GI0-GII))
1184 !      ENDIF
1185 !
1186       M0(07) = AWSA(IRH)      ! 2H-SO4
1187 !      IF (M0(07) .LT. 100.0) THEN
1188 !         IC = 3.0*M0(07)
1189 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX)
1190 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX)
1191 !         M0(07) = M0(07)*EXP(LN10*(GI0-GII))
1192 !      ENDIF
1193 !
1194       M0(08) = AWSA(IRH)      ! H-HSO4
1195 !CC      IF (M0(08) .LT. 100.0) THEN     ! These are redundant, because M0(8) is not used
1196 !CC         IC = M0(08)
1197 !CC         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
1198 !CC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
1199 !CCCCC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX)
1200 !CC         M0(08) = M0(08)*EXP(LN10*(GI0-GII))
1201 !CC      ENDIF
1202 !
1203       M0(09) = AWAB(IRH)      ! NH4HSO4
1204 !      IF (M0(09) .LT. 100.0) THEN
1205 !         IC = M0(09)
1206 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX)
1207 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX)
1208 !         M0(09) = M0(09)*EXP(LN10*(GI0-GII))
1209 !      ENDIF
1210 !
1211 !      M0(12) = AWSB(IRH)      ! NAHSO4
1212 !      IF (M0(12) .LT. 100.0) THEN
1213 !         IC = M0(12)
1214 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0)
1215 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII)
1216 !         M0(12) = M0(12)*EXP(LN10*(GI0-GII))
1217 !      ENDIF
1218 !
1219       M0(13) = AWLC(IRH)      ! (NH4)3H(SO4)2
1220 !      IF (M0(13) .LT. 100.0) THEN
1221 !         IC     = 4.0*M0(13)
1222 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
1223 !         G130   = 0.2*(3.0*GI0+2.0*GII)
1224 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
1225 !         G13I   = 0.2*(3.0*GI0+2.0*GII)
1226 !         M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I))
1227 !      ENDIF
1228 !
1229 ! *** OTHER INITIALIZATIONS *********************************************
1230 !
1231       ICLACT  = 0
1232       CALAOU  = .TRUE.
1233       CALAIN  = .TRUE.
1234       FRST    = .TRUE.
1235       SCASE   = 'xx'
1236       SULRATW = 2.D0
1237       SODRAT  = ZERO
1238       NOFER   = 0
1239       STKOFL  =.FALSE.
1240       DO 60 I=1,NERRMX
1241          ERRSTK(I) =-999
1242          ERRMSG(I) = 'MESSAGE N/A'
1243    60 CONTINUE
1244 !
1245 ! *** END OF SUBROUTINE INIT2 *******************************************
1246 !
1247        END SUBROUTINE INIT2
1248
1249
1250
1251
1252
1253 !=======================================================================
1254 !
1255 ! *** ISORROPIA CODE
1256 ! *** SUBROUTINE ISOINIT3
1257 ! *** THIS SUBROUTINE INITIALIZES ALL GLOBAL VARIABLES FOR AMMONIUM,
1258 !     SODIUM, CHLORIDE, NITRATE, SULFATE AEROSOL SYSTEMS (SUBROUTINE
1259 !     ISRP3)
1260 !
1261 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1262 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1263 ! *** WRITTEN BY ATHANASIOS NENES
1264 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1265 !
1266 !=======================================================================
1267 !
1268       SUBROUTINE ISOINIT3 (WI, RHI, TEMPI)
1269       implicit none
1270       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
1271       REAL(KIND=8) T0, T0T, COEF, TCF
1272       INTEGER IRH
1273       REAL      IC,GII,GI0,XX,LN10
1274       PARAMETER (LN10=2.3025851)
1275       INTEGER I
1276 !
1277 ! *** SAVE INPUT VARIABLES IN COMMON BLOCK ******************************
1278 !
1279       IF (IPROB.EQ.0) THEN                 ! FORWARD CALCULATION
1280          DO 10 I=1,NCOMP
1281             W(I) = MAX(WI(I), TINY)
1282 10       CONTINUE
1283       ELSE
1284          DO 15 I=1,NCOMP                   ! REVERSE CALCULATION
1285             WAER(I) = MAX(WI(I), TINY)
1286             W(I)    = ZERO
1287 15       CONTINUE
1288       ENDIF
1289       RH      = RHI
1290       TEMP    = TEMPI
1291 !
1292 ! *** CALCULATE EQUILIBRIUM CONSTANTS ***********************************
1293 !
1294       XK1  = 1.015D-2  ! HSO4(aq)         <==> H(aq)     + SO4(aq)
1295       XK21 = 57.639D0  ! NH3(g)           <==> NH3(aq)
1296       XK22 = 1.805D-5  ! NH3(aq)          <==> NH4(aq)   + OH(aq)
1297       XK3  = 1.971D6   ! HCL(g)           <==> H(aq)     + CL(aq)
1298       XK31 = 2.500e3   ! HCL(g)           <==> HCL(aq)
1299       XK4  = 2.511e6   ! HNO3(g)          <==> H(aq)     + NO3(aq) ! ISORR
1300 !CC      XK4  = 3.638e6   ! HNO3(g)          <==> H(aq)     + NO3(aq) ! SEQUIL
1301       XK41 = 2.100e5   ! HNO3(g)          <==> HNO3(aq)
1302       XK5  = 0.4799D0  ! NA2SO4(s)        <==> 2*NA(aq)  + SO4(aq)
1303       XK6  = 1.086D-16 ! NH4CL(s)         <==> NH3(g)    + HCL(g)
1304       XK7  = 1.817D0   ! (NH4)2SO4(s)     <==> 2*NH4(aq) + SO4(aq)
1305       XK8  = 37.661D0  ! NACL(s)          <==> NA(aq)    + CL(aq)
1306       XK10 = 5.746D-17 ! NH4NO3(s)        <==> NH3(g)    + HNO3(g) ! ISORR
1307 !CC      XK10 = 2.985e-17 ! NH4NO3(s)        <==> NH3(g)    + HNO3(g) ! SEQUIL
1308       XK11 = 2.413D4   ! NAHSO4(s)        <==> NA(aq)    + HSO4(aq)
1309       XK12 = 1.382D2   ! NH4HSO4(s)       <==> NH4(aq)   + HSO4(aq)
1310       XK13 = 29.268D0  ! (NH4)3H(SO4)2(s) <==> 3*NH4(aq) + HSO4(aq) + SO4(aq)
1311       XK14 = 22.05D0   ! NH4CL(s)         <==> NH4(aq)   + CL(aq)
1312       XKW  = 1.010D-14 ! H2O              <==> H(aq)     + OH(aq)
1313       XK9  = 11.977D0  ! NANO3(s)         <==> NA(aq)    + NO3(aq)
1314 !
1315       IF (INT(TEMP) .NE. 298) THEN   ! FOR T != 298K or 298.15K
1316          T0  = 298.15D0
1317          T0T = T0/TEMP
1318          COEF= 1.0+LOG(T0T)-T0T
1319          XK1 = XK1 *EXP(  8.85*(T0T-1.0) + 25.140*COEF)
1320          XK21= XK21*EXP( 13.79*(T0T-1.0) -  5.393*COEF)
1321          XK22= XK22*EXP( -1.50*(T0T-1.0) + 26.920*COEF)
1322          XK3 = XK3 *EXP( 30.20*(T0T-1.0) + 19.910*COEF)
1323          XK31= XK31*EXP( 30.20*(T0T-1.0) + 19.910*COEF)
1324          XK4 = XK4 *EXP( 29.17*(T0T-1.0) + 16.830*COEF) !ISORR
1325 !CC         XK4 = XK4 *EXP( 29.47*(T0T-1.0) + 16.840*COEF) ! SEQUIL
1326          XK41= XK41*EXP( 29.17*(T0T-1.0) + 16.830*COEF)
1327          XK5 = XK5 *EXP(  0.98*(T0T-1.0) + 39.500*COEF)
1328          XK6 = XK6 *EXP(-71.00*(T0T-1.0) +  2.400*COEF)
1329          XK7 = XK7 *EXP( -2.65*(T0T-1.0) + 38.570*COEF)
1330          XK8 = XK8 *EXP( -1.56*(T0T-1.0) + 16.900*COEF)
1331          XK9 = XK9 *EXP( -8.22*(T0T-1.0) + 16.010*COEF)
1332          XK10= XK10*EXP(-74.38*(T0T-1.0) +  6.120*COEF) ! ISORR
1333 !CC         XK10= XK10*EXP(-75.11*(T0T-1.0) + 13.460*COEF) ! SEQUIL
1334          XK11= XK11*EXP(  0.79*(T0T-1.0) + 14.746*COEF)
1335          XK12= XK12*EXP( -2.87*(T0T-1.0) + 15.830*COEF)
1336          XK13= XK13*EXP( -5.19*(T0T-1.0) + 54.400*COEF)
1337          XK14= XK14*EXP( 24.55*(T0T-1.0) + 16.900*COEF)
1338          XKW = XKW *EXP(-22.52*(T0T-1.0) + 26.920*COEF)
1339       ENDIF
1340       XK2  = XK21*XK22
1341       XK42 = XK4/XK41
1342       XK32 = XK3/XK31
1343 !
1344 ! *** CALCULATE DELIQUESCENCE RELATIVE HUMIDITIES (UNICOMPONENT) ********
1345 !
1346       DRH2SO4  = ZERO
1347       DRNH42S4 = 0.7997D0
1348       DRNH4HS4 = 0.4000D0
1349       DRLC     = 0.6900D0
1350       DRNACL   = 0.7528D0
1351       DRNANO3  = 0.7379D0
1352       DRNH4CL  = 0.7710D0
1353       DRNH4NO3 = 0.6183D0
1354       DRNA2SO4 = 0.9300D0
1355       DRNAHSO4 = 0.5200D0
1356       IF (INT(TEMP) .NE. 298) THEN
1357          T0       = 298.15D0
1358          TCF      = 1.0/TEMP - 1.0/T0
1359          DRNACL   = DRNACL  *EXP( 25.*TCF)
1360          DRNANO3  = DRNANO3 *EXP(304.*TCF)
1361          DRNA2SO4 = DRNA2SO4*EXP( 80.*TCF)
1362          DRNH4NO3 = DRNH4NO3*EXP(852.*TCF)
1363          DRNH42S4 = DRNH42S4*EXP( 80.*TCF)
1364          DRNH4HS4 = DRNH4HS4*EXP(384.*TCF)
1365          DRLC     = DRLC    *EXP(186.*TCF)
1366          DRNH4CL  = DRNH4Cl *EXP(239.*TCF)
1367          DRNAHSO4 = DRNAHSO4*EXP(-45.*TCF)
1368 !
1369 ! *** ADJUST FOR DRH "CROSSOVER" AT LOW TEMPERATURES
1370 !
1371          DRNH4NO3  = MIN (DRNH4NO3, DRNH4CL, DRNH42S4, DRNANO3, DRNACL)
1372          DRNANO3   = MIN (DRNANO3, DRNACL)
1373          DRNH4CL   = MIN (DRNH4Cl, DRNH42S4)
1374
1375       ENDIF
1376 !
1377 ! *** CALCULATE MUTUAL DELIQUESCENCE RELATIVE HUMIDITIES ****************
1378 !
1379       DRMLCAB = 0.378D0    ! (NH4)3H(SO4)2 & NH4HSO4
1380       DRMLCAS = 0.690D0    ! (NH4)3H(SO4)2 & (NH4)2SO4
1381       DRMASAN = 0.600D0    ! (NH4)2SO4     & NH4NO3
1382       DRMG1   = 0.460D0    ! (NH4)2SO4, NH4NO3, NA2SO4, NH4CL
1383       DRMG2   = 0.691D0    ! (NH4)2SO4, NA2SO4, NH4CL
1384       DRMG3   = 0.697D0    ! (NH4)2SO4, NA2SO4
1385       DRMH1   = 0.240D0    ! NA2SO4, NANO3, NACL, NH4NO3, NH4CL
1386       DRMH2   = 0.596D0    ! NA2SO4, NANO3, NACL, NH4CL
1387       DRMI1   = 0.240D0    ! LC, NAHSO4, NH4HSO4, NA2SO4, (NH4)2SO4
1388       DRMI2   = 0.363D0    ! LC, NAHSO4, NA2SO4, (NH4)2SO4  - NO DATA -
1389       DRMI3   = 0.610D0    ! LC, NA2SO4, (NH4)2SO4
1390       DRMQ1   = 0.494D0    ! (NH4)2SO4, NH4NO3, NA2SO4
1391       DRMR1   = 0.663D0    ! NA2SO4, NANO3, NACL
1392       DRMR2   = 0.735D0    ! NA2SO4, NACL
1393       DRMR3   = 0.673D0    ! NANO3, NACL
1394       DRMR4   = 0.694D0    ! NA2SO4, NACL, NH4CL
1395       DRMR5   = 0.731D0    ! NA2SO4, NH4CL
1396       DRMR6   = 0.596D0    ! NA2SO4, NANO3, NH4CL
1397       DRMR7   = 0.380D0    ! NA2SO4, NANO3, NACL, NH4NO3
1398       DRMR8   = 0.380D0    ! NA2SO4, NACL, NH4NO3
1399       DRMR9   = 0.494D0    ! NA2SO4, NH4NO3
1400       DRMR10  = 0.476D0    ! NA2SO4, NANO3, NH4NO3
1401       DRMR11  = 0.340D0    ! NA2SO4, NACL, NH4NO3, NH4CL
1402       DRMR12  = 0.460D0    ! NA2SO4, NH4NO3, NH4CL
1403       DRMR13  = 0.438D0    ! NA2SO4, NANO3, NH4NO3, NH4CL
1404 !CC      IF (INT(TEMP) .NE. 298) THEN
1405 !CC         T0       = 298.15d0
1406 !CC         TCF      = 1.0/TEMP - 1.0/T0
1407 !CC         DRMLCAB  = DRMLCAB*EXP( 507.506*TCF)
1408 !CC         DRMLCAS  = DRMLCAS*EXP( 133.865*TCF)
1409 !CC         DRMASAN  = DRMASAN*EXP(1269.068*TCF)
1410 !CC         DRMG1    = DRMG1  *EXP( 572.207*TCF)
1411 !CC         DRMG2    = DRMG2  *EXP(  58.166*TCF)
1412 !CC         DRMG3    = DRMG3  *EXP(  22.253*TCF)
1413 !CC         DRMH1    = DRMH1  *EXP(2116.542*TCF)
1414 !CC         DRMH2    = DRMH2  *EXP( 650.549*TCF)
1415 !CC         DRMI1    = DRMI1  *EXP( 565.743*TCF)
1416 !CC         DRMI2    = DRMI2  *EXP(  91.745*TCF)
1417 !CC         DRMI3    = DRMI3  *EXP( 161.272*TCF)
1418 !CC         DRMQ1    = DRMQ1  *EXP(1616.621*TCF)
1419 !CC         DRMR1    = DRMR1  *EXP( 292.564*TCF)
1420 !CC         DRMR2    = DRMR2  *EXP(  14.587*TCF)
1421 !CC         DRMR3    = DRMR3  *EXP( 307.907*TCF)
1422 !CC         DRMR4    = DRMR4  *EXP(  97.605*TCF)
1423 !CC         DRMR5    = DRMR5  *EXP(  98.523*TCF)
1424 !CC         DRMR6    = DRMR6  *EXP( 465.500*TCF)
1425 !CC         DRMR7    = DRMR7  *EXP( 324.425*TCF)
1426 !CC         DRMR8    = DRMR8  *EXP(2660.184*TCF)
1427 !CC         DRMR9    = DRMR9  *EXP(1617.178*TCF)
1428 !CC         DRMR10   = DRMR10 *EXP(1745.226*TCF)
1429 !CC         DRMR11   = DRMR11 *EXP(3691.328*TCF)
1430 !CC         DRMR12   = DRMR12 *EXP(1836.842*TCF)
1431 !CC         DRMR13   = DRMR13 *EXP(1967.938*TCF)
1432 !CC      ENDIF
1433 !
1434 ! *** LIQUID PHASE ******************************************************
1435 !
1436       CHNO3  = ZERO
1437       CHCL   = ZERO
1438       CH2SO4 = ZERO
1439       COH    = ZERO
1440       WATER  = TINY
1441 !
1442       DO 20 I=1,NPAIR
1443          MOLALR(I)=ZERO
1444          GAMA(I)  =0.1
1445          GAMIN(I) =GREAT
1446          GAMOU(I) =GREAT
1447          M0(I)    =1d5
1448  20   CONTINUE
1449 !
1450       DO 30 I=1,NPAIR
1451          GAMA(I) = 0.1d0
1452  30   CONTINUE
1453 !
1454       DO 40 I=1,NIONS
1455          MOLAL(I)=ZERO
1456 40    CONTINUE
1457       COH = ZERO
1458 !
1459       DO 50 I=1,NGASAQ
1460          GASAQ(I)=ZERO
1461 50    CONTINUE
1462 !
1463 ! *** SOLID PHASE *******************************************************
1464 !
1465       CNH42S4= ZERO
1466       CNH4HS4= ZERO
1467       CNACL  = ZERO
1468       CNA2SO4= ZERO
1469       CNANO3 = ZERO
1470       CNH4NO3= ZERO
1471       CNH4CL = ZERO
1472       CNAHSO4= ZERO
1473       CLC    = ZERO
1474 !
1475 ! *** GAS PHASE *********************************************************
1476 !
1477       GNH3   = ZERO
1478       GHNO3  = ZERO
1479       GHCL   = ZERO
1480 !
1481 ! *** CALCULATE ZSR PARAMETERS ******************************************
1482 !
1483       IRH    = MIN (INT(RH*NZSR+0.5),NZSR)  ! Position in ZSR arrays
1484       IRH    = MAX (IRH, 1)
1485
1486       M0(01) = AWSC(IRH)      ! NACl
1487 !      IF (M0(01) .LT. 100.0) THEN
1488 !         IC = M0(01)
1489 !         CALL KMTAB(IC,298.0,     GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1490 !         CALL KMTAB(IC,SNGL(TEMP),GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1491 !         M0(01) = M0(01)*EXP(LN10*(GI0-GII))
1492 !      ENDIF
1493 !
1494       M0(02) = AWSS(IRH)      ! (NA)2SO4
1495 !      IF (M0(02) .LT. 100.0) THEN
1496 !         IC = 3.0*M0(02)
1497 !         CALL KMTAB(IC,298.0,     XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1498 !         CALL KMTAB(IC,SNGL(TEMP),XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1499 !         M0(02) = M0(02)*EXP(LN10*(GI0-GII))
1500 !      ENDIF
1501 !
1502       M0(03) = AWSN(IRH)      ! NANO3
1503 !      IF (M0(03) .LT. 100.0) THEN
1504 !         IC = M0(03)
1505 !         CALL KMTAB(IC,298.0,     XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1506 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX,XX)
1507 !         M0(03) = M0(03)*EXP(LN10*(GI0-GII))
1508 !      ENDIF
1509 !
1510       M0(04) = AWAS(IRH)      ! (NH4)2SO4
1511 !      IF (M0(04) .LT. 100.0) THEN
1512 !         IC = 3.0*M0(04)
1513 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX,XX)
1514 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX,XX)
1515 !         M0(04) = M0(04)*EXP(LN10*(GI0-GII))
1516 !      ENDIF
1517 !
1518       M0(05) = AWAN(IRH)      ! NH4NO3
1519 !      IF (M0(05) .LT. 100.0) THEN
1520 !        IC     = M0(05)
1521 !        CALL KMTAB(IC,298.0,     XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX,XX)
1522 !        CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX,XX)
1523 !         M0(05) = M0(05)*EXP(LN10*(GI0-GII))
1524 !      ENDIF
1525 !
1526       M0(06) = AWAC(IRH)      ! NH4CL
1527 !      IF (M0(06) .LT. 100.0) THEN
1528 !         IC = M0(06)
1529 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX,XX)
1530 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX,XX)
1531 !         M0(06) = M0(06)*EXP(LN10*(GI0-GII))
1532 !      ENDIF
1533 !
1534       M0(07) = AWSA(IRH)      ! 2H-SO4
1535 !      IF (M0(07) .LT. 100.0) THEN
1536 !         IC = 3.0*M0(07)
1537 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX,XX)
1538 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX,XX)
1539 !         M0(07) = M0(07)*EXP(LN10*(GI0-GII))
1540 !      ENDIF
1541 !
1542       M0(08) = AWSA(IRH)      ! H-HSO4
1543 !CC      IF (M0(08) .LT. 100.0) THEN     ! These are redundant, because M0(8) is not used
1544 !CC         IC = M0(08)
1545 !CC         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
1546 !CC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX,XX)
1547 !CCCCC         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX,XX)
1548 !CC         M0(08) = M0(08)*EXP(LN10*(GI0-GII))
1549 !CC      ENDIF
1550 !
1551       M0(09) = AWAB(IRH)      ! NH4HSO4
1552 !      IF (M0(09) .LT. 100.0) THEN
1553 !         IC = M0(09)
1554 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,GI0,XX,XX,XX)
1555 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,GII,XX,XX,XX)
1556 !         M0(09) = M0(09)*EXP(LN10*(GI0-GII))
1557 !      ENDIF
1558 !
1559       M0(12) = AWSB(IRH)      ! NAHSO4
1560 !      IF (M0(12) .LT. 100.0) THEN
1561 !         IC = M0(12)
1562 !         CALL KMTAB(IC,298.0,     XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GI0)
1563 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,XX,GII)
1564 !         M0(12) = M0(12)*EXP(LN10*(GI0-GII))
1565 !      ENDIF
1566 !
1567       M0(13) = AWLC(IRH)      ! (NH4)3H(SO4)2
1568 !      IF (M0(13) .LT. 100.0) THEN
1569 !         IC     = 4.0*M0(13)
1570 !         CALL KMTAB(IC,298.0,     XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
1571 !         G130   = 0.2*(3.0*GI0+2.0*GII)
1572 !         CALL KMTAB(IC,SNGL(TEMP),XX,XX,XX,GI0,XX,XX,XX,XX,GII,XX,XX,XX)
1573 !         G13I   = 0.2*(3.0*GI0+2.0*GII)
1574 !         M0(13) = M0(13)*EXP(LN10*SNGL(G130-G13I))
1575 !      ENDIF
1576 !
1577 ! *** OTHER INITIALIZATIONS *********************************************
1578 !
1579       ICLACT  = 0
1580       CALAOU  = .TRUE.
1581       CALAIN  = .TRUE.
1582       FRST    = .TRUE.
1583       SCASE   = 'xx'
1584       SULRATW = 2.D0
1585       NOFER   = 0
1586       STKOFL  =.FALSE.
1587       DO 60 I=1,NERRMX
1588          ERRSTK(I) =-999
1589          ERRMSG(I) = 'MESSAGE N/A'
1590    60 CONTINUE
1591
1592 !
1593 ! *** END OF SUBROUTINE ISOINIT3 *******************************************
1594 !
1595  END  SUBROUTINE ISOINIT3
1596
1597 !=======================================================================
1598 !
1599 ! *** ISORROPIA CODE
1600 ! *** SUBROUTINE ADJUST
1601 ! *** ADJUSTS FOR MASS BALANCE BETWEEN VOLATILE SPECIES AND SULFATE
1602 !     FIRST CALCULATE THE EXCESS OF EACH PRECURSOR, AND IF IT EXISTS, THEN
1603 !     ADJUST SEQUENTIALY AEROSOL PHASE SPECIES WHICH CONTAIN THE EXCESS
1604 !     PRECURSOR.
1605 !
1606 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1607 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1608 ! *** WRITTEN BY ATHANASIOS NENES
1609 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1610 !
1611 !=======================================================================
1612 !
1613       SUBROUTINE ADJUST (WI)
1614       implicit none
1615       REAL(KIND=8) WI(*)
1616       REAL(KIND=8) EXNH4, EXNO3, EXCl, EXS4
1617 !
1618 ! *** FOR AMMONIUM *****************************************************
1619 !
1620       IF (IPROB.EQ.0) THEN         ! Calculate excess (solution - input)
1621          EXNH4 = GNH3 + MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 &
1622                      + 2D0*CNH42S4       + 3D0*CLC            &
1623                -WI(3)
1624       ELSE
1625          EXNH4 = MOLAL(3) + CNH4CL + CNH4NO3 + CNH4HS4 + 2D0*CNH42S4 &
1626               + 3D0*CLC                                  &
1627               -WI(3)
1628
1629       ENDIF
1630       EXNH4 = MAX(EXNH4,ZERO)
1631       IF (EXNH4.LT.TINY) GOTO 20    ! No excess NH4, go to next precursor
1632 !
1633       IF (MOLAL(3).GT.EXNH4) THEN   ! Adjust aqueous phase NH4
1634          MOLAL(3) = MOLAL(3) - EXNH4
1635          GOTO 20
1636       ELSE
1637          EXNH4    = EXNH4 - MOLAL(3)
1638          MOLAL(3) = ZERO
1639       ENDIF
1640 !
1641       IF (CNH4CL.GT.EXNH4) THEN     ! Adjust NH4Cl(s)
1642          CNH4CL   = CNH4CL - EXNH4  ! more solid than excess
1643          GHCL     = GHCL   + EXNH4  ! evaporate Cl to gas phase
1644          GOTO 20
1645       ELSE                          ! less solid than excess
1646          GHCL     = GHCL   + CNH4CL ! evaporate into gas phase
1647          EXNH4    = EXNH4  - CNH4CL ! reduce excess
1648          CNH4CL   = ZERO            ! zero salt concentration
1649       ENDIF
1650
1651       IF (CNH4NO3.GT.EXNH4) THEN    ! Adjust NH4NO3(s)
1652          CNH4NO3  = CNH4NO3- EXNH4  ! more solid than excess
1653          GHNO3    = GHNO3  + EXNH4  ! evaporate NO3 to gas phase
1654          GOTO 20
1655       ELSE                          ! less solid than excess
1656          GHNO3    = GHNO3  + CNH4NO3! evaporate into gas phase
1657          EXNH4    = EXNH4  - CNH4NO3! reduce excess
1658          CNH4NO3  = ZERO            ! zero salt concentration
1659       ENDIF
1660
1661       IF (CLC.GT.3d0*EXNH4) THEN    ! Adjust (NH4)3H(SO4)2(s)
1662          CLC      = CLC - EXNH4/3d0 ! more solid than excess
1663          GOTO 20
1664       ELSE                          ! less solid than excess
1665          EXNH4    = EXNH4 - 3d0*CLC ! reduce excess
1666          CLC      = ZERO            ! zero salt concentration
1667       ENDIF
1668
1669       IF (CNH4HS4.GT.EXNH4) THEN    ! Adjust NH4HSO4(s)
1670          CNH4HS4  = CNH4HS4- EXNH4  ! more solid than excess
1671          GOTO 20
1672       ELSE                          ! less solid than excess
1673          EXNH4    = EXNH4  - CNH4HS4! reduce excess
1674          CNH4HS4  = ZERO            ! zero salt concentration
1675       ENDIF
1676
1677       IF (CNH42S4.GT.EXNH4) THEN    ! Adjust (NH4)2SO4(s)
1678          CNH42S4  = CNH42S4- EXNH4  ! more solid than excess
1679          GOTO 20
1680       ELSE                          ! less solid than excess
1681          EXNH4    = EXNH4  - CNH42S4! reduce excess
1682          CNH42S4  = ZERO            ! zero salt concentration
1683       ENDIF
1684 !
1685 ! *** FOR NITRATE ******************************************************
1686 !
1687  20   IF (IPROB.EQ.0) THEN         ! Calculate excess (solution - input)
1688          EXNO3 = GHNO3 + MOLAL(7) + CNH4NO3 - WI(4)
1689       ELSE
1690          EXNO3 = MOLAL(7) + CNH4NO3 - WI(4)
1691       ENDIF
1692       EXNO3 = MAX(EXNO3,ZERO)
1693       IF (EXNO3.LT.TINY) GOTO 30    ! No excess NO3, go to next precursor
1694
1695       IF (MOLAL(7).GT.EXNO3) THEN   ! Adjust aqueous phase NO3
1696          MOLAL(7) = MOLAL(7) - EXNO3
1697          GOTO 30
1698       ELSE
1699          EXNO3    = EXNO3 - MOLAL(7)
1700          MOLAL(7) = ZERO
1701       ENDIF
1702
1703       IF (CNH4NO3.GT.EXNO3) THEN    ! Adjust NH4NO3(s)
1704          CNH4NO3  = CNH4NO3- EXNO3  ! more solid than excess
1705          GNH3     = GNH3   + EXNO3  ! evaporate NO3 to gas phase
1706          GOTO 30
1707       ELSE                          ! less solid than excess
1708          GNH3     = GNH3   + CNH4NO3! evaporate into gas phase
1709          EXNO3    = EXNO3  - CNH4NO3! reduce excess
1710          CNH4NO3  = ZERO            ! zero salt concentration
1711       ENDIF
1712 !
1713 ! *** FOR CHLORIDE *****************************************************
1714 !
1715  30   IF (IPROB.EQ.0) THEN         ! Calculate excess (solution - input)
1716          EXCl = GHCL + MOLAL(4) + CNH4CL  -WI(5)
1717       ELSE
1718          EXCl = MOLAL(4) + CNH4CL -WI(5)
1719       ENDIF
1720       EXCl = MAX(EXCl,ZERO)
1721       IF (EXCl.LT.TINY) GOTO 40    ! No excess Cl, go to next precursor
1722 !
1723       IF (MOLAL(4).GT.EXCL) THEN   ! Adjust aqueous phase Cl
1724          MOLAL(4) = MOLAL(4) - EXCL
1725          GOTO 40
1726       ELSE
1727          EXCL     = EXCL - MOLAL(4)
1728          MOLAL(4) = ZERO
1729       ENDIF
1730
1731       IF (CNH4CL.GT.EXCL) THEN      ! Adjust NH4Cl(s)
1732          CNH4CL   = CNH4CL - EXCL   ! more solid than excess
1733          GHCL     = GHCL   + EXCL   ! evaporate Cl to gas phase
1734          GOTO 40
1735       ELSE                          ! less solid than excess
1736          GHCL     = GHCL   + CNH4CL ! evaporate into gas phase
1737          EXCL     = EXCL   - CNH4CL ! reduce excess
1738          CNH4CL   = ZERO            ! zero salt concentration
1739       ENDIF
1740 !
1741 ! *** FOR SULFATE ******************************************************
1742 !
1743  40   EXS4 = MOLAL(5) + MOLAL(6) + 2.d0*CLC + CNH42S4 + CNH4HS4 +&
1744             CNA2SO4  + CNAHSO4 - WI(2)
1745       EXS4 = MAX(EXS4,ZERO)        ! Calculate excess (solution - input)
1746       IF (EXS4.LT.TINY) GOTO 50    ! No excess SO4, return
1747
1748       IF (MOLAL(6).GT.EXS4) THEN   ! Adjust aqueous phase HSO4
1749          MOLAL(6) = MOLAL(6) - EXS4
1750          GOTO 50
1751       ELSE
1752          EXS4     = EXS4 - MOLAL(6)
1753          MOLAL(6) = ZERO
1754       ENDIF
1755
1756       IF (MOLAL(5).GT.EXS4) THEN   ! Adjust aqueous phase SO4
1757          MOLAL(5) = MOLAL(5) - EXS4
1758          GOTO 50
1759       ELSE
1760          EXS4     = EXS4 - MOLAL(5)
1761          MOLAL(5) = ZERO
1762       ENDIF
1763
1764       IF (CLC.GT.2d0*EXS4) THEN     ! Adjust (NH4)3H(SO4)2(s)
1765          CLC      = CLC - EXS4/2d0  ! more solid than excess
1766          GNH3     = GNH3 +1.5d0*EXS4! evaporate NH3 to gas phase
1767          GOTO 50
1768       ELSE                          ! less solid than excess
1769          GNH3     = GNH3 + 1.5d0*CLC! evaporate NH3 to gas phase
1770          EXS4     = EXS4 - 2d0*CLC  ! reduce excess
1771          CLC      = ZERO            ! zero salt concentration
1772       ENDIF
1773
1774       IF (CNH4HS4.GT.EXS4) THEN     ! Adjust NH4HSO4(s)
1775          CNH4HS4  = CNH4HS4 - EXS4  ! more solid than excess
1776          GNH3     = GNH3 + EXS4     ! evaporate NH3 to gas phase
1777          GOTO 50
1778       ELSE                          ! less solid than excess
1779          GNH3     = GNH3 + CNH4HS4  ! evaporate NH3 to gas phase
1780          EXS4     = EXS4  - CNH4HS4 ! reduce excess
1781          CNH4HS4  = ZERO            ! zero salt concentration
1782       ENDIF
1783
1784       IF (CNH42S4.GT.EXS4) THEN     ! Adjust (NH4)2SO4(s)
1785          CNH42S4  = CNH42S4- EXS4   ! more solid than excess
1786          GNH3     = GNH3 + 2.d0*EXS4! evaporate NH3 to gas phase
1787          GOTO 50
1788       ELSE                          ! less solid than excess
1789          GNH3     = GNH3+2.d0*CNH42S4 ! evaporate NH3 to gas phase
1790          EXS4     = EXS4  - CNH42S4 ! reduce excess
1791          CNH42S4  = ZERO            ! zero salt concentration
1792       ENDIF
1793 !
1794 ! *** RETURN **********************************************************
1795 !
1796  50   RETURN
1797     END SUBROUTINE ADJUST
1798
1799
1800 !=======================================================================
1801 !
1802 ! *** ISORROPIA CODE
1803 ! *** SUBROUTINE CALCHA
1804 ! *** CALCULATES CHLORIDES SPECIATION
1805 !
1806 !     HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES,
1807 !     AND DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE
1808 !     HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE
1809 !     HCL(G) <-> (H+) + (CL-)
1810 !     EQUILIBRIUM, USING THE (H+) FROM THE SULFATES.
1811 !
1812 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1813 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1814 ! *** WRITTEN BY ATHANASIOS NENES
1815 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1816 !
1817 !=======================================================================
1818 !
1819       SUBROUTINE CALCHA
1820       implicit none
1821       REAL(KIND=8) KAPA, X, DELT, DIAK, ALFA, GHCL
1822 !C      CHARACTER ERRINF*40
1823 !
1824 ! *** CALCULATE HCL DISSOLUTION *****************************************
1825 !
1826       X    = W(5)
1827       DELT = 0.0d0
1828       IF (WATER.GT.TINY) THEN
1829          KAPA = MOLAL(1)
1830          ALFA = XK3*R*TEMP*(WATER/GAMA(11))**2.0
1831          DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X)
1832          DELT = 0.5*(-(KAPA+ALFA) + DIAK)
1833 !C         IF (DELT/KAPA.GT.0.1d0) THEN
1834 !C            WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0
1835 !C            CALL PUSHERR (0033, ERRINF)
1836 !C         ENDIF
1837       ENDIF
1838 !
1839 ! *** CALCULATE HCL SPECIATION IN THE GAS PHASE *************************
1840 !
1841       GHCL     = MAX(X-DELT, 0.0d0)  ! GAS HCL
1842 !
1843 ! *** CALCULATE HCL SPECIATION IN THE LIQUID PHASE **********************
1844 !
1845       MOLAL(4) = DELT                ! CL-
1846       MOLAL(1) = MOLAL(1) + DELT     ! H+
1847
1848       RETURN
1849 !
1850 ! *** END OF SUBROUTINE CALCHA ******************************************
1851 !
1852     END SUBROUTINE CALCHA
1853
1854
1855
1856
1857
1858 !=======================================================================
1859 !
1860 ! *** ISORROPIA CODE
1861 ! *** SUBROUTINE CALCHAP
1862 ! *** CALCULATES CHLORIDES SPECIATION
1863 !
1864 !     HYDROCHLORIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES,
1865 !     THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM.
1866 !     THE HYDROCHLORIC ACID DISSOLVED IS CALCULATED FROM THE
1867 !     HCL(G) -> HCL(AQ)   AND  HCL(AQ) ->  (H+) + (CL-)
1868 !     EQUILIBRIA, USING (H+) FROM THE SULFATES.
1869 !
1870 !     THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER
1871 !
1872 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1873 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1874 ! *** WRITTEN BY ATHANASIOS NENES
1875 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1876 !
1877 !=======================================================================
1878 !
1879       SUBROUTINE CALCHAP
1880       implicit none
1881       REAL(KIND=8) ALFA, DELT
1882 !
1883 ! *** IS THERE A LIQUID PHASE? ******************************************
1884 !
1885       IF (WATER.LE.TINY) RETURN
1886 !
1887 ! *** CALCULATE HCL SPECIATION IN THE GAS PHASE *************************
1888 !
1889       CALL CALCCLAQ (MOLAL(4), MOLAL(1), DELT)
1890       ALFA     = XK3*R*TEMP*(WATER/GAMA(11))**2.0
1891       GASAQ(3) = DELT
1892       MOLAL(1) = MOLAL(1) - DELT
1893       MOLAL(4) = MOLAL(4) - DELT
1894       GHCL     = MOLAL(1)*MOLAL(4)/ALFA
1895
1896       RETURN
1897 !
1898 ! *** END OF SUBROUTINE CALCHAP *****************************************
1899 !
1900     END SUBROUTINE CALCHAP
1901
1902
1903 !=======================================================================
1904 !
1905 ! *** ISORROPIA CODE
1906 ! *** SUBROUTINE CALCNA
1907 ! *** CALCULATES NITRATES SPECIATION
1908 !
1909 !     NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT
1910 !     DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC
1911 !     ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> (H+) + (NO3-)
1912 !     EQUILIBRIUM, USING THE (H+) FROM THE SULFATES.
1913 !
1914 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1915 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1916 ! *** WRITTEN BY ATHANASIOS NENES
1917 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1918 !
1919 !=======================================================================
1920 !
1921       SUBROUTINE CALCNA
1922       implicit none
1923       REAL(KIND=8) X, DELT, DIAK, GHNO3, ALFA
1924       REAL(KIND=8) KAPA
1925 !C      CHARACTER ERRINF*40
1926 !
1927 ! *** CALCULATE HNO3 DISSOLUTION ****************************************
1928 !
1929       X    = W(4)
1930       DELT = 0.0d0
1931       IF (WATER.GT.TINY) THEN
1932          KAPA = MOLAL(1)
1933          ALFA = XK4*R*TEMP*(WATER/GAMA(10))**2.0
1934          DIAK = SQRT( (KAPA+ALFA)**2.0 + 4.0*ALFA*X)
1935          DELT = 0.5*(-(KAPA+ALFA) + DIAK)
1936 !C         IF (DELT/KAPA.GT.0.1d0) THEN
1937 !C            WRITE (ERRINF,'(1PE10.3)') DELT/KAPA*100.0
1938 !C            CALL PUSHERR (0019, ERRINF)    ! WARNING ERROR: NO SOLUTION
1939 !C         ENDIF
1940       ENDIF
1941 !
1942 ! *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************
1943 !
1944       GHNO3    = MAX(X-DELT, 0.0d0)  ! GAS HNO3
1945 !
1946 ! *** CALCULATE HNO3 SPECIATION IN THE LIQUID PHASE *********************
1947 !
1948       MOLAL(7) = DELT                ! NO3-
1949       MOLAL(1) = MOLAL(1) + DELT     ! H+
1950
1951       RETURN
1952 !
1953 ! *** END OF SUBROUTINE CALCNA ******************************************
1954 !
1955     END SUBROUTINE CALCNA
1956
1957
1958
1959 !=======================================================================
1960 !
1961 ! *** ISORROPIA CODE
1962 ! *** SUBROUTINE CALCNAP
1963 ! *** CALCULATES NITRATES SPECIATION
1964 !
1965 !     NITRIC ACID IN THE LIQUID PHASE IS ASSUMED A MINOR SPECIES, THAT
1966 !     DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM. THE NITRIC
1967 !     ACID DISSOLVED IS CALCULATED FROM THE HNO3(G) -> HNO3(AQ) AND
1968 !     HNO3(AQ) -> (H+) + (CL-) EQUILIBRIA, USING (H+) FROM THE SULFATES.
1969 !
1970 !     THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOVER
1971 !
1972 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1973 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
1974 ! *** WRITTEN BY ATHANASIOS NENES
1975 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
1976 !
1977 !=======================================================================
1978 !
1979       SUBROUTINE CALCNAP
1980       implicit none
1981       REAL(KIND=8) ALFA, DELT
1982
1983 ! *** IS THERE A LIQUID PHASE? ******************************************
1984 !
1985       IF (WATER.LE.TINY) RETURN
1986 !
1987 ! *** CALCULATE HNO3 SPECIATION IN THE GAS PHASE ************************
1988 !
1989       CALL CALCNIAQ (MOLAL(7), MOLAL(1), DELT)
1990       ALFA     = XK4*R*TEMP*(WATER/GAMA(10))**2.0
1991       GASAQ(3) = DELT
1992       MOLAL(1) = MOLAL(1) - DELT
1993       MOLAL(7) = MOLAL(7) - DELT
1994       GHNO3    = MOLAL(1)*MOLAL(7)/ALFA
1995
1996       write (*,*) ALFA, MOLAL(1), MOLAL(7), GHNO3, DELT
1997
1998       RETURN
1999 !
2000 ! *** END OF SUBROUTINE CALCNAP *****************************************
2001 !
2002     END SUBROUTINE CALCNAP
2003
2004 !=======================================================================
2005 !
2006 ! *** ISORROPIA CODE
2007 ! *** SUBROUTINE CALCNH3
2008 ! *** CALCULATES AMMONIA IN GAS PHASE
2009 !
2010 !     AMMONIA IN THE GAS PHASE IS ASSUMED A MINOR SPECIES, THAT
2011 !     DOES NOT SIGNIFICANTLY PERTURB THE AEROSOL EQUILIBRIUM.
2012 !     AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l)
2013 !     EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION.
2014 !
2015 !     THIS IS THE VERSION USED BY THE DIRECT PROBLEM
2016 !
2017 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2018 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2019 ! *** WRITTEN BY ATHANASIOS NENES
2020 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2021 !
2022 !=======================================================================
2023 !
2024       SUBROUTINE CALCNH3
2025       implicit none
2026       REAL(KIND=8) BB, CC, DIAK, PSI
2027 !
2028 ! *** IS THERE A LIQUID PHASE? ******************************************
2029 !
2030       IF (WATER.LE.TINY) RETURN
2031 !
2032 ! *** CALCULATE NH3 SUBLIMATION *****************************************
2033 !
2034       A1   = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2035       CHI1 = MOLAL(3)
2036       CHI2 = MOLAL(1)
2037
2038       BB   =(CHI2 + ONE/A1)          ! a=1; b!=1; c!=1
2039       CC   =-CHI1/A1
2040       DIAK = SQRT(BB*BB - 4.D0*CC)   ! Always > 0
2041       PSI  = 0.5*(-BB + DIAK)        ! One positive root
2042       PSI  = MAX(TINY, MIN(PSI,CHI1))! Constrict in acceptible range
2043 !
2044 ! *** CALCULATE NH3 SPECIATION IN THE GAS PHASE *************************
2045 !
2046       GNH3     = PSI                 ! GAS HNO3
2047 !
2048 ! *** CALCULATE NH3 AFFECT IN THE LIQUID PHASE **************************
2049 !
2050       MOLAL(3) = CHI1 - PSI          ! NH4+
2051       MOLAL(1) = CHI2 + PSI          ! H+
2052
2053       RETURN
2054 !
2055 ! *** END OF SUBROUTINE CALCNH3 *****************************************
2056 !
2057     END SUBROUTINE CALCNH3
2058
2059
2060
2061 !=======================================================================
2062 !
2063 ! *** ISORROPIA CODE
2064 ! *** SUBROUTINE CALCNH3P
2065 ! *** CALCULATES AMMONIA IN GAS PHASE
2066 !
2067 !     AMMONIA GAS IS CALCULATED FROM THE NH3(g) + (H+)(l) <==> (NH4+)(l)
2068 !     EQUILIBRIUM, USING (H+), (NH4+) FROM THE AEROSOL SOLUTION.
2069 !
2070 !     THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER
2071 !
2072 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2073 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2074 ! *** WRITTEN BY ATHANASIOS NENES
2075 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2076 !
2077 !=======================================================================
2078 !
2079       SUBROUTINE CALCNH3P
2080       implicit none
2081 !
2082 ! *** IS THERE A LIQUID PHASE? ******************************************
2083 !
2084       IF (WATER.LE.TINY) RETURN
2085
2086 ! *** CALCULATE NH3 GAS PHASE CONCENTRATION *****************************
2087 !
2088       A1   = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2089       GNH3 = MOLAL(3)/MOLAL(1)/A1
2090
2091       RETURN
2092 !
2093 ! *** END OF SUBROUTINE CALCNH3P ****************************************
2094 !
2095     END SUBROUTINE CALCNH3P
2096
2097
2098 !=======================================================================
2099 !
2100 ! *** ISORROPIA CODE
2101 ! *** SUBROUTINE CALCNHA
2102 !
2103 !     THIS SUBROUTINE CALCULATES THE DISSOLUTION OF HCL, HNO3 AT
2104 !     THE PRESENCE OF (H,SO4). HCL, HNO3 ARE CONSIDERED MINOR SPECIES,
2105 !     THAT DO NOT SIGNIFICANTLY AFFECT THE EQUILIBRIUM POINT.
2106 !
2107 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2108 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2109 ! *** WRITTEN BY ATHANASIOS NENES
2110 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2111 !
2112 !=======================================================================
2113 !
2114       SUBROUTINE CALCNHA
2115       implicit none
2116       REAL(KIND=8) M1, M2, M3
2117       REAL(KIND=8) DELCL, DELNO, OMEGA, C1, C2, C3
2118       INTEGER ISLV
2119       CHARACTER ERRINF*40
2120 !
2121 ! *** SPECIAL CASE; WATER=ZERO ******************************************
2122 !
2123       IF (WATER.LE.TINY) THEN
2124          GOTO 55
2125 !
2126 ! *** SPECIAL CASE; HCL=HNO3=ZERO ***************************************
2127 !
2128       ELSEIF (W(5).LE.TINY .AND. W(4).LE.TINY) THEN
2129          GOTO 60
2130 !
2131 ! *** SPECIAL CASE; HCL=ZERO ********************************************
2132 !
2133       ELSE IF (W(5).LE.TINY) THEN
2134          CALL CALCNA              ! CALL HNO3 DISSOLUTION ROUTINE
2135          GOTO 60
2136 !
2137 ! *** SPECIAL CASE; HNO3=ZERO *******************************************
2138 !
2139       ELSE IF (W(4).LE.TINY) THEN
2140          CALL CALCHA              ! CALL HCL DISSOLUTION ROUTINE
2141          GOTO 60
2142       ENDIF
2143 !
2144 ! *** CALCULATE EQUILIBRIUM CONSTANTS ***********************************
2145 !
2146       A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0   ! HNO3
2147       A4 = XK3*R*TEMP*(WATER/GAMA(11))**2.0   ! HCL
2148 !
2149 ! *** CALCULATE CUBIC EQUATION COEFFICIENTS *****************************
2150 !
2151       DELCL = ZERO
2152       DELNO = ZERO
2153
2154       OMEGA = MOLAL(1)       ! H+
2155       CHI3  = W(4)           ! HNO3
2156       CHI4  = W(5)           ! HCL
2157
2158       C1    = A3*CHI3
2159       C2    = A4*CHI4
2160       C3    = A3 - A4
2161
2162       M1    = (C1 + C2 + (OMEGA+A4)*C3)/C3
2163       M2    = ((OMEGA+A4)*C2 - A4*C3*CHI4)/C3
2164       M3    =-A4*C2*CHI4/C3
2165 !
2166 ! *** CALCULATE ROOTS ***************************************************
2167 !
2168       CALL POLY3 (M1, M2, M3, DELCL, ISLV) ! HCL DISSOLUTION
2169       IF (ISLV.NE.0) THEN
2170          DELCL = TINY       ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT
2171          WRITE (ERRINF,'(1PE7.1)') TINY
2172          CALL PUSHERR (0022, ERRINF)    ! WARNING ERROR: NO SOLUTION
2173       ENDIF
2174       DELCL = MIN(DELCL, CHI4)
2175
2176       DELNO = C1*DELCL/(C2 + C3*DELCL)
2177       DELNO = MIN(DELNO, CHI3)
2178
2179       IF (DELCL.LT.ZERO .OR. DELNO.LT.ZERO .OR.&
2180          DELCL.GT.CHI4 .OR. DELNO.GT.CHI3       ) THEN
2181          DELCL = TINY  ! TINY AMOUNTS OF HCL ASSUMED WHEN NO ROOT
2182          DELNO = TINY
2183          WRITE (ERRINF,'(1PE7.1)') TINY
2184          CALL PUSHERR (0022, ERRINF)    ! WARNING ERROR: NO SOLUTION
2185       ENDIF
2186 !CC
2187 !CC *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT TO HSO4 ***************
2188 !CC
2189 !C      IF ((DELCL+DELNO)/MOLAL(1).GT.0.1d0) THEN
2190 !C         WRITE (ERRINF,'(1PE10.3)') (DELCL+DELNO)/MOLAL(1)*100.0
2191 !C         CALL PUSHERR (0021, ERRINF)
2192 !C      ENDIF
2193 !
2194 ! *** EFFECT ON LIQUID PHASE ********************************************
2195 !
2196 50    MOLAL(1) = MOLAL(1) + (DELNO+DELCL)  ! H+   CHANGE
2197       MOLAL(4) = MOLAL(4) + DELCL          ! CL-  CHANGE
2198       MOLAL(7) = MOLAL(7) + DELNO          ! NO3- CHANGE
2199 !
2200 ! *** EFFECT ON GAS PHASE ***********************************************
2201 !
2202 55    GHCL     = MAX(W(5) - MOLAL(4), TINY)
2203       GHNO3    = MAX(W(4) - MOLAL(7), TINY)
2204
2205 60    RETURN
2206 !
2207 ! *** END OF SUBROUTINE CALCNHA *****************************************
2208 !
2209     END SUBROUTINE CALCNHA
2210
2211
2212
2213 !=======================================================================
2214 !
2215 ! *** ISORROPIA CODE
2216 ! *** SUBROUTINE CALCNHP
2217 !
2218 !     THIS SUBROUTINE CALCULATES THE GAS PHASE NITRIC AND HYDROCHLORIC
2219 !     ACID. CONCENTRATIONS ARE CALCULATED FROM THE DISSOLUTION
2220 !     EQUILIBRIA, USING (H+), (Cl-), (NO3-) IN THE AEROSOL PHASE.
2221 !
2222 !     THIS IS THE VERSION USED BY THE INVERSE PROBLEM SOLVER
2223 !
2224 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2225 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2226 ! *** WRITTEN BY ATHANASIOS NENES
2227 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2228 !
2229 !=======================================================================
2230 !
2231       SUBROUTINE CALCNHP
2232       implicit none
2233       REAL(KIND=8) DELT
2234 !
2235 ! *** IS THERE A LIQUID PHASE? ******************************************
2236 !
2237       IF (WATER.LE.TINY) RETURN
2238 !
2239 ! *** CALCULATE EQUILIBRIUM CONSTANTS ***********************************
2240 !
2241       A3       = XK3*R*TEMP*(WATER/GAMA(11))**2.0
2242       A4       = XK4*R*TEMP*(WATER/GAMA(10))**2.0
2243       MOLAL(1) = MOLAL(1) + WAER(4) + WAER(5)  ! H+ increases because NO3, Cl are added.
2244 !
2245 ! *** CALCULATE CONCENTRATIONS ******************************************
2246 ! *** ASSUME THAT 'DELT' FROM HNO3 >> 'DELT' FROM HCL
2247 !
2248       CALL CALCNIAQ (WAER(4), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT)
2249       MOLAL(1) = MOLAL(1) - DELT
2250       MOLAL(7) = WAER(4)  - DELT  ! NO3- = Waer(4) minus any turned into (HNO3aq)
2251       GASAQ(3) = DELT
2252
2253       CALL CALCCLAQ (WAER(5), MOLAL(1)+MOLAL(7)+MOLAL(4), DELT)
2254       MOLAL(1) = MOLAL(1) - DELT
2255       MOLAL(4) = WAER(5)  - DELT  ! Cl- = Waer(4) minus any turned into (HNO3aq)
2256       GASAQ(2) = DELT
2257
2258       GHNO3    = MOLAL(1)*MOLAL(7)/A4
2259       GHCL     = MOLAL(1)*MOLAL(4)/A3
2260
2261       RETURN
2262 !
2263 ! *** END OF SUBROUTINE CALCNHP *****************************************
2264 !
2265     END SUBROUTINE CALCNHP
2266
2267 !=======================================================================
2268 !
2269 ! *** ISORROPIA CODE
2270 ! *** SUBROUTINE CALCAMAQ
2271 ! *** THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+).
2272 !
2273 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2274 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2275 ! *** WRITTEN BY ATHANASIOS NENES
2276 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2277 !
2278 !=======================================================================
2279 !
2280       SUBROUTINE CALCAMAQ (NH4I, OHI, DELT)
2281       implicit none
2282       REAL(KIND=8) NH4I, OHI, DELT, DEL1, DEL2
2283       REAL(KIND=8) A22, AKW, OM1, OM2, BB, CC, DD
2284
2285 !C      CHARACTER ERRINF*40
2286 !
2287 ! *** EQUILIBRIUM CONSTANTS
2288 !
2289       A22  = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1
2290       AKW  = XKW *RH*WATER*WATER
2291 !
2292 ! *** FIND ROOT
2293 !
2294       OM1  = NH4I
2295       OM2  = OHI
2296       BB   =-(OM1+OM2+A22*AKW)
2297       CC   = OM1*OM2
2298       DD   = SQRT(BB*BB-4.D0*CC)
2299       DEL1 = 0.5D0*(-BB - DD)
2300       DEL2 = 0.5D0*(-BB + DD)
2301 !
2302 ! *** GET APPROPRIATE ROOT.
2303 !
2304       IF (DEL1.LT.ZERO) THEN
2305          IF (DEL2.GT.NH4I .OR. DEL2.GT.OHI) THEN
2306             DELT = ZERO
2307          ELSE
2308             DELT = DEL2
2309          ENDIF
2310       ELSE
2311          DELT = DEL1
2312       ENDIF
2313 !C
2314 !C *** COMPARE DELTA TO TOTAL NH4+ ; ESTIMATE EFFECT *********************
2315 !C
2316 !C      IF (DELTA/HYD.GT.0.1d0) THEN
2317 !C         WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0
2318 !C         CALL PUSHERR (0020, ERRINF)
2319 !C      ENDIF
2320 !
2321       RETURN
2322 !
2323 ! *** END OF SUBROUTINE CALCAMAQ ****************************************
2324 !
2325     END SUBROUTINE CALCAMAQ
2326
2327
2328
2329 !=======================================================================
2330 !
2331 ! *** ISORROPIA CODE
2332 ! *** SUBROUTINE CALCAMAQ2
2333 !
2334 !     THIS SUBROUTINE CALCULATES THE NH3(aq) GENERATED FROM (H,NH4+).
2335 !
2336 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2337 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2338 ! *** WRITTEN BY ATHANASIOS NENES
2339 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2340 !
2341 !=======================================================================
2342 !
2343       SUBROUTINE CALCAMAQ2 (GGNH3, NH4I, OHI, NH3AQ)
2344       implicit none
2345       REAL(KIND=8) GGNH3, NH4I, OHI, NH3AQ
2346       REAL(KIND=8) A22, AKW, ALF1, ALF2
2347       REAL(KIND=8) BB, CC, DEL
2348 !
2349 ! *** EQUILIBRIUM CONSTANTS
2350 !
2351       A22  = XK22/XKW/WATER*(GAMA(8)/GAMA(9))**2. ! GAMA(NH3) ASSUMED 1
2352       AKW  = XKW *RH*WATER*WATER
2353 !
2354 ! *** FIND ROOT
2355 !
2356       ALF1 = NH4I - GGNH3
2357       ALF2 = GGNH3
2358       BB   = ALF1 + A22*AKW
2359       CC   =-A22*AKW*ALF2
2360       DEL  = 0.5D0*(-BB + SQRT(BB*BB-4.D0*CC))
2361 !
2362 ! *** ADJUST CONCENTRATIONS
2363 !
2364       NH4I  = ALF1 + DEL
2365       OHI   = DEL
2366       IF (OHI.LE.TINY) OHI = SQRT(AKW)   ! If solution is neutral.
2367       NH3AQ = ALF2 - DEL
2368
2369       RETURN
2370 !
2371 ! *** END OF SUBROUTINE CALCAMAQ2 ****************************************
2372 !
2373     END SUBROUTINE CALCAMAQ2
2374
2375
2376
2377 !=======================================================================
2378 !
2379 ! *** ISORROPIA CODE
2380 ! *** SUBROUTINE CALCCLAQ
2381 !
2382 !     THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-).
2383 !
2384 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2385 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2386 ! *** WRITTEN BY ATHANASIOS NENES
2387 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2388 !
2389 !=======================================================================
2390 !
2391       SUBROUTINE CALCCLAQ (CLI, HI, DELT)
2392       implicit none
2393       REAL(KIND=8) CLI, HI, DELT
2394       REAL(KIND=8) A32, OM1, OM2, BB, CC, DD, DEL1, DEL2
2395 !
2396 ! *** EQUILIBRIUM CONSTANTS
2397 !
2398       A32  = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1
2399 !
2400 ! *** FIND ROOT
2401 !
2402       OM1  = CLI
2403       OM2  = HI
2404       BB   =-(OM1+OM2+A32)
2405       CC   = OM1*OM2
2406       DD   = SQRT(BB*BB-4.D0*CC)
2407
2408       DEL1 = 0.5D0*(-BB - DD)
2409       DEL2 = 0.5D0*(-BB + DD)
2410 !
2411 ! *** GET APPROPRIATE ROOT.
2412 !
2413       IF (DEL1.LT.ZERO) THEN
2414          IF (DEL2.LT.ZERO .OR. DEL2.GT.CLI .OR. DEL2.GT.HI) THEN
2415             DELT = ZERO
2416          ELSE
2417             DELT = DEL2
2418          ENDIF
2419       ELSE
2420          DELT = DEL1
2421       ENDIF
2422
2423       RETURN
2424 !
2425 ! *** END OF SUBROUTINE CALCCLAQ ****************************************
2426 !
2427     END SUBROUTINE CALCCLAQ
2428
2429
2430
2431 !=======================================================================
2432 !
2433 ! *** ISORROPIA CODE
2434 ! *** SUBROUTINE CALCCLAQ2
2435 !
2436 !     THIS SUBROUTINE CALCULATES THE HCL(aq) GENERATED FROM (H+,CL-).
2437 !
2438 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2439 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2440 ! *** WRITTEN BY ATHANASIOS NENES
2441 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2442 !
2443 !====================================================================
2444 !
2445       SUBROUTINE CALCCLAQ2 (GGCL, CLI, HI, CLAQ)
2446       implicit none
2447       REAL(KIND=8)  GGCL, CLI, HI, CLAQ
2448       REAL(KIND=8) A32,  AKW, ALF1, ALF2, COEF, DEL1
2449 !
2450 ! *** EQUILIBRIUM CONSTANTS
2451 !
2452       A32  = XK32*WATER/(GAMA(11))**2. ! GAMA(HCL) ASSUMED 1
2453       AKW  = XKW *RH*WATER*WATER
2454 !
2455 ! *** FIND ROOT
2456 !
2457       ALF1  = CLI - GGCL
2458       ALF2  = GGCL
2459       COEF  = (ALF1+A32)
2460       DEL1  = 0.5*(-COEF + SQRT(COEF*COEF+4.D0*A32*ALF2))
2461 !
2462 ! *** CORRECT CONCENTRATIONS
2463 !
2464       CLI  = ALF1 + DEL1
2465       HI   = DEL1
2466       IF (HI.LE.TINY) HI = SQRT(AKW)   ! If solution is neutral.
2467       CLAQ = ALF2 - DEL1
2468
2469       RETURN
2470 !
2471 ! *** END OF SUBROUTINE CALCCLAQ2 ****************************************
2472 !
2473     END SUBROUTINE CALCCLAQ2
2474
2475
2476
2477 !=======================================================================
2478 !
2479 ! *** ISORROPIA CODE
2480 ! *** SUBROUTINE CALCNIAQ
2481 !
2482 !     THIS SUBROUTINE CALCULATES THE HNO3(aq) GENERATED FROM (H,NO3-).
2483 !
2484 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2485 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2486 ! *** WRITTEN BY ATHANASIOS NENES
2487 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2488 !
2489 !=======================================================================
2490 !
2491       SUBROUTINE CALCNIAQ (NO3I, HI, DELT)
2492       implicit none
2493       REAL(KIND=8) NO3I, HI, DELT
2494       REAL(KIND=8) A42, OM1, OM2, BB, CC, DD, DEL1, DEL2
2495 !
2496 ! *** EQUILIBRIUM CONSTANTS
2497 !
2498       A42  = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1
2499 !
2500 ! *** FIND ROOT
2501 !
2502       OM1  = NO3I
2503       OM2  = HI
2504       BB   =-(OM1+OM2+A42)
2505       CC   = OM1*OM2
2506       DD   = SQRT(BB*BB-4.D0*CC)
2507
2508       DEL1 = 0.5D0*(-BB - DD)
2509       DEL2 = 0.5D0*(-BB + DD)
2510 !
2511 ! *** GET APPROPRIATE ROOT.
2512 !
2513       IF (DEL1.LT.ZERO .OR. DEL1.GT.HI .OR. DEL1.GT.NO3I) THEN
2514          DELT = ZERO
2515       ELSE
2516          DELT = DEL1
2517          RETURN
2518       ENDIF
2519
2520       IF (DEL2.LT.ZERO .OR. DEL2.GT.NO3I .OR. DEL2.GT.HI) THEN
2521          DELT = ZERO
2522       ELSE
2523          DELT = DEL2
2524       ENDIF
2525
2526       RETURN
2527 !
2528 ! *** END OF SUBROUTINE CALCNIAQ ****************************************
2529 !
2530     END SUBROUTINE CALCNIAQ
2531
2532
2533
2534 !=======================================================================
2535 !
2536 ! *** ISORROPIA CODE
2537 ! *** SUBROUTINE CALCNIAQ2
2538 !
2539 !     THIS SUBROUTINE CALCULATES THE UNDISSOCIATED HNO3(aq)
2540 !
2541 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2542 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2543 ! *** WRITTEN BY ATHANASIOS NENES
2544 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2545 !
2546 !=======================================================================
2547 !
2548       SUBROUTINE CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)
2549       implicit none
2550       REAL(KIND=8) GGNO3, NO3I, HI, NO3AQ
2551       REAL(KIND=8) A42, AKW,  ALF1, ALF2, ALF3
2552       REAL(KIND=8) BB, CC, DEL1
2553 !
2554 !
2555 ! *** EQUILIBRIUM CONSTANTS
2556 !
2557       A42  = XK42*WATER/(GAMA(10))**2. ! GAMA(HNO3) ASSUMED 1
2558       AKW  = XKW *RH*WATER*WATER
2559 !
2560 ! *** FIND ROOT
2561 !
2562       ALF1  = NO3I - GGNO3
2563       ALF2  = GGNO3
2564       ALF3  = HI
2565
2566       BB    = ALF3 + ALF1 + A42
2567       CC    = ALF3*ALF1 - A42*ALF2
2568       DEL1  = 0.5*(-BB + SQRT(BB*BB-4.D0*CC))
2569 !
2570 ! *** CORRECT CONCENTRATIONS
2571 !
2572       NO3I  = ALF1 + DEL1
2573       HI    = ALF3 + DEL1
2574       IF (HI.LE.TINY) HI = SQRT(AKW)   ! If solution is neutral.
2575       NO3AQ = ALF2 - DEL1
2576
2577       RETURN
2578 !
2579 ! *** END OF SUBROUTINE CALCNIAQ2 ****************************************
2580 !
2581     END SUBROUTINE CALCNIAQ2
2582
2583
2584 !=======================================================================
2585 !
2586 ! *** ISORROPIA CODE
2587 ! *** SUBROUTINE CALCMR
2588 ! *** THIS SUBROUTINE CALCULATES:
2589 !     1. ION PAIR CONCENTRATIONS (FROM [MOLAR] ARRAY)
2590 !     2. WATER CONTENT OF LIQUID AEROSOL PHASE (FROM ZSR CORRELATION)
2591 !
2592 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2593 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2594 ! *** WRITTEN BY ATHANASIOS NENES
2595 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2596 !
2597 !=======================================================================
2598 !
2599       SUBROUTINE CALCMR
2600       implicit none
2601       CHARACTER SC*1
2602       REAL(KIND=8) SO4I, HSO4I, AML5, TOTS4, FRNH4, FRNO3, FRCL
2603       INTEGER I
2604
2605 ! *** CALCULATE ION PAIR CONCENTRATIONS ACCORDING TO SPECIFIC CASE ****
2606 !
2607       SC =SCASE(1:1)                   ! SULRAT & SODRAT case
2608 !
2609 ! *** NH4-SO4 SYSTEM ; SULFATE POOR CASE
2610 !
2611       IF (SC.EQ.'A') THEN
2612          MOLALR(4) = MOLAL(5)+MOLAL(6) ! (NH4)2SO4 - CORRECT FOR SO4 TO HSO4
2613 !
2614 ! *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID
2615 !
2616       ELSE IF (SC.EQ.'B') THEN
2617          SO4I  = MOLAL(5)-MOLAL(1)     ! CORRECT FOR HSO4 DISSOCIATION
2618          HSO4I = MOLAL(6)+MOLAL(1)
2619          IF (SO4I.LT.HSO4I) THEN
2620             MOLALR(13) = SO4I                   ! [LC] = [SO4]
2621             MOLALR(9)  = MAX(HSO4I-SO4I, ZERO)  ! NH4HSO4
2622          ELSE
2623             MOLALR(13) = HSO4I                  ! [LC] = [HSO4]
2624             MOLALR(4)  = MAX(SO4I-HSO4I, ZERO)  ! (NH4)2SO4
2625          ENDIF
2626 !
2627 ! *** NH4-SO4 SYSTEM ; SULFATE RICH CASE ; FREE ACID
2628 !
2629       ELSE IF (SC.EQ.'C') THEN
2630          MOLALR(9) = MOLAL(3)                     ! NH4HSO4
2631          MOLALR(7) = MAX(W(2)-W(3), ZERO)         ! H2SO4
2632 !
2633 ! *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE
2634 !
2635       ELSE IF (SC.EQ.'D') THEN
2636          MOLALR(4) = MOLAL(5) + MOLAL(6)          ! (NH4)2SO4
2637          AML5      = MOLAL(3)-2.D0*MOLALR(4)      ! "free" NH4
2638          MOLALR(5) = MAX(MIN(AML5,MOLAL(7)), ZERO)! NH4NO3 = MIN("free", NO3)
2639 !
2640 ! *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; NO FREE ACID
2641 !
2642       ELSE IF (SC.EQ.'E') THEN
2643          SO4I  = MAX(MOLAL(5)-MOLAL(1),ZERO)      ! FROM HSO4 DISSOCIATION
2644          HSO4I = MOLAL(6)+MOLAL(1)
2645          IF (SO4I.LT.HSO4I) THEN
2646             MOLALR(13) = SO4I                     ! [LC] = [SO4]
2647             MOLALR(9)  = MAX(HSO4I-SO4I, ZERO)    ! NH4HSO4
2648          ELSE
2649             MOLALR(13) = HSO4I                    ! [LC] = [HSO4]
2650             MOLALR(4)  = MAX(SO4I-HSO4I, ZERO)    ! (NH4)2SO4
2651          ENDIF
2652 !
2653 ! *** NH4-SO4-NO3 SYSTEM ; SULFATE RICH CASE ; FREE ACID
2654 !
2655       ELSE IF (SC.EQ.'F') THEN
2656          MOLALR(9) = MOLAL(3)                              ! NH4HSO4
2657          MOLALR(7) = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3),ZERO)  ! H2SO4
2658 !
2659 ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM POOR CASE
2660 !
2661       ELSE IF (SC.EQ.'G') THEN
2662          MOLALR(2) = 0.5*MOLAL(2)                          ! NA2SO4
2663          TOTS4     = MOLAL(5)+MOLAL(6)                     ! Total SO4
2664          MOLALR(4) = MAX(TOTS4 - MOLALR(2), ZERO)          ! (NH4)2SO4
2665          FRNH4     = MAX(MOLAL(3) - 2.D0*MOLALR(4), ZERO)
2666          MOLALR(5) = MIN(MOLAL(7),FRNH4)                   ! NH4NO3
2667          FRNH4     = MAX(FRNH4 - MOLALR(5), ZERO)
2668          MOLALR(6) = MIN(MOLAL(4), FRNH4)                  ! NH4CL
2669 !
2670 ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE POOR ; SODIUM RICH CASE
2671 ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/
2672 !
2673       ELSE IF (SC.EQ.'H') THEN
2674          MOLALR(1) = PSI7                                  ! NACL
2675          MOLALR(2) = PSI1                                  ! NA2SO4
2676          MOLALR(3) = PSI8                                  ! NANO3
2677          MOLALR(4) = ZERO                                  ! (NH4)2SO4
2678          FRNO3     = MAX(MOLAL(7) - MOLALR(3), ZERO)       ! "FREE" NO3
2679          FRCL      = MAX(MOLAL(4) - MOLALR(1), ZERO)       ! "FREE" CL
2680          MOLALR(5) = MIN(MOLAL(3),FRNO3)                   ! NH4NO3
2681          FRNH4     = MAX(MOLAL(3) - MOLALR(5), ZERO)       ! "FREE" NH3
2682          MOLALR(6) = MIN(FRCL, FRNH4)                      ! NH4CL
2683 !
2684 ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; NO FREE ACID
2685 ! *** RETREIVE DISSOLVED SALTS DIRECTLY FROM COMMON BLOCK /SOLUT/
2686 !
2687       ELSE IF (SC.EQ.'I') THEN
2688          MOLALR(04) = PSI5                                 ! (NH4)2SO4
2689          MOLALR(02) = PSI4                                 ! NA2SO4
2690          MOLALR(09) = PSI1                                 ! NH4HSO4
2691          MOLALR(12) = PSI3                                 ! NAHSO4
2692          MOLALR(13) = PSI2                                 ! LC
2693 !
2694 ! *** NA-NH4-SO4-NO3-CL SYSTEM ; SULFATE RICH CASE ; FREE ACID
2695 !
2696       ELSE IF (SC.EQ.'J') THEN
2697          MOLALR(09) = MOLAL(3)                             ! NH4HSO4
2698          MOLALR(12) = MOLAL(2)                             ! NAHSO4
2699          MOLALR(07) = MOLAL(5)+MOLAL(6)-MOLAL(3)-MOLAL(2)  ! H2SO4
2700          MOLALR(07) = MAX(MOLALR(07),ZERO)
2701 !
2702 ! ======= REVERSE PROBLEMS ===========================================
2703 !
2704 ! *** NH4-SO4-NO3 SYSTEM ; SULFATE POOR CASE
2705 !
2706       ELSE IF (SC.EQ.'N') THEN
2707          MOLALR(4) = MOLAL(5) + MOLAL(6)          ! (NH4)2SO4
2708          AML5      = WAER(3)-2.D0*MOLALR(4)       ! "free" NH4
2709          MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO) ! NH4NO3 = MIN("free", NO3)
2710 !
2711 ! *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM POOR CASE
2712 !
2713       ELSE IF (SC.EQ.'Q') THEN
2714          MOLALR(2) = PSI1                                  ! NA2SO4
2715          MOLALR(4) = PSI6                                  ! (NH4)2SO4
2716          MOLALR(5) = PSI5                                  ! NH4NO3
2717          MOLALR(6) = PSI4                                  ! NH4CL
2718 !
2719 ! *** NH4-SO4-NO3-NA-CL SYSTEM ; SULFATE POOR, SODIUM RICH CASE
2720 !
2721       ELSE IF (SC.EQ.'R') THEN
2722          MOLALR(1) = PSI3                                  ! NACL
2723          MOLALR(2) = PSI1                                  ! NA2SO4
2724          MOLALR(3) = PSI2                                  ! NANO3
2725          MOLALR(4) = ZERO                                  ! (NH4)2SO4
2726          MOLALR(5) = PSI5                                  ! NH4NO3
2727          MOLALR(6) = PSI4                                  ! NH4CL
2728 !
2729 ! *** UNKNOWN CASE
2730 !
2731       ELSE
2732          CALL PUSHERR (1001, ' ') ! FATAL ERROR: CASE NOT SUPPORTED
2733       ENDIF
2734 !
2735 ! *** CALCULATE WATER CONTENT ; ZSR CORRELATION ***********************
2736 !
2737       WATER = ZERO
2738       DO 10 I=1,NPAIR
2739          WATER = WATER + MOLALR(I)/M0(I)
2740 10    CONTINUE
2741       WATER = MAX(WATER, TINY)
2742 !
2743       RETURN
2744 !
2745 ! *** END OF SUBROUTINE CALCMR ******************************************
2746 !
2747       END SUBROUTINE CALCMR
2748 !=======================================================================
2749 !
2750 ! *** ISORROPIA CODE
2751 ! *** SUBROUTINE CALCMDRH
2752 !
2753 !     THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
2754 !     DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
2755 !     SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE
2756 !     'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE).
2757 !
2758 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2759 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2760 ! *** WRITTEN BY ATHANASIOS NENES
2761 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2762 !
2763 !=======================================================================
2764 !
2765       SUBROUTINE CALCMDRH (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE)
2766       implicit none
2767       REAL(KIND=8) RHI, RHDRY, RHLIQ!, DRYCASE, LIQCASE
2768       REAL(KIND=8) WF, ONEMWF
2769       REAL(KIND=8) CNH42SO, CNH4HSO, CLCO, CNH4N3O, CNH4CLO, CNA2SO
2770       REAL(KIND=8) CNAHSO, CNANO, CNACLO, GNH3O, GHNO3O, GHCLO
2771       REAL(KIND=8) DAMSUL, DSOSUL, DAMBIS, DSOBIS, DLC, DAMNIT, DAMCHL
2772       REAL(KIND=8) DSONIT, DSOCHL, DAMG, DHAG, DNAG
2773       INTEGER I
2774       EXTERNAL DRYCASE, LIQCASE
2775 !
2776 ! *** FIND WEIGHT FACTOR **********************************************
2777 !
2778       IF (WFTYP.EQ.0) THEN
2779          WF = ONE
2780       ELSEIF (WFTYP.EQ.1) THEN
2781          WF = 0.5D0
2782       ELSE
2783          WF = (RHLIQ-RHI)/(RHLIQ-RHDRY)
2784       ENDIF
2785       ONEMWF  = ONE - WF
2786 !
2787 ! *** FIND FIRST SECTION ; DRY ONE ************************************
2788 !
2789       CALL DRYCASE
2790       IF (ABS(ONEMWF).LE.1D-5) GOTO 200  ! DRY AEROSOL
2791 !
2792       CNH42SO = CNH42S4                  ! FIRST (DRY) SOLUTION
2793       CNH4HSO = CNH4HS4
2794       CLCO    = CLC
2795       CNH4N3O = CNH4NO3
2796       CNH4CLO = CNH4CL
2797       CNA2SO  = CNA2SO4
2798       CNAHSO  = CNAHSO4
2799       CNANO   = CNANO3
2800       CNACLO  = CNACL
2801       GNH3O   = GNH3
2802       GHNO3O  = GHNO3
2803       GHCLO   = GHCL
2804 !
2805 ! *** FIND SECOND SECTION ; DRY & LIQUID ******************************
2806 !
2807       CNH42S4 = ZERO
2808       CNH4HS4 = ZERO
2809       CLC     = ZERO
2810       CNH4NO3 = ZERO
2811       CNH4CL  = ZERO
2812       CNA2SO4 = ZERO
2813       CNAHSO4 = ZERO
2814       CNANO3  = ZERO
2815       CNACL   = ZERO
2816       GNH3    = ZERO
2817       GHNO3   = ZERO
2818       GHCL    = ZERO
2819       CALL LIQCASE                   ! SECOND (LIQUID) SOLUTION
2820 !
2821 ! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL
2822 !
2823       IF (WATER.LE.TINY) THEN
2824          DO 100 I=1,NIONS
2825             MOLAL(I)= ZERO           ! Aqueous phase
2826   100    CONTINUE
2827          WATER   = ZERO
2828 !
2829          CNH42S4 = CNH42SO           ! Solid phase
2830          CNA2SO4 = CNA2SO
2831          CNAHSO4 = CNAHSO
2832          CNH4HS4 = CNH4HSO
2833          CLC     = CLCO
2834          CNH4NO3 = CNH4N3O
2835          CNANO3  = CNANO
2836          CNACL   = CNACLO
2837          CNH4CL  = CNH4CLO
2838 !
2839          GNH3    = GNH3O             ! Gas phase
2840          GHNO3   = GHNO3O
2841          GHCL    = GHCLO
2842 !
2843          GOTO 200
2844       ENDIF
2845 !
2846 ! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS.
2847 !
2848       DAMSUL  = CNH42SO - CNH42S4
2849       DSOSUL  = CNA2SO  - CNA2SO4
2850       DAMBIS  = CNH4HSO - CNH4HS4
2851       DSOBIS  = CNAHSO  - CNAHSO4
2852       DLC     = CLCO    - CLC
2853       DAMNIT  = CNH4N3O - CNH4NO3
2854       DAMCHL  = CNH4CLO - CNH4CL
2855       DSONIT  = CNANO   - CNANO3
2856       DSOCHL  = CNACLO  - CNACL
2857 !
2858 ! *** FIND GAS DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS.
2859 !
2860       DAMG    = GNH3O   - GNH3
2861       DHAG    = GHCLO   - GHCL
2862       DNAG    = GHNO3O  - GHNO3
2863 !
2864 ! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
2865 !
2866 !     LIQUID
2867 !
2868       MOLAL(1)= ONEMWF*MOLAL(1)                                 ! H+
2869       MOLAL(2)= ONEMWF*(2.D0*DSOSUL + DSOBIS + DSONIT + DSOCHL) ! NA+
2870       MOLAL(3)= ONEMWF*(2.D0*DAMSUL + DAMG   + DAMBIS + DAMCHL +&
2871                         3.D0*DLC    + DAMNIT )                  ! NH4+
2872       MOLAL(4)= ONEMWF*(     DAMCHL + DSOCHL + DHAG)            ! CL-
2873       MOLAL(5)= ONEMWF*(     DAMSUL + DSOSUL + DLC - MOLAL(6))  ! SO4-- !VB 17 Sept 2001
2874       MOLAL(6)= ONEMWF*(   MOLAL(6) + DSOBIS + DAMBIS + DLC)    ! HSO4-
2875       MOLAL(7)= ONEMWF*(     DAMNIT + DSONIT + DNAG)            ! NO3-
2876       WATER   = ONEMWF*WATER
2877 !
2878 !     SOLID
2879 !
2880       CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
2881       CNA2SO4 = WF*CNA2SO  + ONEMWF*CNA2SO4
2882       CNAHSO4 = WF*CNAHSO  + ONEMWF*CNAHSO4
2883       CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4
2884       CLC     = WF*CLCO    + ONEMWF*CLC
2885       CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3
2886       CNANO3  = WF*CNANO   + ONEMWF*CNANO3
2887       CNACL   = WF*CNACLO  + ONEMWF*CNACL
2888       CNH4CL  = WF*CNH4CLO + ONEMWF*CNH4CL
2889 !
2890 !     GAS
2891 !
2892       GNH3    = WF*GNH3O   + ONEMWF*GNH3
2893       GHNO3   = WF*GHNO3O  + ONEMWF*GHNO3
2894       GHCL    = WF*GHCLO   + ONEMWF*GHCL
2895 !
2896 ! *** RETURN POINT
2897 !
2898 200   RETURN
2899 !
2900 ! *** END OF SUBROUTINE CALCMDRH ****************************************
2901 !
2902    END SUBROUTINE CALCMDRH
2903
2904
2905
2906
2907
2908
2909 !=======================================================================
2910 !
2911 ! *** ISORROPIA CODE
2912 ! *** SUBROUTINE CALCMDRP
2913 !
2914 !     THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
2915 !     DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
2916 !     SOLUTIONS ; THE 'DRY' SOLUTION (SUBROUTINE DRYCASE) AND THE
2917 !     'SATURATED LIQUID' SOLUTION (SUBROUTINE LIQCASE).
2918 !
2919 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2920 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
2921 ! *** WRITTEN BY ATHANASIOS NENES
2922 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
2923 !
2924 !=======================================================================
2925 !
2926       SUBROUTINE CALCMDRP (RHI, RHDRY, RHLIQ, DRYCASE, LIQCASE)
2927       implicit none
2928       REAL(KIND=8) RHI, RHDRY, RHLIQ!, DRYCASE, LIQCASE
2929       REAL(KIND=8) WF, ONEMWF
2930       REAL(KIND=8) CNH42SO, CNH4HSO, CLCO, CNH4N3O, CNH4CLO, CNA2SO
2931       REAL(KIND=8) CNAHSO, CNANO, CNACLO
2932       REAL(KIND=8) DAMBIS, DSOBIS, DLC
2933       REAL(KIND=8) HIEQ, HIEN
2934       INTEGER I
2935
2936       EXTERNAL DRYCASE, LIQCASE
2937 !
2938 ! *** FIND WEIGHT FACTOR **********************************************
2939 !
2940       IF (WFTYP.EQ.0) THEN
2941          WF = ONE
2942       ELSEIF (WFTYP.EQ.1) THEN
2943          WF = 0.5D0
2944       ELSE
2945          WF = (RHLIQ-RHI)/(RHLIQ-RHDRY)
2946       ENDIF
2947       ONEMWF  = ONE - WF
2948 !
2949 ! *** FIND FIRST SECTION ; DRY ONE ************************************
2950 !
2951       CALL DRYCASE
2952       IF (ABS(ONEMWF).LE.1D-5) GOTO 200  ! DRY AEROSOL
2953 !
2954       CNH42SO = CNH42S4              ! FIRST (DRY) SOLUTION
2955       CNH4HSO = CNH4HS4
2956       CLCO    = CLC
2957       CNH4N3O = CNH4NO3
2958       CNH4CLO = CNH4CL
2959       CNA2SO  = CNA2SO4
2960       CNAHSO  = CNAHSO4
2961       CNANO   = CNANO3
2962       CNACLO  = CNACL
2963 !
2964 ! *** FIND SECOND SECTION ; DRY & LIQUID ******************************
2965 !
2966       CNH42S4 = ZERO
2967       CNH4HS4 = ZERO
2968       CLC     = ZERO
2969       CNH4NO3 = ZERO
2970       CNH4CL  = ZERO
2971       CNA2SO4 = ZERO
2972       CNAHSO4 = ZERO
2973       CNANO3  = ZERO
2974       CNACL   = ZERO
2975       GNH3    = ZERO
2976       GHNO3   = ZERO
2977       GHCL    = ZERO
2978       CALL LIQCASE                   ! SECOND (LIQUID) SOLUTION
2979 !
2980 ! *** ADJUST THINGS FOR THE CASE THAT THE LIQUID SUB PREDICTS DRY AEROSOL
2981 !
2982       IF (WATER.LE.TINY) THEN
2983          WATER = ZERO
2984          DO 100 I=1,NIONS
2985             MOLAL(I)= ZERO
2986  100     CONTINUE
2987          CALL DRYCASE
2988          GOTO 200
2989       ENDIF
2990 !
2991 ! *** FIND SALT DISSOLUTIONS BETWEEN DRY & LIQUID SOLUTIONS.
2992 !
2993       DAMBIS  = CNH4HSO - CNH4HS4
2994       DSOBIS  = CNAHSO  - CNAHSO4
2995       DLC     = CLCO    - CLC
2996 !
2997 ! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
2998 !
2999 ! *** SOLID
3000 !
3001       CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
3002       CNA2SO4 = WF*CNA2SO  + ONEMWF*CNA2SO4
3003       CNAHSO4 = WF*CNAHSO  + ONEMWF*CNAHSO4
3004       CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4
3005       CLC     = WF*CLCO    + ONEMWF*CLC
3006       CNH4NO3 = WF*CNH4N3O + ONEMWF*CNH4NO3
3007       CNANO3  = WF*CNANO   + ONEMWF*CNANO3
3008       CNACL   = WF*CNACLO  + ONEMWF*CNACL
3009       CNH4CL  = WF*CNH4CLO + ONEMWF*CNH4CL
3010 !
3011 ! *** LIQUID
3012 !
3013       WATER   = ONEMWF*WATER
3014 !
3015       MOLAL(2)= WAER(1) - 2.D0*CNA2SO4 - CNAHSO4 - CNANO3 -      &
3016                                CNACL                            ! NA+
3017       MOLAL(3)= WAER(3) - 2.D0*CNH42S4 - CNH4HS4 - CNH4CL -  &
3018                          3.D0*CLC     - CNH4NO3                ! NH4+
3019       MOLAL(4)= WAER(5) - CNACL - CNH4CL                        ! CL-
3020       MOLAL(7)= WAER(4) - CNANO3 - CNH4NO3                      ! NO3-
3021       MOLAL(6)= ONEMWF*(MOLAL(6) + DSOBIS + DAMBIS + DLC)       ! HSO4-
3022       MOLAL(5)= WAER(2) - MOLAL(6) - CLC - CNH42S4 - CNA2SO4    ! SO4--
3023 !
3024       A8      = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
3025       IF (MOLAL(5).LE.TINY) THEN
3026          HIEQ = SQRT(XKW *RH*WATER*WATER)  ! Neutral solution
3027       ELSE
3028          HIEQ = A8*MOLAL(6)/MOLAL(5)
3029       ENDIF
3030       HIEN    = MOLAL(4) + MOLAL(7) + MOLAL(6) + 2.D0*MOLAL(5) -&
3031                MOLAL(2) - MOLAL(3)
3032       MOLAL(1)= MAX (HIEQ, HIEN)                                ! H+
3033 !
3034 ! *** GAS (ACTIVITY COEFS FROM LIQUID SOLUTION)
3035 !
3036       A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
3037       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
3038       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
3039 !
3040       GNH3    = MOLAL(3)/MAX(MOLAL(1),TINY)/A2
3041       GHNO3   = MOLAL(1)*MOLAL(7)/A3
3042       GHCL    = MOLAL(1)*MOLAL(4)/A4
3043 !
3044 200   RETURN
3045 !
3046 ! *** END OF SUBROUTINE CALCMDRP ****************************************
3047 !
3048    END SUBROUTINE CALCMDRP
3049 !=======================================================================
3050 !
3051 ! *** ISORROPIA CODE
3052 ! *** SUBROUTINE CALCHS4
3053 ! *** THIS SUBROUTINE CALCULATES THE HSO4 GENERATED FROM (H,SO4).
3054 !
3055 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3056 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3057 ! *** WRITTEN BY ATHANASIOS NENES
3058 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3059 !
3060 !=======================================================================
3061 !
3062       SUBROUTINE CALCHS4 (HI, SO4I, HSO4I, DELTA)
3063       implicit none
3064       REAL(KIND=8) HI, SO4I, HSO4I, DELTA
3065       REAL(KIND=8) BB, CC, DD, SQDD, DELTA1, DELTA2
3066 !C      CHARACTER ERRINF*40
3067 !
3068 ! *** IF TOO LITTLE WATER, DONT SOLVE
3069 !
3070       IF (WATER.LE.1d1*TINY) THEN
3071          DELTA = ZERO
3072          RETURN
3073       ENDIF
3074 !
3075 ! *** CALCULATE HSO4 SPECIATION *****************************************
3076 !
3077       A8 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
3078 !
3079       BB =-(HI + SO4I + A8)
3080       CC = HI*SO4I - HSO4I*A8
3081       DD = BB*BB - 4.D0*CC
3082 !
3083       IF (DD.GE.ZERO) THEN
3084          SQDD   = SQRT(DD)
3085          DELTA1 = 0.5*(-BB + SQDD)
3086          DELTA2 = 0.5*(-BB - SQDD)
3087          IF (HSO4I.LE.TINY) THEN
3088             DELTA = DELTA2
3089          ELSEIF( HI*SO4I .GE. A8*HSO4I ) THEN
3090             DELTA = DELTA2
3091          ELSEIF( HI*SO4I .LT. A8*HSO4I ) THEN
3092             DELTA = DELTA1
3093          ELSE
3094             DELTA = ZERO
3095          ENDIF
3096       ELSE
3097          DELTA  = ZERO
3098       ENDIF
3099 !CC
3100 !CC *** COMPARE DELTA TO TOTAL H+ ; ESTIMATE EFFECT OF HSO4 ***************
3101 !CC
3102 !C      HYD = MAX(HI, MOLAL(1))
3103 !C      IF (HYD.GT.TINY) THEN
3104 !C         IF (DELTA/HYD.GT.0.1d0) THEN
3105 !C            WRITE (ERRINF,'(1PE10.3)') DELTA/HYD*100.0
3106 !C            CALL PUSHERR (0020, ERRINF)
3107 !C         ENDIF
3108 !C      ENDIF
3109 !
3110       RETURN
3111 !
3112 ! *** END OF SUBROUTINE CALCHS4 *****************************************
3113 !
3114     END SUBROUTINE CALCHS4
3115
3116
3117 !=======================================================================
3118 !
3119 ! *** ISORROPIA CODE
3120 ! *** SUBROUTINE CALCPH
3121 !
3122 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3123 ! *** GEORGIA INSTITUTE OF
3124
3125 ! *** WRITTEN BY ATHANASIOS NENES
3126 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3127 !
3128 !=======================================================================
3129 !
3130       SUBROUTINE CALCPH (GG, HI, OHI)
3131       implicit none
3132       REAL(KIND=8) GG, HI, OHI
3133       REAL(KIND=8) AKW,CN, BB, CC, DD
3134 !
3135       AKW  = XKW *RH*WATER*WATER
3136       CN   = SQRT(AKW)
3137 !
3138 ! *** GG = (negative charge) - (positive charge)
3139 !
3140       IF (GG.GT.TINY) THEN                        ! H+ in excess
3141          BB =-GG
3142          CC =-AKW
3143          DD = BB*BB - 4.D0*CC
3144          HI = MAX(0.5D0*(-BB + SQRT(DD)),CN)
3145          OHI= AKW/HI
3146       ELSE                                        ! OH- in excess
3147          BB = GG
3148          CC =-AKW
3149          DD = BB*BB - 4.D0*CC
3150          OHI= MAX(0.5D0*(-BB + SQRT(DD)),CN)
3151          HI = AKW/OHI
3152       ENDIF
3153 !
3154       RETURN
3155 !
3156 ! *** END OF SUBROUTINE CALCPH ******************************************
3157 !
3158     END SUBROUTINE CALCPH
3159
3160 !=======================================================================
3161 !
3162 ! *** ISORROPIA CODE
3163 ! *** SUBROUTINE CALCACT
3164 ! *** CALCULATES MULTI-COMPONENET ACTIVITY COEFFICIENTS FROM BROMLEYS
3165 !     METHOD. THE BINARY ACTIVITY COEFFICIENTS ARE CALCULATED BY
3166 !     KUSIK-MEISNER RELATION (SUBROUTINE KMTAB or SUBROUTINE KMFUL).
3167 !
3168 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3169 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3170 ! *** WRITTEN BY ATHANASIOS NENES
3171 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3172 !
3173 !=======================================================================
3174 !
3175       SUBROUTINE CALCACT
3176       implicit none
3177 !
3178       REAL EX10, URF
3179       REAL G0(3,4),ZPL,ZMI,AGAMA,SION,H,CH,F1(3),F2(4)
3180       REAL(KIND=8) MPL, XIJ, YJI
3181       REAL(KIND=8) ERROU, ERRIN
3182 !      PARAMETER (URF=0.5)
3183       REAL(KIND=8),PARAMETER:: LN10=2.30258509299404568402D0
3184       REAL IONIC
3185       INTEGER I,J
3186
3187       REAL(KIND=8) G(3,4)
3188
3189 !
3190 !      G(I,J)= (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H
3191 !
3192 ! *** SAVE ACTIVITIES IN OLD ARRAY *************************************
3193 !
3194       IF (FRST) THEN               ! Outer loop
3195          DO 10 I=1,NPAIR
3196             GAMOU(I) = GAMA(I)
3197 10       CONTINUE
3198       ENDIF
3199 !
3200       DO 20 I=1,NPAIR              ! Inner loop
3201          GAMIN(I) = GAMA(I)
3202 20    CONTINUE
3203 !
3204 ! *** CALCULATE IONIC ACTIVITY OF SOLUTION *****************************
3205 !
3206       IONIC=0.0
3207       DO 30 I=1,NIONS
3208          IONIC=IONIC + MOLAL(I)*Z(I)*Z(I)
3209 30    CONTINUE
3210       IONIC = MAX(MIN(0.5*IONIC/WATER,500.d0), TINY)
3211 !
3212 ! *** CALCULATE BINARY ACTIVITY COEFFICIENTS ***************************
3213 !
3214 !  G0(1,1)=G11;G0(1,2)=G07;G0(1,3)=G08;G0(1,4)=G10;G0(2,1)=G01;G0(2,2)=G02
3215 !  G0(2,3)=G12;G0(2,4)=G03;G0(3,1)=G06;G0(3,2)=G04;G0(3,3)=G09;G0(3,4)=G05
3216 !
3217       IF (IACALC.EQ.0) THEN              ! K.M.; FULL
3218          CALL KMFUL (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4),     &
3219                     G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3),&
3220                     G0(1,4),G0(1,1),G0(2,3))
3221       ELSE                               ! K.M.; TABULATED
3222          CALL KMTAB (IONIC, SNGL(TEMP),G0(2,1),G0(2,2),G0(2,4),      &
3223                     G0(3,2),G0(3,4),G0(3,1),G0(1,2),G0(1,3),G0(3,3),&
3224                     G0(1,4),G0(1,1),G0(2,3))
3225       ENDIF
3226 !
3227 ! *** CALCULATE MULTICOMPONENT ACTIVITY COEFFICIENTS *******************
3228 !
3229       AGAMA = 0.511*(298.0/TEMP)**1.5    ! Debye Huckel const. at T
3230       SION  = SQRT(IONIC)
3231       H     = AGAMA*SION/(1+SION)
3232 !
3233       DO 100 I=1,3
3234          F1(I)=0.0
3235          F2(I)=0.0
3236 100   CONTINUE
3237       F2(4)=0.0
3238 !
3239       DO 110 I=1,3
3240          ZPL = Z(I)
3241          MPL = MOLAL(I)/WATER
3242          DO 110 J=1,4
3243             ZMI   = Z(J+3)
3244             CH    = 0.25*(ZPL+ZMI)*(ZPL+ZMI)/IONIC
3245             XIJ   = CH*MPL
3246             YJI   = CH*MOLAL(J+3)/WATER
3247             F1(I) = F1(I) + SNGL(YJI*(G0(I,J) + ZPL*ZMI*H))
3248             F2(J) = F2(J) + SNGL(XIJ*(G0(I,J) + ZPL*ZMI*H))
3249 110   CONTINUE
3250 !
3251 ! *** LOG10 OF ACTIVITY COEFFICIENTS ***********************************
3252 !
3253       GAMA(01) =  G_GAMA(F1,F2,Z,H,2,1)*ZZ(01)! NACL
3254       GAMA(02) =  G_GAMA(F1,F2,Z,H,2,2)*ZZ(02)! NA2SO4
3255       GAMA(03) =  G_GAMA(F1,F2,Z,H,2,4)*ZZ(03)! NANO3
3256       GAMA(04) =  G_GAMA(F1,F2,Z,H,3,2)*ZZ(04)! (NH4)2SO4
3257       GAMA(05) =  G_GAMA(F1,F2,Z,H,3,4)*ZZ(05)! NH4NO3
3258       GAMA(06) =  G_GAMA(F1,F2,Z,H,3,1)*ZZ(06)! NH4CL
3259       GAMA(07) =  G_GAMA(F1,F2,Z,H,1,2)*ZZ(07)! 2H-SO4
3260       GAMA(08) =  G_GAMA(F1,F2,Z,H,1,3)*ZZ(08)! H-HSO4
3261       GAMA(09) =  G_GAMA(F1,F2,Z,H,3,3)*ZZ(09)! NH4HSO4
3262       GAMA(10) =  G_GAMA(F1,F2,Z,H,1,4)*ZZ(10)! HNO3
3263       GAMA(11) =  G_GAMA(F1,F2,Z,H,1,1)*ZZ(11)! HCL
3264       GAMA(12) =  G_GAMA(F1,F2,Z,H,2,3)*ZZ(12)! NAHSO4
3265       GAMA(13) = 0.20*(3.0*GAMA(04)+2.0*GAMA(09))  ! LC ; SCAPE
3266 !C      GAMA(13) = 0.50*(GAMA(04)+GAMA(09))          ! LC ; SEQUILIB
3267 !C      GAMA(13) = 0.25*(3.0*GAMA(04)+GAMA(07))      ! LC ; AIM
3268
3269 !
3270 ! *** CONVERT LOG (GAMA) COEFFICIENTS TO GAMA **************************
3271 !
3272       DO 200 I=1,NPAIR
3273          GAMA(I)=MAX(-11.0d0, MIN(GAMA(I),11.0d0) ) ! F77 LIBRARY ROUTINE
3274 !         GAMA(I)=10.0**GAMA(I)
3275 !         GAMA(I)=EXP(LN10*GAMA(I))
3276          GAMA(I)=EXP(2*GAMA(I))
3277 !C         GAMA(I)=EX10(SNGL(GAMA(I)), 5.0)    ! CUTOFF SET TO [-5,5]
3278 !         GAMA(I) = GAMIN(I)*(1.0-URF) + URF*GAMA(I)  ! Under-relax GAMA's
3279   200 CONTINUE
3280 !
3281 ! *** SETUP ACTIVITY CALCULATION FLAGS *********************************
3282 !
3283 ! OUTER CALCULATION LOOP ; ONLY IF FRST=.TRUE.
3284 !
3285       IF (FRST) THEN
3286          ERROU = ZERO                    ! CONVERGENCE CRITERION
3287          DO 210 I=1,NPAIR
3288             ERROU=MAX(ERROU, ABS((GAMOU(I)-GAMA(I))/GAMOU(I)))
3289 210      CONTINUE
3290          CALAOU = ERROU .GE. EPSACT      ! SETUP FLAGS
3291          FRST   =.FALSE.
3292       ENDIF
3293 !
3294 ! INNER CALCULATION LOOP ; ALWAYS
3295 !
3296       ERRIN = ZERO                       ! CONVERGENCE CRITERION
3297       DO 220 I=1,NPAIR
3298          ERRIN = MAX (ERRIN, ABS((GAMIN(I)-GAMA(I))/GAMIN(I)))
3299 220   CONTINUE
3300       CALAIN = ERRIN .GE. EPSACT
3301 !
3302       ICLACT = ICLACT + 1                ! Increment ACTIVITY call counter
3303 !
3304 ! *** END OF SUBROUTINE ACTIVITY ****************************************
3305 !
3306       RETURN
3307    END SUBROUTINE CALCACT
3308
3309 !======================================================================
3310 ! ***
3311    REAL(KIND=8) FUNCTION G_GAMA(F1,F2,ZI,H,I,J)
3312      implicit none
3313      REAL H,F1(3),F2(4)
3314      REAL(KIND=8)ZI(NIONS)
3315      INTEGER I,J
3316
3317      G_GAMA = (F1(I)/Z(I) + F2(J)/Z(J+3)) / (Z(I)+Z(J+3)) - H
3318      Return
3319
3320    END FUNCTION G_GAMA
3321  !
3322 ! *** END OF FUNCTION G_GAMA ****************************************
3323 !
3324
3325 !=======================================================================
3326 !
3327 ! *** ISORROPIA CODE
3328 ! *** SUBROUTINE RSTGAM
3329 ! *** RESETS ACTIVITY COEFFICIENT ARRAYS TO DEFAULT VALUE OF 0.1
3330 !
3331 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3332 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3333 ! *** WRITTEN BY ATHANASIOS NENES
3334 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3335 !
3336 !=======================================================================
3337 !
3338       SUBROUTINE RSTGAM
3339       implicit none
3340       INTEGER I
3341 !
3342       DO 10 I=1, NPAIR
3343          GAMA(I) = 0.1
3344 10    CONTINUE
3345 !
3346 ! *** END OF SUBROUTINE RSTGAM ******************************************
3347 !
3348       RETURN
3349    END SUBROUTINE RSTGAM
3350 !=======================================================================
3351 !
3352 ! *** ISORROPIA CODE
3353 ! *** SUBROUTINE KMFUL
3354 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3355 !
3356 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3357 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3358 ! *** WRITTEN BY ATHANASIOS NENES
3359 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3360 !
3361 !=======================================================================
3362 !
3363       SUBROUTINE KMFUL (IONIC,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09,&
3364                        G10,G11,G12)
3365         implicit none
3366       REAL Ionic, TEMP
3367       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3368       REAL Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11
3369       DATA Z01,Z02,Z03,Z04,Z05,Z06,Z07,Z08,Z10,Z11&
3370          /1,  2,  1,  2,  1,  1,  2,  1,  1,  1/
3371       REAL SION
3372       REAL TI, TC, CF1, CF2
3373 !
3374       SION = SQRT(IONIC)
3375 !
3376 ! *** Coefficients at 25 oC
3377 !
3378       CALL MKBI(2.230, IONIC, SION, Z01, G01)
3379       CALL MKBI(-0.19, IONIC, SION, Z02, G02)
3380       CALL MKBI(-0.39, IONIC, SION, Z03, G03)
3381       CALL MKBI(-0.25, IONIC, SION, Z04, G04)
3382       CALL MKBI(-1.15, IONIC, SION, Z05, G05)
3383       CALL MKBI(0.820, IONIC, SION, Z06, G06)
3384       CALL MKBI(-.100, IONIC, SION, Z07, G07)
3385       CALL MKBI(8.000, IONIC, SION, Z08, G08)
3386       CALL MKBI(2.600, IONIC, SION, Z10, G10)
3387       CALL MKBI(6.000, IONIC, SION, Z11, G11)
3388 !
3389 ! *** Correct for T other than 298 K
3390 !
3391       TI  = TEMP-273.0
3392       TC  = TI-25.0
3393       IF (ABS(TC) .GT. 1.0) THEN
3394          CF1 = 1.125-0.005*TI
3395          CF2 = (0.125-0.005*TI)*(0.039*IONIC**0.92-0.41*SION/(1.+SION))
3396          G01 = CF1*G01 - CF2*Z01
3397          G02 = CF1*G02 - CF2*Z02
3398          G03 = CF1*G03 - CF2*Z03
3399          G04 = CF1*G04 - CF2*Z04
3400          G05 = CF1*G05 - CF2*Z05
3401          G06 = CF1*G06 - CF2*Z06
3402          G07 = CF1*G07 - CF2*Z07
3403          G08 = CF1*G08 - CF2*Z08
3404          G10 = CF1*G10 - CF2*Z10
3405          G11 = CF1*G11 - CF2*Z11
3406       ENDIF
3407 !
3408       G09 = G06 + G08 - G11
3409       G12 = G01 + G08 - G11
3410 !
3411 ! *** Return point ; End of subroutine
3412 !
3413       RETURN
3414     END SUBROUTINE KMFUL
3415
3416
3417 !=======================================================================
3418 !
3419 ! *** ISORROPIA CODE
3420 ! *** SUBROUTINE MKBI
3421 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3422 !
3423 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3424 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3425 ! *** WRITTEN BY ATHANASIOS NENES
3426 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3427 !
3428 !=======================================================================
3429 !
3430       SUBROUTINE MKBI(Q,IONIC,SION,ZIP,BI)
3431         implicit none
3432 !
3433
3434       REAL Q,IONIC,SION,ZIP
3435       REAL BI
3436       REAL B, C, XX
3437 !
3438       B=.75-.065*Q
3439       C= 1.0
3440       IF (IONIC.LT.6.0) C=1.+.055*Q*EXP(-.023*IONIC*IONIC*IONIC)
3441       XX=-0.5107*SION/(1.+C*SION)
3442       BI=(1.+B*(1.+.1*IONIC)**Q-B)
3443       BI=ZIP*ALOG10(BI) + ZIP*XX
3444 !
3445       RETURN
3446     END SUBROUTINE MKBI
3447 !=======================================================================
3448 !
3449 ! *** ISORROPIA CODE
3450 ! *** SUBROUTINE KMTAB
3451 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3452 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3453 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IONIC' IS INPUT, AND THE ARRAY
3454 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3455 !
3456 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3457 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3458 ! *** WRITTEN BY ATHANASIOS NENES
3459 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3460 !
3461 !=======================================================================
3462 !
3463       SUBROUTINE KMTAB (IN,TEMP,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,&
3464                                G11,G12)
3465         implicit none
3466       REAL IN, Temp
3467       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3468       INTEGER IND
3469 !
3470 ! *** Find temperature range
3471 !
3472       IND = NINT((TEMP-198.0)/25.0) + 1
3473       IND = MIN(MAX(IND,1),6)
3474 !
3475 ! *** Call appropriate routine
3476 !
3477       IF (IND.EQ.1) THEN
3478          CALL KM198 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3479       ELSEIF (IND.EQ.2) THEN
3480          CALL KM223 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3481       ELSEIF (IND.EQ.3) THEN
3482          CALL KM248 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3483       ELSEIF (IND.EQ.4) THEN
3484          CALL KM273 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3485       ELSEIF (IND.EQ.5) THEN
3486          CALL KM298 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3487       ELSE
3488          CALL KM323 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12)
3489       ENDIF
3490 !
3491 ! *** Return point; End of subroutine
3492 !
3493       RETURN
3494     END SUBROUTINE KMTAB
3495
3496
3497       INTEGER FUNCTION IBACPOS(IN)
3498 !
3499 !     Compute the index in the binary activity coefficient array
3500 !     based on the input ionic strength.
3501 !
3502 !     Chris Nolte, 6/16/05
3503 !
3504       implicit none
3505       real IN
3506       IF (IN .LE. 0.300000E+02) THEN
3507          ibacpos = MIN(NINT( 0.200000E+02*IN) + 1, 600)
3508       ELSE
3509          ibacpos =   600+NINT( 0.200000E+01*IN- 0.600000E+02)
3510       ENDIF
3511       ibacpos = min(ibacpos, 741)
3512       return
3513     end FUNCTION IBACPOS
3514
3515 !=======================================================================
3516 !
3517 ! *** ISORROPIA CODE
3518 ! *** SUBROUTINE KM198
3519 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3520 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3521 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3522 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3523 !
3524 !     TEMPERATURE IS 198K
3525 !
3526 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3527 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3528 ! *** WRITTEN BY ATHANASIOS NENES
3529 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3530 !
3531 !=======================================================================
3532 !
3533       SUBROUTINE KM198 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, &
3534                           G11,G12)
3535         implicit none
3536 !
3537       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3538       INTEGER ipos
3539 ! *** Common block definition
3540 !
3541 !      COMMON /KMC198/                                         &
3542 !      BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3543 !      BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3544 !      BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3545 !      BNC13M(  741)
3546       REAL IN
3547 !
3548 ! *** Find position in arrays for binary activity coefficients
3549 !
3550       ipos = ibacpos(IN)
3551 !
3552 ! *** Assign values to return array
3553 !
3554       G01 = BNC01M(ipos)
3555       G02 = BNC02M(ipos)
3556       G03 = BNC03M(ipos)
3557       G04 = BNC04M(ipos)
3558       G05 = BNC05M(ipos)
3559       G06 = BNC06M(ipos)
3560       G07 = BNC07M(ipos)
3561       G08 = BNC08M(ipos)
3562       G09 = BNC09M(ipos)
3563       G10 = BNC10M(ipos)
3564       G11 = BNC11M(ipos)
3565       G12 = BNC12M(ipos)
3566 !
3567 ! *** Return point ; End of subroutine
3568 !
3569       RETURN
3570     END SUBROUTINE KM198
3571
3572
3573 !=======================================================================
3574 !
3575 ! *** ISORROPIA CODE
3576 ! *** SUBROUTINE KM223
3577 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3578 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3579 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3580 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3581 !
3582 !     TEMPERATURE IS 223K
3583 !
3584 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3585 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3586 ! *** WRITTEN BY ATHANASIOS NENES
3587 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3588 !
3589 !=======================================================================
3590 !
3591       SUBROUTINE KM223 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,&
3592                           G11,G12)
3593         implicit none
3594       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3595       INTEGER ipos
3596 !
3597 ! *** Common block definition
3598 !
3599 !      COMMON /KMC223/                                        &
3600 !     BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3601 !     BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3602 !     BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3603 !     BNC13M(  741)
3604       REAL IN
3605 !
3606 ! *** Find position in arrays for binary activity coefficients
3607 !
3608       ipos = ibacpos(IN)
3609 !
3610 ! *** Assign values to return array
3611 !
3612       G01 = BNC01M(ipos)
3613       G02 = BNC02M(ipos)
3614       G03 = BNC03M(ipos)
3615       G04 = BNC04M(ipos)
3616       G05 = BNC05M(ipos)
3617       G06 = BNC06M(ipos)
3618       G07 = BNC07M(ipos)
3619       G08 = BNC08M(ipos)
3620       G09 = BNC09M(ipos)
3621       G10 = BNC10M(ipos)
3622       G11 = BNC11M(ipos)
3623       G12 = BNC12M(ipos)
3624 !
3625 ! *** Return point ; End of subroutine
3626 !
3627       RETURN
3628     END SUBROUTINE KM223
3629
3630
3631
3632 !=======================================================================
3633 !
3634 ! *** ISORROPIA CODE
3635 ! *** SUBROUTINE KM248
3636 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3637 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3638 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3639 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3640 !
3641 !     TEMPERATURE IS 248K
3642 !
3643 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3644 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3645 ! *** WRITTEN BY ATHANASIOS NENES
3646 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3647 !
3648 !=======================================================================
3649 !
3650       SUBROUTINE KM248 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, &
3651                           G11,G12)
3652         implicit none
3653       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3654       INTEGER ipos
3655 !
3656 ! *** Common block definition
3657 !
3658 !      COMMON /KMC248/                                         &
3659 !      BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3660 !      BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3661 !      BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3662 !      BNC13M(  741)
3663       REAL IN
3664 !
3665 ! *** Find position in arrays for binary activity coefficients
3666 !
3667       ipos = ibacpos(IN)
3668 !
3669 ! *** Assign values to return array
3670 !
3671       G01 = BNC01M(ipos)
3672       G02 = BNC02M(ipos)
3673       G03 = BNC03M(ipos)
3674       G04 = BNC04M(ipos)
3675       G05 = BNC05M(ipos)
3676       G06 = BNC06M(ipos)
3677       G07 = BNC07M(ipos)
3678       G08 = BNC08M(ipos)
3679       G09 = BNC09M(ipos)
3680       G10 = BNC10M(ipos)
3681       G11 = BNC11M(ipos)
3682       G12 = BNC12M(ipos)
3683 !
3684 ! *** Return point ; End of subroutine
3685 !
3686       RETURN
3687     END SUBROUTINE KM248
3688
3689
3690 !=======================================================================
3691 !
3692 ! *** ISORROPIA CODE
3693 ! *** SUBROUTINE KM273
3694 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3695 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3696 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3697 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3698 !
3699 !     TEMPERATURE IS 273K
3700 !
3701 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3702 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3703 ! *** WRITTEN BY ATHANASIOS NENES
3704 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3705 !
3706 !=======================================================================
3707 !
3708       SUBROUTINE KM273 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, &
3709                           G11,G12)
3710         implicit none
3711       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3712       INTEGER ipos
3713 !
3714 ! *** Common block definition
3715 !
3716 !      COMMON /KMC273/                                         &
3717 !      BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3718 !      BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3719 !      BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3720 !      BNC13M(  741)
3721       REAL IN
3722 !
3723 ! *** Find position in arrays for binary activity coefficients
3724 !
3725       ipos = ibacpos(IN)
3726 !
3727 ! *** Assign values to return array
3728 !
3729       G01 = BNC01M(ipos)
3730       G02 = BNC02M(ipos)
3731       G03 = BNC03M(ipos)
3732       G04 = BNC04M(ipos)
3733       G05 = BNC05M(ipos)
3734       G06 = BNC06M(ipos)
3735       G07 = BNC07M(ipos)
3736       G08 = BNC08M(ipos)
3737       G09 = BNC09M(ipos)
3738       G10 = BNC10M(ipos)
3739       G11 = BNC11M(ipos)
3740       G12 = BNC12M(ipos)
3741 !
3742 ! *** Return point ; End of subroutine
3743 !
3744       RETURN
3745     END SUBROUTINE KM273
3746
3747
3748 !=======================================================================
3749 !
3750 ! *** ISORROPIA CODE
3751 ! *** SUBROUTINE KM298
3752 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3753 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3754 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3755 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3756 !
3757 !     TEMPERATURE IS 298K
3758 !
3759 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3760 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3761 ! *** WRITTEN BY ATHANASIOS NENES
3762 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3763 !
3764 !=======================================================================
3765 !
3766       SUBROUTINE KM298 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, &
3767                           G11,G12)
3768         implicit none
3769       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3770       INTEGER ipos
3771 !
3772 ! *** Common block definition
3773 !
3774 !      COMMON /KMC298/                                         &
3775 !      BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3776 !      BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3777 !      BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3778 !      BNC13M(  741)
3779       REAL IN
3780 !
3781 ! *** Find position in arrays for binary activity coefficients
3782 !
3783       ipos = ibacpos(IN)
3784 !
3785 ! *** Assign values to return array
3786 !
3787       G01 = BNC01M(ipos)
3788       G02 = BNC02M(ipos)
3789       G03 = BNC03M(ipos)
3790       G04 = BNC04M(ipos)
3791       G05 = BNC05M(ipos)
3792       G06 = BNC06M(ipos)
3793       G07 = BNC07M(ipos)
3794       G08 = BNC08M(ipos)
3795       G09 = BNC09M(ipos)
3796       G10 = BNC10M(ipos)
3797       G11 = BNC11M(ipos)
3798       G12 = BNC12M(ipos)
3799 !
3800 ! *** Return point ; End of subroutine
3801 !
3802       RETURN
3803     END SUBROUTINE KM298
3804
3805
3806 !=======================================================================
3807 !
3808 ! *** ISORROPIA CODE
3809 ! *** SUBROUTINE KM323
3810 ! *** CALCULATES BINARY ACTIVITY COEFFICIENTS BY KUSIK-MEISSNER METHOD.
3811 !     THE COMPUTATIONS HAVE BEEN PERFORMED AND THE RESULTS ARE STORED IN
3812 !     LOOKUP TABLES. THE IONIC ACTIVITY 'IN' IS INPUT, AND THE ARRAY
3813 !     'BINARR' IS RETURNED WITH THE BINARY COEFFICIENTS.
3814 !
3815 !     TEMPERATURE IS 323K
3816 !
3817 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3818 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
3819 ! *** WRITTEN BY ATHANASIOS NENES
3820 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
3821 !
3822 !=======================================================================
3823 !
3824       SUBROUTINE KM323 (IN,G01,G02,G03,G04,G05,G06,G07,G08,G09,G10, &
3825                           G11,G12)
3826         implicit none
3827       REAL G01,G02,G03,G04,G05,G06,G07,G08,G09,G10,G11,G12
3828       INTEGER ipos
3829 !
3830 ! *** Common block definition
3831 !
3832 !      COMMON /KMC323/                                         &
3833 !      BNC01M(  741),BNC02M(  741),BNC03M(  741),BNC04M(  741),&
3834 !      BNC05M(  741),BNC06M(  741),BNC07M(  741),BNC08M(  741),&
3835 !      BNC09M(  741),BNC10M(  741),BNC11M(  741),BNC12M(  741),&
3836 !      BNC13M(  741)
3837       REAL IN
3838 !
3839 ! *** Find position in arrays for binary activity coefficients
3840 !
3841       ipos = ibacpos(IN)
3842 !
3843 ! *** Assign values to return array
3844 !
3845       G01 = BNC01M(ipos)
3846       G02 = BNC02M(ipos)
3847       G03 = BNC03M(ipos)
3848       G04 = BNC04M(ipos)
3849       G05 = BNC05M(ipos)
3850       G06 = BNC06M(ipos)
3851       G07 = BNC07M(ipos)
3852       G08 = BNC08M(ipos)
3853       G09 = BNC09M(ipos)
3854       G10 = BNC10M(ipos)
3855       G11 = BNC11M(ipos)
3856       G12 = BNC12M(ipos)
3857 !
3858 ! *** Return point ; End of subroutine
3859 !
3860       RETURN
3861     END SUBROUTINE KM323
3862
3863
3864
3865
3866 !C*************************************************************************
3867 !C
3868 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
3869 !C
3870 !C  Program unit   : SUBROUTINE CHRBLN
3871 !C  Purpose        : Position of last non-blank character in a string
3872 !C  Author         : Athanasios Nenes
3873 !C
3874 !C  ======================= ARGUMENTS / USAGE =============================
3875 !C
3876 !C  STR        is the CHARACTER variable containing the string examined
3877 !C  IBLK       is a INTEGER variable containing the position of last non
3878 !C             blank character. If string is all spaces (ie '   '), then
3879 !C             the value returned is 1.
3880 !C
3881 !C  EXAMPLE:
3882 !C             STR = 'TEST1.DAT     '
3883 !C             CALL CHRBLN (STR, IBLK)
3884 !C
3885 !C  after execution of this code segment, "IBLK" has the value "9", which
3886 !C  is the position of the last non-blank character of "STR".
3887 !C
3888 !C***********************************************************************
3889 !C
3890     SUBROUTINE CHRBLN (STR, IBLK)
3891         implicit none
3892 !C
3893 !C***********************************************************************
3894       CHARACTER*(*) STR
3895       INTEGER IBLK
3896       INTEGER I, ILEN
3897 !
3898       IBLK = 1                       ! Substring pointer (default=1)
3899       ILEN = LEN(STR)                ! Length of string
3900       DO 10 i=ILEN,1,-1
3901          IF (STR(i:i).NE.' ' .AND. STR(i:i).NE.CHAR(0)) THEN
3902             IBLK = i
3903             RETURN
3904          ENDIF
3905 10    CONTINUE
3906       RETURN
3907 !
3908     END SUBROUTINE CHRBLN
3909
3910
3911 !C*************************************************************************
3912 !C
3913 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
3914 !C
3915 !C  Program unit   : SUBROUTINE SHFTRGHT
3916 !C  Purpose        : RIGHT-JUSTIFICATION FUNCTION ON A STRING
3917 !C  Author         : Athanasios Nenes
3918 !C
3919 !C  ======================= ARGUMENTS / USAGE =============================
3920 !C
3921 !C  STRING     is the CHARACTER variable with the string to be justified
3922 !C
3923 !C  EXAMPLE:
3924 !C             STRING    = 'AAAA    '
3925 !C             CALL SHFTRGHT (STRING)
3926 !C
3927 !C  after execution of this code segment, STRING contains the value
3928 !C  '    AAAA'.
3929 !C
3930 !C*************************************************************************
3931 !C
3932       SUBROUTINE SHFTRGHT (CHR)
3933         implicit none
3934 !C
3935 !C***********************************************************************
3936       CHARACTER CHR*(*)
3937       INTEGER I, I1, I2
3938 !
3939       I1  = LEN(CHR)             ! Total length of string
3940       CALL CHRBLN(CHR,I2)        ! Position of last non-blank character
3941       IF (I2.EQ.I1) RETURN
3942 !
3943       DO 10 I=I2,1,-1            ! Shift characters
3944          CHR(I1+I-I2:I1+I-I2) = CHR(I:I)
3945          CHR(I:I) = ' '
3946 10    CONTINUE
3947       RETURN
3948 !
3949    END  SUBROUTINE SHFTRGHT
3950
3951
3952
3953
3954 !C*************************************************************************
3955 !C
3956 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
3957 !C
3958 !C  Program unit   : SUBROUTINE RPLSTR
3959 !C  Purpose        : REPLACE CHARACTERS OCCURING IN A STRING
3960 !C  Author         : Athanasios Nenes
3961 !C
3962 !C  ======================= ARGUMENTS / USAGE =============================
3963 !C
3964 !C  STRING     is the CHARACTER variable with the string to be edited
3965 !C  OLD        is the old character which is to be replaced
3966 !C  NEW        is the new character which OLD is to be replaced with
3967 !C  IERR       is 0 if everything went well, is 1 if 'NEW' contains 'OLD'.
3968 !C             In this case, this is invalid, and no change is done.
3969 !C
3970 !C  EXAMPLE:
3971 !C             STRING    = 'AAAA'
3972 !C             OLD       = 'A'
3973 !C             NEW       = 'B'
3974 !C             CALL RPLSTR (STRING, OLD, NEW)
3975 !C
3976 !C  after execution of this code segment, STRING contains the value
3977 !C  'BBBB'.
3978 !C
3979 !C*************************************************************************
3980 !C
3981       SUBROUTINE RPLSTR (STRING, OLD, NEW, IERR)
3982         implicit none
3983 !C
3984 !C***********************************************************************
3985       CHARACTER STRING*(*), OLD*(*), NEW*(*)
3986       INTEGER IERR
3987       INTEGER ILO, IP
3988 !
3989 ! *** INITIALIZE ********************************************************
3990 !
3991       ILO = LEN(OLD)
3992 !
3993 ! *** CHECK AND SEE IF 'NEW' CONTAINS 'OLD', WHICH CANNOT ***************
3994 !
3995       IP = INDEX(NEW,OLD)
3996       IF (IP.NE.0) THEN
3997          IERR = 1
3998          RETURN
3999       ELSE
4000          IERR = 0
4001       ENDIF
4002 !
4003 ! *** PROCEED WITH REPLACING *******************************************
4004 !
4005 10    IP = INDEX(STRING,OLD)      ! SEE IF 'OLD' EXISTS IN 'STRING'
4006       IF (IP.EQ.0) RETURN         ! 'OLD' DOES NOT EXIST ; RETURN
4007       STRING(IP:IP+ILO-1) = NEW   ! REPLACE SUBSTRING 'OLD' WITH 'NEW'
4008       GOTO 10                     ! GO FOR NEW OCCURANCE OF 'OLD'
4009 !
4010     END SUBROUTINE RPLSTR
4011
4012
4013 !C*************************************************************************
4014 !C
4015 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
4016 !C
4017 !C  Program unit   : SUBROUTINE INPTD
4018 !C  Purpose        : Prompts user for a value (DOUBLE). A default value
4019 !C                   is provided, so if user presses <Enter>, the default
4020 !C                   is used.
4021 !C  Author         : Athanasios Nenes
4022 !C
4023 !C  ======================= ARGUMENTS / USAGE =============================
4024 !C
4025 !C  VAR        is the DOUBLE PRECISION variable which value is to be saved
4026 !C  DEF        is a DOUBLE PRECISION variable, with the default value of VAR.
4027 !C  PROMPT     is a CHARACTER varible containing the prompt string.
4028 !C  PRFMT      is a CHARACTER variable containing the FORMAT specifier
4029 !C             for the default value DEF.
4030 !C  IERR       is an INTEGER error flag, and has the values:
4031 !C             0 - No error detected.
4032 !C             1 - Invalid FORMAT and/or Invalid default value.
4033 !C             2 - Bad value specified by user
4034 !C
4035 !C  EXAMPLE:
4036 !C             CALL INPTD (VAR, 1.0D0, 'Give value for A ', '*', Ierr)
4037 !C
4038 !C  after execution of this code segment, the user is prompted for the
4039 !C  value of variable VAR. If <Enter> is pressed (ie no value is specified)
4040 !C  then 1.0 is assigned to VAR. The default value is displayed in free-
4041 !C  format. The error status is specified by variable Ierr
4042 !C
4043 !C***********************************************************************
4044 !C
4045       SUBROUTINE INPTD (VAR, DEF, PROMPT, PRFMT, IERR)
4046         implicit none
4047 !C
4048 !C***********************************************************************
4049       CHARACTER PROMPT*(*), PRFMT*(*), BUFFER*128
4050       REAL(KIND=8) DEF, VAR
4051       INTEGER IERR, IEND
4052 !
4053       IERR = 0
4054 !
4055 ! *** WRITE DEFAULT VALUE TO WORK BUFFER *******************************
4056 !
4057       WRITE (BUFFER, FMT=PRFMT, ERR=10) DEF
4058       CALL CHRBLN (BUFFER, IEND)
4059 !
4060 ! *** PROMPT USER FOR INPUT AND READ IT ********************************
4061 !
4062       WRITE (*,*) PROMPT,' [',BUFFER(1:IEND),']: '
4063       READ  (*, '(A)', ERR=20, END=20) BUFFER
4064       CALL CHRBLN (BUFFER,IEND)
4065 !
4066 ! *** READ DATA OR SET DEFAULT ? ****************************************
4067 !
4068       IF (IEND.EQ.1 .AND. BUFFER(1:1).EQ.' ') THEN
4069          VAR = DEF
4070       ELSE
4071          READ (BUFFER, *, ERR=20, END=20) VAR
4072       ENDIF
4073 !
4074 ! *** RETURN POINT ******************************************************
4075 !
4076 30    RETURN
4077 !
4078 ! *** ERROR HANDLER *****************************************************
4079 !
4080 10    IERR = 1       ! Bad FORMAT and/or bad default value
4081       GOTO 30
4082 !
4083 20    IERR = 2       ! Bad number given by user
4084       GOTO 30
4085 !
4086     END SUBROUTINE INPTD
4087
4088
4089 !C*************************************************************************
4090 !C
4091 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
4092 !C
4093 !C  Program unit   : SUBROUTINE Pushend
4094 !C  Purpose        : Positions the pointer of a sequential file at its end
4095 !C                   Simulates the ACCESS='APPEND' clause of a F77L OPEN
4096 !C                   statement with Standard Fortran commands.
4097 !C
4098 !C  ======================= ARGUMENTS / USAGE =============================
4099 !C
4100 !C  Iunit      is a INTEGER variable, the file unit which the file is
4101 !C             connected to.
4102 !C
4103 !C  EXAMPLE:
4104 !C             CALL PUSHEND (10)
4105 !C
4106 !C  after execution of this code segment, the pointer of unit 10 is
4107 !C  pushed to its end.
4108 !C
4109 !C***********************************************************************
4110 !C
4111       SUBROUTINE Pushend (Iunit)
4112         implicit none
4113 !C
4114 !C***********************************************************************
4115 !
4116         INTEGER IUNIT
4117       LOGICAL OPNED
4118
4119 !
4120 ! *** INQUIRE IF Iunit CONNECTED TO FILE ********************************
4121 !
4122       INQUIRE (UNIT=Iunit, OPENED=OPNED)
4123       IF (.NOT.OPNED) GOTO 25
4124 !
4125 ! *** Iunit CONNECTED, PUSH POINTER TO END ******************************
4126 !
4127 10    READ (Iunit,'()', ERR=20, END=20)
4128       GOTO 10
4129 !
4130 ! *** RETURN POINT ******************************************************
4131 !
4132 20    BACKSPACE (Iunit)
4133 25    RETURN
4134     END SUBROUTINE Pushend
4135
4136
4137
4138 !C*************************************************************************
4139 !C
4140 !C  TOOLBOX LIBRARY v.1.0 (May 1995)
4141 !C
4142 !C  Program unit   : SUBROUTINE APPENDEXT
4143 !C  Purpose        : Fix extension in file name string
4144 !C
4145 !C  ======================= ARGUMENTS / USAGE =============================
4146 !C
4147 !C  Filename   is the CHARACTER variable with the file name
4148 !C  Defext     is the CHARACTER variable with extension (including '.',
4149 !C             ex. '.DAT')
4150 !C  Overwrite  is a LOGICAL value, .TRUE. overwrites any existing extension
4151 !C             in "Filename" with "Defext", .FALSE. puts "Defext" only if
4152 !C             there is no extension in "Filename".
4153 !C
4154 !C  EXAMPLE:
4155 !C             FILENAME1 = 'TEST.DAT'
4156 !C             FILENAME2 = 'TEST.DAT'
4157 !C             CALL APPENDEXT (FILENAME1, '.TXT', .FALSE.)
4158 !C             CALL APPENDEXT (FILENAME2, '.TXT', .TRUE. )
4159 !C
4160 !C  after execution of this code segment, "FILENAME1" has the value
4161 !C  'TEST.DAT', while "FILENAME2" has the value 'TEST.TXT'
4162 !C
4163 !C***********************************************************************
4164 !C
4165       SUBROUTINE Appendext (Filename, Defext, Overwrite)
4166         implicit none
4167 !C
4168 !C***********************************************************************
4169       CHARACTER*(*) Filename, Defext
4170       LOGICAL       Overwrite
4171       INTEGER Idot, Iend
4172 !
4173       CALL CHRBLN (Filename, Iend)
4174       IF (Filename(1:1).EQ.' ' .AND. Iend.EQ.1) RETURN  ! Filename empty
4175       Idot = INDEX (Filename, '.')                      ! Append extension ?
4176       IF (Idot.EQ.0) Filename = Filename(1:Iend)//Defext
4177       IF (Overwrite .AND. Idot.NE.0)&
4178                    Filename = Filename(:Idot-1)//Defext
4179       RETURN
4180     END SUBROUTINE Appendext
4181
4182
4183
4184
4185
4186 !=======================================================================
4187 !
4188 ! *** ISORROPIA CODE
4189 ! *** SUBROUTINE POLY3
4190 ! *** FINDS THE REAL ROOTS OF THE THIRD ORDER ALGEBRAIC EQUATION:
4191 !     X**3 + A1*X**2 + A2*X + A3 = 0.0
4192 !     THE EQUATION IS SOLVED ANALYTICALLY.
4193 !
4194 !     PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM
4195 !     NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS
4196 !     FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30.
4197 !     AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO.
4198 !
4199 !     SOLUTION FORMULA IS FOUND IN PAGE 32 OF:
4200 !     MATHEMATICAL HANDBOOK OF FORMULAS AND TABLES
4201 !     SCHAUM'S OUTLINE SERIES
4202 !     MURRAY SPIEGER, McGRAW-HILL, NEW YORK, 1968
4203 !     (GREEK TRANSLATION: BY SOTIRIOS PERSIDES, ESPI, ATHENS, 1976)
4204 !
4205 !     A SPECIAL CASE IS CONSIDERED SEPERATELY ; WHEN A3 = 0, THEN
4206 !     ONE ROOT IS X=0.0, AND THE OTHER TWO FROM THE SOLUTION OF THE
4207 !     QUADRATIC EQUATION X**2 + A1*X + A2 = 0.0
4208 !     THIS SPECIAL CASE IS CONSIDERED BECAUSE THE ANALYTICAL FORMULA
4209 !     DOES NOT YIELD ACCURATE RESULTS (DUE TO NUMERICAL ROUNDOFF ERRORS)
4210 !
4211 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4212 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4213 ! *** WRITTEN BY ATHANASIOS NENES
4214 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4215 !
4216 !=======================================================================
4217 !
4218     SUBROUTINE POLY3 (A1, A2, A3, ROOT, ISLV)
4219       implicit none
4220       !
4221       REAL(KIND=8) A1, A2, A3, ROOT
4222       INTEGER ISLV
4223       REAL(KIND=8),PARAMETER::EXPON=1.D0/3.D0,     ZERO=0.D0, THET1=120.D0/180.D0, &
4224                 THET2=240.D0/180.D0, PI=3.14159265358932, EPS=1D-50
4225       REAL(KIND=8) X(3)
4226       INTEGER I
4227       INTEGER IX
4228       REAL(KIND=8) D, SQD, Q, R,  THET, COEF, SSIG, S, T, TSIG
4229 !
4230 ! *** SPECIAL CASE : QUADRATIC*X EQUATION *****************************
4231 !
4232       IF (ABS(A3).LE.EPS) THEN
4233          ISLV = 1
4234          IX   = 1
4235          X(1) = ZERO
4236          D    = A1*A1-4.D0*A2
4237          IF (D.GE.ZERO) THEN
4238             IX   = 3
4239             SQD  = SQRT(D)
4240             X(2) = 0.5*(-A1+SQD)
4241             X(3) = 0.5*(-A1-SQD)
4242          ENDIF
4243       ELSE
4244 !
4245 ! *** NORMAL CASE : CUBIC EQUATION ************************************
4246 !
4247 ! DEFINE PARAMETERS Q, R, S, T, D
4248 !
4249          ISLV= 1
4250          Q   = (3.D0*A2 - A1*A1)/9.D0
4251          R   = (9.D0*A1*A2 - 27.D0*A3 - 2.D0*A1*A1*A1)/54.D0
4252          D   = Q*Q*Q + R*R
4253 !
4254 ! *** CALCULATE ROOTS *************************************************
4255 !
4256 !  D < 0, THREE REAL ROOTS
4257 !
4258          IF (D.LT.-EPS) THEN        ! D < -EPS  : D < ZERO
4259             IX   = 3
4260             THET = EXPON*ACOS(R/SQRT(-Q*Q*Q))
4261             COEF = 2.D0*SQRT(-Q)
4262             X(1) = COEF*COS(THET)            - EXPON*A1
4263             X(2) = COEF*COS(THET + THET1*PI) - EXPON*A1
4264             X(3) = COEF*COS(THET + THET2*PI) - EXPON*A1
4265 !
4266 !  D = 0, THREE REAL (ONE DOUBLE) ROOTS
4267 !
4268          ELSE IF (D.LE.EPS) THEN    ! -EPS <= D <= EPS  : D = ZERO
4269             IX   = 2
4270             SSIG = SIGN (1.D0, R)
4271             S    = SSIG*(ABS(R))**EXPON
4272             X(1) = 2.D0*S  - EXPON*A1
4273             X(2) =     -S  - EXPON*A1
4274 !
4275 !  D > 0, ONE REAL ROOT
4276 !
4277          ELSE                       ! D > EPS  : D > ZERO
4278             IX   = 1
4279             SQD  = SQRT(D)
4280             SSIG = SIGN (1.D0, R+SQD)       ! TRANSFER SIGN TO SSIG
4281             TSIG = SIGN (1.D0, R-SQD)
4282             S    = SSIG*(ABS(R+SQD))**EXPON ! EXPONENTIATE ABS()
4283             T    = TSIG*(ABS(R-SQD))**EXPON
4284             X(1) = S + T - EXPON*A1
4285          ENDIF
4286       ENDIF
4287 !
4288 ! *** SELECT APPROPRIATE ROOT *****************************************
4289 !
4290       ROOT = 1.D30
4291       DO 10 I=1,IX
4292          IF (X(I).GT.ZERO) THEN
4293             ROOT = MIN (ROOT, X(I))
4294             ISLV = 0
4295          ENDIF
4296 10    CONTINUE
4297 !
4298 ! *** END OF SUBROUTINE POLY3 *****************************************
4299 !
4300       RETURN
4301       END SUBROUTINE POLY3
4302
4303
4304
4305
4306 !=======================================================================
4307 !
4308 ! *** ISORROPIA CODE
4309 ! *** SUBROUTINE POLY3B
4310 ! *** FINDS A REAL ROOT OF THE THIRD ORDER ALGEBRAIC EQUATION:
4311 !     X**3 + A1*X**2 + A2*X + A3 = 0.0
4312 !     THE EQUATION IS SOLVED NUMERICALLY (BISECTION).
4313 !
4314 !     PARAMETERS A1, A2, A3 ARE SPECIFIED BY THE USER. THE MINIMUM
4315 !     NONEGATIVE ROOT IS RETURNED IN VARIABLE 'ROOT'. IF NO ROOT IS
4316 !     FOUND (WHICH IS GREATER THAN ZERO), ROOT HAS THE VALUE 1D30.
4317 !     AND THE FLAG ISLV HAS A VALUE GREATER THAN ZERO.
4318 !
4319 !     RTLW, RTHI DEFINE THE INTERVAL WHICH THE ROOT IS LOOKED FOR.
4320 !
4321 !=======================================================================
4322 !
4323       SUBROUTINE POLY3B (A1, A2, A3, RTLW, RTHI, ROOT, ISLV)
4324         implicit none
4325 !
4326       REAL(KIND=8) A1, A2, A3, RTLW, RTHI, ROOT
4327       INTEGER ISLV
4328       REAL(KIND=8),PARAMETER::ZERO=0.D0, EPS=1D-15
4329       INTEGER,PARAMETER::MAXIT=100, NDIV=5
4330       INTEGER I
4331       REAL(KIND=8) X1, Y1, X2, Y2, X3, Y3, DX
4332
4333 !
4334 !      FUNC(X) = X**3.d0 + A1*X**2.0 + A2*X + A3
4335 !
4336 ! *** INITIAL VALUES FOR BISECTION *************************************
4337 !
4338       X1   = RTLW
4339 !      Y1   = FUNC(X1)
4340       Y1   = X1**3.d0 + A1*X1**2.0 + A2*X1 + A3
4341       IF (ABS(Y1).LE.EPS) THEN     ! Is low a root?
4342          ROOT = RTLW
4343          GOTO 50
4344       ENDIF
4345 !
4346 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
4347 !
4348       DX = (RTHI-RTLW)/FLOAT(NDIV)
4349       DO 10 I=1,NDIV
4350          X2 = X1+DX
4351 !         Y2 = FUNC (X2)
4352          Y2 = X2**3.d0 + A1*X2**2.0 + A2*X2 + A3
4353          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
4354          X1 = X2
4355          Y1 = Y2
4356 10    CONTINUE
4357 !
4358 ! *** NO SUBDIVISION WITH SOLUTION FOUND
4359 !
4360       IF (ABS(Y2) .LT. EPS) THEN   ! X2 is a root
4361          ROOT = X2
4362       ELSE
4363          ROOT = 1.d30
4364          ISLV = 1
4365       ENDIF
4366       GOTO 50
4367 !
4368 ! *** BISECTION *******************************************************
4369 !
4370 20    DO 30 I=1,MAXIT
4371          X3 = 0.5*(X1+X2)
4372 !         Y3 = FUNC (X3)
4373          Y3 = X3**3.d0 + A1*X3**2.0 + A2*X3 + A3
4374          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
4375             Y2    = Y3
4376             X2    = X3
4377          ELSE
4378             Y1    = Y3
4379             X1    = X3
4380          ENDIF
4381          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
4382 30    CONTINUE
4383 !
4384 ! *** CONVERGED ; RETURN ***********************************************
4385 !
4386 40    X3   = 0.5*(X1+X2)
4387 !      Y3   = FUNC (X3)
4388       Y3 = X3**3.d0 + A1*X3**2.0 + A2*X3 + A3
4389       ROOT = X3
4390       ISLV = 0
4391 !
4392 50    RETURN
4393 !
4394 ! *** END OF SUBROUTINE POLY3B *****************************************
4395 !
4396       END SUBROUTINE POLY3B
4397
4398
4399
4400 !cc      PROGRAM DRIVER
4401 !cc      DOUBLE PRECISION ROOT
4402 !ccC
4403 !cc      CALL POLY3 (-1.d0, 1.d0, -1.d0, ROOT, ISLV)
4404 !cc      IF (ISLV.NE.0) STOP 'Error in POLY3'
4405 !cc      WRITE (*,*) 'Root=', ROOT
4406 !ccC
4407 !cc      CALL POLY3B (-1.d0, 1.d0, -1.d0, -10.d0, 10.d0, ROOT, ISLV)
4408 !cc      IF (ISLV.NE.0) STOP 'Error in POLY3B'
4409 !cc      WRITE (*,*) 'Root=', ROOT
4410 !ccC
4411 !cc      END
4412 !=======================================================================
4413 !
4414 ! *** ISORROPIA CODE
4415 ! *** FUNCTION EX10
4416 ! *** 10^X FUNCTION ; ALTERNATE OF LIBRARY ROUTINE ; USED BECAUSE IT IS
4417 !     MUCH FASTER BUT WITHOUT GREAT LOSS IN ACCURACY. ,
4418 !     MAXIMUM ERROR IS 2%, EXECUTION TIME IS 42% OF THE LIBRARY ROUTINE
4419 !     (ON A 80286/80287 MACHINE, using Lahey FORTRAN 77 v.3.0).
4420 !
4421 !     EXPONENT RANGE IS BETWEEN -K AND K (K IS THE REAL ARGUMENT 'K')
4422 !     MAX VALUE FOR K: 9.999
4423 !     IF X < -K, X IS SET TO -K, IF X > K, X IS SET TO K
4424 !
4425 !     THE EXPONENT IS CALCULATED BY THE PRODUCT ADEC*AINT, WHERE ADEC
4426 !     IS THE MANTISSA AND AINT IS THE MAGNITUDE (EXPONENT). BOTH
4427 !     MANTISSA AND MAGNITUDE ARE PRE-CALCULATED AND STORED IN LOOKUP
4428 !     TABLES ; THIS LEADS TO THE INCREASED SPEED.
4429 !
4430 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4431 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4432 ! *** WRITTEN BY ATHANASIOS NENES
4433 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4434 !
4435 !=======================================================================
4436 !
4437       FUNCTION EX10(X,K)
4438         implicit none
4439       REAL    X, EX10, Y, AINT10, ADEC10, K
4440       INTEGER K1, K2
4441       COMMON /EXPNC/ AINT10(20), ADEC10(200)
4442 !
4443 ! *** LIMIT X TO [-K, K] RANGE *****************************************
4444 !
4445       Y    = MAX(-K, MIN(X,K))   ! MIN: -9.999, MAX: 9.999
4446 !
4447 ! *** GET INTEGER AND DECIMAL PART *************************************
4448 !
4449       K1   = INT(Y)
4450       K2   = INT(100*(Y-K1))
4451 !
4452 ! *** CALCULATE EXP FUNCTION *******************************************
4453 !
4454       EX10 = AINT10(K1+10)*ADEC10(K2+100)
4455 !
4456 ! *** END OF EXP FUNCTION **********************************************
4457 !
4458       RETURN
4459     END FUNCTION EX10
4460
4461
4462
4463 !=======================================================================
4464
4465 !=======================================================================
4466 !
4467 ! *** ISORROPIA CODE
4468 ! *** SUBROUTINE PUSHERR
4469 ! *** THIS SUBROUTINE SAVES AN ERROR MESSAGE IN THE ERROR STACK
4470 !
4471 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4472 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4473 ! *** WRITTEN BY ATHANASIOS NENES
4474 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4475 !
4476 !=======================================================================
4477 !
4478       SUBROUTINE PUSHERR (IERR,ERRINF)
4479       implicit none
4480       CHARACTER ERRINF*(*)
4481       INTEGER IERR
4482 !
4483 ! *** SAVE ERROR CODE IF THERE IS ANY SPACE ***************************
4484 !
4485       IF (NOFER.LT.NERRMX) THEN
4486          NOFER         = NOFER + 1
4487          ERRSTK(NOFER) = IERR
4488          ERRMSG(NOFER) = ERRINF
4489          STKOFL        =.FALSE.
4490       ELSE
4491          STKOFL        =.TRUE.      ! STACK OVERFLOW
4492       ENDIF
4493 !
4494 ! *** END OF SUBROUTINE PUSHERR ****************************************
4495 !
4496     END SUBROUTINE PUSHERR
4497
4498
4499
4500 !=======================================================================
4501 !
4502 ! *** ISORROPIA CODE
4503 ! *** SUBROUTINE ISERRINF
4504 ! *** THIS SUBROUTINE OBTAINS A COPY OF THE ERROR STACK (& MESSAGES)
4505 !
4506 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4507 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4508 ! *** WRITTEN BY ATHANASIOS NENES
4509 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4510 !
4511 !=======================================================================
4512 !
4513       SUBROUTINE ISERRINF (ERRSTKI, ERRMSGI, NOFERI, STKOFLI)
4514       implicit none
4515       CHARACTER(len=40) :: ERRMSGI(NERRMX)
4516       INTEGER   ERRSTKI(NERRMX)
4517       LOGICAL   STKOFLI
4518       INTEGER NOFERI
4519       INTEGER I
4520 !      DIMENSION ERRMSGI(NERRMX), ERRSTKI(NERRMX)
4521 !
4522 ! *** OBTAIN WHOLE ERROR STACK ****************************************
4523 !
4524       DO 10 I=1,NOFER              ! Error messages & codes
4525         ERRSTKI(I) = ERRSTK(I)
4526         ERRMSGI(I) = ERRMSG(I)
4527   10  CONTINUE
4528 !
4529       STKOFLI = STKOFL
4530       NOFERI  = NOFER
4531 !
4532       RETURN
4533 !
4534 ! *** END OF SUBROUTINE ISERRINF ***************************************
4535 !
4536       END SUBROUTINE ISERRINF
4537
4538
4539
4540 !=======================================================================
4541 !
4542 ! *** ISORROPIA CODE
4543 ! *** SUBROUTINE ERRSTAT
4544 ! *** THIS SUBROUTINE REPORTS ERROR MESSAGES TO UNIT 'IO'
4545 !
4546 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4547 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4548 ! *** WRITTEN BY ATHANASIOS NENES
4549 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4550 !
4551 !=======================================================================
4552 !
4553       SUBROUTINE ERRSTAT (IO,IERR,ERRINF)
4554       implicit none
4555       CHARACTER CER*4, NCIS*29, NCIF*27, NSIS*26, NSIF*24, ERRINF*(*)
4556       DATA NCIS /'NO CONVERGENCE IN SUBROUTINE '/,&
4557           NCIF /'NO CONVERGENCE IN FUNCTION '  /,&
4558           NSIS /'NO SOLUTION IN SUBROUTINE '   /,&
4559           NSIF /'NO SOLUTION IN FUNCTION '     /
4560       INTEGER IO,IERR,IOK,IEND
4561 !
4562 ! *** WRITE ERROR IN CHARACTER *****************************************
4563 !
4564       WRITE (CER,'(I4)') IERR
4565       CALL RPLSTR (CER, ' ', '0',IOK)   ! REPLACE BLANKS WITH ZEROS
4566       CALL CHRBLN (ERRINF, IEND)        ! LAST POSITION OF ERRINF CHAR
4567 !
4568 ! *** WRITE ERROR TYPE (FATAL, WARNING ) *******************************
4569 !
4570       IF (IERR.EQ.0) THEN
4571          WRITE (IO,1000) 'NO ERRORS DETECTED '
4572          GOTO 10
4573 !
4574       ELSE IF (IERR.LT.0) THEN
4575          WRITE (IO,1000) 'ERROR STACK EXHAUSTED '
4576          GOTO 10
4577 !
4578       ELSE IF (IERR.GT.1000) THEN
4579          WRITE (IO,1100) 'FATAL',CER
4580 !
4581       ELSE
4582          WRITE (IO,1100) 'WARNING',CER
4583       ENDIF
4584 !
4585 ! *** WRITE ERROR MESSAGE **********************************************
4586 !
4587 ! FATAL MESSAGES
4588 !
4589       IF (IERR.EQ.1001) THEN
4590          CALL CHRBLN (SCASE, IEND)
4591          WRITE (IO,1000) 'CASE NOT SUPPORTED IN CALCMR ['//SCASE(1:IEND) //']'
4592 !
4593       ELSEIF (IERR.EQ.1002) THEN
4594          CALL CHRBLN (SCASE, IEND)
4595          WRITE (IO,1000) 'CASE NOT SUPPORTED ['//SCASE(1:IEND)//']'
4596 !
4597 ! WARNING MESSAGES
4598 !
4599       ELSEIF (IERR.EQ.0001) THEN
4600          WRITE (IO,1000) NSIS,ERRINF
4601 !
4602       ELSEIF (IERR.EQ.0002) THEN
4603          WRITE (IO,1000) NCIS,ERRINF
4604 !
4605       ELSEIF (IERR.EQ.0003) THEN
4606          WRITE (IO,1000) NSIF,ERRINF
4607 !
4608       ELSEIF (IERR.EQ.0004) THEN
4609          WRITE (IO,1000) NCIF,ERRINF
4610 !
4611       ELSE IF (IERR.EQ.0019) THEN
4612          WRITE (IO,1000) 'HNO3(aq) AFFECTS H+, WHICH '// &
4613                          'MIGHT AFFECT SO4/HSO4 RATIO'
4614          WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %'
4615 !
4616       ELSE IF (IERR.EQ.0020) THEN
4617          IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN
4618             WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT HNO3,'&
4619                          //'HCL DISSOLUTION'
4620          ELSE
4621             WRITE (IO,1000) 'HSO4-SO4 EQUILIBRIUM MIGHT AFFECT NH3 '&
4622                          //'DISSOLUTION'
4623          ENDIF
4624          WRITE (IO,1000) 'DIRECT DECREASE IN H+ [',ERRINF(1:IEND),'] %'
4625 !
4626       ELSE IF (IERR.EQ.0021) THEN
4627          WRITE (IO,1000) 'HNO3(aq),HCL(aq) AFFECT H+, WHICH '//&
4628                         'MIGHT AFFECT SO4/HSO4 RATIO'
4629          WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %'
4630 !
4631       ELSE IF (IERR.EQ.0022) THEN
4632          WRITE (IO,1000) 'HCL(g) EQUILIBRIUM YIELDS NONPHYSICAL '//&
4633                         'DISSOLUTION'
4634          WRITE (IO,1000) 'A TINY AMOUNT [',ERRINF(1:IEND),'] IS '//&
4635                         'ASSUMED TO BE DISSOLVED'
4636 !
4637       ELSEIF (IERR.EQ.0033) THEN
4638          WRITE (IO,1000) 'HCL(aq) AFFECTS H+, WHICH '//&
4639                         'MIGHT AFFECT SO4/HSO4 RATIO'
4640          WRITE (IO,1000) 'DIRECT INCREASE IN H+ [',ERRINF(1:IEND),'] %'
4641 !
4642       ELSEIF (IERR.EQ.0050) THEN
4643          WRITE (IO,1000) 'TOO MUCH SODIUM GIVEN AS INPUT.'
4644          WRITE (IO,1000) 'REDUCED TO COMPLETELY NEUTRALIZE SO4,Cl,NO3.'
4645          WRITE (IO,1000) 'EXCESS SODIUM IS IGNORED.'
4646 !
4647       ELSE
4648          WRITE (IO,1000) 'NO DIAGNOSTIC MESSAGE AVAILABLE'
4649       ENDIF
4650 !
4651 10    RETURN
4652 !
4653 ! *** FORMAT STATEMENTS *************************************
4654 !
4655 1000  FORMAT (1X,A:A:A:A:A)
4656 1100  FORMAT (1X,A,' ERROR [',A4,']:')
4657 !
4658 ! *** END OF SUBROUTINE ERRSTAT *****************************
4659 !
4660     END SUBROUTINE ERRSTAT
4661 !=======================================================================
4662 !
4663 ! *** ISORROPIA CODE
4664 ! *** SUBROUTINE ISORINF
4665 ! *** THIS SUBROUTINE PROVIDES INFORMATION ABOUT ISORROPIA
4666 !
4667 ! ======================== ARGUMENTS / USAGE ===========================
4668 !
4669 !  OUTPUT:
4670 !  1. [VERSI]
4671 !     CHARACTER*15 variable.
4672 !     Contains version-date information of ISORROPIA
4673 !
4674 !  2. [NCMP]
4675 !     INTEGER variable.
4676 !     The number of components needed in input array WI
4677 !     (or, the number of major species accounted for by ISORROPIA)
4678 !
4679 !  3. [NION]
4680 !     INTEGER variable
4681 !     The number of ions considered in the aqueous phase
4682 !
4683 !  4. [NAQGAS]
4684 !     INTEGER variable
4685 !     The number of undissociated species found in aqueous aerosol
4686 !     phase
4687 !
4688 !  5. [NSOL]
4689 !     INTEGER variable
4690 !     The number of solids considered in the solid aerosol phase
4691 !
4692 !  6. [NERR]
4693 !     INTEGER variable
4694 !     The size of the error stack (maximum number of errors that can
4695 !     be stored before the stack exhausts).
4696 !
4697 !  7. [TIN]
4698 !     DOUBLE PRECISION variable
4699 !     The value used for a very small number.
4700 !
4701 !  8. [GRT]
4702 !     DOUBLE PRECISION variable
4703 !     The value used for a very large number.
4704 !
4705 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4706 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4707 ! *** WRITTEN BY ATHANASIOS NENES
4708 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
4709 !
4710 !=======================================================================
4711 !
4712       SUBROUTINE ISORINF (VERSI, NCMP, NION, NAQGAS, NSOL, NERR, TIN, GRT)
4713       implicit none
4714       integer  NCMP, NION, NAQGAS, NSOL, NERR
4715       REAL(KIND=8) TIN, GRT
4716       CHARACTER VERSI*(*)
4717 !
4718 ! *** ASSIGN INFO *******************************************************
4719 !
4720
4721
4722       VERSI  = VERSION
4723
4724       NCMP   = NCOMP
4725 !      NION   = NIONS
4726       NSOL = 9
4727       NERR = 25
4728       TIN = 9.999999999999999E-021
4729       GRT = 10000000000.0000
4730 !      NAQGAS = NGASAQ
4731 !      NSOL   = NSLDS
4732 !      NERR   = NERRMX
4733 !      TIN    = TINY
4734 !      GRT    = GREAT
4735 !
4736       RETURN
4737 !
4738 ! *** END OF SUBROUTINE ISORINF *******************************************
4739 !
4740     END SUBROUTINE ISORINF
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751 ! ISOREV code
4752
4753 !=======================================================================
4754 !
4755 ! *** ISORROPIA CODE
4756 ! *** SUBROUTINE ISRP1R
4757 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF
4758 !     AN AMMONIUM-SULFATE AEROSOL SYSTEM.
4759 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
4760 !     THE AMBIENT RELATIVE HUMIDITY.
4761 !
4762 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4763 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4764 ! *** WRITTEN BY ATHANASIOS NENES
4765 !
4766 !=======================================================================
4767 !
4768       SUBROUTINE ISRP1R (WI, RHI, TEMPI)
4769    !   implicit none
4770         implicit none
4771       REAL(KIND=8) WI(NCOMP),RHI,TEMPI
4772 !
4773 ! *** INITIALIZE COMMON BLOCK VARIABLES *********************************
4774 !
4775       CALL INIT1 (WI, RHI, TEMPI)
4776 !
4777 ! *** CALCULATE SULFATE RATIO *******************************************
4778 !
4779       IF (RH.GE.DRNH42S4) THEN         ! WET AEROSOL, NEED NH4 AT SRATIO=2.0
4780          SULRATW = GETASR(WAER(2), RHI)     ! AEROSOL SULFATE RATIO
4781       ELSE
4782          SULRATW = 2.0D0                    ! DRY AEROSOL SULFATE RATIO
4783       ENDIF
4784       SULRAT  = WAER(3)/WAER(2)         ! SULFATE RATIO
4785 !
4786 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
4787 !
4788 ! *** SULFATE POOR
4789 !
4790       IF (SULRATW.LE.SULRAT) THEN
4791 !
4792       IF(METSTBL.EQ.1) THEN
4793          SCASE = 'K2'
4794          CALL CALCK2                 ! Only liquid (metastable)
4795       ELSE
4796 !
4797          IF (RH.LT.DRNH42S4) THEN
4798             SCASE = 'K1'
4799             CALL CALCK1              ! NH42SO4              ; case K1
4800 !
4801          ELSEIF (DRNH42S4.LE.RH) THEN
4802             SCASE = 'K2'
4803             CALL CALCK2              ! Only liquid          ; case K2
4804          ENDIF
4805       ENDIF
4806 !
4807 ! *** SULFATE RICH (NO ACID)
4808 !
4809       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN
4810       W(2) = WAER(2)
4811       W(3) = WAER(3)
4812 !
4813       IF(METSTBL.EQ.1) THEN
4814          SCASE = 'B4'
4815          CALL CALCB4                 ! Only liquid (metastable)
4816          SCASE = 'L4'
4817       ELSE
4818 !
4819          IF (RH.LT.DRNH4HS4) THEN
4820             SCASE = 'B1'
4821             CALL CALCB1              ! NH4HSO4,LC,NH42SO4   ; case B1
4822             SCASE = 'L1'
4823 !
4824          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
4825             SCASE = 'B2'
4826             CALL CALCB2              ! LC,NH42S4            ; case B2
4827             SCASE = 'L2'
4828 !
4829          ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
4830             SCASE = 'B3'
4831             CALL CALCB3              ! NH42S4               ; case B3
4832             SCASE = 'L3'
4833 !
4834          ELSEIF (DRNH42S4.LE.RH) THEN
4835             SCASE = 'B4'
4836             CALL CALCB4              ! Only liquid          ; case B4
4837             SCASE = 'L4'
4838          ENDIF
4839       ENDIF
4840 !
4841       CALL CALCNH3P          ! Compute NH3(g)
4842 !
4843 ! *** SULFATE RICH (FREE ACID)
4844 !
4845       ELSEIF (SULRAT.LT.1.0) THEN
4846       W(2) = WAER(2)
4847       W(3) = WAER(3)
4848 !
4849       IF(METSTBL.EQ.1) THEN
4850          SCASE = 'C2'
4851          CALL CALCC2                 ! Only liquid (metastable)
4852          SCASE = 'M2'
4853       ELSE
4854 !
4855          IF (RH.LT.DRNH4HS4) THEN
4856             SCASE = 'C1'
4857             CALL CALCC1              ! NH4HSO4              ; case C1
4858             SCASE = 'M1'
4859 !
4860          ELSEIF (DRNH4HS4.LE.RH) THEN
4861             SCASE = 'C2'
4862             CALL CALCC2              ! Only liquid          ; case C2
4863             SCASE = 'M2'
4864          ENDIF
4865       ENDIF
4866 !
4867       CALL CALCNH3P
4868 !
4869       ENDIF
4870       RETURN
4871 !
4872 ! *** END OF SUBROUTINE ISRP1R *****************************************
4873 !
4874     END SUBROUTINE ISRP1R
4875
4876
4877 !=======================================================================
4878 !
4879 ! *** ISORROPIA CODE
4880 ! *** SUBROUTINE ISRP2R
4881 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF
4882 !     AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM.
4883 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
4884 !     THE AMBIENT RELATIVE HUMIDITY.
4885 !
4886 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4887 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
4888 ! *** WRITTEN BY ATHANASIOS NENES
4889 !
4890 !=======================================================================
4891 !
4892       SUBROUTINE ISRP2R (WI, RHI, TEMPI)
4893       !implicit none
4894         implicit none
4895       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
4896       LOGICAL   TRYLIQ
4897 !
4898 ! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
4899 !
4900       TRYLIQ = .TRUE.             ! Assume liquid phase, sulfate poor limit
4901 !
4902 10    CALL INIT2 (WI, RHI, TEMPI)
4903 !
4904 ! *** CALCULATE SULFATE RATIO *******************************************
4905 !
4906       IF (TRYLIQ .AND. RH.GE.DRNH4NO3) THEN ! *** WET AEROSOL
4907          SULRATW = GETASR(WAER(2), RHI)     ! LIMITING SULFATE RATIO
4908       ELSE
4909          SULRATW = 2.0D0                    ! *** DRY AEROSOL
4910       ENDIF
4911       SULRAT = WAER(3)/WAER(2)
4912 !
4913 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
4914 !
4915 ! *** SULFATE POOR
4916 !
4917       IF (SULRATW.LE.SULRAT) THEN
4918 !
4919       IF(METSTBL.EQ.1) THEN
4920          SCASE = 'N3'
4921          CALL CALCN3                 ! Only liquid (metastable)
4922       ELSE
4923 !
4924          IF (RH.LT.DRNH4NO3) THEN
4925             SCASE = 'N1'
4926             CALL CALCN1              ! NH42SO4,NH4NO3       ; case N1
4927 !
4928          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH42S4) THEN
4929             SCASE = 'N2'
4930             CALL CALCN2              ! NH42S4               ; case N2
4931 !
4932          ELSEIF (DRNH42S4.LE.RH) THEN
4933             SCASE = 'N3'
4934             CALL CALCN3              ! Only liquid          ; case N3
4935          ENDIF
4936       ENDIF
4937 !
4938 ! *** SULFATE RICH (NO ACID)
4939 !
4940 !     FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE
4941 !     ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE
4942 !     AEROSOL EQUILIBRIUM.
4943 !
4944       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN
4945       W(2) = WAER(2)
4946       W(3) = WAER(3)
4947       W(4) = WAER(4)
4948 !
4949       IF(METSTBL.EQ.1) THEN
4950          SCASE = 'B4'
4951          CALL CALCB4                 ! Only liquid (metastable)
4952          SCASE = 'O4'
4953       ELSE
4954 !
4955          IF (RH.LT.DRNH4HS4) THEN
4956             SCASE = 'B1'
4957             CALL CALCB1              ! NH4HSO4,LC,NH42SO4   ; case O1
4958             SCASE = 'O1'
4959 !
4960          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
4961             SCASE = 'B2'
4962             CALL CALCB2              ! LC,NH42S4            ; case O2
4963             SCASE = 'O2'
4964 !
4965          ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
4966             SCASE = 'B3'
4967             CALL CALCB3              ! NH42S4               ; case O3
4968             SCASE = 'O3'
4969 !
4970          ELSEIF (DRNH42S4.LE.RH) THEN
4971             SCASE = 'B4'
4972             CALL CALCB4              ! Only liquid          ; case O4
4973             SCASE = 'O4'
4974          ENDIF
4975       ENDIF
4976 !
4977 ! *** Add the NO3 to the solution now and calculate partitioning.
4978 !
4979       MOLAL(7) = WAER(4)             ! There is always water, so NO3(aer) is NO3-
4980       MOLAL(1) = MOLAL(1) + WAER(4)  ! Add H+ to balance out
4981       CALL CALCNAP            ! HNO3, NH3 dissolved
4982       CALL CALCNH3P
4983 !
4984 ! *** SULFATE RICH (FREE ACID)
4985 !
4986 !     FOR SOLVING THIS CASE, NITRIC ACID AND AMMONIA IN THE GAS PHASE ARE
4987 !     ASSUMED A MINOR SPECIES, THAT DO NOT SIGNIFICANTLY AFFECT THE
4988 !     AEROSOL EQUILIBRIUM.
4989 !
4990       ELSEIF (SULRAT.LT.1.0) THEN
4991       W(2) = WAER(2)
4992       W(3) = WAER(3)
4993       W(4) = WAER(4)
4994 !
4995       IF(METSTBL.EQ.1) THEN
4996          SCASE = 'C2'
4997          CALL CALCC2                 ! Only liquid (metastable)
4998          SCASE = 'P2'
4999       ELSE
5000 !
5001          IF (RH.LT.DRNH4HS4) THEN
5002             SCASE = 'C1'
5003             CALL CALCC1              ! NH4HSO4              ; case P1
5004             SCASE = 'P1'
5005 !
5006          ELSEIF (DRNH4HS4.LE.RH) THEN
5007             SCASE = 'C2'
5008             CALL CALCC2              ! Only liquid          ; case P2
5009             SCASE = 'P2'
5010          ENDIF
5011       ENDIF
5012 !
5013 ! *** Add the NO3 to the solution now and calculate partitioning.
5014 !
5015       MOLAL(7) = WAER(4)             ! There is always water, so NO3(aer) is NO3-
5016       MOLAL(1) = MOLAL(1) + WAER(4)  ! Add H+ to balance out
5017 !
5018       CALL CALCNAP                   ! HNO3, NH3 dissolved
5019       CALL CALCNH3P
5020       ENDIF
5021 !
5022 ! *** IF SULRATW < SULRAT < 2.0 and WATER = 0 => SULFATE RICH CASE.
5023 !
5024       IF (SULRATW.LE.SULRAT .AND. SULRAT.LT.2.0 .AND. WATER.LE.TINY) THEN
5025           TRYLIQ = .FALSE.
5026           GOTO 10
5027       ENDIF
5028 !
5029       RETURN
5030 !
5031 ! *** END OF SUBROUTINE ISRP2R *****************************************
5032 !
5033       END SUBROUTINE ISRP2R
5034 !=======================================================================
5035 !
5036 ! *** ISORROPIA CODE
5037 ! *** SUBROUTINE ISRP3R
5038 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE REVERSE PROBLEM OF
5039 !     AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM.
5040 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM
5041 !     RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY.
5042 !
5043 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5044 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5045 ! *** WRITTEN BY ATHANASIOS NENES
5046       !
5047 !=======================================================================
5048 !
5049       SUBROUTINE ISRP3R (WI, RHI, TEMPI)
5050       !implicit none
5051       implicit none
5052       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
5053       LOGICAL   TRYLIQ
5054       INTEGER I
5055 !cC
5056 !cC *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE ***********************
5057 !cC
5058 !c      WI(3) = MAX (WI(3), 1.D-10)  ! NH4+ : 1e-4 umoles/m3
5059 !c      WI(5) = MAX (WI(5), 1.D-10)  ! Cl-  : 1e-4 umoles/m3
5060 !
5061 ! *** INITIALIZE ALL VARIABLES ******************************************
5062 !
5063       TRYLIQ = .TRUE.             ! Use liquid phase sulfate poor limit
5064 !
5065 10    CALL ISOINIT3 (WI, RHI, TEMPI) ! COMMON block variables
5066 !cC
5067 !cC *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE *********
5068 !cC
5069 !c      REST = 2.D0*WAER(2) + WAER(4) + WAER(5)
5070 !c      IF (WAER(1).GT.REST) THEN            ! NA > 2*SO4+CL+NO3 ?
5071 !c         WAER(1) = (ONE-1D-6)*REST         ! Adjust Na amount
5072 !c         CALL PUSHERR (0050, 'ISRP3R')     ! Warning error: Na adjusted
5073 !c      ENDIF
5074 !
5075 ! *** CALCULATE SULFATE & SODIUM RATIOS *********************************
5076 !
5077       IF (TRYLIQ .AND. RH.GE.DRNH4NO3) THEN  ! ** WET AEROSOL
5078          FRSO4   = WAER(2) - WAER(1)/2.0D0     ! SULFATE UNBOUND BY SODIUM
5079          FRSO4   = MAX(FRSO4, TINY)
5080          SRI     = GETASR(FRSO4, RHI)          ! SULFATE RATIO FOR NH4+
5081          SULRATW = (WAER(1)+FRSO4*SRI)/WAER(2) ! LIMITING SULFATE RATIO
5082          SULRATW = MIN (SULRATW, 2.0D0)
5083       ELSE
5084          SULRATW = 2.0D0                     ! ** DRY AEROSOL
5085       ENDIF
5086       SULRAT = (WAER(1)+WAER(3))/WAER(2)
5087       SODRAT = WAER(1)/WAER(2)
5088 !
5089 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
5090 !
5091 ! *** SULFATE POOR ; SODIUM POOR
5092 !
5093       IF (SULRATW.LE.SULRAT .AND. SODRAT.LT.2.0) THEN
5094 !
5095       IF(METSTBL.EQ.1) THEN
5096          SCASE = 'Q5'
5097          CALL CALCQ5                 ! Only liquid (metastable)
5098          SCASE = 'Q5'
5099       ELSE
5100 !
5101          IF (RH.LT.DRNH4NO3) THEN
5102             SCASE = 'Q1'
5103             CALL CALCQ1              ! NH42SO4,NH4NO3,NH4CL,NA2SO4
5104 !
5105          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN
5106             SCASE = 'Q2'
5107             CALL CALCQ2              ! NH42SO4,NH4CL,NA2SO4
5108 !
5109          ELSEIF (DRNH4CL.LE.RH  .AND. RH.LT.DRNH42S4) THEN
5110             SCASE = 'Q3'
5111             CALL CALCQ3              ! NH42SO4,NA2SO4
5112 !
5113         ELSEIF (DRNH42S4.LE.RH  .AND. RH.LT.DRNA2SO4) THEN
5114             SCASE = 'Q4'
5115             CALL CALCQ4              ! NA2SO4
5116             SCASE = 'Q4'
5117 !
5118          ELSEIF (DRNA2SO4.LE.RH) THEN
5119             SCASE = 'Q5'
5120             CALL CALCQ5              ! Only liquid
5121             SCASE = 'Q5'
5122          ENDIF
5123       ENDIF
5124 !
5125 ! *** SULFATE POOR ; SODIUM RICH
5126 !
5127       ELSE IF (SULRAT.GE.SULRATW .AND. SODRAT.GE.2.0) THEN
5128 !
5129       IF(METSTBL.EQ.1) THEN
5130          SCASE = 'R6'
5131          CALL CALCR6                 ! Only liquid (metastable)
5132          SCASE = 'R6'
5133       ELSE
5134 !
5135          IF (RH.LT.DRNH4NO3) THEN
5136             SCASE = 'R1'
5137             CALL CALCR1              ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3
5138 !
5139          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN
5140             SCASE = 'R2'
5141             CALL CALCR2              ! NH4CL,NA2SO4,NACL,NANO3
5142 !
5143          ELSEIF (DRNANO3.LE.RH  .AND. RH.LT.DRNACL) THEN
5144             SCASE = 'R3'
5145             CALL CALCR3              ! NH4CL,NA2SO4,NACL
5146 !
5147          ELSEIF (DRNACL.LE.RH   .AND. RH.LT.DRNH4CL) THEN
5148             SCASE = 'R4'
5149             CALL CALCR4              ! NH4CL,NA2SO4
5150 !
5151          ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNA2SO4) THEN
5152             SCASE = 'R5'
5153             CALL CALCR5              ! NA2SO4
5154             SCASE = 'R5'
5155 !
5156          ELSEIF (DRNA2SO4.LE.RH) THEN
5157             SCASE = 'R6'
5158             CALL CALCR6              ! NO SOLID
5159             SCASE = 'R6'
5160          ENDIF
5161       ENDIF
5162 !
5163 ! *** SULFATE RICH (NO ACID)
5164 !
5165       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.SULRATW) THEN
5166       DO 100 I=1,NCOMP
5167          W(I) = WAER(I)
5168 100   CONTINUE
5169 !
5170       IF(METSTBL.EQ.1) THEN
5171          SCASE = 'I6'
5172          CALL CALCI6                 ! Only liquid (metastable)
5173          SCASE = 'S6'
5174       ELSE
5175 !
5176          IF (RH.LT.DRNH4HS4) THEN
5177             SCASE = 'I1'
5178             CALL CALCI1              ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC
5179             SCASE = 'S1'
5180 !
5181          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
5182             SCASE = 'I2'
5183             CALL CALCI2              ! NA2SO4,(NH4)2SO4,NAHSO4,LC
5184             SCASE = 'S2'
5185 !
5186          ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN
5187             SCASE = 'I3'
5188             CALL CALCI3              ! NA2SO4,(NH4)2SO4,LC
5189             SCASE = 'S3'
5190 !
5191          ELSEIF (DRLC.LE.RH     .AND. RH.LT.DRNH42S4) THEN
5192             SCASE = 'I4'
5193             CALL CALCI4              ! NA2SO4,(NH4)2SO4
5194             SCASE = 'S4'
5195 !
5196          ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
5197             SCASE = 'I5'
5198             CALL CALCI5              ! NA2SO4
5199             SCASE = 'S5'
5200 !
5201          ELSEIF (DRNA2SO4.LE.RH) THEN
5202             SCASE = 'I6'
5203             CALL CALCI6              ! NO SOLIDS
5204             SCASE = 'S6'
5205          ENDIF
5206       ENDIF
5207 !
5208       CALL CALCNHP                ! HNO3, NH3, HCL in gas phase
5209       CALL CALCNH3P
5210 !
5211 ! *** SULFATE RICH (FREE ACID)
5212 !
5213       ELSEIF (SULRAT.LT.1.0) THEN
5214       DO 200 I=1,NCOMP
5215          W(I) = WAER(I)
5216 200   CONTINUE
5217 !
5218       IF(METSTBL.EQ.1) THEN
5219          SCASE = 'J3'
5220          CALL CALCJ3                 ! Only liquid (metastable)
5221          SCASE = 'T3'
5222       ELSE
5223 !
5224          IF (RH.LT.DRNH4HS4) THEN
5225             SCASE = 'J1'
5226             CALL CALCJ1              ! NH4HSO4,NAHSO4
5227             SCASE = 'T1'
5228 !
5229          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
5230             SCASE = 'J2'
5231             CALL CALCJ2              ! NAHSO4
5232             SCASE = 'T2'
5233 !
5234          ELSEIF (DRNAHSO4.LE.RH) THEN
5235             SCASE = 'J3'
5236             CALL CALCJ3
5237             SCASE = 'T3'
5238          ENDIF
5239       ENDIF
5240 !
5241       CALL CALCNHP                ! HNO3, NH3, HCL in gas phase
5242       CALL CALCNH3P
5243 !
5244       ENDIF
5245 !
5246 ! *** IF AFTER CALCULATIONS, SULRATW < SULRAT < 2.0
5247 !                            and WATER = 0          => SULFATE RICH CASE.
5248 !
5249       IF (SULRATW.LE.SULRAT .AND. SULRAT.LT.2.0 .AND. WATER.LE.TINY) THEN
5250           TRYLIQ = .FALSE.
5251           GOTO 10
5252       ENDIF
5253 !
5254       RETURN
5255 !
5256 ! *** END OF SUBROUTINE ISRP3R *****************************************
5257 !
5258    END SUBROUTINE ISRP3R
5259
5260
5261
5262 !=======================================================================
5263 !
5264 ! *** ISORROPIA CODE
5265 ! *** SUBROUTINE CALCK2
5266 ! *** CASE K2
5267 !
5268 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5269 !     1. SULFATE POOR (SULRAT > 2.0)
5270 !     2. LIQUID AEROSOL PHASE ONLY POSSIBLE
5271 !
5272 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5273 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5274 ! *** WRITTEN BY ATHANASIOS NENES
5275 !
5276 !=======================================================================
5277 !
5278       SUBROUTINE CALCK2
5279       implicit none
5280       REAL(KIND=8) NH4I, NH3GI, NH3AQ
5281       REAL(KIND=8) AKW, SO4I, HSO4I,  HI, OHI, DEL
5282       INTEGER I
5283 !
5284 ! *** SETUP PARAMETERS ************************************************
5285 !
5286       CALAOU   =.TRUE.     ! Outer loop activity calculation flag
5287       FRST     =.TRUE.
5288       CALAIN   =.TRUE.
5289 !
5290 ! *** CALCULATE WATER CONTENT *****************************************
5291 !
5292       MOLALR(4)= MIN(WAER(2), 0.5d0*WAER(3))
5293       WATER    = MOLALR(4)/M0(4)  ! ZSR correlation
5294 !
5295 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5296 !
5297       DO 10 I=1,NSWEEP
5298 !C         A21  = XK21*WATER*R*TEMP
5299          A2   = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2.
5300          AKW  = XKW *RH*WATER*WATER
5301 !
5302          NH4I = WAER(3)
5303          SO4I = WAER(2)
5304          HSO4I= ZERO
5305 !
5306          CALL CALCPH (2.D0*SO4I - NH4I, HI, OHI)    ! Get pH
5307 !
5308          NH3AQ = ZERO                               ! AMMONIA EQUILIBRIUM
5309          IF (HI.LT.OHI) THEN
5310             CALL CALCAMAQ (NH4I, OHI, DEL)
5311             NH4I  = MAX (NH4I-DEL, ZERO)
5312             OHI   = MAX (OHI -DEL, TINY)
5313             NH3AQ = DEL
5314             HI    = AKW/OHI
5315          ENDIF
5316 !
5317          CALL CALCHS4 (HI, SO4I, ZERO, DEL)         ! SULFATE EQUILIBRIUM
5318          SO4I  = SO4I - DEL
5319          HI    = HI   - DEL
5320          HSO4I = DEL
5321 !
5322          NH3GI = NH4I/HI/A2   !    NH3AQ/A21
5323 !
5324 ! *** SPECIATION & WATER CONTENT ***************************************
5325 !
5326          MOLAL(1) = HI
5327          MOLAL(3) = NH4I
5328          MOLAL(5) = SO4I
5329          MOLAL(6) = HSO4I
5330          COH      = OHI
5331          GASAQ(1) = NH3AQ
5332          GNH3     = NH3GI
5333 !
5334 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5335 !
5336          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5337             CALL CALCACT
5338          ELSE
5339             GOTO 20
5340          ENDIF
5341 10    CONTINUE
5342 !
5343 20    RETURN
5344 !
5345 ! *** END OF SUBROUTINE CALCK2 ****************************************
5346 !
5347        END SUBROUTINE CALCK2
5348 !=======================================================================
5349 !
5350 ! *** ISORROPIA CODE
5351 ! *** SUBROUTINE CALCK1
5352 ! *** CASE K1
5353 !
5354 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5355 !     1. SULFATE POOR (SULRAT > 2.0)
5356 !     2. SOLID AEROSOL ONLY
5357 !     3. SOLIDS POSSIBLE : (NH4)2SO4
5358 !
5359 !     A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4
5360 !     IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN
5361 !     THE GAS PHASE.
5362 !
5363 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5364 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5365 ! *** WRITTEN BY ATHANASIOS NENES
5366 !
5367 !=======================================================================
5368 !
5369       SUBROUTINE CALCK1
5370       implicit none
5371 !
5372       CNH42S4 = MIN(WAER(2),0.5d0*WAER(3))  ! For bad input problems
5373       GNH3    = ZERO
5374 !
5375       W(2)    = CNH42S4
5376       W(3)    = 2.D0*CNH42S4 + GNH3
5377 !
5378       RETURN
5379 !
5380 ! *** END OF SUBROUTINE CALCK1 ******************************************
5381 !
5382     END SUBROUTINE CALCK1
5383
5384
5385 !=======================================================================
5386 !
5387 ! *** ISORROPIA CODE
5388 ! *** SUBROUTINE CALCN3
5389 ! *** CASE N3
5390 !
5391 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5392 !     1. SULFATE POOR (SULRAT > 2.0)
5393 !     2. THERE IS ONLY A LIQUID PHASE
5394 !
5395 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5396 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5397 ! *** WRITTEN BY ATHANASIOS NENES
5398 !
5399 !=======================================================================
5400 !
5401       SUBROUTINE CALCN3
5402       implicit none
5403       REAL(KIND=8) NH4I, NO3I, NH3AQ, NO3AQ
5404       REAL(KIND=8) AML5, AKW, SO4I, HSO4I, HI, OHI, GG, DEL
5405       INTEGER I
5406 !
5407 ! *** SETUP PARAMETERS ************************************************
5408 !
5409       CALAOU =.TRUE.              ! Outer loop activity calculation flag
5410       FRST   =.TRUE.
5411       CALAIN =.TRUE.
5412 !
5413 ! *** AEROSOL WATER CONTENT
5414 !
5415       MOLALR(4) = MIN(WAER(2),0.5d0*WAER(3))       ! (NH4)2SO4
5416       AML5      = MAX(WAER(3)-2.D0*MOLALR(4),ZERO) ! "free" NH4
5417       MOLALR(5) = MAX(MIN(AML5,WAER(4)), ZERO)     ! NH4NO3=MIN("free",NO3)
5418       WATER     = MOLALR(4)/M0(4) + MOLALR(5)/M0(5)
5419       WATER     = MAX(WATER, TINY)
5420 !
5421 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5422 !
5423       DO 10 I=1,NSWEEP
5424          A2    = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2.
5425 !C         A21   = XK21*WATER*R*TEMP
5426          A3    = XK4*R*TEMP*(WATER/GAMA(10))**2.0
5427          A4    = XK7*(WATER/GAMA(4))**3.0
5428          AKW   = XKW *RH*WATER*WATER
5429 !
5430 ! ION CONCENTRATIONS
5431 !
5432          NH4I  = WAER(3)
5433          NO3I  = WAER(4)
5434          SO4I  = WAER(2)
5435          HSO4I = ZERO
5436 !
5437          CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI)
5438 !
5439 ! AMMONIA ASSOCIATION EQUILIBRIUM
5440 !
5441          NH3AQ = ZERO
5442          NO3AQ = ZERO
5443          GG    = 2.D0*SO4I + NO3I - NH4I
5444          IF (HI.LT.OHI) THEN
5445             CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
5446             HI    = AKW/OHI
5447          ELSE
5448             HI    = ZERO
5449             CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3
5450 !
5451 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
5452 !
5453             CALL CALCHS4 (HI, SO4I, ZERO, DEL)
5454             SO4I  = SO4I  - DEL
5455             HI    = HI    - DEL
5456             HSO4I = DEL
5457             OHI   = AKW/HI
5458          ENDIF
5459 !
5460 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
5461 !
5462          MOLAL (1) = HI
5463          MOLAL (3) = NH4I
5464          MOLAL (5) = SO4I
5465          MOLAL (6) = HSO4I
5466          MOLAL (7) = NO3I
5467          COH       = OHI
5468 !
5469          CNH42S4   = ZERO
5470          CNH4NO3   = ZERO
5471 !
5472          GASAQ(1)  = NH3AQ
5473          GASAQ(3)  = NO3AQ
5474 !
5475          GHNO3     = HI*NO3I/A3
5476          GNH3      = NH4I/HI/A2   !   NH3AQ/A21
5477 !
5478 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ******************
5479 !
5480          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5481             CALL CALCACT
5482          ELSE
5483             GOTO 20
5484          ENDIF
5485 10    CONTINUE
5486 !
5487 ! *** RETURN ***********************************************************
5488 !
5489 20    RETURN
5490 !
5491 ! *** END OF SUBROUTINE CALCN3 *****************************************
5492 !
5493       END SUBROUTINE CALCN3
5494 !=======================================================================
5495 !
5496 ! *** ISORROPIA CODE
5497 ! *** SUBROUTINE CALCN2
5498 ! *** CASE N2
5499 !
5500 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5501 !     1. SULFATE POOR (SULRAT > 2.0)
5502 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
5503 !     3. SOLIDS POSSIBLE : (NH4)2SO4
5504 !
5505 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5506 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5507 ! *** WRITTEN BY ATHANASIOS NENES
5508 !
5509 !=======================================================================
5510 !
5511       SUBROUTINE CALCN2
5512       implicit none
5513       REAL(KIND=8) PSI1LO, PSI1HI, YLO, YHI, DX, X1, X2, X3, Y1, Y2, Y3
5514       REAL(KIND=8) P4, YY
5515       INTEGER I
5516 !
5517 ! *** SETUP PARAMETERS ************************************************
5518 !
5519       CHI1   = MIN(WAER(2),0.5d0*WAER(3))     ! (NH4)2SO4
5520       CHI2   = MAX(WAER(3) - 2.D0*CHI1, ZERO) ! "Free" NH4+
5521       CHI3   = MAX(WAER(4) - CHI2, ZERO)      ! "Free" NO3
5522 !
5523       PSI2   = CHI2
5524       PSI3   = CHI3
5525 !
5526       CALAOU = .TRUE.              ! Outer loop activity calculation flag
5527       PSI1LO = TINY                ! Low  limit
5528       PSI1HI = CHI1                ! High limit
5529 !
5530 ! *** INITIAL VALUES FOR BISECTION ************************************
5531 !
5532       X1 = PSI1HI
5533       Y1 = FUNCN2 (X1)
5534       IF (Y1.LE.EPS) RETURN   ! IF (ABS(Y1).LE.EPS .OR. Y1.LE.ZERO) RETURN
5535       YHI= Y1                 ! Save Y-value at HI position
5536 !
5537 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
5538 !
5539       DX = (PSI1HI-PSI1LO)/FLOAT(NDIV)
5540       DO 10 I=1,NDIV
5541          X2 = MAX(X1-DX, ZERO)
5542          Y2 = FUNCN2 (X2)
5543          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
5544          X1 = X2
5545          Y1 = Y2
5546 10    CONTINUE
5547 !
5548 ! *** NO SUBDIVISION WITH SOLUTION FOUND
5549 !
5550       YLO= Y1                      ! Save Y-value at Hi position
5551       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
5552          RETURN
5553 !
5554 ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3
5555 !
5556       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
5557          P4 = CHI4
5558          YY = FUNCN2(P4)
5559          GOTO 50
5560 !
5561 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3
5562 !
5563       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
5564          P4 = TINY
5565          YY = FUNCN2(P4)
5566          GOTO 50
5567       ELSE
5568          CALL PUSHERR (0001, 'CALCN2')    ! WARNING ERROR: NO SOLUTION
5569          RETURN
5570       ENDIF
5571 !
5572 ! *** PERFORM BISECTION ***********************************************
5573 !
5574 20    DO 30 I=1,MAXIT
5575          X3 = 0.5*(X1+X2)
5576          Y3 = FUNCN2 (X3)
5577          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
5578             Y2    = Y3
5579             X2    = X3
5580          ELSE
5581             Y1    = Y3
5582             X1    = X3
5583          ENDIF
5584          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
5585 30    CONTINUE
5586       CALL PUSHERR (0002, 'CALCN2')    ! WARNING ERROR: NO CONVERGENCE
5587 !
5588 ! *** CONVERGED ; RETURN **********************************************
5589 !
5590 40    X3 = 0.5*(X1+X2)
5591       Y3 = FUNCN2 (X3)
5592 50    CONTINUE
5593       RETURN
5594 !
5595 ! *** END OF SUBROUTINE CALCN2 ******************************************
5596 !
5597     END SUBROUTINE CALCN2
5598
5599
5600
5601 !======================================================================
5602 !
5603 ! *** ISORROPIA CODE
5604 ! *** FUNCTION FUNCN2
5605 ! *** CASE D2
5606 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ;
5607 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCN2.
5608 !
5609 !=======================================================================
5610 !
5611       REAL(KIND=8) FUNCTION FUNCN2 (P1)
5612       implicit none
5613       REAL(KIND=8) P1
5614       REAL(KIND=8)  NH4I, NO3I, NH3AQ, NO3AQ
5615       REAL(KIND=8) AKW, SO4I, HSO4I, HI, OHI, GG, DEL
5616       INTEGER I
5617 !
5618 ! *** SETUP PARAMETERS ************************************************
5619 !
5620       FRST   = .TRUE.
5621       CALAIN = .TRUE.
5622       PSI1   = P1
5623 !
5624 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5625 !
5626       DO 10 I=1,NSWEEP
5627          A2    = XK2 *R*TEMP/XKW/RH*(GAMA(8)/GAMA(9))**2.
5628 !C         A21   = XK21*WATER*R*TEMP
5629          A3    = XK4*R*TEMP*(WATER/GAMA(10))**2.0
5630          A4    = XK7*(WATER/GAMA(4))**3.0
5631          AKW   = XKW *RH*WATER*WATER
5632 !
5633 ! ION CONCENTRATIONS
5634 !
5635          NH4I  = 2.D0*PSI1 + PSI2
5636          NO3I  = PSI2 + PSI3
5637          SO4I  = PSI1
5638          HSO4I = ZERO
5639 !
5640          CALL CALCPH (2.D0*SO4I + NO3I - NH4I, HI, OHI)
5641 !
5642 ! AMMONIA ASSOCIATION EQUILIBRIUM
5643 !
5644          NH3AQ = ZERO
5645          NO3AQ = ZERO
5646          GG    = 2.D0*SO4I + NO3I - NH4I
5647          IF (HI.LT.OHI) THEN
5648             CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
5649             HI    = AKW/OHI
5650          ELSE
5651             HI    = ZERO
5652             CALL CALCNIAQ2 (GG, NO3I, HI, NO3AQ) ! HNO3
5653 !
5654 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
5655 !
5656             CALL CALCHS4 (HI, SO4I, ZERO, DEL)
5657             SO4I  = SO4I  - DEL
5658             HI    = HI    - DEL
5659             HSO4I = DEL
5660             OHI   = AKW/HI
5661          ENDIF
5662 !
5663 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
5664 !
5665          MOLAL (1) = HI
5666          MOLAL (3) = NH4I
5667          MOLAL (5) = SO4I
5668          MOLAL (6) = HSO4I
5669          MOLAL (7) = NO3I
5670          COH       = OHI
5671 !
5672          CNH42S4   = CHI1 - PSI1
5673          CNH4NO3   = ZERO
5674 !
5675          GASAQ(1)  = NH3AQ
5676          GASAQ(3)  = NO3AQ
5677 !
5678          GHNO3     = HI*NO3I/A3
5679          GNH3      = NH4I/HI/A2   !   NH3AQ/A21
5680 !
5681 ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
5682 !
5683          CALL CALCMR
5684 !
5685 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5686 !
5687          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5688             CALL CALCACT
5689          ELSE
5690             GOTO 20
5691          ENDIF
5692 10    CONTINUE
5693 !
5694 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
5695 !
5696 20    FUNCN2= NH4I*NH4I*SO4I/A4 - ONE
5697       RETURN
5698 !
5699 ! *** END OF FUNCTION FUNCN2 ********************************************
5700 !
5701     END FUNCTION FUNCN2
5702 !=======================================================================
5703 !
5704 ! *** ISORROPIA CODE
5705 ! *** SUBROUTINE CALCN1
5706 ! *** CASE N1
5707 !
5708 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5709 !     1. SULFATE POOR (SULRAT > 2.0)
5710 !     2. SOLID AEROSOL ONLY
5711 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
5712 !
5713 !     THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY:
5714 !     1. RH < MDRH  ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCN1A)
5715 !     2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
5716 !
5717 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5718 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5719 ! *** WRITTEN BY ATHANASIOS NENES
5720 !
5721 !=======================================================================
5722 !
5723       SUBROUTINE CALCN1
5724       implicit none
5725 !      EXTERNAL CALCN1A, CALCN2
5726 !
5727 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
5728 !
5729       IF (RH.LT.DRMASAN) THEN
5730          SCASE = 'N1 ; SUBCASE 1'
5731          CALL CALCN1A              ! SOLID PHASE ONLY POSSIBLE
5732          SCASE = 'N1 ; SUBCASE 1'
5733       ELSE
5734          SCASE = 'N1 ; SUBCASE 2'
5735          CALL CALCMDRP (RH, DRMASAN, DRNH4NO3, CALCN1A, CALCN2)
5736          SCASE = 'N1 ; SUBCASE 2'
5737       ENDIF
5738 !
5739       RETURN
5740 !
5741 ! *** END OF SUBROUTINE CALCN1 ******************************************
5742 !
5743     END SUBROUTINE CALCN1
5744
5745
5746
5747 !=======================================================================
5748 !
5749 ! *** ISORROPIA CODE
5750 ! *** SUBROUTINE CALCN1A
5751 ! *** CASE N1 ; SUBCASE 1
5752 !
5753 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5754 !     1. SULFATE POOR (SULRAT > 2.0)
5755 !     2. SOLID AEROSOL ONLY
5756 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
5757 !
5758 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5759 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5760 ! *** WRITTEN BY ATHANASIOS NENES
5761 !
5762 !=======================================================================
5763 !
5764       SUBROUTINE CALCN1A
5765       implicit none
5766
5767 !
5768 ! *** SETUP PARAMETERS *************************************************
5769 !
5770 !CC      A1      = XK10/R/TEMP/R/TEMP
5771 !
5772 ! *** CALCULATE AEROSOL COMPOSITION ************************************
5773 !
5774 !CC      CHI1    = 2.D0*WAER(4)        ! Free parameter ; arbitrary value.
5775       PSI1    = WAER(4)
5776 !
5777 ! *** The following statment is here to avoid negative NH4+ values in
5778 !     CALCN? routines that call CALCN1A
5779 !
5780       PSI2    = MAX(MIN(WAER(2),0.5d0*(WAER(3)-PSI1)),TINY)
5781 !
5782       CNH4NO3 = PSI1
5783       CNH42S4 = PSI2
5784 !
5785 !CC      GNH3    = CHI1 + PSI1 + 2.0*PSI2
5786 !CC      GHNO3   = A1/(CHI1-PSI1) + PSI1
5787       GNH3    = ZERO
5788       GHNO3   = ZERO
5789 !
5790       W(2)    = PSI2
5791       W(3)    = GNH3  + PSI1 + 2.0*PSI2
5792       W(4)    = GHNO3 + PSI1
5793 !
5794       RETURN
5795 !
5796 ! *** END OF SUBROUTINE CALCN1A *****************************************
5797 !
5798     END SUBROUTINE CALCN1A
5799
5800 !=======================================================================
5801 !
5802 ! *** ISORROPIA CODE
5803 ! *** SUBROUTINE CALCQ5
5804 ! *** CASE Q5
5805 !
5806 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5807 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0)
5808 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
5809 !
5810 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5811 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5812 ! *** WRITTEN BY ATHANASIOS NENES
5813 !
5814 !=======================================================================
5815 !
5816       SUBROUTINE CALCQ5
5817       implicit none
5818       INTEGER I
5819 !
5820       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ
5821       REAL(KIND=8) AKW, SO4I, CLI, GG, BB, CC, DD, HI, OHI
5822       REAL(KIND=8) GGNO3, GGCL, DEL, HSO4I
5823 !
5824 ! *** SETUP PARAMETERS ************************************************
5825 !
5826       FRST    =.TRUE.
5827       CALAIN  =.TRUE.
5828       CALAOU  =.TRUE.
5829 !
5830 ! *** CALCULATE INITIAL SOLUTION ***************************************
5831 !
5832       CALL CALCQ1A
5833 !
5834       PSI1   = CNA2SO4      ! SALTS DISSOLVED
5835       PSI4   = CNH4CL
5836       PSI5   = CNH4NO3
5837       PSI6   = CNH42S4
5838 !
5839       CALL CALCMR           ! WATER
5840 !
5841       NH3AQ  = ZERO
5842       NO3AQ  = ZERO
5843       CLAQ   = ZERO
5844 !
5845 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5846 !
5847       DO 10 I=1,NSWEEP
5848       AKW = XKW*RH*WATER*WATER               ! H2O       <==> H+
5849 !
5850 ! ION CONCENTRATIONS
5851 !
5852       NAI    = WAER(1)
5853       SO4I   = WAER(2)
5854       NH4I   = WAER(3)
5855       NO3I   = WAER(4)
5856       CLI    = WAER(5)
5857 !
5858 ! SOLUTION ACIDIC OR BASIC?
5859 !
5860       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
5861       IF (GG.GT.TINY) THEN                        ! H+ in excess
5862          BB =-GG
5863          CC =-AKW
5864          DD = BB*BB - 4.D0*CC
5865          HI = 0.5D0*(-BB + SQRT(DD))
5866          OHI= AKW/HI
5867       ELSE                                        ! OH- in excess
5868          BB = GG
5869          CC =-AKW
5870          DD = BB*BB - 4.D0*CC
5871          OHI= 0.5D0*(-BB + SQRT(DD))
5872          HI = AKW/OHI
5873       ENDIF
5874 !
5875 ! UNDISSOCIATED SPECIES EQUILIBRIA
5876 !
5877       IF (HI.LT.OHI) THEN
5878          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
5879          HI    = AKW/OHI
5880          HSO4I = ZERO
5881       ELSE
5882          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
5883          GGCL  = MAX(GG-GGNO3, ZERO)
5884          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
5885          IF (GGNO3.GT.TINY) THEN
5886             IF (GGCL.LE.TINY) HI = ZERO
5887             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
5888          ENDIF
5889 !
5890 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
5891 !
5892          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
5893          SO4I  = SO4I  - DEL
5894          HI    = HI    - DEL
5895          HSO4I = DEL
5896          OHI   = AKW/HI
5897       ENDIF
5898 !
5899 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
5900 !
5901       MOLAL(1) = HI
5902       MOLAL(2) = NAI
5903       MOLAL(3) = NH4I
5904       MOLAL(4) = CLI
5905       MOLAL(5) = SO4I
5906       MOLAL(6) = HSO4I
5907       MOLAL(7) = NO3I
5908 !
5909 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5910 !
5911       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5912          CALL CALCACT
5913       ELSE
5914          GOTO 20
5915       ENDIF
5916 10    CONTINUE
5917 !cc      CALL PUSHERR (0002, 'CALCQ5')    ! WARNING ERROR: NO CONVERGENCE
5918 !
5919 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
5920 !
5921 20    A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
5922       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
5923       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
5924 !
5925       GNH3    = NH4I/HI/A2
5926       GHNO3   = HI*NO3I/A3
5927       GHCL    = HI*CLI /A4
5928 !
5929       GASAQ(1)= NH3AQ
5930       GASAQ(2)= CLAQ
5931       GASAQ(3)= NO3AQ
5932 !
5933       CNH42S4 = ZERO
5934       CNH4NO3 = ZERO
5935       CNH4CL  = ZERO
5936       CNACL   = ZERO
5937       CNANO3  = ZERO
5938       CNA2SO4 = ZERO
5939 !
5940       RETURN
5941 !
5942 ! *** END OF SUBROUTINE CALCQ5 ******************************************
5943 !
5944    END SUBROUTINE CALCQ5
5945 !=======================================================================
5946 !
5947 ! *** ISORROPIA CODE
5948 ! *** SUBROUTINE CALCQ4
5949 ! *** CASE Q4
5950 !
5951 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5952 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0)
5953 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
5954 !
5955 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5956 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
5957 ! *** WRITTEN BY ATHANASIOS NENES
5958 !
5959 !=======================================================================
5960 !
5961       SUBROUTINE CALCQ4
5962       implicit none
5963 !
5964       LOGICAL PSCONV1
5965       REAL(KIND=8) PSI1O, ROOT3, NAI, SO4I, NH4I, NO3I, CLI
5966       REAL(KIND=8) NH3AQ, NO3AQ, CLAQ, AKW, BB, CC, DD, GG, HI, OHI
5967       REAL(KIND=8) GGNO3, GGCL, DEL, HSO4I
5968       INTEGER ISLV
5969       INTEGER I
5970 !
5971 ! *** SETUP PARAMETERS ************************************************
5972 !
5973       FRST    =.TRUE.
5974       CALAIN  =.TRUE.
5975       CALAOU  =.TRUE.
5976 !
5977       PSCONV1 =.TRUE.
5978       PSI1O   =-GREAT
5979       ROOT3   = ZERO
5980 !
5981 ! *** CALCULATE INITIAL SOLUTION ***************************************
5982 !
5983       CALL CALCQ1A
5984 !
5985       CHI1   = CNA2SO4      ! SALTS
5986 !
5987       PSI1   = CNA2SO4      ! AMOUNT DISSOLVED
5988       PSI4   = CNH4CL
5989       PSI5   = CNH4NO3
5990       PSI6   = CNH42S4
5991 !
5992       CALL CALCMR           ! WATER
5993 !
5994       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
5995       SO4I   = WAER(2)
5996       NH4I   = WAER(3)
5997       NO3I   = WAER(4)
5998       CLI    = WAER(5)
5999       HSO4I  = ZERO
6000       NH3AQ  = ZERO
6001       NO3AQ  = ZERO
6002       CLAQ   = ZERO
6003 !
6004 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6005 !
6006       DO 10 I=1,NSWEEP
6007       A5  = XK5 *(WATER/GAMA(2))**3.         ! Na2SO4    <==> Na+
6008       AKW = XKW*RH*WATER*WATER               ! H2O       <==> H+
6009 !
6010 ! SODIUM SULFATE
6011 !
6012       IF (NAI*NAI*SO4I .GT. A5) THEN
6013          BB =-(WAER(2) + WAER(1))
6014          CC = WAER(1)*WAER(2) + 0.25*WAER(1)*WAER(1)
6015          DD =-0.25*(WAER(1)*WAER(1)*WAER(2) - A5)
6016          CALL POLY3(BB, CC, DD, ROOT3, ISLV)
6017          IF (ISLV.NE.0) ROOT3 = TINY
6018          ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2), CHI1)
6019          ROOT3 = MAX (ROOT3, ZERO)
6020          PSI1  = CHI1-ROOT3
6021       ENDIF
6022       PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O
6023       PSI1O   = PSI1
6024 !
6025 ! ION CONCENTRATIONS ; CORRECTIONS
6026 !
6027       NAI = WAER(1) - 2.D0*ROOT3
6028       SO4I= WAER(2) - ROOT3
6029       NH4I   = WAER(3)
6030       NO3I   = WAER(4)
6031       CLI    = WAER(5)
6032 !
6033 ! SOLUTION ACIDIC OR BASIC?
6034 !
6035       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
6036       IF (GG.GT.TINY) THEN                        ! H+ in excess
6037          BB =-GG
6038          CC =-AKW
6039          DD = BB*BB - 4.D0*CC
6040          HI = 0.5D0*(-BB + SQRT(DD))
6041          OHI= AKW/HI
6042       ELSE                                        ! OH- in excess
6043          BB = GG
6044          CC =-AKW
6045          DD = BB*BB - 4.D0*CC
6046          OHI= 0.5D0*(-BB + SQRT(DD))
6047          HI = AKW/OHI
6048       ENDIF
6049 !
6050 ! UNDISSOCIATED SPECIES EQUILIBRIA
6051 !
6052       IF (HI.LT.OHI) THEN
6053          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
6054          HI    = AKW/OHI
6055          HSO4I = ZERO
6056       ELSE
6057          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
6058          GGCL  = MAX(GG-GGNO3, ZERO)
6059          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
6060          IF (GGNO3.GT.TINY) THEN
6061             IF (GGCL.LE.TINY) HI = ZERO
6062             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
6063          ENDIF
6064 !
6065 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
6066 !
6067          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
6068          SO4I  = SO4I  - DEL
6069          HI    = HI    - DEL
6070          HSO4I = DEL
6071          OHI   = AKW/HI
6072       ENDIF
6073 !
6074 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
6075 !
6076       MOLAL(1) = HI
6077       MOLAL(2) = NAI
6078       MOLAL(3) = NH4I
6079       MOLAL(4) = CLI
6080       MOLAL(5) = SO4I
6081       MOLAL(6) = HSO4I
6082       MOLAL(7) = NO3I
6083 !
6084 ! *** CALCULATE WATER **************************************************
6085 !
6086       CALL CALCMR
6087 !
6088 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6089 !
6090       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6091          CALL CALCACT
6092       ELSE
6093          IF (PSCONV1) GOTO 20
6094       ENDIF
6095 10    CONTINUE
6096 !cc      CALL PUSHERR (0002, 'CALCQ4')    ! WARNING ERROR: NO CONVERGENCE
6097 !
6098 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
6099 !
6100 20    A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
6101       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
6102       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
6103 !
6104       GNH3    = NH4I/HI/A2
6105       GHNO3   = HI*NO3I/A3
6106       GHCL    = HI*CLI /A4
6107 !
6108       GASAQ(1)= NH3AQ
6109       GASAQ(2)= CLAQ
6110       GASAQ(3)= NO3AQ
6111 !
6112       CNH42S4 = ZERO
6113       CNH4NO3 = ZERO
6114       CNH4CL  = ZERO
6115       CNACL   = ZERO
6116       CNANO3  = ZERO
6117       CNA2SO4 = CHI1 - PSI1
6118 !
6119       RETURN
6120 !
6121 ! *** END OF SUBROUTINE CALCQ4 ******************************************
6122 !
6123    END SUBROUTINE CALCQ4
6124 !=======================================================================
6125 !
6126 ! *** ISORROPIA CODE
6127 ! *** SUBROUTINE CALCQ3
6128 ! *** CASE Q3
6129 !
6130 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6131 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
6132 !     2. SOLID & LIQUID AEROSOL POSSIBLE
6133 !     3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL
6134 !
6135 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6136 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6137 ! *** WRITTEN BY ATHANASIOS NENES
6138 !
6139 !=======================================================================
6140 !
6141       SUBROUTINE CALCQ3
6142       implicit none
6143       LOGICAL EXNO, EXCL
6144 !      EXTERNAL CALCQ1A, CALCQ4
6145 !
6146 ! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES ***
6147 !
6148       EXNO = WAER(4).GT.TINY
6149       EXCL = WAER(5).GT.TINY
6150 !
6151       IF (EXNO .OR. EXCL) THEN             ! *** NITRATE OR CHLORIDE EXISTS
6152          SCASE = 'Q3 ; SUBCASE 1'
6153          CALL CALCQ3A
6154          SCASE = 'Q3 ; SUBCASE 1'
6155 !
6156       ELSE                                 ! *** NO CHLORIDE AND NITRATE
6157          IF (RH.LT.DRMG3) THEN
6158             SCASE = 'Q3 ; SUBCASE 2'
6159             CALL CALCQ1A             ! SOLID
6160             SCASE = 'Q3 ; SUBCASE 2'
6161          ELSE
6162             SCASE = 'Q3 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4
6163             CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4)
6164             SCASE = 'Q3 ; SUBCASE 3'
6165          ENDIF
6166       ENDIF
6167 !
6168       RETURN
6169 !
6170 ! *** END OF SUBROUTINE CALCQ3 ******************************************
6171 !
6172     END SUBROUTINE CALCQ3
6173
6174
6175
6176 !=======================================================================
6177 !
6178 ! *** ISORROPIA CODE
6179 ! *** SUBROUTINE CALCQ3A
6180 ! *** CASE Q3 ; SUBCASE A
6181 !
6182 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6183 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0)
6184 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
6185 !
6186 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6187 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6188 ! *** WRITTEN BY ATHANASIOS NENES
6189 !
6190 !=======================================================================
6191 !
6192       SUBROUTINE CALCQ3A
6193       implicit none
6194 !
6195       LOGICAL PSCONV1, PSCONV6
6196       REAL(KIND=8) PSI1O, ROOT3, NAI, SO4I, NH4I, NO3I, CLI
6197       REAL(KIND=8) NH3AQ, NO3AQ, CLAQ, AKW, BB, CC, DD, GG, HI, OHI
6198       REAL(KIND=8) GGNO3, GGCL, DEL, HSO4I,PSI6O, ROOT1
6199       INTEGER ISLV
6200       INTEGER I
6201 !
6202 ! *** SETUP PARAMETERS ************************************************
6203 !
6204       FRST    =.TRUE.
6205       CALAIN  =.TRUE.
6206       CALAOU  =.TRUE.
6207 !
6208       PSCONV1 =.TRUE.
6209       PSCONV6 =.TRUE.
6210 !
6211       PSI1O   =-GREAT
6212       PSI6O   =-GREAT
6213 !
6214       ROOT1   = ZERO
6215       ROOT3   = ZERO
6216 !
6217 ! *** CALCULATE INITIAL SOLUTION ***************************************
6218 !
6219       CALL CALCQ1A
6220 !
6221       CHI1   = CNA2SO4      ! SALTS
6222       CHI4   = CNH4CL
6223       CHI6   = CNH42S4
6224 !
6225       PSI1   = CNA2SO4      ! AMOUNT DISSOLVED
6226       PSI4   = CNH4CL
6227       PSI5   = CNH4NO3
6228       PSI6   = CNH42S4
6229 !
6230       CALL CALCMR           ! WATER
6231 !
6232       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
6233       SO4I   = WAER(2)
6234       NH4I   = WAER(3)
6235       NO3I   = WAER(4)
6236       CLI    = WAER(5)
6237       HSO4I  = ZERO
6238       NH3AQ  = ZERO
6239       NO3AQ  = ZERO
6240       CLAQ   = ZERO
6241 !
6242 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6243 !
6244       DO 10 I=1,NSWEEP
6245       A5  = XK5 *(WATER/GAMA(2))**3.         ! Na2SO4    <==> Na+
6246       A7  = XK7 *(WATER/GAMA(4))**3.         ! (NH4)2SO4 <==> Na+
6247       AKW = XKW*RH*WATER*WATER               ! H2O       <==> H+
6248 !
6249 ! SODIUM SULFATE
6250 !
6251       IF (NAI*NAI*SO4I .GT. A5) THEN
6252          BB =-(WAER(2) + WAER(1) - ROOT1)
6253          CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1)
6254          DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5)
6255          CALL POLY3(BB, CC, DD, ROOT3, ISLV)
6256          IF (ISLV.NE.0) ROOT3 = TINY
6257          ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1)
6258          ROOT3 = MAX (ROOT3, ZERO)
6259          PSI1  = CHI1-ROOT3
6260       ENDIF
6261       PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O
6262       PSI1O   = PSI1
6263 !
6264 ! AMMONIUM SULFATE
6265 !
6266       IF (NH4I*NH4I*SO4I .GT. A4) THEN
6267          BB =-(WAER(2)+WAER(3)-ROOT3)
6268          CC =  WAER(3)*(WAER(2)-ROOT3+0.5D0*WAER(3))
6269          DD =-((WAER(2)-ROOT3)*WAER(3)**2.D0 + A4)/4.D0
6270          CALL POLY3(BB, CC, DD, ROOT1, ISLV)
6271          IF (ISLV.NE.0) ROOT1 = TINY
6272          ROOT1 = MIN(ROOT1, WAER(3), WAER(2)-ROOT3, CHI6)
6273          ROOT1 = MAX(ROOT1, ZERO)
6274          PSI6  = CHI6-ROOT1
6275       ENDIF
6276       PSCONV6 = ABS(PSI6-PSI6O) .LE. EPS*PSI6O
6277       PSI6O   = PSI6
6278 !
6279 ! ION CONCENTRATIONS
6280 !
6281       NAI = WAER(1) - 2.D0*ROOT3
6282       SO4I= WAER(2) - ROOT1 - ROOT3
6283       NH4I= WAER(3) - 2.D0*ROOT1
6284       NO3I= WAER(4)
6285       CLI = WAER(5)
6286 !
6287 ! SOLUTION ACIDIC OR BASIC?
6288 !
6289       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
6290       IF (GG.GT.TINY) THEN                        ! H+ in excess
6291          BB =-GG
6292          CC =-AKW
6293          DD = BB*BB - 4.D0*CC
6294          HI = 0.5D0*(-BB + SQRT(DD))
6295          OHI= AKW/HI
6296       ELSE                                        ! OH- in excess
6297          BB = GG
6298          CC =-AKW
6299          DD = BB*BB - 4.D0*CC
6300          OHI= 0.5D0*(-BB + SQRT(DD))
6301          HI = AKW/OHI
6302       ENDIF
6303 !
6304 ! UNDISSOCIATED SPECIES EQUILIBRIA
6305 !
6306       IF (HI.LT.OHI) THEN
6307          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
6308          HI    = AKW/OHI
6309          HSO4I = ZERO
6310       ELSE
6311          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
6312          GGCL  = MAX(GG-GGNO3, ZERO)
6313          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
6314          IF (GGNO3.GT.TINY) THEN
6315             IF (GGCL.LE.TINY) HI = ZERO
6316             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
6317          ENDIF
6318 !
6319 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
6320 !
6321          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
6322          SO4I  = SO4I  - DEL
6323          HI    = HI    - DEL
6324          HSO4I = DEL
6325          OHI   = AKW/HI
6326       ENDIF
6327 !
6328 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
6329 !
6330       MOLAL(1) = HI
6331       MOLAL(2) = NAI
6332       MOLAL(3) = NH4I
6333       MOLAL(4) = CLI
6334       MOLAL(5) = SO4I
6335       MOLAL(6) = HSO4I
6336       MOLAL(7) = NO3I
6337 !
6338 ! *** CALCULATE WATER **************************************************
6339 !
6340       CALL CALCMR
6341 !
6342 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6343 !
6344       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6345          CALL CALCACT
6346       ELSE
6347          IF (PSCONV1 .AND. PSCONV6) GOTO 20
6348       ENDIF
6349 10    CONTINUE
6350 !cc      CALL PUSHERR (0002, 'CALCQ3A')    ! WARNING ERROR: NO CONVERGENCE
6351 !
6352 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
6353 !
6354 20    A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
6355       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
6356       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
6357 !
6358       GNH3    = NH4I/HI/A2
6359       GHNO3   = HI*NO3I/A3
6360       GHCL    = HI*CLI /A4
6361 !
6362       GASAQ(1)= NH3AQ
6363       GASAQ(2)= CLAQ
6364       GASAQ(3)= NO3AQ
6365 !
6366       CNH42S4 = CHI6 - PSI6
6367       CNH4NO3 = ZERO
6368       CNH4CL  = ZERO
6369       CNACL   = ZERO
6370       CNANO3  = ZERO
6371       CNA2SO4 = CHI1 - PSI1
6372 !
6373       RETURN
6374 !
6375 ! *** END OF SUBROUTINE CALCQ3A *****************************************
6376 !
6377    END  SUBROUTINE CALCQ3A
6378
6379
6380
6381 !=======================================================================
6382 !
6383 ! *** ISORROPIA CODE
6384 ! *** SUBROUTINE CALCQ2
6385 ! *** CASE Q2
6386 !
6387 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6388 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
6389 !     2. SOLID & LIQUID AEROSOL POSSIBLE
6390 !     3. SOLIDS POSSIBLE : NH4CL, NA2SO4, NANO3, NACL
6391 !
6392 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6393 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6394 ! *** WRITTEN BY ATHANASIOS NENES
6395 !
6396 !=======================================================================
6397 !
6398       SUBROUTINE CALCQ2
6399       implicit none
6400       LOGICAL EXNO, EXCL
6401 !      EXTERNAL CALCQ1A, CALCQ3A, CALCQ4
6402 !
6403 ! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES ***
6404 !
6405       EXNO = WAER(4).GT.TINY
6406       EXCL = WAER(5).GT.TINY
6407 !
6408       IF (EXNO) THEN                       ! *** NITRATE EXISTS
6409          SCASE = 'Q2 ; SUBCASE 1'
6410          CALL CALCQ2A
6411          SCASE = 'Q2 ; SUBCASE 1'
6412 !
6413       ELSEIF (.NOT.EXNO .AND. EXCL) THEN   ! *** ONLY CHLORIDE EXISTS
6414          IF (RH.LT.DRMG2) THEN
6415             SCASE = 'Q2 ; SUBCASE 2'
6416             CALL CALCQ1A             ! SOLID
6417             SCASE = 'Q2 ; SUBCASE 2'
6418          ELSE
6419             SCASE = 'Q2 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4CL
6420             CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A)
6421             SCASE = 'Q2 ; SUBCASE 3'
6422          ENDIF
6423 !
6424       ELSE                                 ! *** NO CHLORIDE AND NITRATE
6425          IF (RH.LT.DRMG3) THEN
6426             SCASE = 'Q2 ; SUBCASE 2'
6427             CALL CALCQ1A             ! SOLID
6428             SCASE = 'Q2 ; SUBCASE 2'
6429          ELSE
6430             SCASE = 'Q2 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4
6431             CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4)
6432             SCASE = 'Q2 ; SUBCASE 4'
6433          ENDIF
6434       ENDIF
6435 !
6436       RETURN
6437 !
6438 ! *** END OF SUBROUTINE CALCQ2 ******************************************
6439 !
6440     END SUBROUTINE CALCQ2
6441
6442
6443 !=======================================================================
6444 !
6445 ! *** ISORROPIA CODE
6446 ! *** SUBROUTINE CALCQ2A
6447 ! *** CASE Q2 ; SUBCASE A
6448 !
6449 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6450 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM POOR (SODRAT < 2.0)
6451 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
6452 !
6453 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6454 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6455 ! *** WRITTEN BY ATHANASIOS NENES
6456 !
6457 !=======================================================================
6458 !
6459       SUBROUTINE CALCQ2A
6460       implicit none
6461 !
6462       LOGICAL PSCONV1, PSCONV4, PSCONV6
6463       REAL(KIND=8) NH4I, NAI, NO3I, HSO4I, NH3AQ, NO3AQ, CLAQ, SO4I, CLI
6464       REAL(KIND=8) PSI1O, PSI4O, PSI6O, ROOT1, ROOT2, ROOT3
6465       REAL(KIND=8)  ROOT2A, ROOT2B
6466       REAL(KIND=8)  AKW, BB, CC, DD, GG, HI, OHI
6467       REAL(KIND=8) GGNO3, GGCL
6468       REAL(KIND=8) A14, DEL
6469       INTEGER I
6470       INTEGER ISLV
6471
6472 !
6473 ! *** SETUP PARAMETERS ************************************************
6474 !
6475       FRST    =.TRUE.
6476       CALAIN  =.TRUE.
6477       CALAOU  =.TRUE.
6478 !
6479       PSCONV1 =.TRUE.
6480       PSCONV4 =.TRUE.
6481       PSCONV6 =.TRUE.
6482 !
6483       PSI1O   =-GREAT
6484       PSI4O   =-GREAT
6485       PSI6O   =-GREAT
6486 !
6487       ROOT1   = ZERO
6488       ROOT2   = ZERO
6489       ROOT3   = ZERO
6490 !
6491 ! *** CALCULATE INITIAL SOLUTION ***************************************
6492 !
6493       CALL CALCQ1A
6494 !
6495       CHI1   = CNA2SO4      ! SALTS
6496       CHI4   = CNH4CL
6497       CHI6   = CNH42S4
6498 !
6499       PSI1   = CNA2SO4      ! AMOUNT DISSOLVED
6500       PSI4   = CNH4CL
6501       PSI5   = CNH4NO3
6502       PSI6   = CNH42S4
6503 !
6504       CALL CALCMR           ! WATER
6505 !
6506       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
6507       SO4I   = WAER(2)
6508       NH4I   = WAER(3)
6509       NO3I   = WAER(4)
6510       CLI    = WAER(5)
6511       HSO4I  = ZERO
6512       NH3AQ  = ZERO
6513       NO3AQ  = ZERO
6514       CLAQ   = ZERO
6515 !
6516 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6517 !
6518       DO 10 I=1,NSWEEP
6519       A5  = XK5 *(WATER/GAMA(2))**3.         ! Na2SO4    <==> Na+
6520       A14 = XK14*(WATER/GAMA(6))**2.         ! NH4Cl     <==> NH4+
6521       A7  = XK7 *(WATER/GAMA(4))**3.         ! (NH4)2SO4 <==> Na+
6522       AKW = XKW*RH*WATER*WATER               ! H2O       <==> H+
6523 !
6524 ! AMMONIUM CHLORIDE
6525 !
6526       IF (NH4I*CLI .GT. A14) THEN
6527          BB    =-(WAER(3) + WAER(5) - 2.D0*ROOT1)
6528          CC    = WAER(5)*(WAER(3) - 2.D0*ROOT1) - A14
6529          DD    = BB*BB - 4.D0*CC
6530          IF (DD.LT.ZERO) THEN
6531             ROOT2 = ZERO
6532          ELSE
6533             DD    = SQRT(DD)
6534             ROOT2A= 0.5D0*(-BB+DD)
6535             ROOT2B= 0.5D0*(-BB-DD)
6536             IF (ZERO.LE.ROOT2A) THEN
6537                ROOT2 = ROOT2A
6538             ELSE
6539                ROOT2 = ROOT2B
6540             ENDIF
6541             ROOT2 = MIN(ROOT2, WAER(5), WAER(3) - 2.D0*ROOT1, CHI4)
6542             ROOT2 = MAX(ROOT2, ZERO)
6543             PSI4  = CHI4 - ROOT2
6544          ENDIF
6545       ENDIF
6546       PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O
6547       PSI4O   = PSI4
6548 !
6549 ! SODIUM SULFATE
6550 !
6551       IF (NAI*NAI*SO4I .GT. A5) THEN
6552          BB =-(WAER(2) + WAER(1) - ROOT1)
6553          CC = WAER(1)*(WAER(2) - ROOT1) + 0.25*WAER(1)*WAER(1)
6554          DD =-0.25*(WAER(1)*WAER(1)*(WAER(2) - ROOT1) - A5)
6555          CALL POLY3(BB, CC, DD, ROOT3, ISLV)
6556          IF (ISLV.NE.0) ROOT3 = TINY
6557          ROOT3 = MIN (ROOT3, WAER(1)/2.0, WAER(2) - ROOT1, CHI1)
6558          ROOT3 = MAX (ROOT3, ZERO)
6559          PSI1  = CHI1-ROOT3
6560       ENDIF
6561       PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O
6562       PSI1O   = PSI1
6563 !
6564 ! AMMONIUM SULFATE
6565 !
6566       IF (NH4I*NH4I*SO4I .GT. A4) THEN
6567          BB =-(WAER(2)+WAER(3)-ROOT2-ROOT3)
6568          CC = (WAER(3)-ROOT2)*(WAER(2)-ROOT3+0.5D0*(WAER(3)-ROOT2))
6569          DD =-((WAER(2)-ROOT3)*(WAER(3)-ROOT2)**2.D0 + A4)/4.D0
6570          CALL POLY3(BB, CC, DD, ROOT1, ISLV)
6571          IF (ISLV.NE.0) ROOT1 = TINY
6572          ROOT1 = MIN(ROOT1, WAER(3)-ROOT2, WAER(2)-ROOT3, CHI6)
6573          ROOT1 = MAX(ROOT1, ZERO)
6574          PSI6  = CHI6-ROOT1
6575       ENDIF
6576       PSCONV6 = ABS(PSI6-PSI6O) .LE. EPS*PSI6O
6577       PSI6O   = PSI6
6578 !
6579 ! ION CONCENTRATIONS
6580 !
6581       NAI = WAER(1) - 2.D0*ROOT3
6582       SO4I= WAER(2) - ROOT1 - ROOT3
6583       NH4I= WAER(3) - ROOT2 - 2.D0*ROOT1
6584       NO3I= WAER(4)
6585       CLI = WAER(5) - ROOT2
6586 !
6587 ! SOLUTION ACIDIC OR BASIC?
6588 !
6589       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
6590       IF (GG.GT.TINY) THEN                        ! H+ in excess
6591          BB =-GG
6592          CC =-AKW
6593          DD = BB*BB - 4.D0*CC
6594          HI = 0.5D0*(-BB + SQRT(DD))
6595          OHI= AKW/HI
6596       ELSE                                        ! OH- in excess
6597          BB = GG
6598          CC =-AKW
6599          DD = BB*BB - 4.D0*CC
6600          OHI= 0.5D0*(-BB + SQRT(DD))
6601          HI = AKW/OHI
6602       ENDIF
6603 !
6604 ! UNDISSOCIATED SPECIES EQUILIBRIA
6605 !
6606       IF (HI.LT.OHI) THEN
6607          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
6608          HI    = AKW/OHI
6609          HSO4I = ZERO
6610       ELSE
6611          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
6612          GGCL  = MAX(GG-GGNO3, ZERO)
6613          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
6614          IF (GGNO3.GT.TINY) THEN
6615             IF (GGCL.LE.TINY) HI = ZERO
6616             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
6617          ENDIF
6618 !
6619 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
6620 !
6621          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
6622          SO4I  = SO4I  - DEL
6623          HI    = HI    - DEL
6624          HSO4I = DEL
6625          OHI   = AKW/HI
6626       ENDIF
6627 !
6628 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
6629 !
6630       MOLAL(1) = HI
6631       MOLAL(2) = NAI
6632       MOLAL(3) = NH4I
6633       MOLAL(4) = CLI
6634       MOLAL(5) = SO4I
6635       MOLAL(6) = HSO4I
6636       MOLAL(7) = NO3I
6637 !
6638 ! *** CALCULATE WATER **************************************************
6639 !
6640       CALL CALCMR
6641 !
6642 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6643 !
6644       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6645          CALL CALCACT
6646       ELSE
6647          IF (PSCONV1 .AND. PSCONV4 .AND. PSCONV6) GOTO 20
6648       ENDIF
6649 10    CONTINUE
6650 !cc      CALL PUSHERR (0002, 'CALCQ2A')    ! WARNING ERROR: NO CONVERGENCE
6651 !
6652 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
6653 !
6654 20    A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
6655       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
6656       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
6657 !
6658       GNH3    = NH4I/HI/A2
6659       GHNO3   = HI*NO3I/A3
6660       GHCL    = HI*CLI /A4
6661 !
6662       GASAQ(1)= NH3AQ
6663       GASAQ(2)= CLAQ
6664       GASAQ(3)= NO3AQ
6665 !
6666       CNH42S4 = CHI6 - PSI6
6667       CNH4NO3 = ZERO
6668       CNH4CL  = CHI4 - PSI4
6669       CNACL   = ZERO
6670       CNANO3  = ZERO
6671       CNA2SO4 = CHI1 - PSI1
6672 !
6673       RETURN
6674 !
6675 ! *** END OF SUBROUTINE CALCQ2A *****************************************
6676 !
6677    END SUBROUTINE CALCQ2A
6678 !=======================================================================
6679 !
6680 ! *** ISORROPIA CODE
6681 ! *** SUBROUTINE CALCQ1
6682 ! *** CASE Q1
6683 !
6684 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6685 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
6686 !     2. SOLID AEROSOL ONLY
6687 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4
6688 !
6689 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6690 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6691 ! *** WRITTEN BY ATHANASIOS NENES
6692 !
6693 !=======================================================================
6694 !
6695       SUBROUTINE CALCQ1
6696       implicit none
6697       LOGICAL EXNO, EXCL
6698 !      EXTERNAL CALCQ1A, CALCQ2A, CALCQ3A, CALCQ4
6699 !
6700 ! *** REGIME DEPENDS ON AMBIENT RELATIVE HUMIDITY & POSSIBLE SPECIES ***
6701 !
6702       EXNO = WAER(4).GT.TINY
6703       EXCL = WAER(5).GT.TINY
6704 !
6705       IF (EXNO .AND. EXCL) THEN           ! *** NITRATE & CHLORIDE EXIST
6706          IF (RH.LT.DRMG1) THEN
6707             SCASE = 'Q1 ; SUBCASE 1'
6708             CALL CALCQ1A             ! SOLID
6709             SCASE = 'Q1 ; SUBCASE 1'
6710          ELSE
6711             SCASE = 'Q1 ; SUBCASE 2' ! MDRH (NH4)2SO4, NA2SO4, NH4CL, NH4NO3
6712             CALL CALCMDRP (RH, DRMG1, DRNH4NO3, CALCQ1A, CALCQ2A)
6713             SCASE = 'Q1 ; SUBCASE 2'
6714          ENDIF
6715 !
6716       ELSE IF (EXNO .AND. .NOT.EXCL) THEN ! *** ONLY NITRATE EXISTS
6717          IF (RH.LT.DRMQ1) THEN
6718             SCASE = 'Q1 ; SUBCASE 1'
6719             CALL CALCQ1A             ! SOLID
6720             SCASE = 'Q1 ; SUBCASE 1'
6721          ELSE
6722             SCASE = 'Q1 ; SUBCASE 3' ! MDRH (NH4)2SO4, NA2SO4, NH4NO3
6723             CALL CALCMDRP (RH, DRMQ1, DRNH4NO3, CALCQ1A, CALCQ2A)
6724             SCASE = 'Q1 ; SUBCASE 3'
6725          ENDIF
6726 !
6727       ELSE IF (.NOT.EXNO .AND. EXCL) THEN ! *** ONLY CHLORIDE EXISTS
6728          IF (RH.LT.DRMG2) THEN
6729             SCASE = 'Q1 ; SUBCASE 1'
6730             CALL CALCQ1A             ! SOLID
6731             SCASE = 'Q1 ; SUBCASE 1'
6732          ELSE
6733             SCASE = 'Q1 ; SUBCASE 4' ! MDRH (NH4)2SO4, NA2SO4, NH4CL
6734             CALL CALCMDRP (RH, DRMG2, DRNH4CL, CALCQ1A, CALCQ3A)
6735             SCASE = 'Q1 ; SUBCASE 4'
6736          ENDIF
6737 !
6738       ELSE                                ! *** NO CHLORIDE AND NITRATE
6739          IF (RH.LT.DRMG3) THEN
6740             SCASE = 'Q1 ; SUBCASE 1'
6741             CALL CALCQ1A             ! SOLID
6742             SCASE = 'Q1 ; SUBCASE 1'
6743          ELSE
6744             SCASE = 'Q1 ; SUBCASE 5' ! MDRH (NH4)2SO4, NA2SO4
6745             CALL CALCMDRP (RH, DRMG3, DRNH42S4, CALCQ1A, CALCQ4)
6746             SCASE = 'Q1 ; SUBCASE 5'
6747          ENDIF
6748       ENDIF
6749 !
6750       RETURN
6751 !
6752 ! *** END OF SUBROUTINE CALCQ1 ******************************************
6753 !
6754     END SUBROUTINE CALCQ1
6755
6756
6757 !=======================================================================
6758 !
6759 ! *** ISORROPIA CODE
6760 ! *** SUBROUTINE CALCQ1A
6761 ! *** CASE Q1 ; SUBCASE 1
6762 !
6763 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6764 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
6765 !     2. SOLID AEROSOL ONLY
6766 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, (NH4)2SO4, NA2SO4
6767 !
6768 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6769 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6770 ! *** WRITTEN BY ATHANASIOS NENES
6771 !
6772 !=======================================================================
6773 !
6774       SUBROUTINE CALCQ1A
6775       implicit none
6776       REAL(KIND=8) FRNH3
6777 !
6778 ! *** CALCULATE SOLIDS **************************************************
6779 !
6780       CNA2SO4 = 0.5d0*WAER(1)
6781       FRSO4   = MAX (WAER(2)-CNA2SO4, ZERO)
6782 !
6783       CNH42S4 = MAX (MIN(FRSO4,0.5d0*WAER(3)), TINY)
6784       FRNH3   = MAX (WAER(3)-2.D0*CNH42S4, ZERO)
6785 !
6786       CNH4NO3 = MIN (FRNH3, WAER(4))
6787 !CC      FRNO3   = MAX (WAER(4)-CNH4NO3, ZERO)
6788       FRNH3   = MAX (FRNH3-CNH4NO3, ZERO)
6789 !
6790       CNH4CL  = MIN (FRNH3, WAER(5))
6791 !CC      FRCL    = MAX (WAER(5)-CNH4CL, ZERO)
6792       FRNH3   = MAX (FRNH3-CNH4CL, ZERO)
6793 !
6794 ! *** OTHER PHASES ******************************************************
6795 !
6796       WATER   = ZERO
6797 !
6798       GNH3    = ZERO
6799       GHNO3   = ZERO
6800       GHCL    = ZERO
6801 !
6802       RETURN
6803 !
6804 ! *** END OF SUBROUTINE CALCQ1A *****************************************
6805 !
6806     END SUBROUTINE CALCQ1A
6807 !=======================================================================
6808 !
6809 ! *** ISORROPIA CODE
6810 ! *** SUBROUTINE CALCR6
6811 ! *** CASE R6
6812 !
6813 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6814 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0)
6815 !     2. THERE IS ONLY A LIQUID PHASE
6816 !
6817 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6818 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6819 ! *** WRITTEN BY ATHANASIOS NENES
6820 !
6821 !=======================================================================
6822 !
6823       SUBROUTINE CALCR6
6824       implicit none
6825 !
6826       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, HSO4I
6827       REAL(KIND=8) AKW, SO4I,  CLI, GG, BB, CC, DD,HI, OHI, DEL
6828       REAL(KIND=8) GGNO3, GGCL
6829       INTEGER I
6830 !
6831 ! *** SETUP PARAMETERS ************************************************
6832 !
6833       CALL CALCR1A
6834 !
6835       PSI1   = CNA2SO4
6836       PSI2   = CNANO3
6837       PSI3   = CNACL
6838       PSI4   = CNH4CL
6839       PSI5   = CNH4NO3
6840 !
6841       FRST   = .TRUE.
6842       CALAIN = .TRUE.
6843       CALAOU = .TRUE.
6844 !
6845 ! *** CALCULATE WATER **************************************************
6846 !
6847       CALL CALCMR
6848 !
6849 ! *** SETUP LIQUID CONCENTRATIONS **************************************
6850 !
6851       HSO4I  = ZERO
6852       NH3AQ  = ZERO
6853       NO3AQ  = ZERO
6854       CLAQ   = ZERO
6855 !
6856 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6857 !
6858       DO 10 I=1,NSWEEP
6859       AKW = XKW*RH*WATER*WATER                        ! H2O    <==> H+
6860 !
6861       NAI    = WAER(1)
6862       SO4I   = WAER(2)
6863       NH4I   = WAER(3)
6864       NO3I   = WAER(4)
6865       CLI    = WAER(5)
6866 !
6867 ! SOLUTION ACIDIC OR BASIC?
6868 !
6869       GG  = 2.D0*WAER(2) + NO3I + CLI - NAI - NH4I
6870       IF (GG.GT.TINY) THEN                        ! H+ in excess
6871          BB =-GG
6872          CC =-AKW
6873          DD = BB*BB - 4.D0*CC
6874          HI = 0.5D0*(-BB + SQRT(DD))
6875          OHI= AKW/HI
6876       ELSE                                        ! OH- in excess
6877          BB = GG
6878          CC =-AKW
6879          DD = BB*BB - 4.D0*CC
6880          OHI= 0.5D0*(-BB + SQRT(DD))
6881          HI = AKW/OHI
6882       ENDIF
6883 !
6884 ! UNDISSOCIATED SPECIES EQUILIBRIA
6885 !
6886       IF (HI.LT.OHI) THEN
6887          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
6888          HI    = AKW/OHI
6889       ELSE
6890          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
6891          GGCL  = MAX(GG-GGNO3, ZERO)
6892          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
6893          IF (GGNO3.GT.TINY) THEN
6894             IF (GGCL.LE.TINY) HI = ZERO
6895             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
6896          ENDIF
6897 !
6898 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
6899 !
6900          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
6901          SO4I  = SO4I  - DEL
6902          HI    = HI    - DEL
6903          HSO4I = DEL
6904          OHI   = AKW/HI
6905       ENDIF
6906 !
6907 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
6908 !
6909       MOLAL(1) = HI
6910       MOLAL(2) = NAI
6911       MOLAL(3) = NH4I
6912       MOLAL(4) = CLI
6913       MOLAL(5) = SO4I
6914       MOLAL(6) = HSO4I
6915       MOLAL(7) = NO3I
6916 !
6917 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6918 !
6919       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6920          CALL CALCACT
6921       ELSE
6922          GOTO 20
6923       ENDIF
6924 10    CONTINUE
6925 !cc      CALL PUSHERR (0002, 'CALCR6')    ! WARNING ERROR: NO CONVERGENCE
6926 !
6927 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
6928 !
6929 20    A2       = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
6930       A3       = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
6931       A4       = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
6932 !
6933       GNH3     = NH4I/HI/A2
6934       GHNO3    = HI*NO3I/A3
6935       GHCL     = HI*CLI /A4
6936 !
6937       GASAQ(1) = NH3AQ
6938       GASAQ(2) = CLAQ
6939       GASAQ(3) = NO3AQ
6940 !
6941       CNH42S4  = ZERO
6942       CNH4NO3  = ZERO
6943       CNH4CL   = ZERO
6944       CNACL    = ZERO
6945       CNANO3   = ZERO
6946       CNA2SO4  = ZERO
6947 !
6948       RETURN
6949 !
6950 ! *** END OF SUBROUTINE CALCR6 ******************************************
6951 !
6952    END SUBROUTINE CALCR6
6953 !=======================================================================
6954 !
6955 ! *** ISORROPIA CODE
6956 ! *** SUBROUTINE CALCR5
6957 ! *** CASE R5
6958 !
6959 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6960 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0)
6961 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
6962 !
6963 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6964 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
6965 ! *** WRITTEN BY ATHANASIOS NENES
6966 !
6967 !=======================================================================
6968 !
6969       SUBROUTINE CALCR5
6970       implicit none
6971 !
6972       LOGICAL PSCONV
6973       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ
6974       REAL(KIND=8) PSIO, SO4I, CLI, AKW, HSO4I, ROOT, BB, CC, DD, GG, HI, OHI
6975       REAL(KIND=8) GGNO3, GGCL, DEL
6976       LOGICAL  NEAN, NEAC, NESN, NESC
6977       INTEGER I
6978       INTEGER ISLV
6979 !
6980 ! *** SETUP PARAMETERS ************************************************
6981 !
6982       CALL CALCR1A                             ! DRY SOLUTION
6983 !
6984       NEAN = CNH4NO3.LE.TINY    ! NH4NO3       ! Water exists?
6985       NEAC = CNH4CL .LE.TINY    ! NH4CL
6986       NESN = CNANO3 .LE.TINY    ! NANO3
6987       NESC = CNACL  .LE.TINY    ! NACL
6988       IF (NEAN .AND. NEAC .AND. NESN .AND. NESC) RETURN
6989 !
6990       CHI1   = CNA2SO4
6991 !
6992       PSI1   = CNA2SO4
6993       PSI2   = CNANO3
6994       PSI3   = CNACL
6995       PSI4   = CNH4CL
6996       PSI5   = CNH4NO3
6997 !
6998       PSIO   =-GREAT
6999 !
7000 ! *** CALCULATE WATER **************************************************
7001 !
7002       CALL CALCMR
7003 !
7004       FRST   = .TRUE.
7005       CALAIN = .TRUE.
7006       CALAOU = .TRUE.
7007       PSCONV = .FALSE.
7008 !
7009 ! *** SETUP LIQUID CONCENTRATIONS **************************************
7010 !
7011       NAI    = WAER(1)
7012       SO4I   = WAER(2)
7013       NH4I   = WAER(3)
7014       NO3I   = WAER(4)
7015       CLI    = WAER(5)
7016       HSO4I  = ZERO
7017       NH3AQ  = ZERO
7018       NO3AQ  = ZERO
7019       CLAQ   = ZERO
7020 !
7021 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7022 !
7023       DO 10 I=1,NSWEEP
7024       A5  = XK5*(WATER/GAMA(2))**3.                   ! Na2SO4 <==> Na+
7025       AKW = XKW*RH*WATER*WATER                        ! H2O    <==> H+
7026 !
7027 ! SODIUM SULFATE
7028 !
7029       ROOT = ZERO
7030       IF (NAI*NAI*SO4I .GT. A5) THEN
7031          BB =-3.D0*CHI1
7032          CC = 3.D0*CHI1**2.0
7033          DD =-CHI1**3.0 + 0.25D0*A5
7034          CALL POLY3(BB, CC, DD, ROOT, ISLV)
7035          IF (ISLV.NE.0) ROOT = TINY
7036          ROOT = MIN (MAX(ROOT,ZERO), CHI1)
7037          PSI1 = CHI1-ROOT
7038       ENDIF
7039       PSCONV = ABS(PSI1-PSIO) .LE. EPS*PSIO
7040       PSIO   = PSI1
7041 !
7042 ! ION CONCENTRATIONS
7043 !
7044       NAI  = WAER(1) - 2.D0*ROOT
7045       SO4I = WAER(2) - ROOT
7046       NH4I = WAER(3)
7047       NO3I = WAER(4)
7048       CLI  = WAER(5)
7049 !
7050 ! SOLUTION ACIDIC OR BASIC?
7051 !
7052       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
7053       IF (GG.GT.TINY) THEN                        ! H+ in excess
7054          BB =-GG
7055          CC =-AKW
7056          DD = BB*BB - 4.D0*CC
7057          HI = 0.5D0*(-BB + SQRT(DD))
7058          OHI= AKW/HI
7059       ELSE                                        ! OH- in excess
7060          BB = GG
7061          CC =-AKW
7062          DD = BB*BB - 4.D0*CC
7063          OHI= 0.5D0*(-BB + SQRT(DD))
7064          HI = AKW/OHI
7065       ENDIF
7066 !
7067 ! UNDISSOCIATED SPECIES EQUILIBRIA
7068 !
7069       IF (HI.LT.OHI) THEN
7070          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
7071          HI    = AKW/OHI
7072       ELSE
7073          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
7074          GGCL  = MAX(GG-GGNO3, ZERO)
7075          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
7076          IF (GGNO3.GT.TINY) THEN
7077             IF (GGCL.LE.TINY) HI = ZERO
7078             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
7079          ENDIF
7080 !
7081 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
7082 !
7083          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
7084          SO4I  = SO4I  - DEL
7085          HI    = HI    - DEL
7086          HSO4I = DEL
7087          OHI   = AKW/HI
7088       ENDIF
7089 !
7090 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7091 !
7092       MOLAL(1) = HI
7093       MOLAL(2) = NAI
7094       MOLAL(3) = NH4I
7095       MOLAL(4) = CLI
7096       MOLAL(5) = SO4I
7097       MOLAL(6) = HSO4I
7098       MOLAL(7) = NO3I
7099 !
7100 ! *** CALCULATE WATER **************************************************
7101 !
7102       CALL CALCMR
7103 !
7104 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7105 !
7106       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7107          CALL CALCACT
7108       ELSE
7109          IF (PSCONV) GOTO 20
7110       ENDIF
7111 10    CONTINUE
7112 !cc      CALL PUSHERR (0002, 'CALCR5')    ! WARNING ERROR: NO CONVERGENCE
7113 !
7114 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7115 !
7116 20    A2       = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
7117 !C      A21      = XK21*WATER*R*TEMP
7118       A3       = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
7119       A4       = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
7120 !
7121       GNH3     = NH4I/HI/A2  ! NH4I*OHI/A2/AKW
7122       GHNO3    = HI*NO3I/A3
7123       GHCL     = HI*CLI /A4
7124 !
7125       GASAQ(1) = NH3AQ
7126       GASAQ(2) = CLAQ
7127       GASAQ(3) = NO3AQ
7128 !
7129       CNH42S4  = ZERO
7130       CNH4NO3  = ZERO
7131       CNH4CL   = ZERO
7132       CNACL    = ZERO
7133       CNANO3   = ZERO
7134       CNA2SO4  = CHI1 - PSI1
7135 !
7136       RETURN
7137 !
7138 ! *** END OF SUBROUTINE CALCR5 ******************************************
7139 !
7140    END SUBROUTINE CALCR5
7141 !=======================================================================
7142 !
7143 ! *** ISORROPIA CODE
7144 ! *** SUBROUTINE CALCR4
7145 ! *** CASE R4
7146 !
7147 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7148 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
7149 !     2. SOLID AEROSOL ONLY
7150 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL
7151 !
7152 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7153 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7154 ! *** WRITTEN BY ATHANASIOS NENES
7155 !
7156 !=======================================================================
7157 !
7158       SUBROUTINE CALCR4
7159       implicit none
7160       LOGICAL  EXAN, EXAC, EXSN, EXSC
7161 !      EXTERNAL CALCR1A, CALCR5
7162 !
7163 ! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE **************
7164 !
7165       SCASE = 'R4 ; SUBCASE 2'
7166       CALL CALCR1A              ! SOLID
7167       SCASE = 'R4 ; SUBCASE 2'
7168 !
7169       EXAN = CNH4NO3.GT.TINY    ! NH4NO3
7170       EXAC = CNH4CL .GT.TINY    ! NH4CL
7171       EXSN = CNANO3 .GT.TINY    ! NANO3
7172       EXSC = CNACL  .GT.TINY    ! NACL
7173 !
7174 ! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES **********
7175 !
7176       IF (EXAN .OR. EXSN .OR. EXSC) THEN   ! *** NH4NO3,NANO3 EXIST
7177          IF (RH.GE.DRMH1) THEN
7178             SCASE = 'R4 ; SUBCASE 1'
7179             CALL CALCR4A
7180             SCASE = 'R4 ; SUBCASE 1'
7181          ENDIF
7182 !
7183       ELSE IF (EXAC) THEN                  ! *** NH4CL EXISTS ONLY
7184          IF (RH.GE.DRMR5) THEN
7185             SCASE = 'R4 ; SUBCASE 3'
7186             CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5)
7187             SCASE = 'R4 ; SUBCASE 3'
7188          ENDIF
7189       ENDIF
7190 !
7191       RETURN
7192 !
7193 ! *** END OF SUBROUTINE CALCR4 ******************************************
7194 !
7195     END SUBROUTINE CALCR4
7196
7197
7198
7199 !=======================================================================
7200 !
7201 ! *** ISORROPIA CODE
7202 ! *** SUBROUTINE CALCR4A
7203 ! *** CASE R4A
7204 !
7205 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7206 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0)
7207 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
7208 !
7209 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7210 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7211 ! *** WRITTEN BY ATHANASIOS NENES
7212 !
7213 !=======================================================================
7214 !
7215       SUBROUTINE CALCR4A
7216       implicit none
7217 !
7218       LOGICAL PSCONV1, PSCONV4
7219       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ
7220       REAL(KIND=8) PSIO1, PSIO4, PSI10, PSI3O, A14, SO4I, CLI, AKW, HSO4I, ROOT, BB, CC, DD, GG, HI, OHI
7221       REAL(KIND=8) GGNO3, GGCL, DEL
7222       INTEGER I
7223       INTEGER ISLV
7224 !
7225 ! *** SETUP PARAMETERS ************************************************
7226 !
7227       FRST    = .TRUE.
7228       CALAIN  = .TRUE.
7229       CALAOU  = .TRUE.
7230       PSCONV1 = .FALSE.
7231       PSCONV4 = .FALSE.
7232       PSIO1   =-GREAT
7233       PSIO4   =-GREAT
7234 !
7235 ! *** CALCULATE INITIAL SOLUTION ***************************************
7236 !
7237       CALL CALCR1A
7238 !
7239       CHI1   = CNA2SO4      ! SALTS
7240       CHI4   = CNH4CL
7241 !
7242       PSI1   = CNA2SO4
7243       PSI2   = CNANO3
7244       PSI3   = CNACL
7245       PSI4   = CNH4CL
7246       PSI5   = CNH4NO3
7247 !
7248       CALL CALCMR           ! WATER
7249 !
7250       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
7251       SO4I   = WAER(2)
7252       NH4I   = WAER(3)
7253       NO3I   = WAER(4)
7254       CLI    = WAER(5)
7255       HSO4I  = ZERO
7256       NH3AQ  = ZERO
7257       NO3AQ  = ZERO
7258       CLAQ   = ZERO
7259 !
7260 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7261 !
7262       DO 10 I=1,NSWEEP
7263       A5  = XK5 *(WATER/GAMA(2))**3.                  ! Na2SO4 <==> Na+
7264       A14 = XK14*(WATER/GAMA(6))**2.                  ! NH4Cl  <==> NH4+
7265       AKW = XKW*RH*WATER*WATER                        ! H2O    <==> H+
7266 !
7267 ! SODIUM SULFATE
7268 !
7269       ROOT = ZERO
7270       IF (NAI*NAI*SO4I .GT. A5) THEN
7271          BB =-3.D0*CHI1
7272          CC = 3.D0*CHI1**2.0
7273          DD =-CHI1**3.0 + 0.25D0*A5
7274          CALL POLY3(BB, CC, DD, ROOT, ISLV)
7275          IF (ISLV.NE.0) ROOT = TINY
7276          ROOT = MIN (MAX(ROOT,ZERO), CHI1)
7277          PSI1 = CHI1-ROOT
7278          NAI  = WAER(1) - 2.D0*ROOT
7279          SO4I = WAER(2) - ROOT
7280       ENDIF
7281       PSCONV1 = ABS(PSI1-PSIO1) .LE. EPS*PSIO1
7282       PSIO1   = PSI1
7283 !
7284 ! AMMONIUM CHLORIDE
7285 !
7286       ROOT = ZERO
7287       IF (NH4I*CLI .GT. A14) THEN
7288          BB   =-(NH4I + CLI)
7289          CC   =-A14 + NH4I*CLI
7290          DD   = BB*BB - 4.D0*CC
7291          ROOT = 0.5D0*(-BB-SQRT(DD))
7292          IF (ROOT.GT.TINY) THEN
7293             ROOT    = MIN(ROOT, CHI4)
7294             PSI4    = CHI4 - ROOT
7295             NH4I    = WAER(3) - ROOT
7296             CLI     = WAER(5) - ROOT
7297          ENDIF
7298       ENDIF
7299       PSCONV4 = ABS(PSI4-PSIO4) .LE. EPS*PSIO4
7300       PSIO4   = PSI4
7301 !
7302       NO3I   = WAER(4)
7303 !
7304 ! SOLUTION ACIDIC OR BASIC?
7305 !
7306       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
7307       IF (GG.GT.TINY) THEN                        ! H+ in excess
7308          BB =-GG
7309          CC =-AKW
7310          DD = BB*BB - 4.D0*CC
7311          HI = 0.5D0*(-BB + SQRT(DD))
7312          OHI= AKW/HI
7313       ELSE                                        ! OH- in excess
7314          BB = GG
7315          CC =-AKW
7316          DD = BB*BB - 4.D0*CC
7317          OHI= 0.5D0*(-BB + SQRT(DD))
7318          HI = AKW/OHI
7319       ENDIF
7320 !
7321 ! UNDISSOCIATED SPECIES EQUILIBRIA
7322 !
7323       IF (HI.LT.OHI) THEN
7324          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
7325          HI    = AKW/OHI
7326       ELSE
7327          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
7328          GGCL  = MAX(GG-GGNO3, ZERO)
7329          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
7330          IF (GGNO3.GT.TINY) THEN
7331             IF (GGCL.LE.TINY) HI = ZERO
7332             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
7333          ENDIF
7334 !
7335 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
7336 !
7337          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
7338          SO4I  = SO4I  - DEL
7339          HI    = HI    - DEL
7340          HSO4I = DEL
7341          OHI   = AKW/HI
7342       ENDIF
7343 !
7344 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7345 !
7346       MOLAL(1) = HI
7347       MOLAL(2) = NAI
7348       MOLAL(3) = NH4I
7349       MOLAL(4) = CLI
7350       MOLAL(5) = SO4I
7351       MOLAL(6) = HSO4I
7352       MOLAL(7) = NO3I
7353 !
7354 ! *** CALCULATE WATER **************************************************
7355 !
7356       CALL CALCMR
7357 !
7358 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7359 !
7360       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7361          CALL CALCACT
7362       ELSE
7363          IF (PSCONV1 .AND. PSCONV4) GOTO 20
7364       ENDIF
7365 10    CONTINUE
7366 !cc      CALL PUSHERR (0002, 'CALCR4A')    ! WARNING ERROR: NO CONVERGENCE
7367 !
7368 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7369 !
7370 20    A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
7371       A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
7372       A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
7373 !
7374       GNH3    = NH4I/HI/A2
7375       GHNO3   = HI*NO3I/A3
7376       GHCL    = HI*CLI /A4
7377 !
7378       GASAQ(1)= NH3AQ
7379       GASAQ(2)= CLAQ
7380       GASAQ(3)= NO3AQ
7381 !
7382       CNH42S4 = ZERO
7383       CNH4NO3 = ZERO
7384       CNH4CL  = CHI4 - PSI4
7385       CNACL   = ZERO
7386       CNANO3  = ZERO
7387       CNA2SO4 = CHI1 - PSI1
7388 !
7389       RETURN
7390 !
7391 ! *** END OF SUBROUTINE CALCR4A *****************************************
7392 !
7393       END SUBROUTINE CALCR4A
7394 !=======================================================================
7395 !
7396 ! *** ISORROPIA CODE
7397 ! *** SUBROUTINE CALCR3
7398 ! *** CASE R3
7399 !
7400 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7401 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
7402 !     2. SOLID AEROSOL ONLY
7403 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL
7404 !
7405 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7406 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7407 ! *** WRITTEN BY ATHANASIOS NENES
7408 !
7409 !=======================================================================
7410 !
7411       SUBROUTINE CALCR3
7412       implicit none
7413       LOGICAL  EXAN, EXAC, EXSN, EXSC
7414 !      EXTERNAL CALCR1A, CALCR4A, CALCR5
7415 !
7416 ! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE **************
7417 !
7418       SCASE = 'R3 ; SUBCASE 2'
7419       CALL CALCR1A              ! SOLID
7420       SCASE = 'R3 ; SUBCASE 2'
7421 !
7422       EXAN = CNH4NO3.GT.TINY    ! NH4NO3
7423       EXAC = CNH4CL .GT.TINY    ! NH4CL
7424       EXSN = CNANO3 .GT.TINY    ! NANO3
7425       EXSC = CNACL  .GT.TINY    ! NACL
7426 !
7427 ! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES **********
7428 !
7429       IF (EXAN .OR. EXSN) THEN                   ! *** NH4NO3,NANO3 EXIST
7430          IF (RH.GE.DRMH1) THEN
7431             SCASE = 'R3 ; SUBCASE 1'
7432             CALL CALCR3A
7433             SCASE = 'R3 ; SUBCASE 1'
7434          ENDIF
7435 !
7436       ELSE IF (.NOT.EXAN .AND. .NOT.EXSN) THEN   ! *** NH4NO3,NANO3 = 0
7437          IF      (     EXAC .AND.      EXSC) THEN
7438             IF (RH.GE.DRMR4) THEN
7439                SCASE = 'R3 ; SUBCASE 3'
7440                CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A)
7441                SCASE = 'R3 ; SUBCASE 3'
7442             ENDIF
7443
7444          ELSE IF (.NOT.EXAC .AND.      EXSC) THEN
7445             IF (RH.GE.DRMR2) THEN
7446                SCASE = 'R3 ; SUBCASE 4'
7447                CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A)
7448                SCASE = 'R3 ; SUBCASE 4'
7449             ENDIF
7450
7451          ELSE IF (     EXAC .AND. .NOT.EXSC) THEN
7452             IF (RH.GE.DRMR5) THEN
7453                SCASE = 'R3 ; SUBCASE 5'
7454                CALL CALCMDRP (RH, DRMR5, DRNACL, CALCR1A, CALCR5)
7455                SCASE = 'R3 ; SUBCASE 5'
7456             ENDIF
7457          ENDIF
7458 !
7459       ENDIF
7460 !
7461       RETURN
7462 !
7463 ! *** END OF SUBROUTINE CALCR3 ******************************************
7464 !
7465     END SUBROUTINE CALCR3
7466
7467
7468 !=======================================================================
7469 !
7470 ! *** ISORROPIA CODE
7471 ! *** SUBROUTINE CALCR3A
7472 ! *** CASE R3A
7473 !
7474 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7475 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0)
7476 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
7477 !
7478 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7479 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7480 ! *** WRITTEN BY ATHANASIOS NENES
7481 !
7482 !=======================================================================
7483 !
7484       SUBROUTINE CALCR3A
7485       implicit none
7486 !
7487       LOGICAL PSCONV1, PSCONV3, PSCONV4
7488       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, HSO4I, SO4I, CLI
7489       REAL(KIND=8) A14, AKW, BB, CC, DD, GG, HI, OHI
7490       REAL(KIND=8) PSI1O, PSI4O, PSI3O, ROOT1, ROOT2, ROOT3
7491       REAL(KIND=8)  ROOT2A, ROOT2B, ROOT3A, ROOT3B
7492       REAL(KIND=8) GGNO3, GGCL, DEL
7493       INTEGER I
7494       INTEGER ISLV
7495 !
7496 ! *** SETUP PARAMETERS ************************************************
7497 !
7498       FRST    =.TRUE.
7499       CALAIN  =.TRUE.
7500       CALAOU  =.TRUE.
7501       PSCONV1 =.TRUE.
7502       PSCONV3 =.TRUE.
7503       PSCONV4 =.TRUE.
7504       PSI1O   =-GREAT
7505       PSI3O   =-GREAT
7506       PSI4O   =-GREAT
7507       ROOT1   = ZERO
7508       ROOT2   = ZERO
7509       ROOT3   = ZERO
7510 !
7511 ! *** CALCULATE INITIAL SOLUTION ***************************************
7512 !
7513       CALL CALCR1A
7514 !
7515       CHI1   = CNA2SO4      ! SALTS
7516       CHI4   = CNH4CL
7517       CHI3   = CNACL
7518 !
7519       PSI1   = CNA2SO4
7520       PSI2   = CNANO3
7521       PSI3   = CNACL
7522       PSI4   = CNH4CL
7523       PSI5   = CNH4NO3
7524 !
7525       CALL CALCMR           ! WATER
7526 !
7527       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
7528       SO4I   = WAER(2)
7529       NH4I   = WAER(3)
7530       NO3I   = WAER(4)
7531       CLI    = WAER(5)
7532       HSO4I  = ZERO
7533       NH3AQ  = ZERO
7534       NO3AQ  = ZERO
7535       CLAQ   = ZERO
7536 !
7537       MOLAL(1) = ZERO
7538       MOLAL(2) = NAI
7539       MOLAL(3) = NH4I
7540       MOLAL(4) = CLI
7541       MOLAL(5) = SO4I
7542       MOLAL(6) = HSO4I
7543       MOLAL(7) = NO3I
7544 !
7545       CALL CALCACT          ! CALCULATE ACTIVITY COEFFICIENTS
7546 !
7547 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7548 !
7549       DO 10 I=1,NSWEEP
7550       A5  = XK5 *(WATER/GAMA(2))**3.                  ! Na2SO4 <==> Na+
7551       A8  = XK8 *(WATER/GAMA(1))**2.                  ! NaCl   <==> Na+
7552       A14 = XK14*(WATER/GAMA(6))**2.                  ! NH4Cl  <==> NH4+
7553       AKW = XKW*RH*WATER*WATER                        ! H2O    <==> H+
7554 !
7555 ! AMMONIUM CHLORIDE
7556 !
7557       IF (NH4I*CLI .GT. A14) THEN
7558          BB    =-(WAER(3) + WAER(5) - ROOT3)
7559          CC    =-A14 + NH4I*(WAER(5) - ROOT3)
7560          DD    = MAX(BB*BB - 4.D0*CC, ZERO)
7561          ROOT2A= 0.5D0*(-BB+SQRT(DD))
7562          ROOT2B= 0.5D0*(-BB-SQRT(DD))
7563          IF (ZERO.LE.ROOT2A) THEN
7564             ROOT2 = ROOT2A
7565          ELSE
7566             ROOT2 = ROOT2B
7567          ENDIF
7568          ROOT2 = MIN(MAX(ZERO, ROOT2), MAX(WAER(5)-ROOT3,ZERO), CHI4, WAER(3))
7569          PSI4  = CHI4 - ROOT2
7570       ENDIF
7571       PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O
7572       PSI4O   = PSI4
7573 !
7574 ! SODIUM SULFATE
7575 !
7576       IF (NAI*NAI*SO4I .GT. A5) THEN
7577          BB =-(CHI1 + WAER(1) - ROOT3)
7578          CC = 0.25D0*(WAER(1) - ROOT3)*(4.D0*CHI1+WAER(1)-ROOT3)
7579          DD =-0.25D0*(CHI1*(WAER(1)-ROOT3)**2.D0 - A5)
7580          CALL POLY3(BB, CC, DD, ROOT1, ISLV)
7581          IF (ISLV.NE.0) ROOT1 = TINY
7582          ROOT1 = MIN (MAX(ROOT1,ZERO), MAX(WAER(1)-ROOT3,ZERO), CHI1, WAER(2))
7583          PSI1  = CHI1-ROOT1
7584       ENDIF
7585       PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O
7586       PSI1O   = PSI1
7587 !
7588 ! ION CONCENTRATIONS
7589 !
7590       NAI = WAER(1) - (2.D0*ROOT1 + ROOT3)
7591       SO4I= WAER(2) - ROOT1
7592       NH4I= WAER(3) - ROOT2
7593       CLI = WAER(5) - (ROOT3 + ROOT2)
7594       NO3I= WAER(4)
7595 !
7596 ! SODIUM CHLORIDE  ; To obtain new value for ROOT3
7597 !
7598       IF (NAI*CLI .GT. A8) THEN
7599          BB    =-((CHI1-2.D0*ROOT1) + (WAER(5) - ROOT2))
7600          CC    = (CHI1-2.D0*ROOT1)*(WAER(5) - ROOT2) - A8
7601          DD    = SQRT(MAX(BB*BB - 4.D0*CC, TINY))
7602          ROOT3A= 0.5D0*(-BB-SQRT(DD))
7603          ROOT3B= 0.5D0*(-BB+SQRT(DD))
7604          IF (ZERO.LE.ROOT3A) THEN
7605             ROOT3 = ROOT3A
7606          ELSE
7607             ROOT3 = ROOT3B
7608          ENDIF
7609          ROOT3   = MIN(MAX(ROOT3, ZERO), CHI3)
7610          PSI3    = CHI3-ROOT3
7611       ENDIF
7612       PSCONV3 = ABS(PSI3-PSI3O) .LE. EPS*PSI3O
7613       PSI3O   = PSI3
7614 !
7615 ! SOLUTION ACIDIC OR BASIC?
7616 !
7617       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
7618       IF (GG.GT.TINY) THEN                        ! H+ in excess
7619          BB =-GG
7620          CC =-AKW
7621          DD = BB*BB - 4.D0*CC
7622          HI = 0.5D0*(-BB + SQRT(DD))
7623          OHI= AKW/HI
7624       ELSE                                        ! OH- in excess
7625          BB = GG
7626          CC =-AKW
7627          DD = BB*BB - 4.D0*CC
7628          OHI= 0.5D0*(-BB + SQRT(DD))
7629          HI = AKW/OHI
7630       ENDIF
7631 !
7632 ! UNDISSOCIATED SPECIES EQUILIBRIA
7633 !
7634       IF (HI.LT.OHI) THEN
7635          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
7636          HI    = AKW/OHI
7637       ELSE
7638          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
7639          GGCL  = MAX(GG-GGNO3, ZERO)
7640          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
7641          IF (GGNO3.GT.TINY) THEN
7642             IF (GGCL.LE.TINY) HI = ZERO
7643             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
7644          ENDIF
7645 !
7646 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
7647 !
7648          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
7649          SO4I  = SO4I  - DEL
7650          HI    = HI    - DEL
7651          HSO4I = DEL
7652          OHI   = AKW/HI
7653       ENDIF
7654 !
7655 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7656 !
7657       MOLAL(1) = HI
7658       MOLAL(2) = NAI
7659       MOLAL(3) = NH4I
7660       MOLAL(4) = CLI
7661       MOLAL(5) = SO4I
7662       MOLAL(6) = HSO4I
7663       MOLAL(7) = NO3I
7664 !
7665 ! *** CALCULATE WATER **************************************************
7666 !
7667       CALL CALCMR
7668 !
7669 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7670 !
7671       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7672          CALL CALCACT
7673       ELSE
7674          IF (PSCONV1.AND.PSCONV3.AND.PSCONV4) GOTO 20
7675       ENDIF
7676 10    CONTINUE
7677 !cc      CALL PUSHERR (0002, 'CALCR3A')    ! WARNING ERROR: NO CONVERGENCE
7678 !
7679 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7680 !
7681 20    IF (CLI.LE.TINY .AND. WAER(5).GT.TINY) THEN !No disslv Cl-;solid only
7682          DO 30 I=1,NIONS
7683             MOLAL(I) = ZERO
7684 30       CONTINUE
7685          DO 40 I=1,NGASAQ
7686             GASAQ(I) = ZERO
7687 40       CONTINUE
7688          CALL CALCR1A
7689       ELSE
7690          A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
7691          A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
7692          A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
7693 !
7694          GNH3    = NH4I/HI/A2
7695          GHNO3   = HI*NO3I/A3
7696          GHCL    = HI*CLI /A4
7697 !
7698          GASAQ(1)= NH3AQ
7699          GASAQ(2)= CLAQ
7700          GASAQ(3)= NO3AQ
7701 !
7702          CNH42S4 = ZERO
7703          CNH4NO3 = ZERO
7704          CNH4CL  = CHI4 - PSI4
7705          CNACL   = CHI3 - PSI3
7706          CNANO3  = ZERO
7707          CNA2SO4 = CHI1 - PSI1
7708       ENDIF
7709 !
7710       RETURN
7711 !
7712 ! *** END OF SUBROUTINE CALCR3A *****************************************
7713 !
7714    END SUBROUTINE CALCR3A
7715 !=======================================================================
7716 !
7717 ! *** ISORROPIA CODE
7718 ! *** SUBROUTINE CALCR2
7719 ! *** CASE R2
7720 !
7721 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7722 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
7723 !     2. SOLID AEROSOL ONLY
7724 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL
7725 !
7726 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7727 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7728 ! *** WRITTEN BY ATHANASIOS NENES
7729 !
7730 !=======================================================================
7731 !
7732       SUBROUTINE CALCR2
7733       implicit none
7734       LOGICAL  EXAN, EXAC, EXSN, EXSC
7735 !      EXTERNAL CALCR1A, CALCR3A, CALCR4A, CALCR5
7736 !
7737 ! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE **************
7738 !
7739       SCASE = 'R2 ; SUBCASE 2'
7740       CALL CALCR1A              ! SOLID
7741       SCASE = 'R2 ; SUBCASE 2'
7742 !
7743       EXAN = CNH4NO3.GT.TINY    ! NH4NO3
7744       EXAC = CNH4CL .GT.TINY    ! NH4CL
7745       EXSN = CNANO3 .GT.TINY    ! NANO3
7746       EXSC = CNACL  .GT.TINY    ! NACL
7747 !
7748 ! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES **********
7749 !
7750       IF (EXAN) THEN                             ! *** NH4NO3 EXISTS
7751          IF (RH.GE.DRMH1) THEN
7752             SCASE = 'R2 ; SUBCASE 1'
7753             CALL CALCR2A
7754             SCASE = 'R2 ; SUBCASE 1'
7755          ENDIF
7756 !
7757       ELSE IF (.NOT.EXAN) THEN                   ! *** NH4NO3 = 0
7758          IF      (     EXAC .AND.      EXSN .AND.      EXSC) THEN
7759             IF (RH.GE.DRMH2) THEN
7760                SCASE = 'R2 ; SUBCASE 3'
7761                CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A)
7762                SCASE = 'R2 ; SUBCASE 3'
7763             ENDIF
7764
7765          ELSE IF (.NOT.EXAC .AND.      EXSN .AND.      EXSC) THEN
7766             IF (RH.GE.DRMR1) THEN
7767                SCASE = 'R2 ; SUBCASE 4'
7768                CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A)
7769                SCASE = 'R2 ; SUBCASE 4'
7770             ENDIF
7771
7772          ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND.      EXSC) THEN
7773             IF (RH.GE.DRMR2) THEN
7774                SCASE = 'R2 ; SUBCASE 5'
7775                CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR4A)
7776                SCASE = 'R2 ; SUBCASE 5'
7777             ENDIF
7778
7779          ELSE IF (.NOT.EXAC .AND.      EXSN .AND. .NOT.EXSC) THEN
7780             IF (RH.GE.DRMR3) THEN
7781                SCASE = 'R2 ; SUBCASE 6'
7782                CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A)
7783                SCASE = 'R2 ; SUBCASE 6'
7784             ENDIF
7785
7786          ELSE IF (     EXAC .AND. .NOT.EXSN .AND.      EXSC) THEN
7787             IF (RH.GE.DRMR4) THEN
7788                SCASE = 'R2 ; SUBCASE 7'
7789                CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR4A)
7790                SCASE = 'R2 ; SUBCASE 7'
7791             ENDIF
7792
7793          ELSE IF (     EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN
7794             IF (RH.GE.DRMR5) THEN
7795                SCASE = 'R2 ; SUBCASE 8'
7796                CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR5)
7797                SCASE = 'R2 ; SUBCASE 8'
7798             ENDIF
7799
7800          ELSE IF (     EXAC .AND.      EXSN .AND. .NOT.EXSC) THEN
7801             IF (RH.GE.DRMR6) THEN
7802                SCASE = 'R2 ; SUBCASE 9'
7803                CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A)
7804                SCASE = 'R2 ; SUBCASE 9'
7805             ENDIF
7806          ENDIF
7807 !
7808       ENDIF
7809 !
7810       RETURN
7811 !
7812 ! *** END OF SUBROUTINE CALCR2 ******************************************
7813 !
7814     END SUBROUTINE CALCR2
7815
7816
7817 !=======================================================================
7818 !
7819 ! *** ISORROPIA CODE
7820 ! *** SUBROUTINE CALCR2A
7821 ! *** CASE R2A
7822 !
7823 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7824 !     1. SULFATE POOR (SULRAT > 2.0); SODIUM RICH (SODRAT >= 2.0)
7825 !     2. LIQUID AND SOLID PHASES ARE POSSIBLE
7826 !
7827 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
7828 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
7829 ! *** WRITTEN BY ATHANASIOS NENES
7830 !
7831 !=======================================================================
7832 !
7833       SUBROUTINE CALCR2A
7834       implicit none
7835 !
7836       LOGICAL PSCONV1, PSCONV2, PSCONV3, PSCONV4
7837       REAL(KIND=8) NH4I, NAI, NO3I, NH3AQ, NO3AQ, CLAQ, HSO4I, SO4I, CLI
7838       REAL(KIND=8) A9, A14, AKW, BB, CC, DD, GG, HI, OHI
7839       REAL(KIND=8) PSI1O, PSI2O, PSI4O, PSI3O, ROOT1, ROOT2, ROOT3, ROOT4
7840       REAL(KIND=8)  ROOT2A, ROOT2B, ROOT3A, ROOT3B, ROOT4A, ROOT4B
7841       REAL(KIND=8) GGNO3, GGCL, DEL
7842       INTEGER I
7843       INTEGER ISLV
7844 !
7845 ! *** SETUP PARAMETERS ************************************************
7846 !
7847       FRST    =.TRUE.
7848       CALAIN  =.TRUE.
7849       CALAOU  =.TRUE.
7850 !
7851       PSCONV1 =.TRUE.
7852       PSCONV2 =.TRUE.
7853       PSCONV3 =.TRUE.
7854       PSCONV4 =.TRUE.
7855 !
7856       PSI1O   =-GREAT
7857       PSI2O   =-GREAT
7858       PSI3O   =-GREAT
7859       PSI4O   =-GREAT
7860 !
7861       ROOT1   = ZERO
7862       ROOT2   = ZERO
7863       ROOT3   = ZERO
7864       ROOT4   = ZERO
7865 !
7866 ! *** CALCULATE INITIAL SOLUTION ***************************************
7867 !
7868       CALL CALCR1A
7869 !
7870       CHI1   = CNA2SO4      ! SALTS
7871       CHI2   = CNANO3
7872       CHI3   = CNACL
7873       CHI4   = CNH4CL
7874 !
7875       PSI1   = CNA2SO4
7876       PSI2   = CNANO3
7877       PSI3   = CNACL
7878       PSI4   = CNH4CL
7879       PSI5   = CNH4NO3
7880 !
7881       CALL CALCMR           ! WATER
7882 !
7883       NAI    = WAER(1)      ! LIQUID CONCENTRATIONS
7884       SO4I   = WAER(2)
7885       NH4I   = WAER(3)
7886       NO3I   = WAER(4)
7887       CLI    = WAER(5)
7888       HSO4I  = ZERO
7889       NH3AQ  = ZERO
7890       NO3AQ  = ZERO
7891       CLAQ   = ZERO
7892 !
7893       MOLAL(1) = ZERO
7894       MOLAL(2) = NAI
7895       MOLAL(3) = NH4I
7896       MOLAL(4) = CLI
7897       MOLAL(5) = SO4I
7898       MOLAL(6) = HSO4I
7899       MOLAL(7) = NO3I
7900 !
7901       CALL CALCACT          ! CALCULATE ACTIVITY COEFFICIENTS
7902 !
7903 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7904 !
7905       DO 10 I=1,NSWEEP
7906       A5  = XK5 *(WATER/GAMA(2))**3.                  ! Na2SO4 <==> Na+
7907       A8  = XK8 *(WATER/GAMA(1))**2.                  ! NaCl   <==> Na+
7908       A9  = XK9 *(WATER/GAMA(3))**2.                  ! NaNO3  <==> Na+
7909       A14 = XK14*(WATER/GAMA(6))**2.                  ! NH4Cl  <==> NH4+
7910       AKW = XKW*RH*WATER*WATER                        ! H2O    <==> H+
7911 !
7912 ! AMMONIUM CHLORIDE
7913 !
7914       IF (NH4I*CLI .GT. A14) THEN
7915          BB    =-(WAER(3) + WAER(5) - ROOT3)
7916          CC    = NH4I*(WAER(5) - ROOT3) - A14
7917          DD    = MAX(BB*BB - 4.D0*CC, ZERO)
7918          DD    = SQRT(DD)
7919          ROOT2A= 0.5D0*(-BB+DD)
7920          ROOT2B= 0.5D0*(-BB-DD)
7921          IF (ZERO.LE.ROOT2A) THEN
7922             ROOT2 = ROOT2A
7923          ELSE
7924             ROOT2 = ROOT2B
7925          ENDIF
7926          ROOT2 = MIN(MAX(ROOT2, ZERO), CHI4)
7927          PSI4  = CHI4 - ROOT2
7928       ENDIF
7929       PSCONV4 = ABS(PSI4-PSI4O) .LE. EPS*PSI4O
7930       PSI4O   = PSI4
7931 !
7932 ! SODIUM SULFATE
7933 !
7934       IF (NAI*NAI*SO4I .GT. A5) THEN
7935          BB =-(WAER(2) + WAER(1) - ROOT3 - ROOT4)
7936          CC = WAER(1)*(2.D0*ROOT3 + 2.D0*ROOT4 - 4.D0*WAER(2) - ONE)&
7937             -(ROOT3 + ROOT4)**2.0 + 4.D0*WAER(2)*(ROOT3 + ROOT4)
7938          CC =-0.25*CC
7939          DD = WAER(1)*WAER(2)*(ONE - 2.D0*ROOT3 - 2.D0*ROOT4) + &
7940              WAER(2)*(ROOT3 + ROOT4)**2.0 - A5
7941          DD =-0.25*DD
7942          CALL POLY3(BB, CC, DD, ROOT1, ISLV)
7943          IF (ISLV.NE.0) ROOT1 = TINY
7944          ROOT1 = MIN (MAX(ROOT1,ZERO), CHI1)
7945          PSI1  = CHI1-ROOT1
7946       ENDIF
7947       PSCONV1 = ABS(PSI1-PSI1O) .LE. EPS*PSI1O
7948       PSI1O   = PSI1
7949 !
7950 ! SODIUM NITRATE
7951 !
7952       IF (NAI*NO3I .GT. A9) THEN
7953          BB    =-(WAER(4) + WAER(1) - 2.D0*ROOT1 - ROOT3)
7954          CC    = WAER(4)*(WAER(1) - 2.D0*ROOT1 - ROOT3) - A9
7955          DD    = SQRT(MAX(BB*BB - 4.D0*CC, TINY))
7956          ROOT4A= 0.5D0*(-BB-DD)
7957          ROOT4B= 0.5D0*(-BB+DD)
7958          IF (ZERO.LE.ROOT4A) THEN
7959             ROOT4 = ROOT4A
7960          ELSE
7961             ROOT4 = ROOT4B
7962          ENDIF
7963          ROOT4 = MIN(MAX(ROOT4, ZERO), CHI2)
7964          PSI2  = CHI2-ROOT4
7965       ENDIF
7966       PSCONV2 = ABS(PSI2-PSI2O) .LE. EPS*PSI2O
7967       PSI2O   = PSI2
7968 !
7969 ! ION CONCENTRATIONS
7970 !
7971       NAI = WAER(1) - (2.D0*ROOT1 + ROOT3 + ROOT4)
7972       SO4I= WAER(2) - ROOT1
7973       NH4I= WAER(3) - ROOT2
7974       NO3I= WAER(4) - ROOT4
7975       CLI = WAER(5) - (ROOT3 + ROOT2)
7976 !
7977 ! SODIUM CHLORIDE  ; To obtain new value for ROOT3
7978 !
7979       IF (NAI*CLI .GT. A8) THEN
7980          BB    =-(WAER(1) - 2.D0*ROOT1 + WAER(5) - ROOT2 - ROOT4)
7981          CC    = (WAER(5) + ROOT2)*(WAER(1) - 2.D0*ROOT1 - ROOT4) - A8
7982          DD    = SQRT(MAX(BB*BB - 4.D0*CC, TINY))
7983          ROOT3A= 0.5D0*(-BB-DD)
7984          ROOT3B= 0.5D0*(-BB+DD)
7985          IF (ZERO.LE.ROOT3A) THEN
7986             ROOT3 = ROOT3A
7987          ELSE
7988             ROOT3 = ROOT3B
7989          ENDIF
7990          ROOT3   = MIN(MAX(ROOT3, ZERO), CHI3)
7991          PSI3    = CHI3-ROOT3
7992       ENDIF
7993       PSCONV3 = ABS(PSI3-PSI3O) .LE. EPS*PSI3O
7994       PSI3O   = PSI3
7995 !
7996 ! SOLUTION ACIDIC OR BASIC?
7997 !
7998       GG   = 2.D0*SO4I + NO3I + CLI - NAI - NH4I
7999       IF (GG.GT.TINY) THEN                        ! H+ in excess
8000          BB =-GG
8001          CC =-AKW
8002          DD = BB*BB - 4.D0*CC
8003          HI = 0.5D0*(-BB + SQRT(DD))
8004          OHI= AKW/HI
8005       ELSE                                        ! OH- in excess
8006          BB = GG
8007          CC =-AKW
8008          DD = BB*BB - 4.D0*CC
8009          OHI= 0.5D0*(-BB + SQRT(DD))
8010          HI = AKW/OHI
8011       ENDIF
8012 !
8013 ! UNDISSOCIATED SPECIES EQUILIBRIA
8014 !
8015       IF (HI.LT.OHI) THEN
8016          CALL CALCAMAQ2 (-GG, NH4I, OHI, NH3AQ)
8017          HI    = AKW/OHI
8018       ELSE
8019          GGNO3 = MAX(2.D0*SO4I + NO3I - NAI - NH4I, ZERO)
8020          GGCL  = MAX(GG-GGNO3, ZERO)
8021          IF (GGCL .GT.TINY) CALL CALCCLAQ2 (GGCL, CLI, HI, CLAQ) ! HCl
8022          IF (GGNO3.GT.TINY) THEN
8023             IF (GGCL.LE.TINY) HI = ZERO
8024             CALL CALCNIAQ2 (GGNO3, NO3I, HI, NO3AQ)              ! HNO3
8025          ENDIF
8026 !
8027 ! CONCENTRATION ADJUSTMENTS ; HSO4 minor species.
8028 !
8029          CALL CALCHS4 (HI, SO4I, ZERO, DEL)
8030          SO4I  = SO4I  - DEL
8031          HI    = HI    - DEL
8032          HSO4I = DEL
8033          OHI   = AKW/HI
8034       ENDIF
8035 !
8036 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
8037 !
8038       MOLAL(1) = HI
8039       MOLAL(2) = NAI
8040       MOLAL(3) = NH4I
8041       MOLAL(4) = CLI
8042       MOLAL(5) = SO4I
8043       MOLAL(6) = HSO4I
8044       MOLAL(7) = NO3I
8045 !
8046 ! *** CALCULATE WATER **************************************************
8047 !
8048       CALL CALCMR
8049 !
8050 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8051 !
8052       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
8053          CALL CALCACT
8054       ELSE
8055          IF (PSCONV1.AND.PSCONV2.AND.PSCONV3.AND.PSCONV4) GOTO 20
8056       ENDIF
8057 10    CONTINUE
8058 !cc      CALL PUSHERR (0002, 'CALCR2A')    ! WARNING ERROR: NO CONVERGENCE
8059 !
8060 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
8061 !
8062 20    IF (CLI.LE.TINY .AND. WAER(5).GT.TINY) THEN !No disslv Cl-;solid only
8063          DO 30 I=1,NIONS
8064             MOLAL(I) = ZERO
8065 30       CONTINUE
8066          DO 40 I=1,NGASAQ
8067             GASAQ(I) = ZERO
8068 40       CONTINUE
8069          CALL CALCR1A
8070       ELSE                                     ! OK, aqueous phase present
8071          A2      = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2. ! NH3  <==> NH4+
8072          A3      = XK4 *R*TEMP*(WATER/GAMA(10))**2.        ! HNO3 <==> NO3-
8073          A4      = XK3 *R*TEMP*(WATER/GAMA(11))**2.        ! HCL  <==> CL-
8074 !
8075          GNH3    = NH4I/HI/A2
8076          GHNO3   = HI*NO3I/A3
8077          GHCL    = HI*CLI /A4
8078 !
8079          GASAQ(1)= NH3AQ
8080          GASAQ(2)= CLAQ
8081          GASAQ(3)= NO3AQ
8082 !
8083          CNH42S4 = ZERO
8084          CNH4NO3 = ZERO
8085          CNH4CL  = CHI4 - PSI4
8086          CNACL   = CHI3 - PSI3
8087          CNANO3  = CHI2 - PSI2
8088          CNA2SO4 = CHI1 - PSI1
8089       ENDIF
8090 !
8091       RETURN
8092 !
8093 ! *** END OF SUBROUTINE CALCR2A *****************************************
8094 !
8095     END SUBROUTINE CALCR2A
8096 !=======================================================================
8097 !
8098 ! *** ISORROPIA CODE
8099 ! *** SUBROUTINE CALCR1
8100 ! *** CASE R1
8101 !
8102 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8103 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
8104 !     2. SOLID AEROSOL ONLY
8105 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4, NANO3, NACL
8106 !
8107 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8108 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8109 ! *** WRITTEN BY ATHANASIOS NENES
8110 !
8111 !=======================================================================
8112 !
8113       SUBROUTINE CALCR1
8114       implicit none
8115       LOGICAL  EXAN, EXAC, EXSN, EXSC
8116 !      EXTERNAL CALCR1A, CALCR2A, CALCR3A, CALCR4A, CALCR5
8117 !
8118 ! *** SOLVE FOR DRY CASE AND SEE WHICH SOLIDS ARE POSSIBLE **************
8119 !
8120       SCASE = 'R1 ; SUBCASE 1'
8121       CALL CALCR1A              ! SOLID
8122       SCASE = 'R1 ; SUBCASE 1'
8123 !
8124       EXAN = CNH4NO3.GT.TINY    ! NH4NO3
8125       EXAC = CNH4CL .GT.TINY    ! NH4CL
8126       EXSN = CNANO3 .GT.TINY    ! NANO3
8127       EXSC = CNACL  .GT.TINY    ! NACL
8128 !
8129 ! *** REGIME DEPENDS ON RELATIVE HUMIDITY AND POSSIBLE SPECIES **********
8130 !
8131       IF (EXAN.AND.EXAC.AND.EXSC.AND.EXSN) THEN  ! *** ALL EXIST
8132          IF (RH.GE.DRMH1) THEN
8133             SCASE = 'R1 ; SUBCASE 2'  ! MDRH
8134             CALL CALCMDRP (RH, DRMH1, DRNH4NO3, CALCR1A, CALCR2A)
8135             SCASE = 'R1 ; SUBCASE 2'
8136          ENDIF
8137 !
8138       ELSE IF (.NOT.EXAN) THEN                   ! *** NH4NO3 = 0
8139          IF      (     EXAC .AND.      EXSN .AND.      EXSC) THEN
8140             IF (RH.GE.DRMH2) THEN
8141                SCASE = 'R1 ; SUBCASE 3'
8142                CALL CALCMDRP (RH, DRMH2, DRNANO3, CALCR1A, CALCR3A)
8143                SCASE = 'R1 ; SUBCASE 3'
8144             ENDIF
8145
8146          ELSE IF (.NOT.EXAC .AND.      EXSN .AND.      EXSC) THEN
8147             IF (RH.GE.DRMR1) THEN
8148                SCASE = 'R1 ; SUBCASE 4'
8149                CALL CALCMDRP (RH, DRMR1, DRNANO3, CALCR1A, CALCR3A)
8150                SCASE = 'R1 ; SUBCASE 4'
8151             ENDIF
8152
8153          ELSE IF (.NOT.EXAC .AND. .NOT.EXSN .AND.      EXSC) THEN
8154             IF (RH.GE.DRMR2) THEN
8155                SCASE = 'R1 ; SUBCASE 5'
8156                CALL CALCMDRP (RH, DRMR2, DRNACL, CALCR1A, CALCR3A) !, CALCR4A)
8157                SCASE = 'R1 ; SUBCASE 5'
8158             ENDIF
8159
8160          ELSE IF (.NOT.EXAC .AND.      EXSN .AND. .NOT.EXSC) THEN
8161             IF (RH.GE.DRMR3) THEN
8162                SCASE = 'R1 ; SUBCASE 6'
8163                CALL CALCMDRP (RH, DRMR3, DRNANO3, CALCR1A, CALCR3A)
8164                SCASE = 'R1 ; SUBCASE 6'
8165             ENDIF
8166
8167          ELSE IF (     EXAC .AND. .NOT.EXSN .AND.      EXSC) THEN
8168             IF (RH.GE.DRMR4) THEN
8169                SCASE = 'R1 ; SUBCASE 7'
8170                CALL CALCMDRP (RH, DRMR4, DRNACL, CALCR1A, CALCR3A) !, CALCR4A)
8171                SCASE = 'R1 ; SUBCASE 7'
8172             ENDIF
8173
8174          ELSE IF (     EXAC .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN
8175             IF (RH.GE.DRMR5) THEN
8176                SCASE = 'R1 ; SUBCASE 8'
8177                CALL CALCMDRP (RH, DRMR5, DRNH4CL, CALCR1A, CALCR3A) !, CALCR5)
8178                SCASE = 'R1 ; SUBCASE 8'
8179             ENDIF
8180
8181          ELSE IF (     EXAC .AND.      EXSN .AND. .NOT.EXSC) THEN
8182             IF (RH.GE.DRMR6) THEN
8183                SCASE = 'R1 ; SUBCASE 9'
8184                CALL CALCMDRP (RH, DRMR6, DRNANO3, CALCR1A, CALCR3A)
8185                SCASE = 'R1 ; SUBCASE 9'
8186             ENDIF
8187          ENDIF
8188 !
8189       ELSE IF (.NOT.EXAC) THEN                   ! *** NH4CL  = 0
8190          IF      (     EXAN .AND.      EXSN .AND.      EXSC) THEN
8191             IF (RH.GE.DRMR7) THEN
8192                SCASE = 'R1 ; SUBCASE 10'
8193                CALL CALCMDRP (RH, DRMR7, DRNH4NO3, CALCR1A, CALCR2A)
8194                SCASE = 'R1 ; SUBCASE 10'
8195             ENDIF
8196
8197          ELSE IF (     EXAN .AND. .NOT.EXSN .AND.      EXSC) THEN
8198             IF (RH.GE.DRMR8) THEN
8199                SCASE = 'R1 ; SUBCASE 11'
8200                CALL CALCMDRP (RH, DRMR8, DRNH4NO3, CALCR1A, CALCR2A)
8201                SCASE = 'R1 ; SUBCASE 11'
8202             ENDIF
8203
8204          ELSE IF (     EXAN .AND. .NOT.EXSN .AND. .NOT.EXSC) THEN
8205             IF (RH.GE.DRMR9) THEN
8206                SCASE = 'R1 ; SUBCASE 12'
8207                CALL CALCMDRP (RH, DRMR9, DRNH4NO3, CALCR1A, CALCR2A)
8208                SCASE = 'R1 ; SUBCASE 12'
8209             ENDIF
8210
8211          ELSE IF (     EXAN .AND.      EXSN .AND. .NOT.EXSC) THEN
8212             IF (RH.GE.DRMR10) THEN
8213                SCASE = 'R1 ; SUBCASE 13'
8214                CALL CALCMDRP (RH, DRMR10, DRNH4NO3, CALCR1A, CALCR2A)
8215                SCASE = 'R1 ; SUBCASE 13'
8216             ENDIF
8217          ENDIF
8218 !
8219       ELSE IF (.NOT.EXSN) THEN                  ! *** NANO3  = 0
8220          IF      (     EXAN .AND.      EXAC .AND.      EXSC) THEN
8221             IF (RH.GE.DRMR11) THEN
8222                SCASE = 'R1 ; SUBCASE 14'
8223                CALL CALCMDRP (RH, DRMR11, DRNH4NO3, CALCR1A, CALCR2A)
8224                SCASE = 'R1 ; SUBCASE 14'
8225             ENDIF
8226
8227          ELSE IF (     EXAN .AND.      EXAC .AND. .NOT.EXSC) THEN
8228             IF (RH.GE.DRMR12) THEN
8229                SCASE = 'R1 ; SUBCASE 15'
8230                CALL CALCMDRP (RH, DRMR12, DRNH4NO3, CALCR1A, CALCR2A)
8231                SCASE = 'R1 ; SUBCASE 15'
8232             ENDIF
8233          ENDIF
8234 !
8235       ELSE IF (.NOT.EXSC) THEN                  ! *** NACL   = 0
8236          IF      (     EXAN .AND.      EXAC .AND.      EXSN) THEN
8237             IF (RH.GE.DRMR13) THEN
8238                SCASE = 'R1 ; SUBCASE 16'
8239                CALL CALCMDRP (RH, DRMR13, DRNH4NO3, CALCR1A, CALCR2A)
8240                SCASE = 'R1 ; SUBCASE 16'
8241             ENDIF
8242          ENDIF
8243       ENDIF
8244 !
8245       RETURN
8246 !
8247 ! *** END OF SUBROUTINE CALCR1 ******************************************
8248 !
8249     END SUBROUTINE CALCR1
8250
8251
8252 !=======================================================================
8253 !
8254 ! *** ISORROPIA CODE
8255 ! *** SUBROUTINE CALCR1A
8256 ! *** CASE R1 ; SUBCASE 1
8257 !
8258 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8259 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
8260 !     2. SOLID AEROSOL ONLY
8261 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4, NANO3, NACL
8262 !
8263 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8264 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8265 ! *** WRITTEN BY ATHANASIOS NENES
8266 !
8267 !=======================================================================
8268 !
8269       SUBROUTINE CALCR1A
8270       implicit none
8271       REAL(KIND=8) FRNA,CNANO3, FRNO3,  FRCL, FRNH3
8272 !
8273 ! *** CALCULATE SOLIDS **************************************************
8274 !
8275       CNA2SO4 = WAER(2)
8276       FRNA    = MAX (WAER(1)-2*CNA2SO4, ZERO)
8277 !
8278       CNH42S4 = ZERO
8279 !
8280       CNANO3  = MIN (FRNA, WAER(4))
8281       FRNO3   = MAX (WAER(4)-CNANO3, ZERO)
8282       FRNA    = MAX (FRNA-CNANO3, ZERO)
8283 !
8284       CNACL   = MIN (FRNA, WAER(5))
8285       FRCL    = MAX (WAER(5)-CNACL, ZERO)
8286       FRNA    = MAX (FRNA-CNACL, ZERO)
8287 !
8288       CNH4NO3 = MIN (FRNO3, WAER(3))
8289       FRNO3   = MAX (FRNO3-CNH4NO3, ZERO)
8290       FRNH3   = MAX (WAER(3)-CNH4NO3, ZERO)
8291 !
8292       CNH4CL  = MIN (FRCL, FRNH3)
8293       FRCL    = MAX (FRCL-CNH4CL, ZERO)
8294       FRNH3   = MAX (FRNH3-CNH4CL, ZERO)
8295 !
8296 ! *** OTHER PHASES ******************************************************
8297 !
8298       WATER   = ZERO
8299 !
8300       GNH3    = ZERO
8301       GHNO3   = ZERO
8302       GHCL    = ZERO
8303 !
8304       RETURN
8305 !
8306 ! *** END OF SUBROUTINE CALCR1A *****************************************
8307 !
8308     END SUBROUTINE CALCR1A
8309
8310
8311
8312 ! ISOFWD CODE
8313
8314 !=======================================================================
8315 !
8316 ! *** ISORROPIA CODE
8317 ! *** SUBROUTINE ISRP1F
8318 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF
8319 !     AN AMMONIUM-SULFATE AEROSOL SYSTEM.
8320 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
8321 !     THE AMBIENT RELATIVE HUMIDITY.
8322 !
8323 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8324 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8325 ! *** WRITTEN BY ATHANASIOS NENES
8326 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8327 !
8328 !=======================================================================
8329 !
8330       SUBROUTINE ISRP1F (WI, RHI, TEMPI)
8331       implicit none
8332       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
8333       REAL(KIND=8) DC
8334 !
8335 ! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
8336 !
8337       CALL INIT1 (WI, RHI, TEMPI)
8338 !
8339 ! *** CALCULATE SULFATE RATIO *******************************************
8340 !
8341       SULRAT = W(3)/W(2)
8342 !
8343 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
8344 !
8345 ! *** SULFATE POOR
8346 !
8347       IF (2.0.LE.SULRAT) THEN
8348       DC   = W(3) - 2.001D0*W(2)  ! For numerical stability
8349       W(3) = W(3) + MAX(-DC, ZERO)
8350 !
8351       IF(METSTBL.EQ.1) THEN
8352          SCASE = 'A2'
8353          CALL CALCA2                 ! Only liquid (metastable)
8354       ELSE
8355 !
8356          IF (RH.LT.DRNH42S4) THEN
8357             SCASE = 'A1'
8358             CALL CALCA1              ! NH42SO4              ; case A1
8359 !
8360          ELSEIF (DRNH42S4.LE.RH) THEN
8361             SCASE = 'A2'
8362             CALL CALCA2              ! Only liquid          ; case A2
8363          ENDIF
8364       ENDIF
8365 !
8366 ! *** SULFATE RICH (NO ACID)
8367 !
8368       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
8369 !
8370       IF(METSTBL.EQ.1) THEN
8371          SCASE = 'B4'
8372          CALL CALCB4                 ! Only liquid (metastable)
8373       ELSE
8374 !
8375          IF (RH.LT.DRNH4HS4) THEN
8376             SCASE = 'B1'
8377             CALL CALCB1              ! NH4HSO4,LC,NH42SO4   ; case B1
8378 !
8379          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
8380             SCASE = 'B2'
8381             CALL CALCB2              ! LC,NH42S4            ; case B2
8382 !
8383          ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
8384             SCASE = 'B3'
8385             CALL CALCB3              ! NH42S4               ; case B3
8386 !
8387          ELSEIF (DRNH42S4.LE.RH) THEN
8388             SCASE = 'B4'
8389             CALL CALCB4              ! Only liquid          ; case B4
8390          ENDIF
8391       ENDIF
8392       CALL CALCNH3
8393 !
8394 ! *** SULFATE RICH (FREE ACID)
8395 !
8396       ELSEIF (SULRAT.LT.1.0) THEN
8397 !
8398       IF(METSTBL.EQ.1) THEN
8399          SCASE = 'C2'
8400          CALL CALCC2                 ! Only liquid (metastable)
8401       ELSE
8402 !
8403          IF (RH.LT.DRNH4HS4) THEN
8404             SCASE = 'C1'
8405             CALL CALCC1              ! NH4HSO4              ; case C1
8406 !
8407          ELSEIF (DRNH4HS4.LE.RH) THEN
8408             SCASE = 'C2'
8409             CALL CALCC2              ! Only liquid          ; case C2
8410 !
8411          ENDIF
8412       ENDIF
8413       CALL CALCNH3
8414       ENDIF
8415 !
8416 ! *** RETURN POINT
8417 !
8418       RETURN
8419 !
8420 ! *** END OF SUBROUTINE ISRP1F *****************************************
8421 !
8422     END SUBROUTINE ISRP1F
8423
8424
8425
8426 !=======================================================================
8427 !
8428 ! *** ISORROPIA CODE
8429 ! *** SUBROUTINE ISRP2F
8430 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF
8431 !     AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM.
8432 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
8433 !     THE AMBIENT RELATIVE HUMIDITY.
8434 !
8435 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8436 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8437 ! *** WRITTEN BY ATHANASIOS NENES
8438 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8439 !
8440 !=======================================================================
8441 !
8442       SUBROUTINE ISRP2F (WI, RHI, TEMPI)
8443       implicit none
8444
8445       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
8446 !
8447 ! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
8448 !
8449       CALL INIT2 (WI, RHI, TEMPI)
8450 !
8451 ! *** CALCULATE SULFATE RATIO *******************************************
8452 !
8453       SULRAT = W(3)/W(2)
8454 !
8455 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
8456 !
8457 ! *** SULFATE POOR
8458 !
8459       IF (2.0.LE.SULRAT) THEN
8460 !
8461       IF(METSTBL.EQ.1) THEN
8462          SCASE = 'D3'
8463          CALL CALCD3                 ! Only liquid (metastable)
8464       ELSE
8465 !
8466          IF (RH.LT.DRNH4NO3) THEN
8467             SCASE = 'D1'
8468             CALL CALCD1              ! NH42SO4,NH4NO3       ; case D1
8469 !
8470          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH42S4) THEN
8471             SCASE = 'D2'
8472             CALL CALCD2              ! NH42S4               ; case D2
8473 !
8474          ELSEIF (DRNH42S4.LE.RH) THEN
8475             SCASE = 'D3'
8476             CALL CALCD3              ! Only liquid          ; case D3
8477          ENDIF
8478       ENDIF
8479 !
8480 ! *** SULFATE RICH (NO ACID)
8481 !     FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES,
8482 !     THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM.
8483 !     SUBROUTINES CALCB? ARE CALLED, AND THEN THE NITRIC ACID IS DISSOLVED
8484 !     FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM.
8485 !
8486       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
8487 !
8488       IF(METSTBL.EQ.1) THEN
8489          SCASE = 'B4'
8490          CALL CALCB4                 ! Only liquid (metastable)
8491          SCASE = 'E4'
8492       ELSE
8493 !
8494          IF (RH.LT.DRNH4HS4) THEN
8495             SCASE = 'B1'
8496             CALL CALCB1              ! NH4HSO4,LC,NH42SO4   ; case E1
8497             SCASE = 'E1'
8498 !
8499          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
8500             SCASE = 'B2'
8501             CALL CALCB2              ! LC,NH42S4            ; case E2
8502             SCASE = 'E2'
8503 !
8504          ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
8505             SCASE = 'B3'
8506             CALL CALCB3              ! NH42S4               ; case E3
8507             SCASE = 'E3'
8508 !
8509          ELSEIF (DRNH42S4.LE.RH) THEN
8510             SCASE = 'B4'
8511             CALL CALCB4              ! Only liquid          ; case E4
8512             SCASE = 'E4'
8513          ENDIF
8514       ENDIF
8515 !
8516       CALL CALCNA                 ! HNO3(g) DISSOLUTION
8517 !
8518 ! *** SULFATE RICH (FREE ACID)
8519 !     FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES,
8520 !     THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM
8521 !     SUBROUTINE CALCC? IS CALLED, AND THEN THE NITRIC ACID IS DISSOLVED
8522 !     FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM.
8523 !
8524       ELSEIF (SULRAT.LT.1.0) THEN
8525 !
8526       IF(METSTBL.EQ.1) THEN
8527          SCASE = 'C2'
8528          CALL CALCC2                 ! Only liquid (metastable)
8529          SCASE = 'F2'
8530       ELSE
8531 !
8532          IF (RH.LT.DRNH4HS4) THEN
8533             SCASE = 'C1'
8534             CALL CALCC1              ! NH4HSO4              ; case F1
8535             SCASE = 'F1'
8536 !
8537          ELSEIF (DRNH4HS4.LE.RH) THEN
8538             SCASE = 'C2'
8539             CALL CALCC2              ! Only liquid          ; case F2
8540             SCASE = 'F2'
8541          ENDIF
8542       ENDIF
8543 !
8544       CALL CALCNA                 ! HNO3(g) DISSOLUTION
8545       ENDIF
8546 !
8547 ! *** RETURN POINT
8548 !
8549       RETURN
8550 !
8551 ! *** END OF SUBROUTINE ISRP2F *****************************************
8552 !
8553     END SUBROUTINE ISRP2F
8554 !=======================================================================
8555 !
8556 ! *** ISORROPIA CODE
8557 ! *** SUBROUTINE ISRP3F
8558 ! *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF
8559 !     AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM.
8560 !     THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM
8561 !     RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY.
8562 !
8563 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8564 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8565 ! *** WRITTEN BY ATHANASIOS NENES
8566 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8567 !
8568 !=======================================================================
8569 !
8570       SUBROUTINE ISRP3F (WI, RHI, TEMPI)
8571       implicit none
8572       REAL(KIND=8) WI(NCOMP), RHI, TEMPI
8573       REAL(KIND=8) REST
8574 !
8575 ! *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE ***********************
8576 !
8577       WI(3) = MAX (WI(3), 1.D-10)  ! NH4+ : 1e-4 umoles/m3
8578       WI(5) = MAX (WI(5), 1.D-10)  ! Cl-  : 1e-4 umoles/m3
8579 !
8580 ! *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ********
8581 !
8582       IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN
8583          WI(1) = 1.D-10  ! Na+  : 1e-4 umoles/m3
8584          WI(2) = 1.D-10  ! SO4- : 1e-4 umoles/m3
8585       ENDIF
8586 !
8587 ! *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
8588 !
8589       CALL ISOINIT3 (WI, RHI, TEMPI)
8590 !
8591 ! *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE *********
8592 !
8593       REST = 2.D0*W(2) + W(4) + W(5)
8594       IF (W(1).GT.REST) THEN            ! NA > 2*SO4+CL+NO3 ?
8595          W(1) = (ONE-1D-6)*REST         ! Adjust Na amount
8596          CALL PUSHERR (0050, 'ISRP3F')  ! Warning error: Na adjusted
8597       ENDIF
8598 !
8599 ! *** CALCULATE SULFATE & SODIUM RATIOS *********************************
8600 !
8601       SULRAT = (W(1)+W(3))/W(2)
8602       SODRAT = W(1)/W(2)
8603 !
8604 ! *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
8605 !
8606 ! *** SULFATE POOR ; SODIUM POOR
8607 !
8608       IF (2.0.LE.SULRAT .AND. SODRAT.LT.2.0) THEN
8609 !
8610       IF(METSTBL.EQ.1) THEN
8611          SCASE = 'G5'
8612          CALL CALCG5                 ! Only liquid (metastable)
8613       ELSE
8614 !
8615          IF (RH.LT.DRNH4NO3) THEN
8616             SCASE = 'G1'
8617             CALL CALCG1              ! NH42SO4,NH4NO3,NH4CL,NA2SO4
8618 !
8619          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN
8620             SCASE = 'G2'
8621             CALL CALCG2              ! NH42SO4,NH4CL,NA2SO4
8622 !
8623          ELSEIF (DRNH4CL.LE.RH  .AND. RH.LT.DRNH42S4) THEN
8624             SCASE = 'G3'
8625             CALL CALCG3              ! NH42SO4,NA2SO4
8626 !
8627         ELSEIF (DRNH42S4.LE.RH  .AND. RH.LT.DRNA2SO4) THEN
8628             SCASE = 'G4'
8629             CALL CALCG4              ! NA2SO4
8630 !
8631          ELSEIF (DRNA2SO4.LE.RH) THEN
8632             SCASE = 'G5'
8633             CALL CALCG5              ! Only liquid
8634          ENDIF
8635       ENDIF
8636 !
8637 ! *** SULFATE POOR ; SODIUM RICH
8638 !
8639       ELSE IF (SULRAT.GE.2.0 .AND. SODRAT.GE.2.0) THEN
8640 !
8641       IF(METSTBL.EQ.1) THEN
8642          SCASE = 'H6'
8643          CALL CALCH6                 ! Only liquid (metastable)
8644       ELSE
8645 !
8646          IF (RH.LT.DRNH4NO3) THEN
8647             SCASE = 'H1'
8648             CALL CALCH1              ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3
8649 !
8650          ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN
8651             SCASE = 'H2'
8652             CALL CALCH2              ! NH4CL,NA2SO4,NACL,NANO3
8653 !
8654          ELSEIF (DRNANO3.LE.RH  .AND. RH.LT.DRNACL) THEN
8655             SCASE = 'H3'
8656             CALL CALCH3              ! NH4CL,NA2SO4,NACL
8657 !
8658          ELSEIF (DRNACL.LE.RH   .AND. RH.LT.DRNH4Cl) THEN
8659             SCASE = 'H4'
8660             CALL CALCH4              ! NH4CL,NA2SO4
8661 !
8662          ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRNA2SO4) THEN
8663             SCASE = 'H5'
8664             CALL CALCH5              ! NA2SO4
8665 !
8666          ELSEIF (DRNA2SO4.LE.RH) THEN
8667             SCASE = 'H6'
8668             CALL CALCH6              ! NO SOLID
8669          ENDIF
8670       ENDIF
8671 !
8672 ! *** SULFATE RICH (NO ACID)
8673 !
8674       ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
8675 !
8676       IF(METSTBL.EQ.1) THEN
8677          SCASE = 'I6'
8678          CALL CALCI6                 ! Only liquid (metastable)
8679       ELSE
8680 !
8681          IF (RH.LT.DRNH4HS4) THEN
8682             SCASE = 'I1'
8683             CALL CALCI1              ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC
8684 !
8685          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
8686             SCASE = 'I2'
8687             CALL CALCI2              ! NA2SO4,(NH4)2SO4,NAHSO4,LC
8688 !
8689          ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN
8690             SCASE = 'I3'
8691             CALL CALCI3              ! NA2SO4,(NH4)2SO4,LC
8692 !
8693          ELSEIF (DRLC.LE.RH     .AND. RH.LT.DRNH42S4) THEN
8694             SCASE = 'I4'
8695             CALL CALCI4              ! NA2SO4,(NH4)2SO4
8696 !
8697          ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
8698             SCASE = 'I5'
8699             CALL CALCI5              ! NA2SO4
8700 !
8701          ELSEIF (DRNA2SO4.LE.RH) THEN
8702             SCASE = 'I6'
8703             CALL CALCI6              ! NO SOLIDS
8704          ENDIF
8705       ENDIF
8706 !
8707       CALL CALCNHA                ! MINOR SPECIES: HNO3, HCl
8708       CALL CALCNH3                !                NH3
8709 !
8710 ! *** SULFATE RICH (FREE ACID)
8711 !
8712       ELSEIF (SULRAT.LT.1.0) THEN
8713 !
8714       IF(METSTBL.EQ.1) THEN
8715          SCASE = 'J3'
8716          CALL CALCJ3                 ! Only liquid (metastable)
8717       ELSE
8718 !
8719          IF (RH.LT.DRNH4HS4) THEN
8720             SCASE = 'J1'
8721             CALL CALCJ1              ! NH4HSO4,NAHSO4
8722 !
8723          ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
8724             SCASE = 'J2'
8725             CALL CALCJ2              ! NAHSO4
8726 !
8727          ELSEIF (DRNAHSO4.LE.RH) THEN
8728             SCASE = 'J3'
8729             CALL CALCJ3
8730          ENDIF
8731       ENDIF
8732 !
8733       CALL CALCNHA                ! MINOR SPECIES: HNO3, HCl
8734       CALL CALCNH3                !                NH3
8735       ENDIF
8736 !
8737 ! *** RETURN POINT
8738 !
8739       RETURN
8740 !
8741 ! *** END OF SUBROUTINE ISRP3F *****************************************
8742 !
8743     END SUBROUTINE ISRP3F
8744 !=======================================================================
8745 !
8746 ! *** ISORROPIA CODE
8747 ! *** SUBROUTINE CALCA2
8748 ! *** CASE A2
8749 !
8750 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8751 !     1. SULFATE POOR (SULRAT > 2.0)
8752 !     2. LIQUID AEROSOL PHASE ONLY POSSIBLE
8753 !
8754 !     FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS X, THE
8755 !     AMOUNT OF HYDROGEN IONS (H+) FOUND IN THE LIQUID PHASE.
8756 !     FOR EACH ESTIMATION OF H+, FUNCTION FUNCB2A CALCULATES THE
8757 !     CONCENTRATION OF IONS FROM THE NH3(GAS) - NH4+(LIQ) EQUILIBRIUM.
8758 !     ELECTRONEUTRALITY IS USED AS THE OBJECTIVE FUNCTION.
8759 !
8760 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8761 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8762 ! *** WRITTEN BY ATHANASIOS NENES
8763 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8764 !
8765 !=======================================================================
8766 !
8767       SUBROUTINE CALCA2
8768       implicit none
8769       REAL(KIND=8) REST,OMELO, OMEHI, X1, X2, X3, Y1, Y2, Y3, DX
8770       INTEGER I
8771
8772 ! *** SETUP PARAMETERS ************************************************
8773 !
8774       CALAOU    =.TRUE.       ! Outer loop activity calculation flag
8775       OMELO     = TINY        ! Low  limit: SOLUTION IS VERY BASIC
8776       OMEHI     = 2.0D0*W(2)  ! High limit: FROM NH4+ -> NH3(g) + H+(aq)
8777 !
8778 ! *** CALCULATE WATER CONTENT *****************************************
8779 !
8780       MOLAL(5) = W(2)
8781       MOLAL(6) = ZERO
8782       CALL CALCMR
8783 !
8784 ! *** INITIAL VALUES FOR BISECTION ************************************
8785 !
8786       X1 = OMEHI
8787       Y1 = FUNCA2 (X1)
8788       IF (ABS(Y1).LE.EPS) RETURN
8789 !
8790 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
8791 !
8792       DX = (OMEHI-OMELO)/FLOAT(NDIV)
8793       DO 10 I=1,NDIV
8794          X2 = MAX(X1-DX, OMELO)
8795          Y2 = FUNCA2 (X2)
8796          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
8797          X1 = X2
8798          Y1 = Y2
8799 10    CONTINUE
8800       IF (ABS(Y2).LE.EPS) THEN
8801          RETURN
8802       ELSE
8803          CALL PUSHERR (0001, 'CALCA2')    ! WARNING ERROR: NO SOLUTION
8804          RETURN
8805       ENDIF
8806 !
8807 ! *** PERFORM BISECTION ***********************************************
8808 !
8809 20    DO 30 I=1,MAXIT
8810          X3 = 0.5*(X1+X2)
8811          Y3 = FUNCA2 (X3)
8812          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
8813             Y2    = Y3
8814             X2    = X3
8815          ELSE
8816             Y1    = Y3
8817             X1    = X3
8818          ENDIF
8819          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
8820 30    CONTINUE
8821       CALL PUSHERR (0002, 'CALCA2')    ! WARNING ERROR: NO CONVERGENCE
8822 !
8823 ! *** CONVERGED ; RETURN **********************************************
8824 !
8825 40    X3 = 0.5*(X1+X2)
8826       Y3 = FUNCA2 (X3)
8827       RETURN
8828 !
8829 ! *** END OF SUBROUTINE CALCA2 ****************************************
8830 !
8831    END SUBROUTINE CALCA2
8832
8833
8834
8835 !=======================================================================
8836 !
8837 ! *** ISORROPIA CODE
8838 ! *** FUNCTION FUNCA2
8839 ! *** CASE A2
8840 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE A2 ;
8841 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA2.
8842 !
8843 !=======================================================================
8844 !
8845    REAL(KIND=8) FUNCTION FUNCA2 (OMEGI)
8846      implicit none
8847      REAL(KIND=8) OMEGI
8848      REAL(KIND=8) LAMDA, PSI, A1, A2, A3, ZETA, DENOM
8849      INTEGER I
8850
8851 !
8852 ! *** SETUP PARAMETERS ************************************************
8853 !
8854       FRST   = .TRUE.
8855       CALAIN = .TRUE.
8856       PSI    = W(2)         ! INITIAL AMOUNT OF (NH4)2SO4 IN SOLUTION
8857 !
8858 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
8859 !
8860       DO 10 I=1,NSWEEP
8861          A1    = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
8862          A2    = XK2*R*TEMP/XKW*(GAMA(8)/GAMA(9))**2.
8863          A3    = XKW*RH*WATER*WATER
8864 !
8865          LAMDA = PSI/(A1/OMEGI+ONE)
8866          ZETA  = A3/OMEGI
8867 !
8868 ! *** SPECIATION & WATER CONTENT ***************************************
8869 !
8870          MOLAL (1) = OMEGI                        ! HI
8871          MOLAL (3) = W(3)/(ONE/A2/OMEGI + ONE)    ! NH4I
8872          MOLAL (5) = MAX(PSI-LAMDA,TINY)          ! SO4I
8873          MOLAL (6) = LAMDA                        ! HSO4I
8874          GNH3      = MAX (W(3)-MOLAL(3), TINY)    ! NH3GI
8875          COH       = ZETA                         ! OHI
8876 !
8877 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8878 !
8879          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
8880             CALL CALCACT
8881          ELSE
8882             GOTO 20
8883          ENDIF
8884 10    CONTINUE
8885 !
8886 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
8887 !
8888 20    DENOM = (2.0*MOLAL(5)+MOLAL(6))
8889       FUNCA2= (MOLAL(3)/DENOM - ONE) + MOLAL(1)/DENOM
8890       RETURN
8891 !
8892 ! *** END OF FUNCTION FUNCA2 ********************************************
8893 !
8894     END FUNCTION FUNCA2
8895
8896
8897 !=======================================================================
8898 !
8899 ! *** ISORROPIA CODE
8900 ! *** SUBROUTINE CALCA1
8901 ! *** CASE A1
8902 !
8903 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8904 !     1. SULFATE POOR (SULRAT > 2.0)
8905 !     2. SOLID AEROSOL ONLY
8906 !     3. SOLIDS POSSIBLE : (NH4)2SO4
8907 !
8908 !     A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4
8909 !     IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN
8910 !     THE GAS PHASE.
8911 !
8912 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8913 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8914 ! *** WRITTEN BY ATHANASIOS NENES
8915 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8916 !
8917 !=======================================================================
8918 !
8919       SUBROUTINE CALCA1
8920         implicit none
8921 !
8922       CNH42S4 = W(2)
8923       GNH3    = MAX (W(3)-2.0*CNH42S4, ZERO)
8924       RETURN
8925 !
8926 ! *** END OF SUBROUTINE CALCA1 ******************************************
8927 !
8928     END SUBROUTINE CALCA1
8929
8930
8931
8932 !=======================================================================
8933 !
8934 ! *** ISORROPIA CODE
8935 ! *** SUBROUTINE CALCB4
8936 ! *** CASE B4
8937 !
8938 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8939 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
8940 !     2. LIQUID AEROSOL PHASE ONLY POSSIBLE
8941 !
8942 !     FOR CALCULATIONS, A BISECTION IS PERFORMED WITH RESPECT TO H+.
8943 !     THE OBJECTIVE FUNCTION IS THE DIFFERENCE BETWEEN THE ESTIMATED H+
8944 !     AND THAT CALCULATED FROM ELECTRONEUTRALITY.
8945 !
8946 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8947 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
8948 ! *** WRITTEN BY ATHANASIOS NENES
8949 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
8950 !
8951 !=======================================================================
8952 !
8953       SUBROUTINE CALCB4
8954       implicit none
8955       REAL(KIND=8) ALF, BET, GAM, AK1, BB, CC, DD
8956       INTEGER I
8957 !
8958 ! *** SOLVE EQUATIONS **************************************************
8959 !
8960       FRST       = .TRUE.
8961       CALAIN     = .TRUE.
8962       CALAOU     = .TRUE.
8963 !
8964 ! *** CALCULATE WATER CONTENT ******************************************
8965 !
8966       CALL CALCB1A         ! GET DRY SALT CONTENT, AND USE FOR WATER.
8967       MOLALR(13) = CLC
8968       MOLALR(9)  = CNH4HS4
8969       MOLALR(4)  = CNH42S4
8970       CLC        = ZERO
8971       CNH4HS4    = ZERO
8972       CNH42S4    = ZERO
8973       WATER      = MOLALR(13)/M0(13)+MOLALR(9)/M0(9)+MOLALR(4)/M0(4)
8974 !
8975       MOLAL(3)   = W(3)   ! NH4I
8976 !
8977       DO 20 I=1,NSWEEP
8978          AK1   = XK1*((GAMA(8)/GAMA(7))**2.)*(WATER/GAMA(7))
8979          BET   = W(2)
8980          GAM   = MOLAL(3)
8981 !
8982          BB    = BET + AK1 - GAM
8983          CC    =-AK1*BET
8984          DD    = BB*BB - 4.D0*CC
8985 !
8986 ! *** SPECIATION & WATER CONTENT ***************************************
8987 !
8988          MOLAL (5) = MAX(TINY,MIN(0.5*(-BB + SQRT(DD)), W(2))) ! SO4I
8989          MOLAL (6) = MAX(TINY,MIN(W(2)-MOLAL(5),W(2)))         ! HSO4I
8990          MOLAL (1) = MAX(TINY,MIN(AK1*MOLAL(6)/MOLAL(5),W(2))) ! HI
8991          CALL CALCMR                                           ! Water content
8992 !
8993 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8994 !
8995          IF (.NOT.CALAIN) GOTO 30
8996          CALL CALCACT
8997 20    CONTINUE
8998 !
8999 30    RETURN
9000 !
9001 ! *** END OF SUBROUTINE CALCB4 ******************************************
9002 !
9003       END SUBROUTINE CALCB4
9004 !=======================================================================
9005 !
9006 ! *** ISORROPIA CODE
9007 ! *** SUBROUTINE CALCB3
9008 ! *** CASE B3
9009 !
9010 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9011 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
9012 !     2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
9013 !     3. SOLIDS POSSIBLE: (NH4)2SO4
9014 !
9015 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9016 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9017 ! *** WRITTEN BY ATHANASIOS NENES
9018 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9019 !
9020 !=======================================================================
9021 !
9022       SUBROUTINE CALCB3
9023       implicit none
9024       REAL(KIND=8) X,Y,TLC,TNH42S4, TNH4HS4
9025 !
9026 ! *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 ***********************
9027 !
9028       X = MAX(2*W(2)-W(3), ZERO)   ! Equivalent NH4HSO4
9029       Y = MAX(W(3)  -W(2), ZERO)   ! Equivalent NH42SO4
9030 !
9031 ! *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 *********
9032 !
9033       IF (X.LT.Y) THEN             ! LC is the MIN (x,y)
9034          SCASE   = 'B3 ; SUBCASE 1'
9035          TLC     = X
9036          TNH42S4 = Y-X
9037          CALL CALCB3A (TLC,TNH42S4)      ! LC + (NH4)2SO4
9038       ELSE
9039          SCASE   = 'B3 ; SUBCASE 2'
9040          TLC     = Y
9041          TNH4HS4 = X-Y
9042          CALL CALCB3B (TLC,TNH4HS4)      ! LC + NH4HSO4
9043       ENDIF
9044 !
9045       RETURN
9046 !
9047 ! *** END OF SUBROUTINE CALCB3 ******************************************
9048 !
9049     END SUBROUTINE CALCB3
9050
9051
9052 !=======================================================================
9053 !
9054 ! *** ISORROPIA CODE
9055 ! *** SUBROUTINE CALCB3A
9056 ! *** CASE B3 ; SUBCASE 1
9057 !
9058 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9059 !     1. SULFATE RICH (1.0 < SULRAT < 2.0)
9060 !     2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
9061 !     3. SOLIDS POSSIBLE: (NH4)2SO4
9062 !
9063 !     FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE
9064 !     AMOUNT OF SOLID (NH4)2SO4 DISSOLVED IN THE LIQUID PHASE.
9065 !     FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB3A CALCULATES THE
9066 !     AMOUNT OF H+ PRODUCED (BASED ON THE SO4 RELEASED INTO THE
9067 !     SOLUTION). THE SOLUBILITY PRODUCT OF (NH4)2SO4 IS USED AS THE
9068 !     OBJECTIVE FUNCTION.
9069 !
9070 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9071 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9072 ! *** WRITTEN BY ATHANASIOS NENES
9073 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9074 !
9075 !=======================================================================
9076 !
9077       SUBROUTINE CALCB3A (TLC, TNH42S4)
9078       implicit none
9079       REAL(KIND=8) TLC, TNH42S4
9080       REAL(KIND=8)  ZLO, ZHI, Z1, Z2, Z3, ZK, YLO, YHI, Y1, Y2, Y3, DZ
9081       INTEGER I
9082 !
9083       CALAOU = .TRUE.         ! Outer loop activity calculation flag
9084       ZLO    = ZERO           ! MIN DISSOLVED (NH4)2SO4
9085       ZHI    = TNH42S4        ! MAX DISSOLVED (NH4)2SO4
9086 !
9087 ! *** INITIAL VALUES FOR BISECTION (DISSOLVED (NH4)2SO4 ****************
9088 !
9089       Z1 = ZLO
9090       Y1 = FUNCB3A (Z1, TLC, TNH42S4)
9091       IF (ABS(Y1).LE.EPS) RETURN
9092       YLO= Y1
9093 !
9094 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
9095 !
9096       DZ = (ZHI-ZLO)/FLOAT(NDIV)
9097       DO 10 I=1,NDIV
9098          Z2 = Z1+DZ
9099          Y2 = FUNCB3A (Z2, TLC, TNH42S4)
9100          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
9101          Z1 = Z2
9102          Y1 = Y2
9103 10    CONTINUE
9104 !
9105 ! *** NO SUBDIVISION WITH SOLUTION FOUND
9106 !
9107       YHI= Y1                      ! Save Y-value at HI position
9108       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
9109          RETURN
9110 !
9111 ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC
9112 !
9113       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
9114          Z1 = ZHI
9115          Z2 = ZHI
9116          GOTO 40
9117 !
9118 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
9119 !
9120       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
9121          Z1 = ZLO
9122          Z2 = ZLO
9123          GOTO 40
9124       ELSE
9125          CALL PUSHERR (0001, 'CALCB3A')    ! WARNING ERROR: NO SOLUTION
9126          RETURN
9127       ENDIF
9128 !
9129 ! *** PERFORM BISECTION ***********************************************
9130 !
9131 20    DO 30 I=1,MAXIT
9132          Z3 = 0.5*(Z1+Z2)
9133          Y3 = FUNCB3A (Z3, TLC, TNH42S4)
9134          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
9135             Y2    = Y3
9136             Z2    = Z3
9137          ELSE
9138             Y1    = Y3
9139             Z1    = Z3
9140          ENDIF
9141          IF (ABS(Z2-Z1) .LE. EPS*Z1) GOTO 40
9142 30    CONTINUE
9143       CALL PUSHERR (0002, 'CALCB3A')    ! WARNING ERROR: NO CONVERGENCE
9144 !
9145 ! *** CONVERGED ; RETURN ************************************************
9146 !
9147 40    ZK = 0.5*(Z1+Z2)
9148       Y3 = FUNCB3A (ZK, TLC, TNH42S4)
9149 !
9150       RETURN
9151 !
9152 ! *** END OF SUBROUTINE CALCB3A  ******************************************
9153 !
9154       END SUBROUTINE CALCB3A
9155
9156
9157
9158 !=======================================================================
9159 !
9160 ! *** ISORROPIA CODE
9161 ! *** FUNCTION FUNCB3A
9162 ! *** CASE B3 ; SUBCASE 1
9163 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B3
9164 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA3.
9165 !
9166 !=======================================================================
9167 !
9168       DOUBLE PRECISION FUNCTION FUNCB3A (ZK, Y, X)
9169       implicit none
9170       REAL(KIND=8) ZK, Y, X
9171       REAL(KIND=8) KK, GRAT1, DD
9172       INTEGER I
9173 !
9174 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9175 !
9176       FRST   = .TRUE.
9177       CALAIN = .TRUE.
9178       DO 20 I=1,NSWEEP
9179          GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9180          DD    = SQRT( (ZK+GRAT1+Y)**2. + 4.0*Y*GRAT1)
9181          KK    = 0.5*(-(ZK+GRAT1+Y) + DD )
9182 !
9183 ! *** SPECIATION & WATER CONTENT ***************************************
9184 !
9185          MOLAL (1) = KK                ! HI
9186          MOLAL (5) = KK+ZK+Y           ! SO4I
9187          MOLAL (6) = MAX (Y-KK, TINY)  ! HSO4I
9188          MOLAL (3) = 3.0*Y+2*ZK        ! NH4I
9189          CNH42S4   = X-ZK              ! Solid (NH4)2SO4
9190          CALL CALCMR                   ! Water content
9191 !
9192 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9193 !
9194          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9195             CALL CALCACT
9196          ELSE
9197             GOTO 30
9198          ENDIF
9199 20    CONTINUE
9200 !
9201 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
9202 !
9203 !CC30    FUNCB3A= ( SO4I*NH4I**2.0 )/( XK7*(WATER/GAMA(4))**3.0 )
9204 30    FUNCB3A= MOLAL(5)*MOLAL(3)**2.0
9205       FUNCB3A= FUNCB3A/(XK7*(WATER/GAMA(4))**3.0) - ONE
9206       RETURN
9207 !
9208 ! *** END OF FUNCTION FUNCB3A ********************************************
9209 !
9210       END FUNCTION FUNCB3A
9211
9212
9213
9214 !=======================================================================
9215 !
9216 ! *** ISORROPIA CODE
9217 ! *** SUBROUTINE CALCB3B
9218 ! *** CASE B3 ; SUBCASE 2
9219 !
9220 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9221 !     1. SULFATE RICH (1.0 < SULRAT < 2.0)
9222 !     2. LIQUID PHASE ONLY IS POSSIBLE
9223 !
9224 !     SPECIATION CALCULATIONS IS BASED ON THE HSO4 <--> SO4 EQUILIBRIUM.
9225 !
9226 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9227 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9228 ! *** WRITTEN BY ATHANASIOS NENES
9229 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9230 !
9231 !=======================================================================
9232 !
9233       SUBROUTINE CALCB3B (Y, X)
9234       implicit none
9235       REAL(KIND=8) Y,X
9236       REAL(KIND=8) KK, GRAT1, DD
9237       INTEGER I
9238 !
9239       CALAOU = .FALSE.        ! Outer loop activity calculation flag
9240       FRST   = .FALSE.
9241       CALAIN = .TRUE.
9242 !
9243 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9244 !
9245       DO 20 I=1,NSWEEP
9246          GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9247          DD    = SQRT( (GRAT1+Y)**2. + 4.0*(X+Y)*GRAT1)
9248          KK    = 0.5*(-(GRAT1+Y) + DD )
9249 !
9250 ! *** SPECIATION & WATER CONTENT ***************************************
9251 !
9252          MOLAL (1) = KK                   ! HI
9253          MOLAL (5) = Y+KK                 ! SO4I
9254          MOLAL (6) = MAX (X+Y-KK, TINY)   ! HSO4I
9255          MOLAL (3) = 3.0*Y+X              ! NH4I
9256          CALL CALCMR                      ! Water content
9257 !
9258 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9259 !
9260          IF (.NOT.CALAIN) GOTO 30
9261          CALL CALCACT
9262 20    CONTINUE
9263 !
9264 30    RETURN
9265 !
9266 ! *** END OF SUBROUTINE CALCB3B ******************************************
9267 !
9268       END SUBROUTINE CALCB3B
9269 !=======================================================================
9270 !
9271 ! *** ISORROPIA CODE
9272 ! *** SUBROUTINE CALCB2
9273 ! *** CASE B2
9274 !
9275 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9276 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
9277 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
9278 !     3. SOLIDS POSSIBLE : LC, (NH4)2SO4
9279 !
9280 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON THE SULFATE RATIO:
9281 !     1. WHEN BOTH LC AND (NH4)2SO4 ARE POSSIBLE (SUBROUTINE CALCB2A)
9282 !     2. WHEN ONLY LC IS POSSIBLE (SUBROUTINE CALCB2B).
9283 !
9284 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9285 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9286 ! *** WRITTEN BY ATHANASIOS NENES
9287 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9288 !
9289 !=======================================================================
9290 !
9291       SUBROUTINE CALCB2
9292       implicit none
9293       REAL(KIND=8) X, Y
9294 !
9295 ! *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 ***********************
9296 !
9297       X = MAX(2*W(2)-W(3), TINY)   ! Equivalent NH4HSO4
9298       Y = MAX(W(3)  -W(2), TINY)   ! Equivalent NH42SO4
9299 !
9300 ! *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 *********
9301 !
9302       IF (X.LE.Y) THEN             ! LC is the MIN (x,y)
9303          SCASE = 'B2 ; SUBCASE 1'
9304          CALL CALCB2A (X,Y-X)      ! LC + (NH4)2SO4 POSSIBLE
9305       ELSE
9306          SCASE = 'B2 ; SUBCASE 2'
9307          CALL CALCB2B (Y,X-Y)      ! LC ONLY POSSIBLE
9308       ENDIF
9309 !
9310       RETURN
9311 !
9312 ! *** END OF SUBROUTINE CALCB2 ******************************************
9313 !
9314       END SUBROUTINE CALCB2
9315
9316
9317
9318 !=======================================================================
9319 !
9320 ! *** ISORROPIA CODE
9321 ! *** SUBROUTINE CALCB2
9322 ! *** CASE B2 ; SUBCASE A.
9323 !
9324 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9325 !     1. SULFATE RICH (1.0 < SULRAT < 2.0)
9326 !     2. SOLID PHASE ONLY POSSIBLE
9327 !     3. SOLIDS POSSIBLE: LC, (NH4)2SO4
9328 !
9329 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
9330 !     1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
9331 !     2. WHEN RH < MDRH  ; ONLY SOLID PHASE POSSIBLE
9332 !
9333 !     FOR SOLID CALCULATIONS, A MATERIAL BALANCE BASED ON THE STOICHIMETRIC
9334 !     PROPORTION OF AMMONIUM AND SULFATE IS DONE TO CALCULATE THE AMOUNT
9335 !     OF LC AND (NH4)2SO4 IN THE SOLID PHASE.
9336 !
9337 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9338 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9339 ! *** WRITTEN BY ATHANASIOS NENES
9340 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9341 !
9342 !=======================================================================
9343 !
9344       SUBROUTINE CALCB2A (TLC, TNH42S4)
9345       implicit none
9346       REAL(KIND=8) TLC, TNH42S4
9347 !
9348 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
9349 !
9350       IF (RH.LT.DRMLCAS) THEN
9351          SCASE   = 'B2 ; SUBCASE A1'    ! SOLIDS POSSIBLE ONLY
9352          CLC     = TLC
9353          CNH42S4 = TNH42S4
9354          SCASE   = 'B2 ; SUBCASE A1'
9355       ELSE
9356          SCASE = 'B2 ; SUBCASE A2'
9357          CALL CALCB2A2 (TLC, TNH42S4)   ! LIQUID & SOLID PHASE POSSIBLE
9358          SCASE = 'B2 ; SUBCASE A2'
9359       ENDIF
9360 !
9361       RETURN
9362 !
9363 ! *** END OF SUBROUTINE CALCB2A *****************************************
9364 !
9365       END SUBROUTINE CALCB2A
9366
9367
9368
9369 !=======================================================================
9370 !
9371 ! *** ISORROPIA CODE
9372 ! *** SUBROUTINE CALCB2A2
9373 ! *** CASE B2 ; SUBCASE A2.
9374 !
9375 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9376 !     1. SULFATE RICH (1.0 < SULRAT < 2.0)
9377 !     2. SOLID PHASE ONLY POSSIBLE
9378 !     3. SOLIDS POSSIBLE: LC, (NH4)2SO4
9379 !
9380 !     THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
9381 !     DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
9382 !     SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB2A1) AND THE
9383 !     THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB3).
9384 !
9385 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9386 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9387 ! *** WRITTEN BY ATHANASIOS NENES
9388 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9389 !
9390 !=======================================================================
9391 !
9392       SUBROUTINE CALCB2A2 (TLC, TNH42S4)
9393       implicit none
9394       REAL(KIND=8) TLC, TNH42S4
9395       REAL(KIND=8) WF, ONEMWF, CLCO, CNH42SO
9396 !
9397 ! *** FIND WEIGHT FACTOR **********************************************
9398 !
9399       IF (WFTYP.EQ.0) THEN
9400          WF = ZERO
9401       ELSEIF (WFTYP.EQ.1) THEN
9402          WF = 0.5D0
9403       ELSE
9404          WF = (DRLC-RH)/(DRLC-DRMLCAS)
9405       ENDIF
9406       ONEMWF  = ONE - WF
9407 !
9408 ! *** FIND FIRST SECTION ; DRY ONE ************************************
9409 !
9410       CLCO     = TLC                     ! FIRST (DRY) SOLUTION
9411       CNH42SO  = TNH42S4
9412 !
9413 ! *** FIND SECOND SECTION ; DRY & LIQUID ******************************
9414 !
9415       CLC     = ZERO
9416       CNH42S4 = ZERO
9417       CALL CALCB3                        ! SECOND (LIQUID) SOLUTION
9418 !
9419 ! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
9420 !
9421       MOLAL(1)= ONEMWF*MOLAL(1)                                   ! H+
9422       MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + 3.D0*(CLCO-CLC)) ! NH4+
9423       MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC)               ! SO4--
9424       MOLAL(6)= ONEMWF*(CLCO-CLC)                                 ! HSO4-
9425 !
9426       WATER   = ONEMWF*WATER
9427 !
9428       CLC     = WF*CLCO    + ONEMWF*CLC
9429       CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
9430 !
9431       RETURN
9432 !
9433 ! *** END OF SUBROUTINE CALCB2A2 ****************************************
9434 !
9435       END SUBROUTINE CALCB2A2
9436
9437
9438
9439 !=======================================================================
9440 !
9441 ! *** ISORROPIA CODE
9442 ! *** SUBROUTINE CALCB2
9443 ! *** CASE B2 ; SUBCASE B
9444 !
9445 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9446 !     1. SULFATE RICH (1.0 < SULRAT < 2.0)
9447 !     2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
9448 !     3. SOLIDS POSSIBLE: LC
9449 !
9450 !     FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE
9451 !     AMOUNT OF SOLID LC DISSOLVED IN THE LIQUID PHASE.
9452 !     FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB2A CALCULATES THE
9453 !     AMOUNT OF H+ PRODUCED (BASED ON THE HSO4, SO4 RELEASED INTO THE
9454 !     SOLUTION). THE SOLUBILITY PRODUCT OF LC IS USED AS THE OBJECTIVE
9455 !     FUNCTION.
9456 !
9457 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9458 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9459 ! *** WRITTEN BY ATHANASIOS NENES
9460 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9461 !
9462 !=======================================================================
9463 !
9464       SUBROUTINE CALCB2B (TLC,TNH4HS4)
9465       implicit none
9466       REAL(KIND=8) TLC, TNH4HS4
9467       REAL(KIND=8) ZLO, ZHI, YLO, YHI, DX, X1, X2, X3, Y1, Y2, Y3
9468       INTEGER I
9469 !
9470       CALAOU = .TRUE.       ! Outer loop activity calculation flag
9471       ZLO    = ZERO
9472       ZHI    = TLC          ! High limit: all of it in liquid phase
9473 !
9474 ! *** INITIAL VALUES FOR BISECTION **************************************
9475 !
9476       X1 = ZHI
9477       Y1 = FUNCB2B (X1,TNH4HS4,TLC)
9478       IF (ABS(Y1).LE.EPS) RETURN
9479       YHI= Y1                        ! Save Y-value at Hi position
9480 !
9481 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ************************
9482 !
9483       DX = (ZHI-ZLO)/NDIV
9484       DO 10 I=1,NDIV
9485          X2 = X1-DX
9486          Y2 = FUNCB2B (X2,TNH4HS4,TLC)
9487          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
9488          X1 = X2
9489          Y1 = Y2
9490 10    CONTINUE
9491 !
9492 ! *** NO SUBDIVISION WITH SOLUTION FOUND
9493 !
9494       YLO= Y1                      ! Save Y-value at LO position
9495       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
9496          RETURN
9497 !
9498 ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC
9499 !
9500       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
9501          X1 = ZHI
9502          X2 = ZHI
9503          GOTO 40
9504 !
9505 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
9506 !
9507       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
9508          X1 = ZLO
9509          X2 = ZLO
9510          GOTO 40
9511       ELSE
9512          CALL PUSHERR (0001, 'CALCB2B')    ! WARNING ERROR: NO SOLUTION
9513          RETURN
9514       ENDIF
9515 !
9516 ! *** PERFORM BISECTION *************************************************
9517 !
9518 20    DO 30 I=1,MAXIT
9519          X3 = 0.5*(X1+X2)
9520          Y3 = FUNCB2B (X3,TNH4HS4,TLC)
9521          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
9522             Y2    = Y3
9523             X2    = X3
9524          ELSE
9525             Y1    = Y3
9526             X1    = X3
9527          ENDIF
9528          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9529 30    CONTINUE
9530       CALL PUSHERR (0002, 'CALCB2B')    ! WARNING ERROR: NO CONVERGENCE
9531 !
9532 ! *** CONVERGED ; RETURN ************************************************
9533 !
9534 40    X3 = 0.5*(X1+X2)
9535       Y3 = FUNCB2B (X3,TNH4HS4,TLC)
9536 !
9537       RETURN
9538 !
9539 ! *** END OF SUBROUTINE CALCB2B *****************************************
9540 !
9541       END SUBROUTINE CALCB2B
9542
9543
9544
9545 !=======================================================================
9546 !
9547 ! *** ISORROPIA CODE
9548 ! *** FUNCTION FUNCB2B
9549 ! *** CASE B2 ;
9550 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B2 ; SUBCASE 2
9551 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCB2B.
9552 !
9553 !=======================================================================
9554 !
9555       DOUBLE PRECISION FUNCTION FUNCB2B (X,TNH4HS4,TLC)
9556       implicit none
9557       REAL(KIND=8) X,TNH4HS4,TLC
9558       REAL(KIND=8) GRAT2, PARM, DELTA, OMEGA
9559       INTEGER I
9560 !
9561 ! *** SOLVE EQUATIONS **************************************************
9562 !
9563       FRST   = .TRUE.
9564       CALAIN = .TRUE.
9565       DO 20 I=1,NSWEEP
9566          GRAT2 = XK1*WATER*(GAMA(8)/GAMA(7))**2./GAMA(7)
9567          PARM  = X+GRAT2
9568          DELTA = PARM*PARM + 4.0*(X+TNH4HS4)*GRAT2 ! Diakrinousa
9569          OMEGA = 0.5*(-PARM + SQRT(DELTA))         ! Thetiki riza (ie:H+>0)
9570 !
9571 ! *** SPECIATION & WATER CONTENT ***************************************
9572 !
9573          MOLAL (1) = OMEGA                         ! HI
9574          MOLAL (3) = 3.0*X+TNH4HS4                 ! NH4I
9575          MOLAL (5) = X+OMEGA                       ! SO4I
9576          MOLAL (6) = MAX (X+TNH4HS4-OMEGA, TINY)   ! HSO4I
9577          CLC       = MAX(TLC-X,ZERO)               ! Solid LC
9578          CALL CALCMR                               ! Water content
9579 !
9580 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ******************
9581 !
9582          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9583             CALL CALCACT
9584          ELSE
9585             GOTO 30
9586          ENDIF
9587 20    CONTINUE
9588 !
9589 ! *** CALCULATE OBJECTIVE FUNCTION **************************************
9590 !
9591 !CC30    FUNCB2B= ( NH4I**3.*SO4I*HSO4I )/( XK13*(WATER/GAMA(13))**5. )
9592 30    FUNCB2B= (MOLAL(3)**3.)*MOLAL(5)*MOLAL(6)
9593       FUNCB2B= FUNCB2B/(XK13*(WATER/GAMA(13))**5.) - ONE
9594       RETURN
9595 !
9596 ! *** END OF FUNCTION FUNCB2B *******************************************
9597 !
9598       END FUNCTION FUNCB2B
9599
9600
9601 !=======================================================================
9602 !
9603 ! *** ISORROPIA CODE
9604 ! *** SUBROUTINE CALCB1
9605 ! *** CASE B1
9606 !
9607 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9608 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
9609 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
9610 !     3. SOLIDS POSSIBLE : LC, (NH4)2SO4, NH4HSO4
9611 !
9612 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
9613 !     1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
9614 !     2. WHEN RH < MDRH  ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCB1A)
9615 !
9616 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9617 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9618 ! *** WRITTEN BY ATHANASIOS NENES
9619 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9620 !
9621 !=======================================================================
9622 !
9623       SUBROUTINE CALCB1
9624       implicit none
9625 !
9626 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
9627 !
9628       IF (RH.LT.DRMLCAB) THEN
9629          SCASE = 'B1 ; SUBCASE 1'
9630          CALL CALCB1A              ! SOLID PHASE ONLY POSSIBLE
9631          SCASE = 'B1 ; SUBCASE 1'
9632       ELSE
9633          SCASE = 'B1 ; SUBCASE 2'
9634          CALL CALCB1B              ! LIQUID & SOLID PHASE POSSIBLE
9635          SCASE = 'B1 ; SUBCASE 2'
9636       ENDIF
9637 !
9638       RETURN
9639 !
9640 ! *** END OF SUBROUTINE CALCB1 ******************************************
9641 !
9642       END SUBROUTINE CALCB1
9643
9644
9645
9646 !=======================================================================
9647 !
9648 ! *** ISORROPIA CODE
9649 ! *** SUBROUTINE CALCB1A
9650 ! *** CASE B1 ; SUBCASE 1
9651 !
9652 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9653 !     1. SULFATE RICH
9654 !     2. THERE IS NO LIQUID PHASE
9655 !     3. SOLIDS POSSIBLE: LC, { (NH4)2SO4  XOR  NH4HSO4 } (ONE OF TWO
9656 !                         BUT NOT BOTH)
9657 !
9658 !     A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE AMOUNT OF LC
9659 !     IS CALCULATED FROM THE (NH4)2SO4 AND NH4HSO4 WHICH IS LEAST
9660 !     ABUNDANT (STOICHIMETRICALLY). THE REMAINING EXCESS OF SALT
9661 !     IS MIXED WITH THE LC.
9662 !
9663 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9664 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9665 ! *** WRITTEN BY ATHANASIOS NENES
9666 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9667 !
9668 !=======================================================================
9669 !
9670       SUBROUTINE CALCB1A
9671       implicit none
9672       REAL(KIND=8) X, Y
9673 !
9674 ! *** SETUP PARAMETERS ************************************************
9675 !
9676       X = 2*W(2)-W(3)       ! Equivalent NH4HSO4
9677       Y = W(3)-W(2)         ! Equivalent (NH4)2SO4
9678 !
9679 ! *** CALCULATE COMPOSITION *******************************************
9680 !
9681       IF (X.LE.Y) THEN      ! LC is the MIN (x,y)
9682          CLC     = X        ! NH4HSO4 >= (NH4)2S04
9683          CNH4HS4 = ZERO
9684          CNH42S4 = Y-X
9685       ELSE
9686          CLC     = Y        ! NH4HSO4 <  (NH4)2S04
9687          CNH4HS4 = X-Y
9688          CNH42S4 = ZERO
9689       ENDIF
9690       RETURN
9691 !
9692 ! *** END OF SUBROUTINE CALCB1 ******************************************
9693 !
9694     END SUBROUTINE CALCB1A
9695
9696
9697
9698
9699 !=======================================================================
9700 !
9701 ! *** ISORROPIA CODE
9702 ! *** SUBROUTINE CALCB1B
9703 ! *** CASE B1 ; SUBCASE 2
9704 !
9705 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9706 !     1. SULFATE RICH
9707 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
9708 !     3. SOLIDS POSSIBLE: LC, { (NH4)2SO4  XOR  NH4HSO4 } (ONE OF TWO
9709 !                         BUT NOT BOTH)
9710 !
9711 !     THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
9712 !     DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
9713 !     SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB1A) AND THE
9714 !     THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB2).
9715 !
9716 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9717 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9718 ! *** WRITTEN BY ATHANASIOS NENES
9719 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9720 !
9721 !=======================================================================
9722 !
9723       SUBROUTINE CALCB1B
9724       implicit none
9725       REAL(KIND=8) WF, ONEMWF, CLCO, CNH42SO, CNH4HSO
9726 !
9727 ! *** FIND WEIGHT FACTOR **********************************************
9728 !
9729       IF (WFTYP.EQ.0) THEN
9730          WF = ZERO
9731       ELSEIF (WFTYP.EQ.1) THEN
9732          WF = 0.5D0
9733       ELSE
9734          WF = (DRNH4HS4-RH)/(DRNH4HS4-DRMLCAB)
9735       ENDIF
9736       ONEMWF  = ONE - WF
9737 !
9738 ! *** FIND FIRST SECTION ; DRY ONE ************************************
9739 !
9740       CALL CALCB1A
9741       CLCO     = CLC               ! FIRST (DRY) SOLUTION
9742       CNH42SO  = CNH42S4
9743       CNH4HSO  = CNH4HS4
9744 !
9745 ! *** FIND SECOND SECTION ; DRY & LIQUID ******************************
9746 !
9747       CLC     = ZERO
9748       CNH42S4 = ZERO
9749       CNH4HS4 = ZERO
9750       CALL CALCB2                  ! SECOND (LIQUID) SOLUTION
9751 !
9752 ! *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
9753 !
9754       MOLAL(1)= ONEMWF*MOLAL(1)                                   ! H+
9755       MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + (CNH4HSO-CNH4HS4)  &
9756                      + 3.D0*(CLCO-CLC))                          ! NH4+
9757       MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC)               ! SO4--
9758       MOLAL(6)= ONEMWF*(CNH4HSO-CNH4HS4 + CLCO-CLC)               ! HSO4-
9759 !
9760       WATER   = ONEMWF*WATER
9761 !
9762       CLC     = WF*CLCO    + ONEMWF*CLC
9763       CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
9764       CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4
9765 !
9766       RETURN
9767 !
9768 ! *** END OF SUBROUTINE CALCB1B *****************************************
9769 !
9770       END SUBROUTINE CALCB1B
9771
9772
9773 !=======================================================================
9774 !
9775 ! *** ISORROPIA CODE
9776 ! *** SUBROUTINE CALCC2
9777 ! *** CASE C2
9778 !
9779 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9780 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
9781 !     2. THERE IS ONLY A LIQUID PHASE
9782 !
9783 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9784 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9785 ! *** WRITTEN BY ATHANASIOS NENES
9786 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9787 !
9788 !=======================================================================
9789 !
9790       SUBROUTINE CALCC2
9791       implicit none
9792       REAL(KIND=8) LAMDA, KAPA, PSI, PARM, BB, CC
9793       INTEGER I
9794 !
9795       CALAOU =.TRUE.         ! Outer loop activity calculation flag
9796       FRST   =.TRUE.
9797       CALAIN =.TRUE.
9798 !
9799 ! *** SOLVE EQUATIONS **************************************************
9800 !
9801       LAMDA  = W(3)           ! NH4HSO4 INITIALLY IN SOLUTION
9802       PSI    = W(2)-W(3)      ! H2SO4 IN SOLUTION
9803       DO 20 I=1,NSWEEP
9804          PARM  = WATER*XK1/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9805          BB    = PSI+PARM
9806          CC    =-PARM*(LAMDA+PSI)
9807          KAPA  = 0.5*(-BB+SQRT(BB*BB-4.0*CC))
9808 !
9809 ! *** SPECIATION & WATER CONTENT ***************************************
9810 !
9811          MOLAL(1) = PSI+KAPA                               ! HI
9812          MOLAL(3) = LAMDA                                  ! NH4I
9813          MOLAL(5) = KAPA                                   ! SO4I
9814          MOLAL(6) = MAX(LAMDA+PSI-KAPA, TINY)              ! HSO4I
9815          CH2SO4   = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3), ZERO)  ! Free H2SO4
9816          CALL CALCMR                                       ! Water content
9817 !
9818 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9819 !
9820          IF (.NOT.CALAIN) GOTO 30
9821          CALL CALCACT
9822 20    CONTINUE
9823 !
9824 30    RETURN
9825 !
9826 ! *** END OF SUBROUTINE CALCC2 *****************************************
9827 !
9828       END SUBROUTINE CALCC2
9829
9830
9831
9832 !=======================================================================
9833 !
9834 ! *** ISORROPIA CODE
9835 ! *** SUBROUTINE CALCC1
9836 ! *** CASE C1
9837 !
9838 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9839 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
9840 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
9841 !     3. SOLIDS POSSIBLE: NH4HSO4
9842 !
9843 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9844 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9845 ! *** WRITTEN BY ATHANASIOS NENES
9846 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9847 !
9848 !=======================================================================
9849 !
9850       SUBROUTINE CALCC1
9851       implicit none
9852       REAL(KIND=8) KLO, KHI, YLO, YHI, X1, X2, X3, Y1, Y2, Y3, DX
9853       INTEGER I
9854 !
9855       CALAOU = .TRUE.    ! Outer loop activity calculation flag
9856       KLO    = TINY
9857       KHI    = W(3)
9858 !
9859 ! *** INITIAL VALUES FOR BISECTION *************************************
9860 !
9861       X1 = KLO
9862       Y1 = FUNCC1 (X1)
9863       IF (ABS(Y1).LE.EPS) GOTO 50
9864       YLO= Y1
9865 !
9866 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
9867 !
9868       DX = (KHI-KLO)/FLOAT(NDIV)
9869       DO 10 I=1,NDIV
9870          X2 = X1+DX
9871          Y2 = FUNCC1 (X2)
9872          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2 .LT. ZERO)
9873          X1 = X2
9874          Y1 = Y2
9875 10    CONTINUE
9876 !
9877 ! *** NO SUBDIVISION WITH SOLUTION FOUND
9878 !
9879       YHI= Y2                 ! Save Y-value at HI position
9880       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
9881          GOTO 50
9882 !
9883 ! *** { YLO, YHI } < 0.0  SOLUTION IS ALWAYS UNDERSATURATED WITH NH4HS04
9884 !
9885       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
9886          GOTO 50
9887 !
9888 ! *** { YLO, YHI } > 0.0 SOLUTION IS ALWAYS SUPERSATURATED WITH NH4HS04
9889 !
9890       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
9891          X1 = KLO
9892          X2 = KLO
9893          GOTO 40
9894       ELSE
9895          CALL PUSHERR (0001, 'CALCC1')    ! WARNING ERROR: NO SOLUTION
9896          GOTO 50
9897       ENDIF
9898 !
9899 ! *** PERFORM BISECTION OF DISSOLVED NH4HSO4 **************************
9900 !
9901 20    DO 30 I=1,MAXIT
9902          X3 = 0.5*(X1+X2)
9903          Y3 = FUNCC1 (X3)
9904          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
9905             Y2    = Y3
9906             X2    = X3
9907          ELSE
9908             Y1    = Y3
9909             X1    = X3
9910          ENDIF
9911          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9912 30    CONTINUE
9913       CALL PUSHERR (0002, 'CALCC1')    ! WARNING ERROR: NO CONVERGENCE
9914 !
9915 ! *** CONVERGED ; RETURN ***********************************************
9916 !
9917 40    X3 = 0.5*(X1+X2)
9918       Y3 = FUNCC1 (X3)
9919 !
9920 50    RETURN
9921 !
9922 ! *** END OF SUBROUTINE CALCC1 *****************************************
9923 !
9924       END SUBROUTINE CALCC1
9925
9926
9927
9928 !=======================================================================
9929 !
9930 ! *** ISORROPIA CODE
9931 ! *** FUNCTION FUNCC1
9932 ! *** CASE C1 ;
9933 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE C1
9934 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCC1.
9935 !
9936 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
9937 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
9938 ! *** WRITTEN BY ATHANASIOS NENES
9939 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
9940 !
9941 !=======================================================================
9942 !
9943       DOUBLE PRECISION FUNCTION FUNCC1 (KAPA)
9944       implicit none
9945       REAL(KIND=8) KAPA, LAMDA, PSI, PAR1, PAR2, BB, CC
9946       INTEGER I
9947 !
9948 ! *** SOLVE EQUATIONS **************************************************
9949 !
9950       FRST   = .TRUE.
9951       CALAIN = .TRUE.
9952 !
9953       PSI = W(2)-W(3)
9954       DO 20 I=1,NSWEEP
9955          PAR1  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
9956          PAR2  = XK12*(WATER/GAMA(9))**2.0
9957          BB    = PSI + PAR1
9958          CC    =-PAR1*(PSI+KAPA)
9959          LAMDA = 0.5*(-BB+SQRT(BB*BB-4*CC))
9960 !
9961 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY *******************************
9962 !
9963          MOLAL(1) = PSI+LAMDA                    ! HI
9964          MOLAL(3) = KAPA                         ! NH4I
9965          MOLAL(5) = LAMDA                        ! SO4I
9966          MOLAL(6) = MAX (ZERO, PSI+KAPA-LAMDA)   ! HSO4I
9967          CNH4HS4  = MAX(W(3)-MOLAL(3), ZERO)     ! Solid NH4HSO4
9968          CH2SO4   = MAX(PSI, ZERO)               ! Free H2SO4
9969          CALL CALCMR                             ! Water content
9970 !
9971 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9972 !
9973          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9974             CALL CALCACT
9975          ELSE
9976             GOTO 30
9977          ENDIF
9978 20    CONTINUE
9979 !
9980 ! *** CALCULATE ZERO FUNCTION *******************************************
9981 !
9982 !CC30    FUNCC1= (NH4I*HSO4I/PAR2) - ONE
9983 30    FUNCC1= (MOLAL(3)*MOLAL(6)/PAR2) - ONE
9984       RETURN
9985 !
9986 ! *** END OF FUNCTION FUNCC1 ********************************************
9987 !
9988       END FUNCTION FUNCC1
9989
9990 !=======================================================================
9991 !
9992 ! *** ISORROPIA CODE
9993 ! *** SUBROUTINE CALCD3
9994 ! *** CASE D3
9995 !
9996 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9997 !     1. SULFATE POOR (SULRAT > 2.0)
9998 !     2. THERE IS OLNY A LIQUID PHASE
9999 !
10000 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10001 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10002 ! *** WRITTEN BY ATHANASIOS NENES
10003 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10004 !
10005 !=======================================================================
10006 !
10007       SUBROUTINE CALCD3
10008       implicit none
10009       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
10010       REAL(KIND=8) PSI4LO, PSI4HI, YLO, YHI, DX, P4, YY, DELTA
10011       INTEGER I
10012 !
10013 ! *** FIND DRY COMPOSITION **********************************************
10014 !
10015       CALL CALCD1A
10016 !
10017 ! *** SETUP PARAMETERS ************************************************
10018 !
10019       CHI1 = CNH4NO3               ! Save from CALCD1 run
10020       CHI2 = CNH42S4
10021       CHI3 = GHNO3
10022       CHI4 = GNH3
10023 !
10024       PSI1 = CNH4NO3               ! ASSIGN INITIAL PSI's
10025       PSI2 = CHI2
10026       PSI3 = ZERO
10027       PSI4 = ZERO
10028 !
10029       MOLAL(5) = ZERO
10030       MOLAL(6) = ZERO
10031       MOLAL(3) = PSI1
10032       MOLAL(7) = PSI1
10033       CALL CALCMR                  ! Initial water
10034 !
10035       CALAOU = .TRUE.              ! Outer loop activity calculation flag
10036       PSI4LO = TINY                ! Low  limit
10037       PSI4HI = CHI4                ! High limit
10038 !
10039 ! *** INITIAL VALUES FOR BISECTION ************************************
10040 !
10041 60    X1 = PSI4LO
10042       Y1 = FUNCD3 (X1)
10043       IF (ABS(Y1).LE.EPS) RETURN
10044       YLO= Y1                 ! Save Y-value at HI position
10045 !
10046 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10047 !
10048       DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
10049       DO 10 I=1,NDIV
10050          X2 = X1+DX
10051          Y2 = FUNCD3 (X2)
10052          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
10053          X1 = X2
10054          Y1 = Y2
10055 10    CONTINUE
10056 !
10057 ! *** NO SUBDIVISION WITH SOLUTION FOUND
10058 !
10059       YHI= Y1                      ! Save Y-value at Hi position
10060       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
10061          RETURN
10062 !
10063 ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3
10064 ! Physically I dont know when this might happen, but I have put this
10065 ! branch in for completeness. I assume there is no solution; all NO3 goes to the
10066 ! gas phase.
10067 !
10068       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
10069          P4 = TINY ! PSI4LO ! CHI4
10070          YY = FUNCD3(P4)
10071          GOTO 50
10072 !
10073 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3
10074 ! This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates
10075 ! and goes to the gas phase ; so I redefine the LO and HI limits of PSI4
10076 ! and proceed again with root tracking.
10077 !
10078       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
10079          PSI4HI = PSI4LO
10080          PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates
10081          IF (PSI4LO.LT.-(PSI1+PSI2)) THEN
10082             CALL PUSHERR (0001, 'CALCD3')  ! WARNING ERROR: NO SOLUTION
10083             RETURN
10084          ELSE
10085             MOLAL(5) = ZERO
10086             MOLAL(6) = ZERO
10087             MOLAL(3) = PSI1
10088             MOLAL(7) = PSI1
10089             CALL CALCMR                  ! Initial water
10090             GOTO 60                        ! Redo root tracking
10091          ENDIF
10092       ENDIF
10093 !
10094 ! *** PERFORM BISECTION ***********************************************
10095 !
10096 20    DO 30 I=1,MAXIT
10097          X3 = 0.5*(X1+X2)
10098          Y3 = FUNCD3 (X3)
10099          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
10100             Y2    = Y3
10101             X2    = X3
10102          ELSE
10103             Y1    = Y3
10104             X1    = X3
10105          ENDIF
10106          IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40
10107 30    CONTINUE
10108       CALL PUSHERR (0002, 'CALCD3')    ! WARNING ERROR: NO CONVERGENCE
10109 !
10110 ! *** CONVERGED ; RETURN **********************************************
10111 !
10112 40    X3 = 0.5*(X1+X2)
10113       Y3 = FUNCD3 (X3)
10114 !
10115 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10116 !
10117 50    CONTINUE
10118       IF (MOLAL(1).GT.TINY) THEN
10119          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10120          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
10121          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
10122          MOLAL(6) = DELTA                                ! HSO4 EFFECT
10123       ENDIF
10124       RETURN
10125 !
10126 ! *** END OF SUBROUTINE CALCD3 ******************************************
10127 !
10128       END SUBROUTINE CALCD3
10129
10130  !=======================================================================
10131 !
10132 ! *** ISORROPIA CODE
10133 ! *** FUNCTION FUNCD3
10134 ! *** CASE D3
10135 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D3 ;
10136 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD3.
10137 !
10138 !=======================================================================
10139 !
10140       REAL(KIND=8) FUNCTION FUNCD3 (P4)
10141         implicit none
10142         REAL(KIND=8) P4
10143         REAL(KIND=8)  BB, DENM, ABB, AHI
10144         INTEGER I
10145 !
10146 ! *** SETUP PARAMETERS ************************************************
10147 !
10148       FRST   = .TRUE.
10149       CALAIN = .TRUE.
10150       PSI4   = P4
10151 !
10152 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10153 !
10154       DO 10 I=1,NSWEEP
10155          A2   = XK7*(WATER/GAMA(4))**3.0
10156          A3   = XK4*R*TEMP*(WATER/GAMA(10))**2.0
10157          A4   = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10158          A7   = XKW *RH*WATER*WATER
10159 !
10160          PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4)
10161          PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4)
10162          PSI3 = MIN(MAX(PSI3, ZERO), CHI3)
10163 !
10164          BB   = PSI4 - PSI3
10165 !CCOLD         AHI  = 0.5*(-BB + SQRT(BB*BB + 4.d0*A7)) ! This is correct also
10166 !CC         AHI  =2.0*A7/(BB+SQRT(BB*BB + 4.d0*A7)) ! Avoid overflow when HI->0
10167          DENM = BB+SQRT(BB*BB + 4.d0*A7)
10168          IF (DENM.LE.TINY) THEN       ! Avoid overflow when HI->0
10169             ABB  = ABS(BB)
10170             DENM = (BB+ABB) + 2.0*A7/ABB ! Taylor expansion of SQRT
10171          ENDIF
10172          AHI = 2.0*A7/DENM
10173 !
10174 ! *** SPECIATION & WATER CONTENT ***************************************
10175 !
10176          MOLAL (1) = AHI                             ! HI
10177          MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2         ! NH4I
10178          MOLAL (5) = PSI2                            ! SO4I
10179          MOLAL (6) = ZERO                            ! HSO4I
10180          MOLAL (7) = PSI3 + PSI1                     ! NO3I
10181          CNH42S4   = CHI2 - PSI2                     ! Solid (NH4)2SO4
10182          CNH4NO3   = ZERO                            ! Solid NH4NO3
10183          GHNO3     = CHI3 - PSI3                     ! Gas HNO3
10184          GNH3      = CHI4 - PSI4                     ! Gas NH3
10185          CALL CALCMR                                 ! Water content
10186 !
10187 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10188 !
10189          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10190             CALL CALCACT
10191          ELSE
10192             GOTO 20
10193          ENDIF
10194 10    CONTINUE
10195 !
10196 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
10197 !
10198 20    CONTINUE
10199 !CC      FUNCD3= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE
10200       FUNCD3= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE
10201       RETURN
10202 !
10203 ! *** END OF FUNCTION FUNCD3 ********************************************
10204 !
10205    END FUNCTION FUNCD3
10206
10207
10208  !=======================================================================
10209 !
10210 ! *** ISORROPIA CODE
10211 ! *** SUBROUTINE CALCD2
10212 ! *** CASE D2
10213 !
10214 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10215 !     1. SULFATE POOR (SULRAT > 2.0)
10216 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
10217 !     3. SOLIDS POSSIBLE : (NH4)2SO4
10218 !
10219 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10220 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10221 ! *** WRITTEN BY ATHANASIOS NENES
10222 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10223 !
10224 !=======================================================================
10225 !
10226    SUBROUTINE CALCD2
10227      implicit none
10228       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
10229       REAL(KIND=8) PSI4LO, PSI4HI, YLO, YHI, DX, P4, YY, DELTA
10230       INTEGER I
10231
10232
10233 !
10234 ! *** FIND DRY COMPOSITION **********************************************
10235 !
10236       CALL CALCD1A
10237 !
10238 ! *** SETUP PARAMETERS ************************************************
10239 !
10240       CHI1 = CNH4NO3               ! Save from CALCD1 run
10241       CHI2 = CNH42S4
10242       CHI3 = GHNO3
10243       CHI4 = GNH3
10244 !
10245       PSI1 = CNH4NO3               ! ASSIGN INITIAL PSI's
10246       PSI2 = CNH42S4
10247       PSI3 = ZERO
10248       PSI4 = ZERO
10249 !
10250       MOLAL(5) = ZERO
10251       MOLAL(6) = ZERO
10252       MOLAL(3) = PSI1
10253       MOLAL(7) = PSI1
10254       CALL CALCMR                  ! Initial water
10255 !
10256       CALAOU = .TRUE.              ! Outer loop activity calculation flag
10257       PSI4LO = TINY                ! Low  limit
10258       PSI4HI = CHI4                ! High limit
10259 !
10260 ! *** INITIAL VALUES FOR BISECTION ************************************
10261 !
10262 60    X1 = PSI4LO
10263       Y1 = FUNCD2 (X1)
10264       IF (ABS(Y1).LE.EPS) RETURN
10265       YLO= Y1                 ! Save Y-value at HI position
10266 !
10267 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10268 !
10269       DX   = (PSI4HI-PSI4LO)/FLOAT(NDIV)
10270       DO 10 I=1,NDIV
10271          X2 = X1+DX
10272          Y2 = FUNCD2 (X2)
10273          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) THEN
10274 !
10275 ! This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat)
10276 !
10277              IF (Y1 .LE. Y2) GOTO 20  ! (Y1*Y2.LT.ZERO)
10278          ENDIF
10279          X1 = X2
10280          Y1 = Y2
10281 10    CONTINUE
10282 !
10283 ! *** NO SUBDIVISION WITH SOLUTION FOUND
10284 !
10285       YHI= Y1                      ! Save Y-value at Hi position
10286       IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
10287          RETURN
10288 !
10289 ! *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3
10290 ! Physically I dont know when this might happen, but I have put this
10291 ! branch in for completeness. I assume there is no solution; all NO3 goes to the
10292 ! gas phase.
10293 !
10294       ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
10295          P4 = TINY ! PSI4LO ! CHI4
10296          YY = FUNCD2(P4)
10297          GOTO 50
10298 !
10299 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3
10300 ! This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates
10301 ! and goes to the gas phase ; so I redefine the LO and HI limits of PSI4
10302 ! and proceed again with root tracking.
10303 !
10304       ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
10305          PSI4HI = PSI4LO
10306          PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates
10307          IF (PSI4LO.LT.-(PSI1+PSI2)) THEN
10308             CALL PUSHERR (0001, 'CALCD2')  ! WARNING ERROR: NO SOLUTION
10309             RETURN
10310          ELSE
10311             MOLAL(5) = ZERO
10312             MOLAL(6) = ZERO
10313             MOLAL(3) = PSI1
10314             MOLAL(7) = PSI1
10315             CALL CALCMR                  ! Initial water
10316             GOTO 60                        ! Redo root tracking
10317          ENDIF
10318       ENDIF
10319 !
10320 ! *** PERFORM BISECTION ***********************************************
10321 !
10322 20    DO 30 I=1,MAXIT
10323          X3 = 0.5*(X1+X2)
10324          Y3 = FUNCD2 (X3)
10325          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
10326             Y2    = Y3
10327             X2    = X3
10328          ELSE
10329             Y1    = Y3
10330             X1    = X3
10331          ENDIF
10332          IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40
10333 30    CONTINUE
10334       CALL PUSHERR (0002, 'CALCD2')    ! WARNING ERROR: NO CONVERGENCE
10335 !
10336 ! *** CONVERGED ; RETURN **********************************************
10337 !
10338 40    X3 = MIN(X1,X2)   ! 0.5*(X1+X2)  ! Get "low" side, it's acidic soln.
10339       Y3 = FUNCD2 (X3)
10340 !
10341 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10342 !
10343 50    CONTINUE
10344       IF (MOLAL(1).GT.TINY) THEN
10345          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10346          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
10347          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
10348          MOLAL(6) = DELTA                                ! HSO4 EFFECT
10349       ENDIF
10350       RETURN
10351 !
10352 ! *** END OF SUBROUTINE CALCD2 ******************************************
10353 !
10354     END  SUBROUTINE CALCD2
10355
10356  !=======================================================================
10357 !
10358 ! *** ISORROPIA CODE
10359 ! *** FUNCTION FUNCD2
10360 ! *** CASE D2
10361 !     FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ;
10362 !     AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD2.
10363 !
10364 !=======================================================================
10365 !
10366     REAL(KIND=8) FUNCTION FUNCD2 (P4)
10367       implicit none
10368       REAL(KIND=8) P4
10369       REAL(KIND=8)  BB, DENM, ABB, AHI, PSI4, PSI2, PSI3, PSI14
10370       INTEGER I, ISLV
10371
10372
10373 !
10374 ! *** SETUP PARAMETERS ************************************************
10375 !
10376       CALL RSTGAM       ! Reset activity coefficients to 0.1
10377       FRST   = .TRUE.
10378       CALAIN = .TRUE.
10379       PSI4   = P4
10380       PSI2   = CHI2
10381 !
10382 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10383 !
10384       DO 10 I=1,NSWEEP
10385          A2  = XK7*(WATER/GAMA(4))**3.0
10386          A3  = XK4*R*TEMP*(WATER/GAMA(10))**2.0
10387          A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10388          A7  = XKW *RH*WATER*WATER
10389 !
10390          IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
10391             PSI14 = PSI1+PSI4
10392             CALL POLY3 (PSI14,0.25*PSI14**2.,-A2/4.D0, PSI2, ISLV)  ! PSI2
10393             IF (ISLV.EQ.0) THEN
10394                 PSI2 = MIN (PSI2, CHI2)
10395             ELSE
10396                 PSI2 = ZERO
10397             ENDIF
10398          ENDIF
10399 !
10400          PSI3  = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4)
10401          PSI3  = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4)
10402 !cc         PSI3  = MIN(MAX(PSI3, ZERO), CHI3)
10403 !
10404          BB   = PSI4-PSI3 ! (BB > 0, acidic solution, <0 alkaline)
10405 !
10406 ! Do not change computation scheme for H+, all others did not work well.
10407 !
10408          DENM = BB+SQRT(BB*BB + 4.d0*A7)
10409          IF (DENM.LE.TINY) THEN       ! Avoid overflow when HI->0
10410             ABB  = ABS(BB)
10411             DENM = (BB+ABB) + 2.d0*A7/ABB ! Taylor expansion of SQRT
10412          ENDIF
10413          AHI = 2.d0*A7/DENM
10414 !
10415 ! *** SPECIATION & WATER CONTENT ***************************************
10416 !
10417          MOLAL (1) = AHI                              ! HI
10418          MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2          ! NH4
10419          MOLAL (5) = PSI2                             ! SO4
10420          MOLAL (6) = ZERO                             ! HSO4
10421          MOLAL (7) = PSI3 + PSI1                      ! NO3
10422          CNH42S4   = CHI2 - PSI2                      ! Solid (NH4)2SO4
10423          CNH4NO3   = ZERO                             ! Solid NH4NO3
10424          GHNO3     = CHI3 - PSI3                      ! Gas HNO3
10425          GNH3      = CHI4 - PSI4                      ! Gas NH3
10426          CALL CALCMR                                  ! Water content
10427 !
10428 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10429 !
10430          IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10431             CALL CALCACT
10432          ELSE
10433             GOTO 20
10434          ENDIF
10435 10    CONTINUE
10436 !
10437 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
10438 !
10439 20    CONTINUE
10440 !CC      FUNCD2= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE
10441       FUNCD2= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE
10442       RETURN
10443 !
10444 ! *** END OF FUNCTION FUNCD2 ********************************************
10445 !
10446     END FUNCTION FUNCD2
10447
10448 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10449 !     1. SULFATE POOR (SULRAT > 2.0)
10450 !     2. SOLID AEROSOL ONLY
10451 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
10452 !
10453 !     THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY:
10454 !     1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCD1A)
10455 !     2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
10456 !
10457 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10458 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10459 ! *** WRITTEN BY ATHANASIOS NENES
10460 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10461 !
10462 !=======================================================================
10463 !
10464     SUBROUTINE CALCD1
10465       implicit none
10466 !      EXTERNAL CALCD1A, CALCD2
10467 !
10468 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
10469 !
10470       IF (RH.LT.DRMASAN) THEN
10471          SCASE = 'D1 ; SUBCASE 1'   ! SOLID PHASE ONLY POSSIBLE
10472          CALL CALCD1A
10473          SCASE = 'D1 ; SUBCASE 1'
10474       ELSE
10475          SCASE = 'D1 ; SUBCASE 2'   ! LIQUID & SOLID PHASE POSSIBLE
10476          CALL CALCMDRH (RH, DRMASAN, DRNH4NO3, CALCD1A, CALCD2)
10477          SCASE = 'D1 ; SUBCASE 2'
10478       ENDIF
10479 !
10480       RETURN
10481 !
10482 ! *** END OF SUBROUTINE CALCD1 ******************************************
10483 !
10484     END SUBROUTINE CALCD1
10485
10486
10487
10488 !=======================================================================
10489 !
10490 ! *** ISORROPIA CODE
10491 ! *** SUBROUTINE CALCD1A
10492 ! *** CASE D1 ; SUBCASE 1
10493 !
10494 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10495 !     1. SULFATE POOR (SULRAT > 2.0)
10496 !     2. SOLID AEROSOL ONLY
10497 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
10498 !
10499 !     THE SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3
10500 !     IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF
10501 !     NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN
10502 !     THE SOLID PHASE.
10503 !
10504 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10505 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10506 ! *** WRITTEN BY ATHANASIOS NENES
10507 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10508 !
10509 !=======================================================================
10510 !
10511     SUBROUTINE CALCD1A
10512       implicit none
10513       REAL(KIND=8) PARM, X, PS, OM, OMPS, DIAK, ZE
10514 !
10515 ! *** SETUP PARAMETERS ************************************************
10516 !
10517       PARM    = XK10/(R*TEMP)/(R*TEMP)
10518 !
10519 ! *** CALCULATE NH4NO3 THAT VOLATIZES *********************************
10520 !
10521       CNH42S4 = W(2)
10522       X       = MAX(ZERO, MIN(W(3)-2.0*CNH42S4, W(4)))  ! MAX NH4NO3
10523       PS      = MAX(W(3) - X - 2.0*CNH42S4, ZERO)
10524       OM      = MAX(W(4) - X, ZERO)
10525 !
10526       OMPS    = OM+PS
10527       DIAK    = SQRT(OMPS*OMPS + 4.0*PARM)              ! DIAKRINOUSA
10528       ZE      = MIN(X, 0.5*(-OMPS + DIAK))              ! THETIKI RIZA
10529 !
10530 ! *** SPECIATION *******************************************************
10531 !
10532       CNH4NO3 = X  - ZE    ! Solid NH4NO3
10533       GNH3    = PS + ZE    ! Gas NH3
10534       GHNO3   = OM + ZE    ! Gas HNO3
10535 !
10536       RETURN
10537 !
10538 ! *** END OF SUBROUTINE CALCD1A *****************************************
10539 !
10540     END SUBROUTINE CALCD1A
10541 !=======================================================================
10542 !
10543 ! *** ISORROPIA CODE
10544 ! *** SUBROUTINE CALCG5
10545 ! *** CASE G5
10546 !
10547 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10548 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
10549 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
10550 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
10551 !
10552 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10553 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10554 ! *** WRITTEN BY ATHANASIOS NENES
10555 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10556 !
10557 !=======================================================================
10558 !
10559       SUBROUTINE CALCG5
10560       implicit none
10561       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DELTA
10562       INTEGER I
10563 !
10564 !
10565 ! *** SETUP PARAMETERS ************************************************
10566 !
10567       CALAOU = .TRUE.
10568       CHI1   = 0.5*W(1)
10569       CHI2   = MAX (W(2)-CHI1, ZERO)
10570       CHI3   = ZERO
10571       CHI4   = MAX (W(3)-2.D0*CHI2, ZERO)
10572       CHI5   = W(4)
10573       CHI6   = W(5)
10574 !
10575       PSI1   = CHI1
10576       PSI2   = CHI2
10577       PSI6LO = TINY
10578       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
10579 !
10580       WATER  = CHI2/M0(4) + CHI1/M0(2)
10581 !
10582 ! *** INITIAL VALUES FOR BISECTION ************************************
10583 !
10584       X1 = PSI6LO
10585       Y1 = FUNCG5A (X1)
10586       IF (CHI6.LE.TINY) GOTO 50
10587 !      IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
10588 !      IF (WATER .LE. TINY) RETURN                    ! No water
10589 !
10590 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10591 !
10592       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
10593       DO 10 I=1,NDIV
10594          X2 = X1+DX
10595          Y2 = FUNCG5A (X2)
10596          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
10597          X1 = X2
10598          Y1 = Y2
10599 10    CONTINUE
10600 !
10601 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
10602 !
10603       IF (ABS(Y2) .GT. EPS) Y2 = FUNCG5A (PSI6LO)
10604       GOTO 50
10605 !
10606 ! *** PERFORM BISECTION ***********************************************
10607 !
10608 20    DO 30 I=1,MAXIT
10609          X3 = 0.5*(X1+X2)
10610          Y3 = FUNCG5A (X3)
10611          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
10612             Y2    = Y3
10613             X2    = X3
10614          ELSE
10615             Y1    = Y3
10616             X1    = X3
10617          ENDIF
10618          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
10619 30    CONTINUE
10620       CALL PUSHERR (0002, 'CALCG5')    ! WARNING ERROR: NO CONVERGENCE
10621 !
10622 ! *** CONVERGED ; RETURN **********************************************
10623 !
10624 40    X3 = 0.5*(X1+X2)
10625       Y3 = FUNCG5A (X3)
10626 !
10627 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10628 !
10629 50    CONTINUE
10630       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN  ! If quadrat.called
10631          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10632          MOLAL(1) = MOLAL(1) - DELTA                    ! H+   EFFECT
10633          MOLAL(5) = MOLAL(5) - DELTA                    ! SO4  EFFECT
10634          MOLAL(6) = DELTA                               ! HSO4 EFFECT
10635       ENDIF
10636 !
10637       RETURN
10638 !
10639 ! *** END OF SUBROUTINE CALCG5 *******************************************
10640 !
10641     END SUBROUTINE CALCG5
10642
10643
10644
10645
10646 !=======================================================================
10647 !
10648 ! *** ISORROPIA CODE
10649 ! *** SUBROUTINE FUNCG5A
10650 ! *** CASE G5
10651 !
10652 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10653 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
10654 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
10655 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
10656 !
10657 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10658 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10659 ! *** WRITTEN BY ATHANASIOS NENES
10660 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10661 !
10662 !=======================================================================
10663 !
10664       REAL(KIND=8) FUNCTION FUNCG5A (X)
10665       implicit none
10666       REAL(KIND=8) X
10667       REAL(KIND=8) AKK, BB, CC, DD, SMIN, HI, OHI
10668       INTEGER I
10669 !
10670
10671 !
10672 ! *** SETUP PARAMETERS ************************************************
10673 !
10674       PSI6   = X
10675       FRST   = .TRUE.
10676       CALAIN = .TRUE.
10677 !
10678 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10679 !
10680       DO 10 I=1,NSWEEP
10681 !
10682       A1  = XK5 *(WATER/GAMA(2))**3.0
10683       A2  = XK7 *(WATER/GAMA(4))**3.0
10684       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10685       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
10686       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
10687       AKK = A4*A6
10688 !
10689 !  CALCULATE DISSOCIATION QUANTITIES
10690 !
10691       IF (CHI5.GE.TINY) THEN
10692          PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
10693       ELSE
10694          PSI5 = TINY
10695       ENDIF
10696 !
10697 !CC      IF(CHI4.GT.TINY) THEN
10698       IF(W(2).GT.TINY) THEN       ! Accounts for NH3 evaporation
10699          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
10700          CC   = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
10701          DD   = MAX(BB*BB-4.d0*CC,ZERO)           ! Patch proposed by Uma Shankar, 19/11/01
10702          PSI4 =0.5d0*(-BB - SQRT(DD))
10703       ELSE
10704          PSI4 = TINY
10705       ENDIF
10706 !
10707 ! *** CALCULATE SPECIATION ********************************************
10708 !
10709       MOLAL (2) = 2.0D0*PSI1                          ! NAI
10710       MOLAL (3) = 2.0*PSI2 + PSI4                     ! NH4I
10711       MOLAL (4) = PSI6                                ! CLI
10712       MOLAL (5) = PSI2 + PSI1                         ! SO4I
10713       MOLAL (6) = ZERO
10714       MOLAL (7) = PSI5                                ! NO3I
10715 !
10716       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
10717       CALL CALCPH (SMIN, HI, OHI)
10718       MOLAL (1) = HI
10719 !
10720       GNH3      = MAX(CHI4 - PSI4, TINY)              ! Gas NH3
10721       GHNO3     = MAX(CHI5 - PSI5, TINY)              ! Gas HNO3
10722       GHCL      = MAX(CHI6 - PSI6, TINY)              ! Gas HCl
10723 !
10724       CNH42S4   = ZERO                                ! Solid (NH4)2SO4
10725       CNH4NO3   = ZERO                                ! Solid NH4NO3
10726       CNH4CL    = ZERO                                ! Solid NH4Cl
10727 !
10728       CALL CALCMR                                     ! Water content
10729 !
10730 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10731 !
10732       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10733          CALL CALCACT
10734       ELSE
10735          GOTO 20
10736       ENDIF
10737 10    CONTINUE
10738 !
10739 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
10740 !
10741 20    FUNCG5A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
10742 !CC         FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
10743 !
10744       RETURN
10745 !
10746 ! *** END OF FUNCTION FUNCG5A *******************************************
10747 !
10748    END FUNCTION FUNCG5A
10749
10750 !=======================================================================
10751 !
10752 ! *** ISORROPIA CODE
10753 ! *** SUBROUTINE CALCG4
10754 ! *** CASE G4
10755 !
10756 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10757 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
10758 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
10759 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
10760 !
10761 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10762 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10763 ! *** WRITTEN BY ATHANASIOS NENES
10764 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10765 !
10766 !=======================================================================
10767 !
10768    SUBROUTINE CALCG4
10769      implicit none
10770      REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
10771      REAL(KIND=8) PSI6LO, PSI6HI, DX, DELTA
10772      INTEGER I
10773 !
10774 !
10775 ! *** SETUP PARAMETERS ************************************************
10776 !
10777       CALAOU = .TRUE.
10778       CHI1   = 0.5*W(1)
10779       CHI2   = MAX (W(2)-CHI1, ZERO)
10780       CHI3   = ZERO
10781       CHI4   = MAX (W(3)-2.D0*CHI2, ZERO)
10782       CHI5   = W(4)
10783       CHI6   = W(5)
10784 !
10785       PSI2   = CHI2
10786       PSI6LO = TINY
10787       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
10788 !
10789       WATER  = CHI2/M0(4) + CHI1/M0(2)
10790 !
10791 ! *** INITIAL VALUES FOR BISECTION ************************************
10792 !
10793       X1 = PSI6LO
10794       Y1 = FUNCG4A (X1)
10795       IF (CHI6.LE.TINY) GOTO 50
10796 !CC      IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50
10797 !CC      IF (WATER .LE. TINY) RETURN                    ! No water
10798 !
10799 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10800 !
10801       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
10802       DO 10 I=1,NDIV
10803          X2  = X1+DX
10804          Y2  = FUNCG4A (X2)
10805          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
10806          X1  = X2
10807          Y1  = Y2
10808 10    CONTINUE
10809 !
10810 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
10811 !
10812       IF (ABS(Y2) .GT. EPS) Y2 = FUNCG4A (PSI6LO)
10813       GOTO 50
10814 !
10815 ! *** PERFORM BISECTION ***********************************************
10816 !
10817 20    DO 30 I=1,MAXIT
10818          X3 = 0.5*(X1+X2)
10819          Y3 = FUNCG4A (X3)
10820          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
10821             Y2    = Y3
10822             X2    = X3
10823          ELSE
10824             Y1    = Y3
10825             X1    = X3
10826          ENDIF
10827          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
10828 30    CONTINUE
10829       CALL PUSHERR (0002, 'CALCG4')    ! WARNING ERROR: NO CONVERGENCE
10830 !
10831 ! *** CONVERGED ; RETURN **********************************************
10832 !
10833 40    X3 = 0.5*(X1+X2)
10834       Y3 = FUNCG4A (X3)
10835 !
10836 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10837 !
10838 50    CONTINUE
10839       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
10840          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10841          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
10842          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
10843          MOLAL(6) = DELTA                                ! HSO4 EFFECT
10844       ENDIF
10845 !
10846       RETURN
10847 !
10848 ! *** END OF SUBROUTINE CALCG4 *******************************************
10849 !
10850     END SUBROUTINE CALCG4
10851
10852
10853 !=======================================================================
10854 !
10855 ! *** ISORROPIA CODE
10856 ! *** SUBROUTINE FUNCG4A
10857 ! *** CASE G4
10858 !
10859 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10860 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
10861 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
10862 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
10863 !
10864 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10865 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10866 ! *** WRITTEN BY ATHANASIOS NENES
10867 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10868 !
10869 !=======================================================================
10870 !
10871     REAL(KIND=8) FUNCTION FUNCG4A (X)
10872 !
10873       REAL(KIND=8) X
10874       REAL(KIND=8)  NAI, NH4I, NO3I
10875       REAL(KIND=8) HI, OHI
10876 !
10877 ! *** SETUP PARAMETERS ************************************************
10878 !
10879       PSI6   = X
10880       PSI1   = CHI1
10881       FRST   = .TRUE.
10882       CALAIN = .TRUE.
10883 !
10884 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10885 !
10886       DO 10 I=1,NSWEEP
10887 !
10888       A1  = XK5 *(WATER/GAMA(2))**3.0
10889       A2  = XK7 *(WATER/GAMA(4))**3.0
10890       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10891       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
10892       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
10893 !
10894 !  CALCULATE DISSOCIATION QUANTITIES
10895 !
10896       IF (CHI5.GE.TINY) THEN
10897          PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
10898       ELSE
10899          PSI5 = TINY
10900       ENDIF
10901 !
10902 !CC      IF(CHI4.GT.TINY) THEN
10903       IF(W(2).GT.TINY) THEN       ! Accounts for NH3 evaporation
10904          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
10905          CC   = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
10906          DD   = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma shankar, 19/11/2001
10907          PSI4 =0.5d0*(-BB - SQRT(DD))
10908       ELSE
10909          PSI4 = TINY
10910       ENDIF
10911 !
10912 !  CALCULATE CONCENTRATIONS
10913 !
10914       NH4I = 2.0*PSI2 + PSI4
10915       CLI  = PSI6
10916       SO4I = PSI2 + PSI1
10917       NO3I = PSI5
10918       NAI  = 2.0D0*PSI1
10919 !
10920       CALL CALCPH(2.d0*SO4I+NO3I+CLI-NAI-NH4I, HI, OHI)
10921 !
10922 ! *** Na2SO4 DISSOLUTION
10923 !
10924       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN        ! PSI1
10925          CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
10926          IF (ISLV.EQ.0) THEN
10927              PSI1 = MIN (PSI1, CHI1)
10928          ELSE
10929              PSI1 = ZERO
10930          ENDIF
10931       ELSE
10932          PSI1 = ZERO
10933       ENDIF
10934 !
10935 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
10936 !
10937       MOLAL (1) = HI
10938       MOLAL (2) = NAI
10939       MOLAL (3) = NH4I
10940       MOLAL (4) = CLI
10941       MOLAL (5) = SO4I
10942       MOLAL (6) = ZERO
10943       MOLAL (7) = NO3I
10944 !
10945 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
10946 !
10947       GNH3      = MAX(CHI4 - PSI4, TINY)
10948       GHNO3     = MAX(CHI5 - PSI5, TINY)
10949       GHCL      = MAX(CHI6 - PSI6, TINY)
10950 !
10951       CNH42S4   = ZERO
10952       CNH4NO3   = ZERO
10953       CNH4CL    = ZERO
10954       CNA2SO4   = MAX(CHI1-PSI1,ZERO)
10955 !
10956 ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
10957 !
10958       CALL CALCMR
10959 !
10960 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10961 !
10962       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10963          CALL CALCACT
10964       ELSE
10965          GOTO 20
10966       ENDIF
10967 10    CONTINUE
10968 !
10969 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
10970 !
10971 20    FUNCG4A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
10972 !CC         FUNCG4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
10973 !
10974       RETURN
10975 !
10976 ! *** END OF FUNCTION FUNCG4A *******************************************
10977 !
10978    END FUNCTION FUNCG4A
10979
10980 !=======================================================================
10981 !
10982 ! *** ISORROPIA CODE
10983 ! *** SUBROUTINE CALCG3
10984 ! *** CASE G3
10985 !
10986 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10987 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
10988 !     2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE
10989 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
10990 !
10991 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10992 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
10993 ! *** WRITTEN BY ATHANASIOS NENES
10994 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
10995 !
10996 !=======================================================================
10997 !
10998       SUBROUTINE CALCG3
10999 !      EXTERNAL CALCG1A, CALCG4
11000 !
11001 ! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
11002 !
11003       IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE
11004          SCASE = 'G3 ; SUBCASE 1'
11005          CALL CALCG3A
11006          SCASE = 'G3 ; SUBCASE 1'
11007       ELSE                                      ! NO3, CL NON EXISTANT
11008          SCASE = 'G1 ; SUBCASE 1'
11009          CALL CALCG1A
11010          SCASE = 'G1 ; SUBCASE 1'
11011       ENDIF
11012 !
11013       IF (WATER.LE.TINY) THEN
11014          IF (RH.LT.DRMG3) THEN        ! ONLY SOLIDS
11015             WATER = TINY
11016             DO 10 I=1,NIONS
11017                MOLAL(I) = ZERO
11018 10          CONTINUE
11019             CALL CALCG1A
11020             SCASE = 'G3 ; SUBCASE 2'
11021             RETURN
11022          ELSE
11023             SCASE = 'G3 ; SUBCASE 3'  ! MDRH REGION (NA2SO4, NH42S4)
11024             CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4)
11025             SCASE = 'G3 ; SUBCASE 3'
11026          ENDIF
11027       ENDIF
11028 !
11029       RETURN
11030 !
11031 ! *** END OF SUBROUTINE CALCG3 ******************************************
11032 !
11033    END SUBROUTINE CALCG3
11034
11035
11036
11037 !=======================================================================
11038 !
11039 ! *** ISORROPIA CODE
11040 ! *** SUBROUTINE CALCG3A
11041 ! *** CASE G3 ; SUBCASE 1
11042 !
11043 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11044 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11045 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11046 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11047 !
11048 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11049 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11050 ! *** WRITTEN BY ATHANASIOS NENES
11051 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11052 !
11053 !=======================================================================
11054 !
11055       SUBROUTINE CALCG3A
11056       implicit none
11057       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DELTA
11058       REAL(KIND=8) CC, BB
11059       INTEGER ISLV
11060       INTEGER I
11061 !
11062 ! *** SETUP PARAMETERS ************************************************
11063 !
11064       CALAOU = .TRUE.
11065       CHI1   = 0.5*W(1)
11066       CHI2   = MAX (W(2)-CHI1, ZERO)
11067       CHI3   = ZERO
11068       CHI4   = MAX (W(3)-2.D0*CHI2, ZERO)
11069       CHI5   = W(4)
11070       CHI6   = W(5)
11071 !
11072       PSI6LO = TINY
11073       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
11074 !
11075       WATER  = TINY
11076 !
11077 ! *** INITIAL VALUES FOR BISECTION ************************************
11078 !
11079       X1 = PSI6LO
11080       Y1 = FUNCG3A (X1)
11081       IF (CHI6.LE.TINY) GOTO 50
11082 !CC      IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50
11083 !CC      IF (WATER .LE. TINY) RETURN                    ! No water
11084 !
11085 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11086 !
11087       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11088       DO 10 I=1,NDIV
11089          X2  = X1+DX
11090          Y2  = FUNCG3A (X2)
11091 !
11092          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
11093          X1  = X2
11094          Y1  = Y2
11095 10    CONTINUE
11096 !
11097 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11098 !
11099       IF (ABS(Y2) .GT. EPS) Y2 = FUNCG3A (PSI6LO)
11100       GOTO 50
11101 !
11102 ! *** PERFORM BISECTION ***********************************************
11103 !
11104 20    DO 30 I=1,MAXIT
11105          X3 = 0.5*(X1+X2)
11106          Y3 = FUNCG3A (X3)
11107          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
11108             Y2    = Y3
11109             X2    = X3
11110          ELSE
11111             Y1    = Y3
11112             X1    = X3
11113          ENDIF
11114          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11115 30    CONTINUE
11116       CALL PUSHERR (0002, 'CALCG3A')    ! WARNING ERROR: NO CONVERGENCE
11117 !
11118 ! *** CONVERGED ; RETURN **********************************************
11119 !
11120 40    X3 = 0.5*(X1+X2)
11121       Y3 = FUNCG3A (X3)
11122 !
11123 ! *** FINAL CALCULATIONS *************************************************
11124 !
11125 50    CONTINUE
11126 !
11127 ! *** Na2SO4 DISSOLUTION
11128 !
11129       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN        ! PSI1
11130          CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
11131          IF (ISLV.EQ.0) THEN
11132              PSI1 = MIN (PSI1, CHI1)
11133          ELSE
11134              PSI1 = ZERO
11135          ENDIF
11136       ELSE
11137          PSI1 = ZERO
11138       ENDIF
11139       MOLAL(2) = 2.0D0*PSI1               ! Na+  EFFECT
11140       MOLAL(5) = MOLAL(5) + PSI1          ! SO4  EFFECT
11141       CNA2SO4  = MAX(CHI1 - PSI1, ZERO)   ! NA2SO4(s) depletion
11142 !
11143 ! *** HSO4 equilibrium
11144 !
11145       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11146          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11147          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
11148          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
11149          MOLAL(6) = DELTA                                ! HSO4 EFFECT
11150       ENDIF
11151 !
11152       RETURN
11153 !
11154 ! *** END OF SUBROUTINE CALCG3A ******************************************
11155 !
11156    END SUBROUTINE CALCG3A
11157
11158
11159
11160
11161 !=======================================================================
11162 !
11163 ! *** ISORROPIA CODE
11164 ! *** SUBROUTINE FUNCG3A
11165 ! *** CASE G3 ; SUBCASE 1
11166 !
11167 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11168 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11169 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11170 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11171 !
11172 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11173 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11174 ! *** WRITTEN BY ATHANASIOS NENES
11175 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11176 !
11177 !=======================================================================
11178 !
11179       DOUBLE PRECISION FUNCTION FUNCG3A (X)
11180       implicit none
11181       REAL(KIND=8) X
11182       REAL(KIND=8) SMIN, HI, OHI
11183       REAL(KIND=8) PSI20, BB, CC, DD
11184       INTEGER ISLV
11185 !
11186       INTEGER I
11187 !
11188 ! *** SETUP PARAMETERS ************************************************
11189 !
11190       PSI6   = X
11191       PSI2   = CHI2
11192       FRST   = .TRUE.
11193       CALAIN = .TRUE.
11194 !
11195 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11196 !
11197       DO 10 I=1,NSWEEP
11198 !
11199       A1  = XK5 *(WATER/GAMA(2))**3.0
11200       A2  = XK7 *(WATER/GAMA(4))**3.0
11201       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11202       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11203       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11204 !
11205 !  CALCULATE DISSOCIATION QUANTITIES
11206 !
11207       IF (CHI5.GE.TINY) THEN
11208          PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
11209       ELSE
11210          PSI5 = TINY
11211       ENDIF
11212 !
11213 !CC      IF(CHI4.GT.TINY) THEN
11214       IF(W(2).GT.TINY) THEN       ! Accounts for NH3 evaporation
11215          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
11216          CC   = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
11217          DD   = MAX(BB*BB-4.d0*CC,ZERO)  ! Patch proposed by Uma Shankar, 19/11/01
11218          PSI4 =0.5d0*(-BB - SQRT(DD))
11219       ELSE
11220          PSI4 = TINY
11221       ENDIF
11222 !
11223       IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
11224          CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV)
11225          IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2)
11226       ENDIF
11227 !
11228 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
11229 !
11230       MOLAL (2) = ZERO                                ! Na
11231       MOLAL (3) = 2.0*PSI2 + PSI4                     ! NH4I
11232       MOLAL (4) = PSI6                                ! CLI
11233       MOLAL (5) = PSI2                                ! SO4I
11234       MOLAL (6) = ZERO                                ! HSO4
11235       MOLAL (7) = PSI5                                ! NO3I
11236 !
11237       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
11238       CALL CALCPH (SMIN, HI, OHI)
11239       MOLAL (1) = HI
11240
11241       GNH3      = MAX(CHI4 - PSI4, TINY)              ! Gas NH3
11242       GHNO3     = MAX(CHI5 - PSI5, TINY)              ! Gas HNO3
11243       GHCL      = MAX(CHI6 - PSI6, TINY)              ! Gas HCl
11244 !
11245       CNH42S4   = CHI2 - PSI2                         ! Solid (NH4)2SO4
11246       CNH4NO3   = ZERO                                ! Solid NH4NO3
11247       CNH4CL    = ZERO                                ! Solid NH4Cl
11248 !
11249       CALL CALCMR                                     ! Water content
11250 !
11251 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
11252 !
11253       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
11254          CALL CALCACT
11255       ELSE
11256          GOTO 20
11257       ENDIF
11258 10    CONTINUE
11259 !
11260 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
11261 !
11262 20    FUNCG3A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
11263 !CC         FUNCG3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
11264 !
11265       RETURN
11266 !
11267 ! *** END OF FUNCTION FUNCG3A *******************************************
11268 !
11269    END FUNCTION FUNCG3A
11270
11271 !=======================================================================
11272 !
11273 ! *** ISORROPIA CODE
11274 ! *** SUBROUTINE CALCG2
11275 ! *** CASE G2
11276 !
11277 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11278 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11279 !     2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE
11280 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11281 !
11282 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11283 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11284 ! *** WRITTEN BY ATHANASIOS NENES
11285 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11286 !
11287 !=======================================================================
11288 !
11289       SUBROUTINE CALCG2
11290
11291 !      EXTERNAL CALCG1A, CALCG3A, CALCG4
11292 !
11293 ! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
11294 !
11295       IF (W(4).GT.TINY) THEN        ! NO3 EXISTS, WATER POSSIBLE
11296          SCASE = 'G2 ; SUBCASE 1'
11297          CALL CALCG2A
11298          SCASE = 'G2 ; SUBCASE 1'
11299       ELSE                          ! NO3 NON EXISTANT, WATER NOT POSSIBLE
11300          SCASE = 'G1 ; SUBCASE 1'
11301          CALL CALCG1A
11302          SCASE = 'G1 ; SUBCASE 1'
11303       ENDIF
11304 !
11305 ! *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
11306 !
11307       IF (WATER.LE.TINY) THEN
11308          IF (RH.LT.DRMG2) THEN             ! ONLY SOLIDS
11309             WATER = TINY
11310             DO 10 I=1,NIONS
11311                MOLAL(I) = ZERO
11312 10          CONTINUE
11313             CALL CALCG1A
11314             SCASE = 'G2 ; SUBCASE 2'
11315          ELSE
11316             IF (W(5).GT. TINY) THEN
11317                SCASE = 'G2 ; SUBCASE 3'    ! MDRH (NH4CL, NA2SO4, NH42S4)
11318                CALL CALCMDRH (RH, DRMG2, DRNH4CL, CALCG1A, CALCG3A)
11319                SCASE = 'G2 ; SUBCASE 3'
11320             ENDIF
11321             IF (WATER.LE.TINY .AND. RH.GE.DRMG3) THEN
11322                SCASE = 'G2 ; SUBCASE 4'    ! MDRH (NA2SO4, NH42S4)
11323                CALL CALCMDRH (RH, DRMG3, DRNH42S4, CALCG1A, CALCG4)
11324                SCASE = 'G2 ; SUBCASE 4'
11325             ELSE
11326                WATER = TINY
11327                DO 20 I=1,NIONS
11328                   MOLAL(I) = ZERO
11329 20             CONTINUE
11330                CALL CALCG1A
11331                SCASE = 'G2 ; SUBCASE 2'
11332             ENDIF
11333          ENDIF
11334       ENDIF
11335 !
11336       RETURN
11337 !
11338 ! *** END OF SUBROUTINE CALCG2 ******************************************
11339 !
11340    END SUBROUTINE CALCG2
11341
11342
11343 !=======================================================================
11344 !
11345 ! *** ISORROPIA CODE
11346 ! *** SUBROUTINE CALCG2A
11347 ! *** CASE G2 ; SUBCASE 1
11348 !
11349 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11350 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11351 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11352 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11353 !
11354 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11355 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11356 ! *** WRITTEN BY ATHANASIOS NENES
11357 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11358 !
11359 !=======================================================================
11360 !
11361    SUBROUTINE CALCG2A
11362      implicit none
11363      REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DELTA
11364      INTEGER ISLV
11365      INTEGER I
11366 !
11367 ! *** SETUP PARAMETERS ************************************************
11368 !
11369       CALAOU = .TRUE.
11370       CHI1   = 0.5*W(1)
11371       CHI2   = MAX (W(2)-CHI1, ZERO)
11372       CHI3   = ZERO
11373       CHI4   = MAX (W(3)-2.D0*CHI2, ZERO)
11374       CHI5   = W(4)
11375       CHI6   = W(5)
11376 !
11377       PSI6LO = TINY
11378       PSI6HI = CHI6-TINY
11379 !
11380       WATER  = TINY
11381 !
11382 ! *** INITIAL VALUES FOR BISECTION ************************************
11383 !
11384       X1 = PSI6LO
11385       Y1 = FUNCG2A (X1)
11386       IF (CHI6.LE.TINY) GOTO 50
11387 !CC      IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
11388 !CC      IF (WATER .LE. TINY) GOTO 50               ! No water
11389 !
11390 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11391 !
11392       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11393       DO 10 I=1,NDIV
11394          X2 = X1+DX
11395          Y2 = FUNCG2A (X2)
11396          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
11397          X1 = X2
11398          Y1 = Y2
11399 10    CONTINUE
11400 !
11401 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11402 !
11403       IF (ABS(Y2) .GT. EPS) WATER = TINY
11404       GOTO 50
11405 !
11406 ! *** PERFORM BISECTION ***********************************************
11407 !
11408 20    DO 30 I=1,MAXIT
11409          X3 = 0.5*(X1+X2)
11410          Y3 = FUNCG2A (X3)
11411          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
11412             Y2    = Y3
11413             X2    = X3
11414          ELSE
11415             Y1    = Y3
11416             X1    = X3
11417          ENDIF
11418          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11419 30    CONTINUE
11420       CALL PUSHERR (0002, 'CALCG2A')    ! WARNING ERROR: NO CONVERGENCE
11421 !
11422 ! *** CONVERGED ; RETURN **********************************************
11423 !
11424 40    X3 = 0.5*(X1+X2)
11425       IF (X3.LE.TINY2) THEN   ! PRACTICALLY NO NITRATES, SO DRY SOLUTION
11426          WATER = TINY
11427       ELSE
11428          Y3 = FUNCG2A (X3)
11429       ENDIF
11430 !
11431 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
11432 !
11433 50    CONTINUE
11434 !
11435 ! *** Na2SO4 DISSOLUTION
11436 !
11437       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN        ! PSI1
11438          CALL POLY3 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
11439          IF (ISLV.EQ.0) THEN
11440              PSI1 = MIN (PSI1, CHI1)
11441          ELSE
11442              PSI1 = ZERO
11443          ENDIF
11444       ELSE
11445          PSI1 = ZERO
11446       ENDIF
11447       MOLAL(2) = 2.0D0*PSI1               ! Na+  EFFECT
11448       MOLAL(5) = MOLAL(5) + PSI1          ! SO4  EFFECT
11449       CNA2SO4  = MAX(CHI1 - PSI1, ZERO)   ! NA2SO4(s) depletion
11450 !
11451 ! *** HSO4 equilibrium
11452 !
11453       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11454          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11455          MOLAL(1) = MOLAL(1) - DELTA     ! H+   AFFECT
11456          MOLAL(5) = MOLAL(5) - DELTA     ! SO4  AFFECT
11457          MOLAL(6) = DELTA                ! HSO4 AFFECT
11458       ENDIF
11459 !
11460       RETURN
11461 !
11462 ! *** END OF SUBROUTINE CALCG2A ******************************************
11463 !
11464    END SUBROUTINE CALCG2A
11465
11466
11467
11468
11469 !=======================================================================
11470 !
11471 ! *** ISORROPIA CODE
11472 ! *** SUBROUTINE FUNCG2A
11473 ! *** CASE G2
11474 !
11475 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11476 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11477 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11478 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11479 !
11480 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11481 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11482 ! *** WRITTEN BY ATHANASIOS NENES
11483 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11484 !
11485 !=======================================================================
11486 !
11487    REAL(KIND=8) FUNCTION FUNCG2A (X)
11488      implicit none
11489      REAL(KIND=8) X
11490      REAL(KIND=8) DENO
11491      REAL(KIND=8) SMIN, HI, OHI
11492      REAL(KIND=8) PSI31, PSI32, PSI20, BB, CC, DD, DELT
11493      REAL(KIND=8) ALF, BET, GAM, RTSQ, THETA1, THETA2
11494      INTEGER ISLV
11495      INTEGER I
11496 !
11497 !
11498 ! *** SETUP PARAMETERS ************************************************
11499 !
11500       PSI6   = X
11501       PSI2   = CHI2
11502       PSI3   = ZERO
11503       FRST   = .TRUE.
11504       CALAIN = .TRUE.
11505 !
11506 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11507 !
11508       DO 10 I=1,NSWEEP
11509 !
11510       A1  = XK5 *(WATER/GAMA(2))**3.0
11511       A2  = XK7 *(WATER/GAMA(4))**3.0
11512       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11513       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11514       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11515 !
11516       DENO = MAX(CHI6-PSI6-PSI3, ZERO)
11517       PSI5 = CHI5/((A6/A5)*(DENO/PSI6) + ONE)
11518 !
11519       PSI4 = MIN(PSI5+PSI6,CHI4)
11520 !
11521       IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
11522          CALL POLY3 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV)
11523          IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2)
11524       ENDIF
11525 !
11526 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
11527 !
11528       MOLAL (2) = ZERO                             ! NA
11529       MOLAL (3) = 2.0*PSI2 + PSI4                  ! NH4I
11530       MOLAL (4) = PSI6                             ! CLI
11531       MOLAL (5) = PSI2                             ! SO4I
11532       MOLAL (6) = ZERO                             ! HSO4
11533       MOLAL (7) = PSI5                             ! NO3I
11534 !
11535 !CC      MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5   ! HI
11536       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
11537       CALL CALCPH (SMIN, HI, OHI)
11538       MOLAL (1) = HI
11539 !
11540 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
11541 !
11542       GNH3      = MAX(CHI4 - PSI4, TINY)
11543       GHNO3     = MAX(CHI5 - PSI5, TINY)
11544       GHCL      = MAX(CHI6 - PSI6, TINY)
11545 !
11546       CNH42S4   = MAX(CHI2 - PSI2, ZERO)
11547       CNH4NO3   = ZERO
11548 !
11549 ! *** NH4Cl(s) calculations
11550 !
11551       A3   = XK6 /(R*TEMP*R*TEMP)
11552       IF (GNH3*GHCL.GT.A3) THEN
11553          DELT = MIN(GNH3, GHCL)
11554          BB = -(GNH3+GHCL)
11555          CC = GNH3*GHCL-A3
11556          DD = BB*BB - 4.D0*CC
11557          PSI31 = 0.5D0*(-BB + SQRT(DD))
11558          PSI32 = 0.5D0*(-BB - SQRT(DD))
11559          IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
11560             PSI3 = PSI31
11561          ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
11562             PSI3 = PSI32
11563          ELSE
11564             PSI3 = ZERO
11565          ENDIF
11566       ELSE
11567          PSI3 = ZERO
11568       ENDIF
11569 !
11570 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
11571 !
11572       GNH3    = MAX(GNH3 - PSI3, TINY)
11573       GHCL    = MAX(GHCL - PSI3, TINY)
11574       CNH4CL  = PSI3
11575 !
11576 ! *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
11577 !
11578       CALL CALCMR
11579 !
11580 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
11581 !
11582       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
11583          CALL CALCACT
11584       ELSE
11585          GOTO 20
11586       ENDIF
11587 10    CONTINUE
11588 !
11589 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
11590 !
11591 20    IF (CHI4.LE.TINY) THEN
11592          FUNCG2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
11593       ELSE
11594          FUNCG2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
11595       ENDIF
11596 !
11597       RETURN
11598 !
11599 ! *** END OF FUNCTION FUNCG2A *******************************************
11600 !
11601    END  FUNCTION FUNCG2A
11602
11603 !=======================================================================
11604 !
11605 ! *** ISORROPIA CODE
11606 ! *** SUBROUTINE CALCG1
11607 ! *** CASE G1
11608 !
11609 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11610 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
11611 !     2. SOLID AEROSOL ONLY
11612 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4CL, NA2SO4
11613 !
11614 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
11615 !     1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
11616 !     2. WHEN RH < MDRH  ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCG1A)
11617 !
11618 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11619 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11620 ! *** WRITTEN BY ATHANASIOS NENES
11621 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11622 !
11623 !=======================================================================
11624 !
11625       SUBROUTINE CALCG1
11626         implicit none
11627 !      EXTERNAL CALCG1A, CALCG2A
11628 !
11629 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
11630 !
11631       IF (RH.LT.DRMG1) THEN
11632          SCASE = 'G1 ; SUBCASE 1'
11633          CALL CALCG1A              ! SOLID PHASE ONLY POSSIBLE
11634          SCASE = 'G1 ; SUBCASE 1'
11635       ELSE
11636          SCASE = 'G1 ; SUBCASE 2'  ! LIQUID & SOLID PHASE POSSIBLE
11637          CALL CALCMDRH (RH, DRMG1, DRNH4NO3, CALCG1A, CALCG2A)
11638          SCASE = 'G1 ; SUBCASE 2'
11639       ENDIF
11640 !
11641       RETURN
11642 !
11643 ! *** END OF SUBROUTINE CALCG1 ******************************************
11644 !
11645     END SUBROUTINE CALCG1
11646
11647
11648 !=======================================================================
11649 !
11650 ! *** ISORROPIA CODE
11651 ! *** SUBROUTINE CALCG1A
11652 ! *** CASE G1 ; SUBCASE 1
11653 !
11654 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11655 !     1. SULFATE POOR (SULRAT > 2.0)
11656 !     2. SOLID AEROSOL ONLY
11657 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
11658 !
11659 !     SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3
11660 !     IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF
11661 !     NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN
11662 !     THE SOLID PHASE.
11663 !
11664 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11665 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11666 ! *** WRITTEN BY ATHANASIOS NENES
11667 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11668 !
11669 !=======================================================================
11670 !
11671     SUBROUTINE CALCG1A
11672       implicit none
11673       REAL(KIND=8) LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2
11674       REAL(KIND=8) ALF, BET, GAM, RTSQ, THETA1, THETA2
11675       REAL(KIND=8) SQDD, DD1, DD2, SQD1
11676       REAL(KIND=8) BB, CC, DD, SQDD1, SQDD2
11677 !
11678 ! *** CALCULATE NON VOLATILE SOLIDS ***********************************
11679 !
11680       CNA2SO4 = 0.5*W(1)
11681       CNH42S4 = W(2) - CNA2SO4
11682 !
11683 ! *** CALCULATE VOLATILE SPECIES **************************************
11684 !
11685       ALF     = W(3) - 2.0*CNH42S4
11686       BET     = W(5)
11687       GAM     = W(4)
11688 !
11689       RTSQ    = R*TEMP*R*TEMP
11690       A1      = XK6/RTSQ
11691       A2      = XK10/RTSQ
11692 !
11693       THETA1  = GAM - BET*(A2/A1)
11694       THETA2  = A2/A1
11695 !
11696 ! QUADRATIC EQUATION SOLUTION
11697 !
11698       BB      = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
11699       CC      = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
11700       DD      = BB*BB - 4.0D0*CC
11701       IF (DD.LT.ZERO) GOTO 100   ! Solve each reaction seperately
11702 !
11703 ! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
11704 !
11705       SQDD    = SQRT(DD)
11706       KAPA1   = 0.5D0*(-BB+SQDD)
11707       KAPA2   = 0.5D0*(-BB-SQDD)
11708       LAMDA1  = THETA1 + THETA2*KAPA1
11709       LAMDA2  = THETA1 + THETA2*KAPA2
11710 !
11711       IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
11712          IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND.                 &
11713             BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
11714              KAPA = KAPA1
11715              LAMDA= LAMDA1
11716              GOTO 200
11717          ENDIF
11718       ENDIF
11719 !
11720       IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
11721          IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND.                  &
11722             BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
11723              KAPA = KAPA2
11724              LAMDA= LAMDA2
11725              GOTO 200
11726          ENDIF
11727       ENDIF
11728 !
11729 ! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
11730 !
11731 100   KAPA  = ZERO
11732       LAMDA = ZERO
11733       DD1   = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
11734       DD2   = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
11735 !
11736 ! NH4CL EQUILIBRIUM
11737 !
11738       IF (DD1.GE.ZERO) THEN
11739          SQDD1 = SQRT(DD1)
11740          KAPA1 = 0.5D0*(ALF+BET + SQDD1)
11741          KAPA2 = 0.5D0*(ALF+BET - SQDD1)
11742 !
11743          IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
11744             KAPA = KAPA1
11745          ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
11746             KAPA = KAPA2
11747          ELSE
11748             KAPA = ZERO
11749          ENDIF
11750       ENDIF
11751 !
11752 ! NH4NO3 EQUILIBRIUM
11753 !
11754       IF (DD2.GE.ZERO) THEN
11755          SQDD2 = SQRT(DD2)
11756          LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
11757          LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
11758 !
11759          IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
11760             LAMDA = LAMDA1
11761          ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
11762             LAMDA = LAMDA2
11763          ELSE
11764             LAMDA = ZERO
11765          ENDIF
11766       ENDIF
11767 !
11768 ! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
11769 !
11770       IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
11771          IF (BET .LT. LAMDA/THETA1) THEN
11772             KAPA = ZERO
11773          ELSE
11774             LAMDA= ZERO
11775          ENDIF
11776       ENDIF
11777 !
11778 ! *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
11779 !
11780 200   CONTINUE
11781       CNH4NO3 = LAMDA
11782       CNH4CL  = KAPA
11783 !
11784       GNH3    = MAX(ALF - KAPA - LAMDA, ZERO)
11785       GHNO3   = MAX(GAM - LAMDA, ZERO)
11786       GHCL    = MAX(BET - KAPA, ZERO)
11787 !
11788       RETURN
11789 !
11790 ! *** END OF SUBROUTINE CALCG1A *****************************************
11791 !
11792     END SUBROUTINE CALCG1A
11793
11794 !=======================================================================
11795 !
11796 ! *** ISORROPIA CODE
11797 ! *** SUBROUTINE CALCH6
11798 ! *** CASE H6
11799 !
11800 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11801 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
11802 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11803 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11804 !
11805 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11806 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11807 ! *** WRITTEN BY ATHANASIOS NENES
11808 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11809 !
11810 !=======================================================================
11811 !
11812     SUBROUTINE CALCH6
11813       implicit none
11814       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DELTA
11815       REAL(KIND=8) FRNA
11816       INTEGER I
11817 !
11818
11819
11820
11821 !
11822 ! *** SETUP PARAMETERS ************************************************
11823 !
11824       CALAOU = .TRUE.
11825       CHI1   = W(2)                                ! CNA2SO4
11826       CHI2   = ZERO                                ! CNH42S4
11827       CHI3   = ZERO                                ! CNH4CL
11828       FRNA   = MAX (W(1)-2.D0*CHI1, ZERO)
11829       CHI8   = MIN (FRNA, W(4))                    ! CNANO3
11830       CHI4   = W(3)                                ! NH3(g)
11831       CHI5   = MAX (W(4)-CHI8, ZERO)               ! HNO3(g)
11832       CHI7   = MIN (MAX(FRNA-CHI8, ZERO), W(5))    ! CNACL
11833       CHI6   = MAX (W(5)-CHI7, ZERO)               ! HCL(g)
11834 !
11835       PSI6LO = TINY
11836       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
11837 !
11838 ! *** INITIAL VALUES FOR BISECTION ************************************
11839 !
11840       X1 = PSI6LO
11841       Y1 = FUNCH6A (X1)
11842       IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
11843 !
11844 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11845 !
11846       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11847       DO 10 I=1,NDIV
11848          X2 = X1+DX
11849          Y2 = FUNCH6A (X2)
11850          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
11851          X1 = X2
11852          Y1 = Y2
11853 10    CONTINUE
11854 !
11855 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11856 !
11857       IF (ABS(Y2) .GT. EPS) Y2 = FUNCH6A (PSI6LO)
11858       GOTO 50
11859 !
11860 ! *** PERFORM BISECTION ***********************************************
11861 !
11862 20    DO 30 I=1,MAXIT
11863          X3 = 0.5*(X1+X2)
11864          Y3 = FUNCH6A (X3)
11865          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
11866             Y2    = Y3
11867             X2    = X3
11868          ELSE
11869             Y1    = Y3
11870             X1    = X3
11871          ENDIF
11872          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11873 30    CONTINUE
11874       CALL PUSHERR (0002, 'CALCH6')    ! WARNING ERROR: NO CONVERGENCE
11875 !
11876 ! *** CONVERGED ; RETURN **********************************************
11877 !
11878 40    X3 = 0.5*(X1+X2)
11879       Y3 = FUNCH6A (X3)
11880 !
11881 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
11882 !
11883 50    CONTINUE
11884       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11885          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11886          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
11887          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
11888          MOLAL(6) = DELTA                                ! HSO4 EFFECT
11889       ENDIF
11890 !
11891       RETURN
11892 !
11893 ! *** END OF SUBROUTINE CALCH6 ******************************************
11894 !
11895    END SUBROUTINE CALCH6
11896
11897
11898
11899
11900 !=======================================================================
11901 !
11902 ! *** ISORROPIA CODE
11903 ! *** SUBROUTINE FUNCH6A
11904 ! *** CASE H6
11905 !
11906 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11907 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
11908 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
11909 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
11910 !
11911 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
11912 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
11913 ! *** WRITTEN BY ATHANASIOS NENES
11914 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
11915 !
11916 !=======================================================================
11917 !
11918       REAL(KIND=8) FUNCTION FUNCH6A (X)
11919       implicit none
11920       REAL(KIND=8) X
11921       REAL(KIND=8) FRNA, A9
11922       REAL(KIND=8)  BB, CC, DD, SMIN, HI, OHI
11923       INTEGER I
11924 !
11925
11926
11927
11928 !
11929 ! *** SETUP PARAMETERS ************************************************
11930 !
11931       PSI6   = X
11932       PSI1   = CHI1
11933       PSI2   = ZERO
11934       PSI3   = ZERO
11935       PSI7   = CHI7
11936       PSI8   = CHI8
11937       FRST   = .TRUE.
11938       CALAIN = .TRUE.
11939 !
11940 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11941 !
11942       DO 10 I=1,NSWEEP
11943 !
11944       A1  = XK5 *(WATER/GAMA(2))**3.0
11945       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11946       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11947       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11948       A7  = XK8 *(WATER/GAMA(1))**2.0
11949       A8  = XK9 *(WATER/GAMA(3))**2.0
11950       A9  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
11951 !
11952 !  CALCULATE DISSOCIATION QUANTITIES
11953 !
11954       PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
11955       PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
11956       PSI5 = MAX(PSI5, TINY)
11957 !
11958       IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN  ! First try 3rd order soln
11959          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
11960          CC   = CHI4*(PSI5+PSI6)
11961          DD   = BB*BB-4.d0*CC
11962          PSI4 =0.5d0*(-BB - SQRT(DD))
11963          PSI4 = MIN(PSI4,CHI4)
11964       ELSE
11965          PSI4 = TINY
11966       ENDIF
11967 !
11968 ! *** CALCULATE SPECIATION ********************************************
11969 !
11970       MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1               ! NAI
11971       MOLAL (3) = PSI4                                  ! NH4I
11972       MOLAL (4) = PSI6 + PSI7                           ! CLI
11973       MOLAL (5) = PSI2 + PSI1                           ! SO4I
11974       MOLAL (6) = ZERO                                  ! HSO4I
11975       MOLAL (7) = PSI5 + PSI8                           ! NO3I
11976 !
11977       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
11978       CALL CALCPH (SMIN, HI, OHI)
11979       MOLAL (1) = HI
11980 !
11981       GNH3      = MAX(CHI4 - PSI4, TINY)
11982       GHNO3     = MAX(CHI5 - PSI5, TINY)
11983       GHCL      = MAX(CHI6 - PSI6, TINY)
11984 !
11985       CNH42S4   = ZERO
11986       CNH4NO3   = ZERO
11987       CNACL     = MAX(CHI7 - PSI7, ZERO)
11988       CNANO3    = MAX(CHI8 - PSI8, ZERO)
11989       CNA2SO4   = MAX(CHI1 - PSI1, ZERO)
11990 !
11991       CALL CALCMR                                    ! Water content
11992 !
11993 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
11994 !
11995       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
11996          CALL CALCACT
11997       ELSE
11998          GOTO 20
11999       ENDIF
12000 10    CONTINUE
12001 !
12002 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12003 !
12004 20    FUNCH6A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12005 !
12006       RETURN
12007 !
12008 ! *** END OF FUNCTION FUNCH6A *******************************************
12009 !
12010    END FUNCTION FUNCH6A
12011
12012 !=======================================================================
12013 !
12014 ! *** ISORROPIA CODE
12015 ! *** SUBROUTINE CALCH5
12016 ! *** CASE H5
12017 !
12018 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12019 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12020 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12021 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
12022 !
12023 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12024 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12025 ! *** WRITTEN BY ATHANASIOS NENES
12026 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12027 !
12028 !=======================================================================
12029 !
12030       SUBROUTINE CALCH5
12031       implicit none
12032       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DEL
12033       REAL(KIND=8) FRNA, DELTA
12034       INTEGER I
12035 !
12036 !
12037 ! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
12038 !
12039       IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN
12040          SCASE = 'H5'
12041          CALL CALCH1A
12042          SCASE = 'H5'
12043          RETURN
12044       ENDIF
12045 !
12046 ! *** SETUP PARAMETERS ************************************************
12047 !
12048       CALAOU = .TRUE.
12049       CHI1   = W(2)                                ! CNA2SO4
12050       CHI2   = ZERO                                ! CNH42S4
12051       CHI3   = ZERO                                ! CNH4CL
12052       FRNA   = MAX (W(1)-2.D0*CHI1, ZERO)
12053       CHI8   = MIN (FRNA, W(4))                    ! CNANO3
12054       CHI4   = W(3)                                ! NH3(g)
12055       CHI5   = MAX (W(4)-CHI8, ZERO)               ! HNO3(g)
12056       CHI7   = MIN (MAX(FRNA-CHI8, ZERO), W(5))    ! CNACL
12057       CHI6   = MAX (W(5)-CHI7, ZERO)               ! HCL(g)
12058 !
12059       PSI6LO = TINY
12060       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
12061 !
12062 ! *** INITIAL VALUES FOR BISECTION ************************************
12063 !
12064       X1 = PSI6LO
12065       Y1 = FUNCH5A (X1)
12066       IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12067 !
12068 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12069 !
12070       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12071       DO 10 I=1,NDIV
12072          X2 = X1+DX
12073          Y2 = FUNCH5A (X2)
12074          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
12075          X1 = X2
12076          Y1 = Y2
12077 10    CONTINUE
12078 !
12079 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12080 !
12081       IF (ABS(Y2) .GT. EPS) Y2 = FUNCH5A (PSI6LO)
12082       GOTO 50
12083 !
12084 ! *** PERFORM BISECTION ***********************************************
12085 !
12086 20    DO 30 I=1,MAXIT
12087          X3 = 0.5*(X1+X2)
12088          Y3 = FUNCH5A (X3)
12089          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
12090             Y2    = Y3
12091             X2    = X3
12092          ELSE
12093             Y1    = Y3
12094             X1    = X3
12095          ENDIF
12096          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12097 30    CONTINUE
12098       CALL PUSHERR (0002, 'CALCH5')    ! WARNING ERROR: NO CONVERGENCE
12099 !
12100 ! *** CONVERGED ; RETURN **********************************************
12101 !
12102 40    X3 = 0.5*(X1+X2)
12103       Y3 = FUNCH5A (X3)
12104 !
12105 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12106 !
12107 50    CONTINUE
12108       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12109          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12110          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFECT
12111          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
12112          MOLAL(6) = DELTA                                ! HSO4 EFFECT
12113       ENDIF
12114
12115 !
12116       RETURN
12117 !
12118 ! *** END OF SUBROUTINE CALCH5 ******************************************
12119 !
12120    END SUBROUTINE CALCH5
12121
12122
12123
12124
12125 !=======================================================================
12126 !
12127 ! *** ISORROPIA CODE
12128 ! *** SUBROUTINE FUNCH5A
12129 ! *** CASE H5
12130 !
12131 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12132 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12133 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12134 !     3. SOLIDS POSSIBLE : NONE
12135 !
12136 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12137 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12138 ! *** WRITTEN BY ATHANASIOS NENES
12139 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12140 !
12141 !=======================================================================
12142 !
12143       REAL(KIND=8) FUNCTION FUNCH5A (X)
12144       implicit none
12145       REAL(KIND=8) X
12146       REAL(KIND=8) FRNA, A9
12147       REAL(KIND=8)  AA, BB, CC, DD, SMIN, HI, OHI
12148       INTEGER ISLV
12149       INTEGER I
12150 !
12151
12152 !
12153 ! *** SETUP PARAMETERS ************************************************
12154 !
12155       PSI6   = X
12156       PSI1   = CHI1
12157       PSI2   = ZERO
12158       PSI3   = ZERO
12159       PSI7   = CHI7
12160       PSI8   = CHI8
12161       FRST   = .TRUE.
12162       CALAIN = .TRUE.
12163 !
12164 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12165 !
12166       DO 10 I=1,NSWEEP
12167 !
12168
12169       A1  = XK5 *(WATER/GAMA(2))**3.0
12170       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12171       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12172       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12173       A7  = XK8 *(WATER/GAMA(1))**2.0
12174       A8  = XK9 *(WATER/GAMA(3))**2.0
12175       A9  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
12176 !
12177 !  CALCULATE DISSOCIATION QUANTITIES
12178 !
12179       PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
12180       PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
12181       PSI5 = MAX(PSI5, TINY)
12182 !
12183       IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN  ! First try 3rd order soln
12184          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12185          CC   = CHI4*(PSI5+PSI6)
12186          DD   = BB*BB-4.d0*CC
12187          PSI4 =0.5d0*(-BB - SQRT(DD))
12188          PSI4 = MIN(PSI4,CHI4)
12189       ELSE
12190          PSI4 = TINY
12191       ENDIF
12192 !
12193       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN     ! NA2SO4 DISSOLUTION
12194          AA = PSI7+PSI8
12195          BB = AA*AA
12196          CC =-A1/4.D0
12197          CALL POLY3 (AA, BB, CC, PSI1, ISLV)
12198          IF (ISLV.EQ.0) THEN
12199              PSI1 = MIN (PSI1, CHI1)
12200          ELSE
12201              PSI1 = ZERO
12202          ENDIF
12203       ENDIF
12204 !
12205 ! *** CALCULATE SPECIATION ********************************************
12206 !
12207       MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1                ! NAI
12208       MOLAL (3) = PSI4                                   ! NH4I
12209       MOLAL (4) = PSI6 + PSI7                            ! CLI
12210       MOLAL (5) = PSI2 + PSI1                            ! SO4I
12211       MOLAL (6) = ZERO
12212       MOLAL (7) = PSI5 + PSI8                            ! NO3I
12213 !
12214       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
12215       CALL CALCPH (SMIN, HI, OHI)
12216       MOLAL (1) = HI
12217 !
12218       GNH3      = MAX(CHI4 - PSI4, TINY)
12219       GHNO3     = MAX(CHI5 - PSI5, TINY)
12220       GHCL      = MAX(CHI6 - PSI6, TINY)
12221 !
12222       CNH42S4   = ZERO
12223       CNH4NO3   = ZERO
12224       CNACL     = MAX(CHI7 - PSI7, ZERO)
12225       CNANO3    = MAX(CHI8 - PSI8, ZERO)
12226       CNA2SO4   = MAX(CHI1 - PSI1, ZERO)
12227 !
12228       CALL CALCMR                               ! Water content
12229 !
12230 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12231 !
12232       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12233          CALL CALCACT
12234       ELSE
12235          GOTO 20
12236       ENDIF
12237 10    CONTINUE
12238 !
12239 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12240 !
12241 20    FUNCH5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12242 !
12243       RETURN
12244 !
12245 ! *** END OF FUNCTION FUNCH5A *******************************************
12246 !
12247    END FUNCTION FUNCH5A
12248
12249 !=======================================================================
12250 !
12251 ! *** ISORROPIA CODE
12252 ! *** SUBROUTINE CALCH4
12253 ! *** CASE H4
12254 !
12255 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12256 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12257 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12258 !     3. SOLIDS POSSIBLE : NA2SO4
12259 !
12260 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12261 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12262 ! *** WRITTEN BY ATHANASIOS NENES
12263 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12264 !
12265 !=======================================================================
12266 !
12267       SUBROUTINE CALCH4
12268       implicit none
12269       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DEL
12270       REAL(KIND=8) FRNA, DELTA
12271       INTEGER I
12272 !
12273
12274
12275
12276 !
12277 ! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
12278 !
12279       IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN
12280          SCASE = 'H4'
12281          CALL CALCH1A
12282          SCASE = 'H4'
12283          RETURN
12284       ENDIF
12285 !
12286 ! *** SETUP PARAMETERS ************************************************
12287 !
12288       CALAOU = .TRUE.
12289       CHI1   = W(2)                                ! CNA2SO4
12290       CHI2   = ZERO                                ! CNH42S4
12291       CHI3   = ZERO                                ! CNH4CL
12292       FRNA   = MAX (W(1)-2.D0*CHI1, ZERO)
12293       CHI8   = MIN (FRNA, W(4))                    ! CNANO3
12294       CHI4   = W(3)                                ! NH3(g)
12295       CHI5   = MAX (W(4)-CHI8, ZERO)               ! HNO3(g)
12296       CHI7   = MIN (MAX(FRNA-CHI8, ZERO), W(5))    ! CNACL
12297       CHI6   = MAX (W(5)-CHI7, ZERO)               ! HCL(g)
12298 !
12299       PSI6LO = TINY
12300       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
12301 !
12302 ! *** INITIAL VALUES FOR BISECTION ************************************
12303 !
12304       X1 = PSI6LO
12305       Y1 = FUNCH4A (X1)
12306       IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12307 !
12308 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12309 !
12310       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12311       DO 10 I=1,NDIV
12312          X2 = X1+DX
12313          Y2 = FUNCH4A (X2)
12314          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
12315          X1 = X2
12316          Y1 = Y2
12317 10    CONTINUE
12318 !
12319 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12320 !
12321       IF (ABS(Y2) .GT. EPS) Y2 = FUNCH4A (PSI6LO)
12322       GOTO 50
12323 !
12324 ! *** PERFORM BISECTION ***********************************************
12325 !
12326 20    DO 30 I=1,MAXIT
12327          X3 = 0.5*(X1+X2)
12328          Y3 = FUNCH4A (X3)
12329          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
12330             Y2    = Y3
12331             X2    = X3
12332          ELSE
12333             Y1    = Y3
12334             X1    = X3
12335          ENDIF
12336          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12337 30    CONTINUE
12338       CALL PUSHERR (0002, 'CALCH4')    ! WARNING ERROR: NO CONVERGENCE
12339 !
12340 ! *** CONVERGED ; RETURN **********************************************
12341 !
12342 40    X3 = 0.5*(X1+X2)
12343       Y3 = FUNCH4A (X3)
12344 !
12345 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12346 !
12347 50    CONTINUE
12348       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12349          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12350          MOLAL(1) = MOLAL(1) - DELTA                      ! H+   EFFECT
12351          MOLAL(5) = MOLAL(5) - DELTA                      ! SO4  EFFECT
12352          MOLAL(6) = DELTA                                 ! HSO4 EFFECT
12353       ENDIF
12354 !
12355       RETURN
12356 !
12357 ! *** END OF SUBROUTINE CALCH4 ******************************************
12358 !
12359    END SUBROUTINE CALCH4
12360
12361
12362
12363
12364 !=======================================================================
12365 !
12366 ! *** ISORROPIA CODE
12367 ! *** SUBROUTINE FUNCH4A
12368 ! *** CASE H4
12369 !
12370 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12371 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12372 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12373 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
12374 !
12375 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12376 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12377 ! *** WRITTEN BY ATHANASIOS NENES
12378 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12379 !
12380 !=======================================================================
12381 !
12382       REAL(KIND=8) FUNCTION FUNCH4A (X)
12383       implicit none
12384       REAL(KIND=8) X
12385       REAL(KIND=8)  A9, DELT, PSI31, PSI32
12386       REAL(KIND=8)  AA, BB, CC, DD, SMIN, HI, OHI
12387       INTEGER ISLV
12388       INTEGER I
12389 !
12390
12391
12392
12393 !
12394 ! *** SETUP PARAMETERS ************************************************
12395 !
12396       PSI6   = X
12397       PSI1   = CHI1
12398       PSI2   = ZERO
12399       PSI3   = ZERO
12400       PSI7   = CHI7
12401       PSI8   = CHI8
12402       FRST   = .TRUE.
12403       CALAIN = .TRUE.
12404 !
12405 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12406 !
12407       DO 10 I=1,NSWEEP
12408 !
12409       A1  = XK5 *(WATER/GAMA(2))**3.0
12410       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12411       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12412       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12413       A7  = XK8 *(WATER/GAMA(1))**2.0
12414       A8  = XK9 *(WATER/GAMA(3))**2.0
12415       A9  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
12416 !
12417 !  CALCULATE DISSOCIATION QUANTITIES
12418 !
12419       PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
12420       PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
12421       PSI5 = MAX(PSI5, TINY)
12422 !
12423       IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN  ! First try 3rd order soln
12424          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12425          CC   = CHI4*(PSI5+PSI6)
12426          DD   = BB*BB-4.d0*CC
12427          PSI4 =0.5d0*(-BB - SQRT(DD))
12428          PSI4 = MIN(PSI4,CHI4)
12429       ELSE
12430          PSI4 = TINY
12431       ENDIF
12432 !
12433       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN     ! NA2SO4 DISSOLUTION
12434          AA = PSI7+PSI8
12435          BB = AA*AA
12436          CC =-A1/4.D0
12437          CALL POLY3 (AA, BB, CC, PSI1, ISLV)
12438          IF (ISLV.EQ.0) THEN
12439              PSI1 = MIN (PSI1, CHI1)
12440          ELSE
12441              PSI1 = ZERO
12442          ENDIF
12443       ENDIF
12444 !
12445 ! *** CALCULATE SPECIATION ********************************************
12446 !
12447       MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1                ! NAI
12448       MOLAL (3) = PSI4                                   ! NH4I
12449       MOLAL (4) = PSI6 + PSI7                            ! CLI
12450       MOLAL (5) = PSI2 + PSI1                            ! SO4I
12451       MOLAL (6) = ZERO
12452       MOLAL (7) = PSI5 + PSI8                            ! NO3I
12453 !
12454       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
12455       CALL CALCPH (SMIN, HI, OHI)
12456       MOLAL (1) = HI
12457 !
12458 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
12459 !
12460       GNH3      = MAX(CHI4 - PSI4, TINY)
12461       GHNO3     = MAX(CHI5 - PSI5, TINY)
12462       GHCL      = MAX(CHI6 - PSI6, TINY)
12463 !
12464       CNH42S4   = ZERO
12465       CNH4NO3   = ZERO
12466       CNACL     = MAX(CHI7 - PSI7, ZERO)
12467       CNANO3    = MAX(CHI8 - PSI8, ZERO)
12468       CNA2SO4   = MAX(CHI1 - PSI1, ZERO)
12469 !
12470 ! *** NH4Cl(s) calculations
12471 !
12472       A3   = XK6 /(R*TEMP*R*TEMP)
12473       DELT = MIN(GNH3, GHCL)
12474       BB = -(GNH3+GHCL)
12475       CC = GNH3*GHCL-A3
12476       DD = BB*BB - 4.D0*CC
12477       PSI31 = 0.5D0*(-BB + SQRT(DD))
12478       PSI32 = 0.5D0*(-BB - SQRT(DD))
12479       IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
12480          PSI3 = PSI31
12481       ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
12482          PSI3 = PSI32
12483       ELSE
12484          PSI3 = ZERO
12485       ENDIF
12486 !
12487 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
12488 !
12489       GNH3    = MAX(GNH3 - PSI3, TINY)
12490       GHCL    = MAX(GHCL - PSI3, TINY)
12491       CNH4CL  = PSI3
12492 !
12493       CALL CALCMR                           ! Water content
12494 !
12495 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12496 !
12497       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12498          CALL CALCACT
12499       ELSE
12500          GOTO 20
12501       ENDIF
12502 10    CONTINUE
12503 !
12504 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12505 !
12506 20    FUNCH4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12507 !
12508       RETURN
12509 !
12510 ! *** END OF FUNCTION FUNCH4A *******************************************
12511 !
12512    END FUNCTION FUNCH4A
12513
12514
12515 !=======================================================================
12516 !
12517 ! *** ISORROPIA CODE
12518 ! *** SUBROUTINE CALCH3
12519 ! *** CASE H3
12520 !
12521 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12522 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12523 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12524 !     3. SOLIDS POSSIBLE : NH4CL, NA2SO4
12525 !
12526 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12527 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12528 ! *** WRITTEN BY ATHANASIOS NENES
12529 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12530 !
12531 !=======================================================================
12532 !
12533    SUBROUTINE CALCH3
12534      implicit none
12535      !
12536       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DELTA
12537       REAL(KIND=8) FRNA
12538      INTEGER I
12539
12540
12541
12542 !
12543 ! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
12544 !
12545       IF (W(4).LE.TINY) THEN        ! NO3 NOT EXIST, WATER NOT POSSIBLE
12546          SCASE = 'H3'
12547          CALL CALCH1A
12548          SCASE = 'H3'
12549          RETURN
12550       ENDIF
12551 !
12552 ! *** SETUP PARAMETERS ************************************************
12553 !
12554       CALAOU = .TRUE.
12555       CHI1   = W(2)                                ! CNA2SO4
12556       CHI2   = ZERO                                ! CNH42S4
12557       CHI3   = ZERO                                ! CNH4CL
12558       FRNA   = MAX (W(1)-2.D0*CHI1, ZERO)
12559       CHI8   = MIN (FRNA, W(4))                    ! CNANO3
12560       CHI4   = W(3)                                ! NH3(g)
12561       CHI5   = MAX (W(4)-CHI8, ZERO)               ! HNO3(g)
12562       CHI7   = MIN (MAX(FRNA-CHI8, ZERO), W(5))    ! CNACL
12563       CHI6   = MAX (W(5)-CHI7, ZERO)               ! HCL(g)
12564 !
12565       PSI6LO = TINY
12566       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
12567 !
12568 ! *** INITIAL VALUES FOR BISECTION ************************************
12569 !
12570       X1 = PSI6LO
12571       Y1 = FUNCH3A (X1)
12572       IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12573 !
12574 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12575 !
12576       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12577       DO 10 I=1,NDIV
12578          X2 = X1+DX
12579          Y2 = FUNCH3A (X2)
12580          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
12581          X1 = X2
12582          Y1 = Y2
12583 10    CONTINUE
12584 !
12585 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12586 !
12587       IF (ABS(Y2) .GT. EPS) Y2 = FUNCH3A (PSI6LO)
12588       GOTO 50
12589 !
12590 ! *** PERFORM BISECTION ***********************************************
12591 !
12592 20    DO 30 I=1,MAXIT
12593          X3 = 0.5*(X1+X2)
12594          Y3 = FUNCH3A (X3)
12595          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
12596             Y2    = Y3
12597             X2    = X3
12598          ELSE
12599             Y1    = Y3
12600             X1    = X3
12601          ENDIF
12602          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12603 30    CONTINUE
12604       CALL PUSHERR (0002, 'CALCH3')    ! WARNING ERROR: NO CONVERGENCE
12605 !
12606 ! *** CONVERGED ; RETURN **********************************************
12607 !
12608 40    X3 = 0.5*(X1+X2)
12609       Y3 = FUNCH3A (X3)
12610 !
12611 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12612 !
12613 50    CONTINUE
12614       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12615          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12616          MOLAL(1) = MOLAL(1) - DELTA                     ! H+   EFFECT
12617          MOLAL(5) = MOLAL(5) - DELTA                     ! SO4  EFFECT
12618          MOLAL(6) = DELTA                                ! HSO4 EFFECT
12619       ENDIF
12620 !
12621       RETURN
12622 !
12623 ! *** END OF SUBROUTINE CALCH3 ******************************************
12624 !
12625     END SUBROUTINE CALCH3
12626
12627
12628
12629
12630 !=======================================================================
12631 !
12632 ! *** ISORROPIA CODE
12633 ! *** SUBROUTINE FUNCH3A
12634 ! *** CASE H3
12635 !
12636 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12637 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12638 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12639 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
12640 !
12641 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12642 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12643 ! *** WRITTEN BY ATHANASIOS NENES
12644 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12645 !
12646 !=======================================================================
12647 !
12648       REAL(KIND=8) FUNCTION FUNCH3A (X)
12649
12650       implicit none
12651       REAL(KIND=8) X
12652       REAL(KIND=8) FRNA, A9
12653       REAL(KIND=8)  AA, BB, CC, DD, SMIN, HI, OHI
12654       REAL(KIND=8) DIAK, PSI31, PSI32, DELT
12655       INTEGER ISLV
12656       INTEGER I
12657 !
12658
12659
12660
12661 !
12662 ! *** SETUP PARAMETERS ************************************************
12663 !
12664       PSI6   = X
12665       PSI1   = CHI1
12666       PSI2   = ZERO
12667       PSI3   = ZERO
12668       PSI7   = CHI7
12669       PSI8   = CHI8
12670       FRST   = .TRUE.
12671       CALAIN = .TRUE.
12672 !
12673 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12674 !
12675       DO 10 I=1,NSWEEP
12676 !
12677       A1  = XK5 *(WATER/GAMA(2))**3.0
12678       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12679       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12680       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12681       A7  = XK8 *(WATER/GAMA(1))**2.0
12682       A8  = XK9 *(WATER/GAMA(3))**2.0
12683       A9  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
12684 !
12685 !  CALCULATE DISSOCIATION QUANTITIES
12686 !
12687       PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
12688       PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
12689       PSI5 = MAX(PSI5, TINY)
12690 !
12691       IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN  ! First try 3rd order soln
12692          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12693          CC   = CHI4*(PSI5+PSI6)
12694          DD   = BB*BB-4.d0*CC
12695          PSI4 =0.5d0*(-BB - SQRT(DD))
12696          PSI4 = MIN(PSI4,CHI4)
12697       ELSE
12698          PSI4 = TINY
12699       ENDIF
12700 !
12701       IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN     ! NACL DISSOLUTION
12702          DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
12703          PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
12704          PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
12705       ENDIF
12706 !
12707       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN     ! NA2SO4 DISSOLUTION
12708          AA = PSI7+PSI8
12709          BB = AA*AA
12710          CC =-A1/4.D0
12711          CALL POLY3 (AA, BB, CC, PSI1, ISLV)
12712          IF (ISLV.EQ.0) THEN
12713              PSI1 = MIN (PSI1, CHI1)
12714          ELSE
12715              PSI1 = ZERO
12716          ENDIF
12717       ENDIF
12718 !
12719 ! *** CALCULATE SPECIATION ********************************************
12720 !
12721       MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1             ! NAI
12722       MOLAL (3) = PSI4                                ! NH4I
12723       MOLAL (4) = PSI6 + PSI7                         ! CLI
12724       MOLAL (5) = PSI2 + PSI1                         ! SO4I
12725       MOLAL (6) = ZERO
12726       MOLAL (7) = PSI5 + PSI8                         ! NO3I
12727 !
12728       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
12729       CALL CALCPH (SMIN, HI, OHI)
12730       MOLAL (1) = HI
12731 !
12732 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
12733 !
12734       GNH3      = MAX(CHI4 - PSI4, TINY)
12735       GHNO3     = MAX(CHI5 - PSI5, TINY)
12736       GHCL      = MAX(CHI6 - PSI6, TINY)
12737 !
12738       CNH42S4   = ZERO
12739       CNH4NO3   = ZERO
12740       CNACL     = MAX(CHI7 - PSI7, ZERO)
12741       CNANO3    = MAX(CHI8 - PSI8, ZERO)
12742       CNA2SO4   = MAX(CHI1 - PSI1, ZERO)
12743 !
12744 ! *** NH4Cl(s) calculations
12745 !
12746       A3   = XK6 /(R*TEMP*R*TEMP)
12747       DELT = MIN(GNH3, GHCL)
12748       BB = -(GNH3+GHCL)
12749       CC = GNH3*GHCL-A3
12750       DD = BB*BB - 4.D0*CC
12751       PSI31 = 0.5D0*(-BB + SQRT(DD))
12752       PSI32 = 0.5D0*(-BB - SQRT(DD))
12753       IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
12754          PSI3 = PSI31
12755       ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
12756          PSI3 = PSI32
12757       ELSE
12758          PSI3 = ZERO
12759       ENDIF
12760 !
12761 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
12762 !
12763       GNH3    = MAX(GNH3 - PSI3, TINY)
12764       GHCL    = MAX(GHCL - PSI3, TINY)
12765       CNH4CL  = PSI3
12766 !
12767       CALL CALCMR                                 ! Water content
12768 !
12769 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12770 !
12771       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12772          CALL CALCACT
12773       ELSE
12774          GOTO 20
12775       ENDIF
12776 10    CONTINUE
12777 !
12778 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12779 !
12780 20    FUNCH3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12781 !
12782       RETURN
12783 !
12784 ! *** END OF FUNCTION FUNCH3A *******************************************
12785 !
12786    END FUNCTION FUNCH3A
12787
12788 !=======================================================================
12789 !
12790 ! *** ISORROPIA CODE
12791 ! *** SUBROUTINE CALCH2
12792 ! *** CASE H2
12793 !
12794 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12795 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12796 !     2. SOLID & LIQUID AEROSOL POSSIBLE
12797 !     3. SOLIDS POSSIBLE : NH4Cl, NA2SO4, NANO3, NACL
12798 !
12799 !     THERE ARE THREE REGIMES IN THIS CASE:
12800 !     1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A)
12801 !     2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
12802 !     3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION)
12803 !
12804 !     REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES H1A, H2B
12805 !     RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE).
12806 !
12807 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12808 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12809 ! *** WRITTEN BY ATHANASIOS NENES
12810 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12811 !
12812 !=======================================================================
12813 !
12814       SUBROUTINE CALCH2
12815       implicit none
12816 !      EXTERNAL CALCH1A, CALCH3
12817 !
12818 ! *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
12819 !
12820       IF (W(4).GT.TINY) THEN        ! NO3 EXISTS, WATER POSSIBLE
12821          SCASE = 'H2 ; SUBCASE 1'
12822          CALL CALCH2A
12823          SCASE = 'H2 ; SUBCASE 1'
12824       ELSE                          ! NO3 NON EXISTANT, WATER NOT POSSIBLE
12825          SCASE = 'H2 ; SUBCASE 1'
12826          CALL CALCH1A
12827          SCASE = 'H2 ; SUBCASE 1'
12828       ENDIF
12829 !
12830       IF (WATER.LE.TINY .AND. RH.LT.DRMH2) THEN      ! DRY AEROSOL
12831          SCASE = 'H2 ; SUBCASE 2'
12832 !
12833       ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMH2) THEN  ! MDRH OF H2
12834          SCASE = 'H2 ; SUBCASE 3'
12835          CALL CALCMDRH (RH, DRMH2, DRNANO3, CALCH1A, CALCH3)
12836          SCASE = 'H2 ; SUBCASE 3'
12837       ENDIF
12838 !
12839       RETURN
12840 !
12841 ! *** END OF SUBROUTINE CALCH2 ******************************************
12842 !
12843     END SUBROUTINE CALCH2
12844
12845
12846
12847
12848 !=======================================================================
12849 !
12850 ! *** ISORROPIA CODE
12851 ! *** SUBROUTINE CALCH2A
12852 ! *** CASE H2 ; SUBCASE 1
12853 !
12854 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12855 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12856 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12857 !     3. SOLIDS POSSIBLE : NH4CL, NA2SO4
12858 !
12859 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12860 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12861 ! *** WRITTEN BY ATHANASIOS NENES
12862 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12863 !
12864 !=======================================================================
12865 !
12866       SUBROUTINE CALCH2A
12867       implicit none
12868       REAL(KIND=8) PSI6LO,PSI6HI ,X1, X2, X3, Y1, Y2, Y3, DX, DEL
12869       REAL(KIND=8) FRNA, DELTA
12870
12871       INTEGER I
12872 !
12873
12874
12875
12876 !
12877 ! *** SETUP PARAMETERS ************************************************
12878 !
12879       CALAOU = .TRUE.
12880       CHI1   = W(2)                                ! CNA2SO4
12881       CHI2   = ZERO                                ! CNH42S4
12882       CHI3   = ZERO                                ! CNH4CL
12883       FRNA   = MAX (W(1)-2.D0*CHI1, ZERO)
12884       CHI8   = MIN (FRNA, W(4))                    ! CNANO3
12885       CHI4   = W(3)                                ! NH3(g)
12886       CHI5   = MAX (W(4)-CHI8, ZERO)               ! HNO3(g)
12887       CHI7   = MIN (MAX(FRNA-CHI8, ZERO), W(5))    ! CNACL
12888       CHI6   = MAX (W(5)-CHI7, ZERO)               ! HCL(g)
12889 !
12890       PSI6LO = TINY
12891       PSI6HI = CHI6-TINY    ! MIN(CHI6-TINY, CHI4)
12892 !
12893 ! *** INITIAL VALUES FOR BISECTION ************************************
12894 !
12895       X1 = PSI6LO
12896       Y1 = FUNCH2A (X1)
12897       IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12898 !
12899 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12900 !
12901       DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12902       DO 10 I=1,NDIV
12903          X2 = X1+DX
12904          Y2 = FUNCH2A (X2)
12905          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
12906          X1 = X2
12907          Y1 = Y2
12908 10    CONTINUE
12909 !
12910 ! *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12911 !
12912       IF (Y2 .GT. EPS) Y2 = FUNCH2A (PSI6LO)
12913       GOTO 50
12914 !
12915 ! *** PERFORM BISECTION ***********************************************
12916 !
12917 20    DO 30 I=1,MAXIT
12918          X3 = 0.5*(X1+X2)
12919          Y3 = FUNCH2A (X3)
12920          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
12921             Y2    = Y3
12922             X2    = X3
12923          ELSE
12924             Y1    = Y3
12925             X1    = X3
12926          ENDIF
12927          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12928 30    CONTINUE
12929       CALL PUSHERR (0002, 'CALCH2A')    ! WARNING ERROR: NO CONVERGENCE
12930 !
12931 ! *** CONVERGED ; RETURN **********************************************
12932 !
12933 40    X3 = 0.5*(X1+X2)
12934       Y3 = FUNCH2A (X3)
12935 !
12936 ! *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12937 !
12938 50    CONTINUE
12939       IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12940          CALL CALCHS4 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12941          MOLAL(1) = MOLAL(1) - DELTA                    ! H+   EFFECT
12942          MOLAL(5) = MOLAL(5) - DELTA                    ! SO4  EFFECT
12943          MOLAL(6) = DELTA                               ! HSO4 EFFECT
12944       ENDIF
12945 !
12946       RETURN
12947 !
12948 ! *** END OF SUBROUTINE CALCH2A ******************************************
12949 !
12950    END SUBROUTINE CALCH2A
12951
12952
12953
12954
12955 !=======================================================================
12956 !
12957 ! *** ISORROPIA CODE
12958 ! *** SUBROUTINE FUNCH2A
12959 ! *** CASE H2 ; SUBCASE 1
12960 !
12961 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12962 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
12963 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
12964 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
12965 !
12966 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12967 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
12968 ! *** WRITTEN BY ATHANASIOS NENES
12969 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
12970 !
12971 !=======================================================================
12972 !
12973       REAL(KIND=8) FUNCTION FUNCH2A (X)
12974       implicit none
12975       REAL(KIND=8) X
12976       REAL(KIND=8) A9, A64, DIAK, PSI31, PSI32, DELT, CLFR
12977       REAL(KIND=8) ALF, BET, GAM, RTSQ, THETA1, THETA2
12978       REAL(KIND=8)  AA, BB, CC, DD, SMIN, HI, OHI
12979       INTEGER ISLV
12980       INTEGER I
12981 !
12982
12983
12984
12985 !
12986 ! *** SETUP PARAMETERS ************************************************
12987 !
12988       PSI6   = X
12989       PSI1   = CHI1
12990       PSI2   = ZERO
12991       PSI3   = ZERO
12992       PSI7   = CHI7
12993       PSI8   = CHI8
12994       FRST   = .TRUE.
12995       CALAIN = .TRUE.
12996 !
12997 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12998 !
12999       DO 10 I=1,NSWEEP
13000 !
13001       A1  = XK5 *(WATER/GAMA(2))**3.0
13002       A4  = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
13003       A5  = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
13004       A6  = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
13005       A7  = XK8 *(WATER/GAMA(1))**2.0
13006       A8  = XK9 *(WATER/GAMA(3))**2.0
13007       A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0
13008       A64 = A64*(R*TEMP*WATER)**2.0
13009       A9  = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
13010 !
13011 !  CALCULATE DISSOCIATION QUANTITIES
13012 !
13013       PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
13014       PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
13015       PSI5 = MAX(PSI5, TINY)
13016 !
13017       IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN  ! First try 3rd order soln
13018          BB   =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
13019          CC   = CHI4*(PSI5+PSI6)
13020          DD   = BB*BB-4.d0*CC
13021          PSI4 =0.5d0*(-BB - SQRT(DD))
13022          PSI4 = MIN(PSI4,CHI4)
13023       ELSE
13024          PSI4 = TINY
13025       ENDIF
13026 !
13027       IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN     ! NACL DISSOLUTION
13028          DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
13029          PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
13030          PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
13031       ENDIF
13032 !
13033       IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN     ! NANO3 DISSOLUTION
13034          DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8
13035          PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) )
13036          PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
13037       ENDIF
13038 !
13039       IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN     ! NA2SO4 DISSOLUTION
13040          AA = PSI7+PSI8
13041          BB = AA*AA
13042          CC =-A1/4.D0
13043          CALL POLY3 (AA, BB, CC, PSI1, ISLV)
13044          IF (ISLV.EQ.0) THEN
13045              PSI1 = MIN (PSI1, CHI1)
13046          ELSE
13047              PSI1 = ZERO
13048          ENDIF
13049       ENDIF
13050 !
13051 ! *** CALCULATE SPECIATION ********************************************
13052 !
13053       MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1                 ! NAI
13054       MOLAL (3) = PSI4                                    ! NH4I
13055       MOLAL (4) = PSI6 + PSI7                             ! CLI
13056       MOLAL (5) = PSI2 + PSI1                             ! SO4I
13057       MOLAL (6) = ZERO                                    ! HSO4I
13058       MOLAL (7) = PSI5 + PSI8                             ! NO3I
13059 !
13060       SMIN      = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
13061       CALL CALCPH (SMIN, HI, OHI)
13062       MOLAL (1) = HI
13063 !
13064       GNH3      = MAX(CHI4 - PSI4, TINY)
13065       GHNO3     = MAX(CHI5 - PSI5, TINY)
13066       GHCL      = MAX(CHI6 - PSI6, TINY)
13067 !
13068       CNH42S4   = ZERO
13069       CNH4NO3   = ZERO
13070       CNACL     = MAX(CHI7 - PSI7, ZERO)
13071       CNANO3    = MAX(CHI8 - PSI8, ZERO)
13072       CNA2SO4   = MAX(CHI1 - PSI1, ZERO)
13073 !
13074 ! *** NH4Cl(s) calculations
13075 !
13076       A3   = XK6 /(R*TEMP*R*TEMP)
13077       DELT = MIN(GNH3, GHCL)
13078       BB = -(GNH3+GHCL)
13079       CC = GNH3*GHCL-A3
13080       DD = BB*BB - 4.D0*CC
13081       PSI31 = 0.5D0*(-BB + SQRT(DD))
13082       PSI32 = 0.5D0*(-BB - SQRT(DD))
13083       IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
13084          PSI3 = PSI31
13085       ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
13086          PSI3 = PSI32
13087       ELSE
13088          PSI3 = ZERO
13089       ENDIF
13090 !
13091 ! *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
13092 !
13093       GNH3    = MAX(GNH3 - PSI3, TINY)
13094       GHCL    = MAX(GHCL - PSI3, TINY)
13095       CNH4CL  = PSI3
13096 !
13097       CALL CALCMR                        ! Water content
13098 !
13099 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13100 !
13101       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13102          CALL CALCACT
13103       ELSE
13104          GOTO 20
13105       ENDIF
13106 10    CONTINUE
13107 !
13108 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
13109 !
13110 20    FUNCH2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE
13111 !
13112       RETURN
13113 !
13114 ! *** END OF FUNCTION FUNCH2A *******************************************
13115 !
13116    END FUNCTION FUNCH2A
13117
13118
13119 !=======================================================================
13120 !
13121 ! *** ISORROPIA CODE
13122 ! *** SUBROUTINE CALCH1
13123 ! *** CASE H1
13124 !
13125 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13126 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
13127 !     2. SOLID AEROSOL ONLY
13128 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4
13129 !
13130 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
13131 !     1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
13132 !     2. WHEN RH < MDRH  ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A)
13133 !
13134 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13135 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13136 ! *** WRITTEN BY ATHANASIOS NENES
13137 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13138 !
13139 !=======================================================================
13140 !
13141       SUBROUTINE CALCH1
13142         implicit none
13143 !      EXTERNAL CALCH1A, CALCH2A
13144 !
13145 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
13146 !
13147       IF (RH.LT.DRMH1) THEN
13148          SCASE = 'H1 ; SUBCASE 1'
13149          CALL CALCH1A              ! SOLID PHASE ONLY POSSIBLE
13150          SCASE = 'H1 ; SUBCASE 1'
13151       ELSE
13152          SCASE = 'H1 ; SUBCASE 2'  ! LIQUID & SOLID PHASE POSSIBLE
13153          CALL CALCMDRH (RH, DRMH1, DRNH4NO3, CALCH1A, CALCH2A)
13154          SCASE = 'H1 ; SUBCASE 2'
13155       ENDIF
13156 !
13157       RETURN
13158 !
13159 ! *** END OF SUBROUTINE CALCH1 ******************************************
13160 !
13161     END SUBROUTINE CALCH1
13162
13163
13164 !=======================================================================
13165 !
13166 ! *** ISORROPIA CODE
13167 ! *** SUBROUTINE CALCH1A
13168 ! *** CASE H1 ; SUBCASE 1
13169 !
13170 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13171 !     1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
13172       !     2. SOLID AEROSOL ONLY
13173 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4
13174 !
13175 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13176 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13177 ! *** WRITTEN BY ATHANASIOS NENES
13178 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13179 !
13180 !=======================================================================
13181 !
13182       SUBROUTINE CALCH1A
13183       implicit none
13184       REAL(KIND=8)  LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR,NO3FR, CLFR
13185       REAL(KIND=8) ALF, BET, GAM, RTSQ, THETA1, THETA2
13186       REAL(KIND=8) BB, CC, DD, SQDD, DD1, DD2, SQDD1, SQDD2
13187 !
13188 ! *** CALCULATE NON VOLATILE SOLIDS ***********************************
13189 !
13190       CNA2SO4 = W(2)
13191       CNH42S4 = ZERO
13192       NAFR    = MAX (W(1)-2*CNA2SO4, ZERO)
13193       CNANO3  = MIN (NAFR, W(4))
13194       NO3FR   = MAX (W(4)-CNANO3, ZERO)
13195       CNACL   = MIN (MAX(NAFR-CNANO3, ZERO), W(5))
13196       CLFR    = MAX (W(5)-CNACL, ZERO)
13197 !
13198 ! *** CALCULATE VOLATILE SPECIES **************************************
13199 !
13200       ALF     = W(3)                     ! FREE NH3
13201       BET     = CLFR                     ! FREE CL
13202       GAM     = NO3FR                    ! FREE NO3
13203 !
13204       RTSQ    = R*TEMP*R*TEMP
13205       A1      = XK6/RTSQ
13206       A2      = XK10/RTSQ
13207 !
13208       THETA1  = GAM - BET*(A2/A1)
13209       THETA2  = A2/A1
13210 !
13211 ! QUADRATIC EQUATION SOLUTION
13212 !
13213       BB      = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
13214       CC      = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
13215       DD      = BB*BB - 4.0D0*CC
13216       IF (DD.LT.ZERO) GOTO 100   ! Solve each reaction seperately
13217 !
13218 ! TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
13219 !
13220       SQDD    = SQRT(DD)
13221       KAPA1   = 0.5D0*(-BB+SQDD)
13222       KAPA2   = 0.5D0*(-BB-SQDD)
13223       LAMDA1  = THETA1 + THETA2*KAPA1
13224       LAMDA2  = THETA1 + THETA2*KAPA2
13225 !
13226       IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
13227          IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND.&
13228             BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
13229              KAPA = KAPA1
13230              LAMDA= LAMDA1
13231              GOTO 200
13232          ENDIF
13233       ENDIF
13234 !
13235       IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
13236          IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
13237             BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
13238              KAPA = KAPA2
13239              LAMDA= LAMDA2
13240              GOTO 200
13241          ENDIF
13242       ENDIF
13243 !
13244 ! SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
13245 !
13246 100   KAPA  = ZERO
13247       LAMDA = ZERO
13248       DD1   = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
13249       DD2   = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
13250 !
13251 ! NH4CL EQUILIBRIUM
13252 !
13253       IF (DD1.GE.ZERO) THEN
13254          SQDD1 = SQRT(DD1)
13255          KAPA1 = 0.5D0*(ALF+BET + SQDD1)
13256          KAPA2 = 0.5D0*(ALF+BET - SQDD1)
13257 !
13258          IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
13259             KAPA = KAPA1
13260          ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
13261             KAPA = KAPA2
13262          ELSE
13263             KAPA = ZERO
13264          ENDIF
13265       ENDIF
13266 !
13267 ! NH4NO3 EQUILIBRIUM
13268 !
13269       IF (DD2.GE.ZERO) THEN
13270          SQDD2 = SQRT(DD2)
13271          LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
13272          LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
13273 !
13274          IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
13275             LAMDA = LAMDA1
13276          ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
13277             LAMDA = LAMDA2
13278          ELSE
13279             LAMDA = ZERO
13280          ENDIF
13281       ENDIF
13282 !
13283 ! IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
13284 !
13285       IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
13286          IF (BET .LT. LAMDA/THETA1) THEN
13287             KAPA = ZERO
13288          ELSE
13289             LAMDA= ZERO
13290          ENDIF
13291       ENDIF
13292 !
13293 ! *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
13294 !
13295 200   CONTINUE
13296       CNH4NO3 = LAMDA
13297       CNH4CL  = KAPA
13298 !
13299       GNH3    = ALF - KAPA - LAMDA
13300       GHNO3   = GAM - LAMDA
13301       GHCL    = BET - KAPA
13302 !
13303       RETURN
13304 !
13305 ! *** END OF SUBROUTINE CALCH1A *****************************************
13306 !
13307     END SUBROUTINE CALCH1A
13308 !=======================================================================
13309 !
13310 ! *** ISORROPIA CODE
13311 ! *** SUBROUTINE CALCI6
13312 ! *** CASE I6
13313 !
13314 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13315 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13316 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13317 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
13318 !
13319 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13320 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13321 ! *** WRITTEN BY ATHANASIOS NENES
13322 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13323 !
13324 !=======================================================================
13325 !
13326       SUBROUTINE CALCI6
13327       implicit none
13328       REAL(KIND=8) BB, CC, DD
13329       INTEGER I
13330
13331
13332 !
13333 ! *** FIND DRY COMPOSITION **********************************************
13334 !
13335       CALL CALCI1A
13336 !
13337 ! *** SETUP PARAMETERS ************************************************
13338 !
13339       CHI1 = CNH4HS4               ! Save from CALCI1 run
13340       CHI2 = CLC
13341       CHI3 = CNAHSO4
13342       CHI4 = CNA2SO4
13343       CHI5 = CNH42S4
13344 !
13345       PSI1 = CNH4HS4               ! ASSIGN INITIAL PSI's
13346       PSI2 = CLC
13347       PSI3 = CNAHSO4
13348       PSI4 = CNA2SO4
13349       PSI5 = CNH42S4
13350 !
13351       CALAOU = .TRUE.              ! Outer loop activity calculation flag
13352       FRST   = .TRUE.
13353       CALAIN = .TRUE.
13354 !
13355 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
13356 !
13357       DO 10 I=1,NSWEEP
13358 !
13359       A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
13360 !
13361 !  CALCULATE DISSOCIATION QUANTITIES
13362 !
13363       BB   = PSI2 + PSI4 + PSI5 + A6                    ! PSI6
13364       CC   =-A6*(PSI2 + PSI3 + PSI1)
13365       DD   = BB*BB - 4.D0*CC
13366       PSI6 = 0.5D0*(-BB + SQRT(DD))
13367 !
13368 ! *** CALCULATE SPECIATION ********************************************
13369 !
13370       MOLAL (1) = PSI6                                    ! HI
13371       MOLAL (2) = 2.D0*PSI4 + PSI3                        ! NAI
13372       MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1            ! NH4I
13373       MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6               ! SO4I
13374       MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6               ! HSO4I
13375       CLC       = ZERO
13376       CNAHSO4   = ZERO
13377       CNA2SO4   = CHI4 - PSI4
13378       CNH42S4   = ZERO
13379       CNH4HS4   = ZERO
13380       CALL CALCMR                                         ! Water content
13381 !
13382 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13383 !
13384       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13385          CALL CALCACT
13386       ELSE
13387          GOTO 20
13388       ENDIF
13389 10    CONTINUE
13390 !
13391 20    RETURN
13392 !
13393 ! *** END OF SUBROUTINE CALCI6 *****************************************
13394 !
13395     END SUBROUTINE CALCI6
13396
13397 !=======================================================================
13398 !
13399 ! *** ISORROPIA CODE
13400 ! *** SUBROUTINE CALCI5
13401 ! *** CASE I5
13402 !
13403 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13404 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13405 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13406 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
13407 !
13408 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13409 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13410 ! *** WRITTEN BY ATHANASIOS NENES
13411 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13412 !
13413 !=======================================================================
13414 !
13415       SUBROUTINE CALCI5
13416       implicit none
13417       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
13418       REAL(KIND=8) PSI4LO, PSI4HI, YLO, YHI, DX
13419       INTEGER I
13420
13421
13422
13423 !
13424 ! *** FIND DRY COMPOSITION **********************************************
13425 !
13426       CALL CALCI1A
13427 !
13428 ! *** SETUP PARAMETERS ************************************************
13429 !
13430       CHI1 = CNH4HS4               ! Save from CALCI1 run
13431       CHI2 = CLC
13432       CHI3 = CNAHSO4
13433       CHI4 = CNA2SO4
13434       CHI5 = CNH42S4
13435 !
13436       PSI1 = CNH4HS4               ! ASSIGN INITIAL PSI's
13437       PSI2 = CLC
13438       PSI3 = CNAHSO4
13439       PSI4 = ZERO
13440       PSI5 = CNH42S4
13441 !
13442       CALAOU =.TRUE.               ! Outer loop activity calculation flag
13443       PSI4LO = ZERO                ! Low  limit
13444       PSI4HI = CHI4                ! High limit
13445 !
13446 ! *** IF NA2SO4(S) =0, CALL FUNCI5B FOR Y4=0 ***************************
13447 !
13448       IF (CHI4.LE.TINY) THEN
13449          Y1 = FUNCI5A (ZERO)
13450          GOTO 50
13451       ENDIF
13452 !
13453 ! *** INITIAL VALUES FOR BISECTION ************************************
13454 !
13455       X1 = PSI4HI
13456       Y1 = FUNCI5A (X1)
13457       YHI= Y1                      ! Save Y-value at HI position
13458 !
13459 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 **
13460 !
13461       IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
13462 !
13463 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13464 !
13465       DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
13466       DO 10 I=1,NDIV
13467          X2 = X1-DX
13468          Y2 = FUNCI5A (X2)
13469          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
13470          X1 = X2
13471          Y1 = Y2
13472 10    CONTINUE
13473 !
13474 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL
13475 !
13476       YLO= Y1                      ! Save Y-value at Hi position
13477       IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
13478          Y3 = FUNCI5A (ZERO)
13479          GOTO 50
13480       ELSE IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
13481          GOTO 50
13482       ELSE
13483          CALL PUSHERR (0001, 'CALCI5')    ! WARNING ERROR: NO SOLUTION
13484          GOTO 50
13485       ENDIF
13486 !
13487 ! *** PERFORM BISECTION ***********************************************
13488 !
13489 20    DO 30 I=1,MAXIT
13490          X3 = 0.5*(X1+X2)
13491          Y3 = FUNCI5A (X3)
13492          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
13493             Y2    = Y3
13494             X2    = X3
13495          ELSE
13496             Y1    = Y3
13497             X1    = X3
13498          ENDIF
13499          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13500 30    CONTINUE
13501       CALL PUSHERR (0002, 'CALCI5')    ! WARNING ERROR: NO CONVERGENCE
13502 !
13503 ! *** CONVERGED ; RETURN **********************************************
13504 !
13505 40    X3 = 0.5*(X1+X2)
13506       Y3 = FUNCI5A (X3)
13507 !
13508 50    RETURN
13509
13510 ! *** END OF SUBROUTINE CALCI5 *****************************************
13511 !
13512     END SUBROUTINE CALCI5
13513
13514
13515
13516
13517 !=======================================================================
13518 !
13519 ! *** ISORROPIA CODE
13520 ! *** SUBROUTINE FUNCI5A
13521 ! *** CASE I5
13522 !
13523 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13524 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13525 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13526 !     3. SOLIDS POSSIBLE : NA2SO4
13527 !
13528 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13529 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13530 ! *** WRITTEN BY ATHANASIOS NENES
13531 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13532 !
13533 !=======================================================================
13534 !
13535       REAL(KIND=8) FUNCTION FUNCI5A (P4)
13536       implicit none
13537       REAL(KIND=8) P4
13538       REAL(KIND=8) BB, CC, DD
13539       INTEGER I
13540
13541
13542 !
13543 ! *** SETUP PARAMETERS ************************************************
13544 !
13545       PSI4   = P4     ! PSI3 already assigned in FUNCI5A
13546       FRST   = .TRUE.
13547       CALAIN = .TRUE.
13548 !
13549 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
13550 !
13551       DO 10 I=1,NSWEEP
13552 !
13553       A4 = XK5 *(WATER/GAMA(2))**3.0
13554       A5 = XK7 *(WATER/GAMA(4))**3.0
13555       A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
13556 !
13557 !  CALCULATE DISSOCIATION QUANTITIES
13558 !
13559       BB   = PSI2 + PSI4 + PSI5 + A6                    ! PSI6
13560       CC   =-A6*(PSI2 + PSI3 + PSI1)
13561       DD   = BB*BB - 4.D0*CC
13562       PSI6 = 0.5D0*(-BB + SQRT(DD))
13563 !
13564 ! *** CALCULATE SPECIATION ********************************************
13565 !
13566       MOLAL (1) = PSI6                            ! HI
13567       MOLAL (2) = 2.D0*PSI4 + PSI3                ! NAI
13568       MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1    ! NH4I
13569       MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6       ! SO4I
13570       MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6       ! HSO4I
13571       CLC       = ZERO
13572       CNAHSO4   = ZERO
13573       CNA2SO4   = CHI4 - PSI4
13574       CNH42S4   = ZERO
13575       CNH4HS4   = ZERO
13576       CALL CALCMR                                 ! Water content
13577 !
13578 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13579 !
13580       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13581          CALL CALCACT
13582       ELSE
13583          GOTO 20
13584       ENDIF
13585 10    CONTINUE
13586 !
13587 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
13588 !
13589 20    A4     = XK5 *(WATER/GAMA(2))**3.0
13590       FUNCI5A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
13591       RETURN
13592 !
13593 ! *** END OF FUNCTION FUNCI5A ********************************************
13594 !
13595    END FUNCTION FUNCI5A
13596
13597 !=======================================================================
13598 !
13599 ! *** ISORROPIA CODE
13600 ! *** SUBROUTINE CALCI4
13601 ! *** CASE I4
13602 !
13603 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13604 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13605 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13606 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
13607 !
13608 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13609 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13610 ! *** WRITTEN BY ATHANASIOS NENES
13611 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13612 !
13613 !=======================================================================
13614 !
13615       SUBROUTINE CALCI4
13616       implicit none
13617       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
13618       REAL(KIND=8) PSI4LO, PSI4HI, YLO, YHI, DX, P4, YY, DELTA
13619
13620       INTEGER I
13621
13622
13623 !
13624 ! *** FIND DRY COMPOSITION **********************************************
13625 !
13626       CALL CALCI1A
13627 !
13628 ! *** SETUP PARAMETERS ************************************************
13629 !
13630       CHI1 = CNH4HS4               ! Save from CALCI1 run
13631       CHI2 = CLC
13632       CHI3 = CNAHSO4
13633       CHI4 = CNA2SO4
13634       CHI5 = CNH42S4
13635 !
13636       PSI1 = CNH4HS4               ! ASSIGN INITIAL PSI's
13637       PSI2 = CLC
13638       PSI3 = CNAHSO4
13639       PSI4 = ZERO
13640       PSI5 = ZERO
13641 !
13642       CALAOU = .TRUE.              ! Outer loop activity calculation flag
13643       PSI4LO = ZERO                ! Low  limit
13644       PSI4HI = CHI4                ! High limit
13645 !
13646 ! *** IF NA2SO4(S) =0, CALL FUNCI4B FOR Y4=0 ***************************
13647 !
13648       IF (CHI4.LE.TINY) THEN
13649          Y1 = FUNCI4A (ZERO)
13650          GOTO 50
13651       ENDIF
13652 !
13653 ! *** INITIAL VALUES FOR BISECTION ************************************
13654 !
13655       X1 = PSI4HI
13656       Y1 = FUNCI4A (X1)
13657       YHI= Y1                      ! Save Y-value at HI position
13658 !
13659 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 **
13660 !
13661       IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
13662 !
13663 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13664 !
13665       DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
13666       DO 10 I=1,NDIV
13667          X2 = X1-DX
13668          Y2 = FUNCI4A (X2)
13669          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
13670          X1 = X2
13671          Y1 = Y2
13672 10    CONTINUE
13673 !
13674 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL
13675 !
13676       YLO= Y1                      ! Save Y-value at Hi position
13677       IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
13678          Y3 = FUNCI4A (ZERO)
13679          GOTO 50
13680       ELSE IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
13681          GOTO 50
13682       ELSE
13683          CALL PUSHERR (0001, 'CALCI4')    ! WARNING ERROR: NO SOLUTION
13684          GOTO 50
13685       ENDIF
13686 !
13687 ! *** PERFORM BISECTION ***********************************************
13688 !
13689 20    DO 30 I=1,MAXIT
13690          X3 = 0.5*(X1+X2)
13691          Y3 = FUNCI4A (X3)
13692          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
13693             Y2    = Y3
13694             X2    = X3
13695          ELSE
13696             Y1    = Y3
13697             X1    = X3
13698          ENDIF
13699          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13700 30    CONTINUE
13701       CALL PUSHERR (0002, 'CALCI4')    ! WARNING ERROR: NO CONVERGENCE
13702 !
13703 ! *** CONVERGED ; RETURN **********************************************
13704 !
13705 40    X3 = 0.5*(X1+X2)
13706       Y3 = FUNCI4A (X3)
13707 !
13708 50    RETURN
13709
13710 ! *** END OF SUBROUTINE CALCI4 *****************************************
13711 !
13712    END SUBROUTINE CALCI4
13713
13714
13715
13716
13717 !=======================================================================
13718 !
13719 ! *** ISORROPIA CODE
13720 ! *** SUBROUTINE FUNCI4A
13721 ! *** CASE I4
13722 !
13723 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13724 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13725 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13726 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
13727 !
13728 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13729 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13730 ! *** WRITTEN BY ATHANASIOS NENES
13731 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13732 !
13733 !=======================================================================
13734 !
13735       REAL(KIND=8) FUNCTION FUNCI4A (P4)
13736       implicit none
13737       REAL(KIND=8)  BB, CC, DD
13738       REAL(KIND=8) P4
13739       INTEGER I
13740
13741
13742
13743 !
13744 ! *** SETUP PARAMETERS ************************************************
13745 !
13746       PSI4   = P4     ! PSI3 already assigned in FUNCI4A
13747       FRST   = .TRUE.
13748       CALAIN = .TRUE.
13749 !
13750 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
13751 !
13752       DO 10 I=1,NSWEEP
13753 !
13754       A4 = XK5 *(WATER/GAMA(2))**3.0
13755       A5 = XK7 *(WATER/GAMA(4))**3.0
13756       A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
13757       A7 = SQRT(A4/A5)
13758 !
13759 !  CALCULATE DISSOCIATION QUANTITIES
13760 !
13761       BB   = PSI2 + PSI4 + PSI5 + A6                    ! PSI6
13762       CC   =-A6*(PSI2 + PSI3 + PSI1)
13763       DD   = BB*BB - 4.D0*CC
13764       PSI6 = 0.5D0*(-BB + SQRT(DD))
13765 !
13766       PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
13767       PSI5 = MIN (PSI5, CHI5)
13768 !
13769 ! *** CALCULATE SPECIATION ********************************************
13770 !
13771       MOLAL (1) = PSI6                            ! HI
13772       MOLAL (2) = 2.D0*PSI4 + PSI3                ! NAI
13773       MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1    ! NH4I
13774       MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6       ! SO4I
13775       MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6       ! HSO4I
13776       CLC       = ZERO
13777       CNAHSO4   = ZERO
13778       CNA2SO4   = CHI4 - PSI4
13779       CNH42S4   = CHI5 - PSI5
13780       CNH4HS4   = ZERO
13781       CALL CALCMR                                 ! Water content
13782 !
13783 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13784 !
13785       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13786          CALL CALCACT
13787       ELSE
13788          GOTO 20
13789       ENDIF
13790 10    CONTINUE
13791 !
13792 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
13793 !
13794 20    A4     = XK5 *(WATER/GAMA(2))**3.0
13795       FUNCI4A= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
13796       RETURN
13797 !
13798 ! *** END OF FUNCTION FUNCI4A ********************************************
13799 !
13800    END FUNCTION FUNCI4A
13801 !=======================================================================
13802 !
13803 ! *** ISORROPIA CODE
13804 ! *** SUBROUTINE CALCI3
13805 ! *** CASE I3
13806 !
13807 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13808 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13809 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13810 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
13811 !
13812 !     THERE ARE THREE REGIMES IN THIS CASE:
13813 !     1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A)
13814 !     2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
13815 !     3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
13816 !
13817 !     REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B
13818 !     RESPECTIVELY
13819 !
13820 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13821 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13822 ! *** WRITTEN BY ATHANASIOS NENES
13823 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13824 !
13825 !=======================================================================
13826 !
13827       SUBROUTINE CALCI3
13828       implicit none
13829       INTEGER I
13830 !      EXTERNAL CALCI1A, CALCI4
13831 !
13832 ! *** FIND DRY COMPOSITION **********************************************
13833 !
13834       CALL CALCI1A
13835 !
13836 ! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
13837 !
13838       IF (CNH4HS4.GT.TINY .OR. CNAHSO4.GT.TINY) THEN
13839          SCASE = 'I3 ; SUBCASE 1'
13840          CALL CALCI3A                     ! FULL SOLUTION
13841          SCASE = 'I3 ; SUBCASE 1'
13842       ENDIF
13843 !
13844       IF (WATER.LE.TINY) THEN
13845          IF (RH.LT.DRMI3) THEN         ! SOLID SOLUTION
13846             WATER = TINY
13847             DO 10 I=1,NIONS
13848                MOLAL(I) = ZERO
13849 10          CONTINUE
13850             CALL CALCI1A
13851             SCASE = 'I3 ; SUBCASE 2'
13852 !
13853          ELSEIF (RH.GE.DRMI3) THEN     ! MDRH OF I3
13854             SCASE = 'I3 ; SUBCASE 3'
13855             CALL CALCMDRH (RH, DRMI3, DRLC, CALCI1A, CALCI4)
13856             SCASE = 'I3 ; SUBCASE 3'
13857          ENDIF
13858       ENDIF
13859 !
13860       RETURN
13861 !
13862 ! *** END OF SUBROUTINE CALCI3 ******************************************
13863 !
13864    END SUBROUTINE CALCI3
13865
13866
13867
13868 !=======================================================================
13869 !
13870 ! *** ISORROPIA CODE
13871 ! *** SUBROUTINE CALCI3A
13872 ! *** CASE I3 ; SUBCASE 1
13873 !
13874 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13875 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13876 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13877 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
13878 !
13879 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13880 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13881 ! *** WRITTEN BY ATHANASIOS NENES
13882 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13883 !
13884 !=======================================================================
13885 !
13886       SUBROUTINE CALCI3A
13887       implicit none
13888       REAL(KIND=8) PSI2LO, PSI2HI
13889       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
13890       REAL(KIND=8)  YLO, YHI, DX
13891       INTEGER I
13892
13893 !
13894 ! *** FIND DRY COMPOSITION **********************************************
13895 !
13896       CALL CALCI1A         ! Needed when called from CALCMDRH
13897 !
13898 ! *** SETUP PARAMETERS ************************************************
13899 !
13900       CHI1 = CNH4HS4               ! Save from CALCI1 run
13901       CHI2 = CLC
13902       CHI3 = CNAHSO4
13903       CHI4 = CNA2SO4
13904       CHI5 = CNH42S4
13905 !
13906       PSI1 = CNH4HS4               ! ASSIGN INITIAL PSI's
13907       PSI2 = ZERO
13908       PSI3 = CNAHSO4
13909       PSI4 = ZERO
13910       PSI5 = ZERO
13911 !
13912       CALAOU = .TRUE.              ! Outer loop activity calculation flag
13913       PSI2LO = ZERO                ! Low  limit
13914       PSI2HI = CHI2                ! High limit
13915 !
13916 ! *** INITIAL VALUES FOR BISECTION ************************************
13917 !
13918       X1 = PSI2HI
13919       Y1 = FUNCI3A (X1)
13920       YHI= Y1                      ! Save Y-value at HI position
13921 !
13922 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
13923 !
13924       IF (YHI.LT.EPS) GOTO 50
13925 !
13926 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13927 !
13928       DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
13929       DO 10 I=1,NDIV
13930          X2 = MAX(X1-DX, PSI2LO)
13931          Y2 = FUNCI3A (X2)
13932          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
13933          X1 = X2
13934          Y1 = Y2
13935 10    CONTINUE
13936 !
13937 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
13938 !
13939       IF (Y2.GT.EPS) Y2 = FUNCI3A (ZERO)
13940       GOTO 50
13941 !
13942 ! *** PERFORM BISECTION ***********************************************
13943 !
13944 20    DO 30 I=1,MAXIT
13945          X3 = 0.5*(X1+X2)
13946          Y3 = FUNCI3A (X3)
13947          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
13948             Y2    = Y3
13949             X2    = X3
13950          ELSE
13951             Y1    = Y3
13952             X1    = X3
13953          ENDIF
13954          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13955 30    CONTINUE
13956       CALL PUSHERR (0002, 'CALCI3A')    ! WARNING ERROR: NO CONVERGENCE
13957 !
13958 ! *** CONVERGED ; RETURN **********************************************
13959 !
13960 40    X3 = 0.5*(X1+X2)
13961       Y3 = FUNCI3A (X3)
13962 !
13963 50    RETURN
13964
13965 ! *** END OF SUBROUTINE CALCI3A *****************************************
13966 !
13967    END SUBROUTINE CALCI3A
13968 !
13969 !=======================================================================
13970 !
13971 ! *** ISORROPIA CODE
13972 ! *** SUBROUTINE FUNCI3A
13973 ! *** CASE I3 ; SUBCASE 1
13974 !
13975 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13976 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
13977 !     2. SOLID & LIQUID AEROSOL POSSIBLE
13978 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
13979 !
13980 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13981 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
13982 ! *** WRITTEN BY ATHANASIOS NENES
13983 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
13984 !
13985 !=======================================================================
13986 !
13987       REAL(KIND=8) FUNCTION FUNCI3A (P2)
13988       implicit none
13989
13990       REAL(KIND=8) P2
13991       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
13992       REAL(KIND=8) PSI4LO, PSI4HI, YLO, YHI, DX
13993       INTEGER I
13994
13995
13996
13997 !
13998 ! *** SETUP PARAMETERS ************************************************
13999 !
14000       PSI2   = P2                  ! Save PSI2 in COMMON BLOCK
14001       PSI4LO = ZERO                ! Low  limit for PSI4
14002       PSI4HI = CHI4                ! High limit for PSI4
14003 !
14004 ! *** IF NH3 =0, CALL FUNCI3B FOR Y4=0 ********************************
14005 !
14006       IF (CHI4.LE.TINY) THEN
14007          FUNCI3A = FUNCI3B (ZERO)
14008          GOTO 50
14009       ENDIF
14010 !
14011 ! *** INITIAL VALUES FOR BISECTION ************************************
14012 !
14013       X1 = PSI4HI
14014       Y1 = FUNCI3B (X1)
14015       IF (ABS(Y1).LE.EPS) GOTO 50
14016       YHI= Y1                      ! Save Y-value at HI position
14017 !
14018 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *****
14019 !
14020       IF (YHI.LT.ZERO) GOTO 50
14021 !
14022 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14023 !
14024       DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
14025       DO 10 I=1,NDIV
14026          X2 = MAX(X1-DX, PSI4LO)
14027          Y2 = FUNCI3B (X2)
14028          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
14029          X1 = X2
14030          Y1 = Y2
14031 10    CONTINUE
14032 !
14033 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4
14034 !
14035       IF (Y2.GT.EPS) Y2 = FUNCI3B (PSI4LO)
14036       GOTO 50
14037 !
14038 ! *** PERFORM BISECTION ***********************************************
14039 !
14040 20    DO 30 I=1,MAXIT
14041          X3 = 0.5*(X1+X2)
14042          Y3 = FUNCI3B (X3)
14043          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
14044             Y2    = Y3
14045             X2    = X3
14046          ELSE
14047             Y1    = Y3
14048             X1    = X3
14049          ENDIF
14050          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14051 30    CONTINUE
14052       CALL PUSHERR (0004, 'FUNCI3A')    ! WARNING ERROR: NO CONVERGENCE
14053 !
14054 ! *** INNER LOOP CONVERGED **********************************************
14055 !
14056 40    X3 = 0.5*(X1+X2)
14057       Y3 = FUNCI3B (X3)
14058 !
14059 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
14060 !
14061 50    A2      = XK13*(WATER/GAMA(13))**5.0
14062       FUNCI3A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE
14063       RETURN
14064 !
14065 ! *** END OF FUNCTION FUNCI3A *******************************************
14066 !
14067    END FUNCTION FUNCI3A
14068
14069
14070
14071 !=======================================================================
14072 !
14073 ! *** ISORROPIA CODE
14074 ! *** FUNCTION FUNCI3B
14075 ! *** CASE I3 ; SUBCASE 2
14076 !
14077 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14078 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14079 !     2. SOLID & LIQUID AEROSOL POSSIBLE
14080 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
14081 !
14082 !     SOLUTION IS SAVED IN COMMON BLOCK /CASE/
14083 !
14084 !=======================================================================
14085 !
14086       REAL(KIND=8) FUNCTION FUNCI3B (P4)
14087       implicit none
14088
14089       REAL(KIND=8) P4
14090       REAL(KIND=8) BB, CC, DD
14091       INTEGER I
14092 !
14093
14094
14095
14096 !
14097 ! *** SETUP PARAMETERS ************************************************
14098 !
14099       PSI4   = P4
14100 !
14101 ! *** SETUP PARAMETERS ************************************************
14102 !
14103       FRST   = .TRUE.
14104       CALAIN = .TRUE.
14105 !
14106 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14107 !
14108       DO 10 I=1,NSWEEP
14109 !
14110       A4 = XK5*(WATER/GAMA(2))**3.0
14111       A5 = XK7*(WATER/GAMA(4))**3.0
14112       A6 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
14113       A7 = SQRT(A4/A5)
14114 !
14115 !  CALCULATE DISSOCIATION QUANTITIES
14116 !
14117       BB   = PSI2 + PSI4 + PSI5 + A6                    ! PSI6
14118       CC   =-A6*(PSI2 + PSI3 + PSI1)
14119       DD   = BB*BB - 4.D0*CC
14120       PSI6 = 0.5D0*(-BB + SQRT(DD))
14121 !
14122       PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
14123       PSI5 = MIN (PSI5, CHI5)
14124 !
14125 ! *** CALCULATE SPECIATION ********************************************
14126 !
14127       MOLAL(1) = PSI6                                  ! HI
14128       MOLAL(2) = 2.D0*PSI4 + PSI3                      ! NAI
14129       MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1          ! NH4I
14130       MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6             ! SO4I
14131       MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 - PSI6, TINY)  ! HSO4I
14132       CLC      = MAX(CHI2 - PSI2, ZERO)
14133       CNAHSO4  = ZERO
14134       CNA2SO4  = MAX(CHI4 - PSI4, ZERO)
14135       CNH42S4  = MAX(CHI5 - PSI5, ZERO)
14136       CNH4HS4  = ZERO
14137       CALL CALCMR                                       ! Water content
14138 !
14139 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14140 !
14141       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14142          CALL CALCACT
14143       ELSE
14144          GOTO 20
14145       ENDIF
14146 10    CONTINUE
14147 !
14148 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
14149 !
14150 20    A4     = XK5 *(WATER/GAMA(2))**3.0
14151       FUNCI3B= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
14152       RETURN
14153 !
14154 ! *** END OF FUNCTION FUNCI3B ********************************************
14155 !
14156    END FUNCTION FUNCI3B
14157 !=======================================================================
14158 !
14159 ! *** ISORROPIA CODE
14160 ! *** SUBROUTINE CALCI2
14161 ! *** CASE I2
14162 !
14163 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14164 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14165 !     2. SOLID & LIQUID AEROSOL POSSIBLE
14166 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
14167 !
14168 !     THERE ARE THREE REGIMES IN THIS CASE:
14169 !     1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI2A)
14170 !     2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
14171 !     3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
14172 !
14173 !     REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B
14174 !     RESPECTIVELY
14175 !
14176 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14177 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14178 ! *** WRITTEN BY ATHANASIOS NENES
14179 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14180 !
14181 !=======================================================================
14182 !
14183       SUBROUTINE CALCI2
14184       implicit none
14185       INTEGER I
14186 !      EXTERNAL CALCI1A, CALCI3A
14187 !
14188 ! *** FIND DRY COMPOSITION **********************************************
14189 !
14190       CALL CALCI1A
14191 !
14192 ! *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
14193 !
14194       IF (CNH4HS4.GT.TINY) THEN
14195          SCASE = 'I2 ; SUBCASE 1'
14196          CALL CALCI2A
14197          SCASE = 'I2 ; SUBCASE 1'
14198       ENDIF
14199 !
14200       IF (WATER.LE.TINY) THEN
14201          IF (RH.LT.DRMI2) THEN         ! SOLID SOLUTION ONLY
14202             WATER = TINY
14203             DO 10 I=1,NIONS
14204                MOLAL(I) = ZERO
14205 10          CONTINUE
14206             CALL CALCI1A
14207             SCASE = 'I2 ; SUBCASE 2'
14208 !
14209          ELSEIF (RH.GE.DRMI2) THEN     ! MDRH OF I2
14210             SCASE = 'I2 ; SUBCASE 3'
14211             CALL CALCMDRH (RH, DRMI2, DRNAHSO4, CALCI1A, CALCI3A)
14212             SCASE = 'I2 ; SUBCASE 3'
14213          ENDIF
14214       ENDIF
14215 !
14216       RETURN
14217 !
14218 ! *** END OF SUBROUTINE CALCI2 ******************************************
14219 !
14220     END  SUBROUTINE CALCI2
14221
14222
14223 !=======================================================================
14224 !
14225 ! *** ISORROPIA CODE
14226 ! *** SUBROUTINE CALCI2A
14227 ! *** CASE I2 ; SUBCASE A
14228 !
14229 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14230 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14231 !     2. SOLID & LIQUID AEROSOL POSSIBLE
14232 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
14233 !
14234 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14235 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14236 ! *** WRITTEN BY ATHANASIOS NENES
14237 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14238 !
14239 !=======================================================================
14240 !
14241       SUBROUTINE CALCI2A
14242       implicit none
14243       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
14244       REAL(KIND=8) PSI2LO, PSI2HI, YLO, YHI, DX
14245       INTEGER I
14246
14247
14248 !
14249 ! *** FIND DRY COMPOSITION **********************************************
14250 !
14251       CALL CALCI1A    ! Needed when called from CALCMDRH
14252 !
14253 ! *** SETUP PARAMETERS ************************************************
14254 !
14255       CHI1 = CNH4HS4               ! Save from CALCI1 run
14256       CHI2 = CLC
14257       CHI3 = CNAHSO4
14258       CHI4 = CNA2SO4
14259       CHI5 = CNH42S4
14260 !
14261       PSI1 = CNH4HS4               ! ASSIGN INITIAL PSI's
14262       PSI2 = ZERO
14263       PSI3 = ZERO
14264       PSI4 = ZERO
14265       PSI5 = ZERO
14266 !
14267       CALAOU = .TRUE.              ! Outer loop activity calculation flag
14268       PSI2LO = ZERO                ! Low  limit
14269       PSI2HI = CHI2                ! High limit
14270 !
14271 ! *** INITIAL VALUES FOR BISECTION ************************************
14272 !
14273       X1 = PSI2HI
14274       Y1 = FUNCI2A (X1)
14275       YHI= Y1                      ! Save Y-value at HI position
14276 !
14277 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
14278 !
14279       IF (YHI.LT.EPS) GOTO 50
14280 !
14281 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14282 !
14283       DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
14284       DO 10 I=1,NDIV
14285          X2 = MAX(X1-DX, PSI2LO)
14286          Y2 = FUNCI2A (X2)
14287          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
14288          X1 = X2
14289          Y1 = Y2
14290 10    CONTINUE
14291 !
14292 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
14293 !
14294       IF (Y2.GT.EPS) Y2 = FUNCI3A (ZERO)
14295       GOTO 50
14296 !
14297 ! *** PERFORM BISECTION ***********************************************
14298 !
14299 20    DO 30 I=1,MAXIT
14300          X3 = 0.5*(X1+X2)
14301          Y3 = FUNCI2A (X3)
14302          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
14303             Y2    = Y3
14304             X2    = X3
14305          ELSE
14306             Y1    = Y3
14307             X1    = X3
14308          ENDIF
14309          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14310 30    CONTINUE
14311       CALL PUSHERR (0002, 'CALCI2A')    ! WARNING ERROR: NO CONVERGENCE
14312 !
14313 ! *** CONVERGED ; RETURN **********************************************
14314 !
14315 40    X3 = 0.5*(X1+X2)
14316       Y3 = FUNCI2A (X3)
14317 !
14318 50    RETURN
14319
14320 ! *** END OF SUBROUTINE CALCI2A *****************************************
14321 !
14322     END SUBROUTINE CALCI2A
14323
14324
14325
14326
14327 !=======================================================================
14328 !
14329 ! *** ISORROPIA CODE
14330 ! *** SUBROUTINE FUNCI2A
14331 ! *** CASE I2 ; SUBCASE 1
14332 !
14333 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14334 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14335 !     2. SOLID & LIQUID AEROSOL POSSIBLE
14336 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
14337 !
14338 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14339 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14340 ! *** WRITTEN BY ATHANASIOS NENES
14341 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14342 !
14343 !=======================================================================
14344 !
14345       REAL(KIND=8) FUNCTION FUNCI2A (P2)
14346       implicit none
14347       REAL(KIND=8) P2
14348       REAL(KIND=8) AA, BB, CC, DD
14349       INTEGER ISLV
14350       INTEGER I
14351
14352
14353
14354 !
14355 ! *** SETUP PARAMETERS ************************************************
14356 !
14357       FRST   = .TRUE.
14358       CALAIN = .TRUE.
14359       PSI2   = P2                  ! Save PSI2 in COMMON BLOCK
14360       PSI3   = CHI3
14361       PSI4   = CHI4
14362       PSI5   = CHI5
14363       PSI6   = ZERO
14364 !
14365 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14366 !
14367       DO 10 I=1,NSWEEP
14368 !
14369       A3 = XK11*(WATER/GAMA(12))**2.0
14370       A4 = XK5 *(WATER/GAMA(2))**3.0
14371       A5 = XK7 *(WATER/GAMA(4))**3.0
14372       A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
14373       A7 = SQRT(A4/A5)
14374 !
14375 !  CALCULATE DISSOCIATION QUANTITIES
14376 !
14377       IF (CHI5.GT.TINY .AND. WATER.GT.TINY) THEN
14378          PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
14379          PSI5 = MAX(MIN (PSI5, CHI5), TINY)
14380       ENDIF
14381 !
14382       IF (CHI4.GT.TINY .AND. WATER.GT.TINY) THEN
14383          AA   = PSI2+PSI5+PSI6+PSI3
14384          BB   = PSI3*AA
14385          CC   = 0.25D0*(PSI3*PSI3*(PSI2+PSI5+PSI6)-A4)
14386          CALL POLY3 (AA, BB, CC, PSI4, ISLV)
14387          IF (ISLV.EQ.0) THEN
14388             PSI4 = MIN (PSI4, CHI4)
14389          ELSE
14390             PSI4 = ZERO
14391          ENDIF
14392       ENDIF
14393 !
14394       IF (CHI3.GT.TINY .AND. WATER.GT.TINY) THEN
14395          AA   = 2.D0*PSI4 + PSI2 + PSI1 - PSI6
14396          BB   = 2.D0*PSI4*(PSI2 + PSI1 - PSI6) - A3
14397          CC   = ZERO
14398          CALL POLY3 (AA, BB, CC, PSI3, ISLV)
14399          IF (ISLV.EQ.0) THEN
14400             PSI3 = MIN (PSI3, CHI3)
14401          ELSE
14402             PSI3 = ZERO
14403          ENDIF
14404       ENDIF
14405 !
14406       BB   = PSI2 + PSI4 + PSI5 + A6                    ! PSI6
14407       CC   =-A6*(PSI2 + PSI3 + PSI1)
14408       DD   = BB*BB - 4.D0*CC
14409       PSI6 = 0.5D0*(-BB + SQRT(DD))
14410 !
14411 ! *** CALCULATE SPECIATION ********************************************
14412 !
14413       MOLAL (1) = PSI6                           ! HI
14414       MOLAL (2) = 2.D0*PSI4 + PSI3               ! NAI
14415       MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1   ! NH4I
14416       MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6      ! SO4I
14417       MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6      ! HSO4I
14418       CLC       = CHI2 - PSI2
14419       CNAHSO4   = CHI3 - PSI3
14420       CNA2SO4   = CHI4 - PSI4
14421       CNH42S4   = CHI5 - PSI5
14422       CNH4HS4   = ZERO
14423       CALL CALCMR                                ! Water content
14424 !
14425 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14426 !
14427       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14428          CALL CALCACT
14429       ELSE
14430          GOTO 20
14431       ENDIF
14432 10    CONTINUE
14433 !
14434 ! *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
14435 !
14436 20    A2      = XK13*(WATER/GAMA(13))**5.0
14437       FUNCI2A = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE
14438       RETURN
14439 !
14440 ! *** END OF FUNCTION FUNCI2A *******************************************
14441 !
14442     END FUNCTION FUNCI2A
14443
14444 !=======================================================================
14445 !
14446 ! *** ISORROPIA CODE
14447 ! *** SUBROUTINE CALCI1
14448 ! *** CASE I1
14449 !
14450 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14451 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14452 !     2. SOLID AEROSOL ONLY
14453 !     3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4
14454 !
14455 !     THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
14456 !     1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
14457 !     2. WHEN RH < MDRH  ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A)
14458 !
14459 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14460 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14461 ! *** WRITTEN BY ATHANASIOS NENES
14462 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14463 !
14464 !=======================================================================
14465 !
14466       SUBROUTINE CALCI1
14467       implicit none
14468 !      EXTERNAL CALCI1A, CALCI2A
14469 !
14470 ! *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
14471 !
14472       IF (RH.LT.DRMI1) THEN
14473          SCASE = 'I1 ; SUBCASE 1'
14474          CALL CALCI1A              ! SOLID PHASE ONLY POSSIBLE
14475          SCASE = 'I1 ; SUBCASE 1'
14476       ELSE
14477          SCASE = 'I1 ; SUBCASE 2'  ! LIQUID & SOLID PHASE POSSIBLE
14478          CALL CALCMDRH (RH, DRMI1, DRNH4HS4, CALCI1A, CALCI2A)
14479          SCASE = 'I1 ; SUBCASE 2'
14480       ENDIF
14481 !
14482 ! *** AMMONIA IN GAS PHASE **********************************************
14483 !
14484 !      CALL CALCNH3
14485 !
14486       RETURN
14487 !
14488 ! *** END OF SUBROUTINE CALCI1 ******************************************
14489 !
14490     END SUBROUTINE CALCI1
14491
14492
14493 !=======================================================================
14494 !
14495 ! *** ISORROPIA CODE
14496 ! *** SUBROUTINE CALCI1A
14497 ! *** CASE I1 ; SUBCASE 1
14498 !
14499 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14500 !     1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
14501 !     2. SOLID AEROSOL ONLY
14502 !     3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
14503 !
14504 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14505 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14506 ! *** WRITTEN BY ATHANASIOS NENES
14507 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14508 !
14509 !=======================================================================
14510 !
14511       SUBROUTINE CALCI1A
14512       implicit none
14513 !
14514 ! *** CALCULATE NON VOLATILE SOLIDS ***********************************
14515 !
14516       CNA2SO4 = 0.5D0*W(1)
14517       CNH4HS4 = ZERO
14518       CNAHSO4 = ZERO
14519       CNH42S4 = ZERO
14520       FRSO4   = MAX(W(2)-CNA2SO4, ZERO)
14521 !
14522       CLC     = MIN(W(3)/3.D0, FRSO4/2.D0)
14523       FRSO4   = MAX(FRSO4-2.D0*CLC, ZERO)
14524       FRNH4   = MAX(W(3)-3.D0*CLC,  ZERO)
14525 !
14526       IF (FRSO4.LE.TINY) THEN
14527          CLC     = MAX(CLC - FRNH4, ZERO)
14528          CNH42S4 = 2.D0*FRNH4
14529
14530       ELSEIF (FRNH4.LE.TINY) THEN
14531          CNH4HS4 = 3.D0*MIN(FRSO4, CLC)
14532          CLC     = MAX(CLC-FRSO4, ZERO)
14533          IF (CNA2SO4.GT.TINY) THEN
14534             FRSO4   = MAX(FRSO4-CNH4HS4/3.D0, ZERO)
14535             CNAHSO4 = 2.D0*FRSO4
14536             CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO)
14537          ENDIF
14538       ENDIF
14539 !
14540 ! *** CALCULATE GAS SPECIES *********************************************
14541 !
14542       GHNO3 = W(4)
14543       GHCL  = W(5)
14544       GNH3  = ZERO
14545 !
14546       RETURN
14547 !
14548 ! *** END OF SUBROUTINE CALCI1A *****************************************
14549 !
14550     END SUBROUTINE CALCI1A
14551 !=======================================================================
14552 !
14553 ! *** ISORROPIA CODE
14554 ! *** SUBROUTINE CALCJ3
14555 ! *** CASE J3
14556 !
14557 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14558 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
14559 !     2. THERE IS ONLY A LIQUID PHASE
14560 !
14561 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14562 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14563 ! *** WRITTEN BY ATHANASIOS NENES
14564 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14565 !
14566 !=======================================================================
14567 !
14568     SUBROUTINE CALCJ3
14569       implicit none
14570 !
14571       REAL(KIND=8) KAPA
14572       REAL(KIND=8) BB, CC, DD
14573       INTEGER I
14574 !
14575 ! *** SETUP PARAMETERS ************************************************
14576 !
14577       CALAOU = .TRUE.              ! Outer loop activity calculation flag
14578       FRST   = .TRUE.
14579       CALAIN = .TRUE.
14580 !
14581       LAMDA  = MAX(W(2) - W(3) - W(1), TINY)  ! FREE H2SO4
14582       CHI1   = W(1)                           ! NA TOTAL as NaHSO4
14583       CHI2   = W(3)                           ! NH4 TOTAL as NH4HSO4
14584       PSI1   = CHI1
14585       PSI2   = CHI2                           ! ALL NH4HSO4 DELIQUESCED
14586 !
14587 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14588 !
14589       DO 10 I=1,NSWEEP
14590 !
14591       A3 = XK1  *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
14592 !
14593 !  CALCULATE DISSOCIATION QUANTITIES
14594 !
14595       BB   = A3+LAMDA                        ! KAPA
14596       CC   =-A3*(LAMDA + PSI1 + PSI2)
14597       DD   = BB*BB-4.D0*CC
14598       KAPA = 0.5D0*(-BB+SQRT(DD))
14599 !
14600 ! *** CALCULATE SPECIATION ********************************************
14601 !
14602       MOLAL (1) = LAMDA + KAPA                 ! HI
14603       MOLAL (2) = PSI1                         ! NAI
14604       MOLAL (3) = PSI2                         ! NH4I
14605       MOLAL (4) = ZERO                         ! CLI
14606       MOLAL (5) = KAPA                         ! SO4I
14607       MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA   ! HSO4I
14608       MOLAL (7) = ZERO                         ! NO3I
14609 !
14610       CNAHSO4   = ZERO
14611       CNH4HS4   = ZERO
14612 !
14613       CALL CALCMR                              ! Water content
14614 !
14615 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14616 !
14617       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14618          CALL CALCACT
14619       ELSE
14620          GOTO 50
14621       ENDIF
14622 10    CONTINUE
14623 !
14624 50    RETURN
14625 !
14626 ! *** END OF SUBROUTINE CALCJ3 ******************************************
14627 !
14628     END SUBROUTINE CALCJ3
14629 !=======================================================================
14630 !
14631 ! *** ISORROPIA CODE
14632 ! *** SUBROUTINE CALCJ2
14633 ! *** CASE J2
14634 !
14635 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14636 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
14637 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
14638 !     3. SOLIDS POSSIBLE : NAHSO4
14639 !
14640 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14641 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14642 ! *** WRITTEN BY ATHANASIOS NENES
14643 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14644 !
14645 !=======================================================================
14646 !
14647       SUBROUTINE CALCJ2
14648       implicit none
14649       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
14650       REAL(KIND=8) PSI1LO, PSI1HI, YLO, YHI, DX
14651
14652       INTEGER I
14653 !
14654 !
14655 ! *** SETUP PARAMETERS ************************************************
14656 !
14657       CALAOU = .TRUE.              ! Outer loop activity calculation flag
14658       CHI1   = W(1)                ! NA TOTAL
14659       CHI2   = W(3)                ! NH4 TOTAL
14660       PSI1LO = TINY                ! Low  limit
14661       PSI1HI = CHI1                ! High limit
14662 !
14663 ! *** INITIAL VALUES FOR BISECTION ************************************
14664 !
14665       X1 = PSI1HI
14666       Y1 = FUNCJ2 (X1)
14667       YHI= Y1                      ! Save Y-value at HI position
14668 !
14669 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 ****
14670 !
14671       IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
14672 !
14673 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14674 !
14675       DX = (PSI1HI-PSI1LO)/FLOAT(NDIV)
14676       DO 10 I=1,NDIV
14677          X2 = X1-DX
14678          Y2 = FUNCJ2 (X2)
14679          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
14680          X1 = X2
14681          Y1 = Y2
14682 10    CONTINUE
14683 !
14684 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4
14685 !
14686       YLO= Y1                      ! Save Y-value at Hi position
14687       IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
14688          Y3 = FUNCJ2 (ZERO)
14689          GOTO 50
14690       ELSE IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
14691          GOTO 50
14692       ELSE
14693          CALL PUSHERR (0001, 'CALCJ2')    ! WARNING ERROR: NO SOLUTION
14694          GOTO 50
14695       ENDIF
14696 !
14697 ! *** PERFORM BISECTION ***********************************************
14698 !
14699 20    DO 30 I=1,MAXIT
14700          X3 = 0.5*(X1+X2)
14701          Y3 = FUNCJ2 (X3)
14702          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
14703             Y2    = Y3
14704             X2    = X3
14705          ELSE
14706             Y1    = Y3
14707             X1    = X3
14708          ENDIF
14709          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14710 30    CONTINUE
14711       CALL PUSHERR (0002, 'CALCJ2')    ! WARNING ERROR: NO CONVERGENCE
14712 !
14713 ! *** CONVERGED ; RETURN **********************************************
14714 !
14715 40    X3 = 0.5*(X1+X2)
14716       Y3 = FUNCJ2 (X3)
14717 !
14718 50    RETURN
14719 !
14720 ! *** END OF SUBROUTINE CALCJ2 ******************************************
14721 !
14722     END SUBROUTINE CALCJ2
14723
14724
14725
14726
14727 !=======================================================================
14728 !
14729 ! *** ISORROPIA CODE
14730 ! *** SUBROUTINE FUNCJ2
14731 ! *** CASE J2
14732 !
14733 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14734 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
14735 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
14736 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
14737 !
14738 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14739 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14740 ! *** WRITTEN BY ATHANASIOS NENES
14741 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14742 !
14743 !=======================================================================
14744 !
14745       REAL(KIND=8) FUNCTION FUNCJ2 (P1)
14746       implicit none
14747
14748       REAL(KIND=8) P1
14749       REAL(KIND=8) BB, CC, DD, KAPA
14750       INTEGER I
14751 !
14752 !
14753 ! *** SETUP PARAMETERS ************************************************
14754 !
14755       FRST   = .TRUE.
14756       CALAIN = .TRUE.
14757 !
14758       LAMDA  = MAX(W(2) - W(3) - W(1), TINY)  ! FREE H2SO4
14759       PSI1   = P1
14760       PSI2   = CHI2                           ! ALL NH4HSO4 DELIQUESCED
14761 !
14762 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14763 !
14764       DO 10 I=1,NSWEEP
14765 !
14766       A1 = XK11 *(WATER/GAMA(12))**2.0
14767       A3 = XK1  *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
14768 !
14769 !  CALCULATE DISSOCIATION QUANTITIES
14770 !
14771       BB   = A3+LAMDA                        ! KAPA
14772       CC   =-A3*(LAMDA + PSI1 + PSI2)
14773       DD   = BB*BB-4.D0*CC
14774       KAPA = 0.5D0*(-BB+SQRT(DD))
14775 !
14776 ! *** CALCULATE SPECIATION ********************************************
14777 !
14778       MOLAL (1) = LAMDA + KAPA                  ! HI
14779       MOLAL (2) = PSI1                          ! NAI
14780       MOLAL (3) = PSI2                          ! NH4I
14781       MOLAL (4) = ZERO                          ! CLI
14782       MOLAL (5) = KAPA                          ! SO4I
14783       MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA    ! HSO4I
14784       MOLAL (7) = ZERO                          ! NO3I
14785 !
14786       CNAHSO4   = MAX(CHI1-PSI1,ZERO)
14787       CNH4HS4   = ZERO
14788 !
14789       CALL CALCMR                               ! Water content
14790 !
14791 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14792 !
14793       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14794          CALL CALCACT
14795       ELSE
14796          GOTO 20
14797       ENDIF
14798 10    CONTINUE
14799 !
14800 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
14801 !
14802 20    FUNCJ2 = MOLAL(2)*MOLAL(6)/A1 - ONE
14803 !
14804 ! *** END OF FUNCTION FUNCJ2 *******************************************
14805 !
14806       END FUNCTION FUNCJ2
14807
14808 !=======================================================================
14809 !
14810 ! *** ISORROPIA CODE
14811 ! *** SUBROUTINE CALCJ1
14812 ! *** CASE J1
14813 !
14814 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14815 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
14816 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
14817 !     3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4
14818 !
14819 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14820 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14821 ! *** WRITTEN BY ATHANASIOS NENES
14822 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14823 !
14824 !=======================================================================
14825 !
14826       SUBROUTINE CALCJ1
14827       implicit none
14828       REAL(KIND=8) X1, X2, X3, Y1, Y2, Y3
14829       REAL(KIND=8) PSI1LO, PSI1HI, YLO, YHI, DX
14830
14831       INTEGER I
14832 !
14833 !
14834 ! *** SETUP PARAMETERS ************************************************
14835 !
14836       CALAOU =.TRUE.               ! Outer loop activity calculation flag
14837       CHI1   = W(1)                ! Total NA initially as NaHSO4
14838       CHI2   = W(3)                ! Total NH4 initially as NH4HSO4
14839 !
14840       PSI1LO = TINY                ! Low  limit
14841       PSI1HI = CHI1                ! High limit
14842 !
14843 ! *** INITIAL VALUES FOR BISECTION ************************************
14844 !
14845       X1 = PSI1HI
14846       Y1 = FUNCJ1 (X1)
14847       YHI= Y1                      ! Save Y-value at HI position
14848 !
14849 ! *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 ****
14850 !
14851       IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
14852 !
14853 ! *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14854 !
14855       DX = (PSI1HI-PSI1LO)/FLOAT(NDIV)
14856       DO 10 I=1,NDIV
14857          X2 = X1-DX
14858          Y2 = FUNCJ1 (X2)
14859          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20  ! (Y1*Y2.LT.ZERO)
14860          X1 = X2
14861          Y1 = Y2
14862 10    CONTINUE
14863 !
14864 ! *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4
14865 !
14866       YLO= Y1                      ! Save Y-value at Hi position
14867       IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
14868          Y3 = FUNCJ1 (ZERO)
14869          GOTO 50
14870       ELSE IF (ABS(Y2) .LT. EPS) THEN   ! X2 IS A SOLUTION
14871          GOTO 50
14872       ELSE
14873          CALL PUSHERR (0001, 'CALCJ1')    ! WARNING ERROR: NO SOLUTION
14874          GOTO 50
14875       ENDIF
14876 !
14877 ! *** PERFORM BISECTION ***********************************************
14878 !
14879 20    DO 30 I=1,MAXIT
14880          X3 = 0.5*(X1+X2)
14881          Y3 = FUNCJ1 (X3)
14882          IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN  ! (Y1*Y3 .LE. ZERO)
14883             Y2    = Y3
14884             X2    = X3
14885          ELSE
14886             Y1    = Y3
14887             X1    = X3
14888          ENDIF
14889          IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14890 30    CONTINUE
14891       CALL PUSHERR (0002, 'CALCJ1')    ! WARNING ERROR: NO CONVERGENCE
14892 !
14893 ! *** CONVERGED ; RETURN **********************************************
14894 !
14895 40    X3 = 0.5*(X1+X2)
14896       Y3 = FUNCJ1 (X3)
14897 !
14898 50    RETURN
14899 !
14900 ! *** END OF SUBROUTINE CALCJ1 ******************************************
14901 !
14902    END  SUBROUTINE CALCJ1
14903
14904
14905
14906
14907 !=======================================================================
14908 !
14909 ! *** ISORROPIA CODE
14910 ! *** SUBROUTINE FUNCJ1
14911 ! *** CASE J1
14912 !
14913 !     THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14914 !     1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
14915 !     2. THERE IS BOTH A LIQUID & SOLID PHASE
14916 !     3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
14917 !
14918 ! *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14919 ! *** GEORGIA INSTITUTE OF TECHNOLOGY
14920 ! *** WRITTEN BY ATHANASIOS NENES
14921 ! *** UPDATED BY CHRISTOS FOUNTOUKIS
14922 !
14923 !=======================================================================
14924 !
14925       REAL(KIND=8) FUNCTION FUNCJ1 (P1)
14926       implicit none
14927       REAL(KIND=8) P1
14928       REAL(KIND=8)  BB, CC, DD, KAPA
14929       INTEGER I
14930 !
14931 ! *** SETUP PARAMETERS ************************************************
14932 !
14933       FRST   = .TRUE.
14934       CALAIN = .TRUE.
14935 !
14936       LAMDA  = MAX(W(2) - W(3) - W(1), TINY)  ! FREE H2SO4
14937       PSI1   = P1
14938 !
14939 ! *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14940 !
14941       DO 10 I=1,NSWEEP
14942 !
14943       A1 = XK11 *(WATER/GAMA(12))**2.0
14944       A2 = XK12 *(WATER/GAMA(09))**2.0
14945       A3 = XK1  *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
14946 !
14947       PSI2 = 0.5*(-(LAMDA+PSI1) + SQRT((LAMDA+PSI1)**2.D0+4.D0*A2))  ! PSI2
14948       PSI2 = MIN (PSI2, CHI2)
14949 !
14950       BB   = A3+LAMDA                        ! KAPA
14951       CC   =-A3*(LAMDA + PSI2 + PSI1)
14952       DD   = BB*BB-4.D0*CC
14953       KAPA = 0.5D0*(-BB+SQRT(DD))
14954 !
14955 ! *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
14956 !
14957       MOLAL (1) = LAMDA + KAPA                  ! HI
14958       MOLAL (2) = PSI1                          ! NAI
14959       MOLAL (3) = PSI2                          ! NH4I
14960       MOLAL (4) = ZERO
14961       MOLAL (5) = KAPA                          ! SO4I
14962       MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA    ! HSO4I
14963       MOLAL (7) = ZERO
14964 !
14965       CNAHSO4   = MAX(CHI1-PSI1,ZERO)
14966       CNH4HS4   = MAX(CHI2-PSI2,ZERO)
14967 !
14968       CALL CALCMR                               ! Water content
14969 !
14970 ! *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14971 !
14972       IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14973          CALL CALCACT
14974       ELSE
14975          GOTO 20
14976       ENDIF
14977 10    CONTINUE
14978 !
14979 ! *** CALCULATE OBJECTIVE FUNCTION ************************************
14980 !
14981 20    FUNCJ1 = MOLAL(2)*MOLAL(6)/A1 - ONE
14982 !
14983 ! *** END OF FUNCTION FUNCJ1 *******************************************
14984 !
14985       END FUNCTION FUNCJ1
14986
14987 END module module_isrpia