| blob | a4960a9ba0e877f60e49cf62cdaed60168fd6052 |
2 !CC=======================================================================
3 !!C
4 !!C *** ISORROPIA CODE
5 !C *** SUBROUTINE ISRP1F
6 !C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF
7 !C AN AMMONIUM-SULFATE AEROSOL SYSTEM.
8 !C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
9 !C THE AMBIENT RELATIVE HUMIDITY.
10 !C
11 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
12 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13 !C *** WRITTEN BY ATHANASIOS NENES
14 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
15 !C
16 !C=======================================================================
17 !C
18 SUBROUTINE ISRP1F2p1 (WI, RHI, TEMPI)
19 INCLUDE 'module_isrpia_inc.F'
20 DIMENSION WI(NCOMP)
21 !liqy
22 !
23 ! write(*,*) 'running isrp1f'
24 !liqy-20140512
25 !C
26 !C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
27 !C
28 CALL INIT12p1 (WI, RHI, TEMPI)
29 !C
30 !C *** CALCULATE SULFATE RATIO *******************************************
31 !C
32 SULRAT = W(3)/W(2)
33 !C
34 !C *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
35 !C
36 !C *** SULFATE POOR
37 !C
38 IF (2.0.LE.SULRAT) THEN
39 DC = W(3) - 2.001D0*W(2) ! For numerical stability
40 W(3) = W(3) + MAX(-DC, ZERO)
41 !C
42 IF(METSTBL.EQ.1) THEN
43 SCASE = 'A2'
44 CALL CALCA22p1 ! Only liquid (metastable)
45 ELSE
46 !C
47 IF (RH.LT.DRNH42S4) THEN
48 SCASE = 'A1'
49 CALL CALCA12p1 ! NH42SO4 ; case A1
50 !C
51 ELSEIF (DRNH42S4.LE.RH) THEN
52 SCASE = 'A2'
53 CALL CALCA22p1 ! Only liquid ; case A2
54 ENDIF
55 ENDIF
56 !C
57 !C *** SULFATE RICH (NO ACID)
58 !C
59 ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
60 !C
61 IF(METSTBL.EQ.1) THEN
62 SCASE = 'B4'
63 CALL CALCB42p1 ! Only liquid (metastable)
64 ELSE
65 !C
66 IF (RH.LT.DRNH4HS4) THEN
67 SCASE = 'B1'
68 CALL CALCB12p1 ! NH4HSO4,LC,NH42SO4 ; case B1
69 !C
70 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
71 SCASE = 'B2'
72 CALL CALCB22p1 ! LC,NH42S4 ; case B2
73 !C
74 ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
75 SCASE = 'B3'
76 CALL CALCB32p1 ! NH42S4 ; case B3
77 !C
78 ELSEIF (DRNH42S4.LE.RH) THEN
79 SCASE = 'B4'
80 CALL CALCB42p1 ! Only liquid ; case B4
81 ENDIF
82 ENDIF
83 CALL CALCNH32p1
84 !C
85 !C *** SULFATE RICH (FREE ACID)
86 !C
87 ELSEIF (SULRAT.LT.1.0) THEN
88 !C
89 IF(METSTBL.EQ.1) THEN
90 SCASE = 'C2'
91 CALL CALCC22p1 ! Only liquid (metastable)
92 ELSE
93 !C
94 IF (RH.LT.DRNH4HS4) THEN
95 SCASE = 'C1'
96 CALL CALCC12p1 ! NH4HSO4 ; case C1
97 !C
98 ELSEIF (DRNH4HS4.LE.RH) THEN
99 SCASE = 'C2'
100 CALL CALCC22p1 ! Only liquid ; case C2
101 !C
102 ENDIF
103 ENDIF
104 CALL CALCNH32p1
105 ENDIF
106 !C
107 !C *** RETURN POINT
108 !C
109 RETURN
110 !C
111 !C *** END OF SUBROUTINE ISRP1F *****************************************
112 !C
113 END
114 !C=======================================================================
115 !C
116 !C *** ISORROPIA CODE
117 !C *** SUBROUTINE ISRP2F
118 !C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FOREWARD PROBLEM OF
119 !C AN AMMONIUM-SULFATE-NITRATE AEROSOL SYSTEM.
120 !C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE RATIO AND BY
121 !C THE AMBIENT RELATIVE HUMIDITY.
122 !C
123 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
124 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
125 !C *** WRITTEN BY ATHANASIOS NENES
126 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
127 !C
128 !C=======================================================================
129 !C
130 SUBROUTINE ISRP2F2p1 (WI, RHI, TEMPI)
131 INCLUDE 'module_isrpia_inc.F'
132 DIMENSION WI(NCOMP)
133 !liqy
134 !
135 ! write(*,*) 'running isrp2f'
136 !liqy-20140512
137 !C
138 !C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
139 !C
140 CALL INIT22p1 (WI, RHI, TEMPI)
141 !C
142 !C *** CALCULATE SULFATE RATIO *******************************************
143 !C
144 SULRAT = W(3)/W(2)
145 !C
146 !C *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
147 !C
148 !C *** SULFATE POOR
149 !C
150 IF (2.0.LE.SULRAT) THEN
151 !C
152 IF(METSTBL.EQ.1) THEN
153 SCASE = 'D3'
154 CALL CALCD32p1 ! Only liquid (metastable)
155 ELSE
156 !C
157 IF (RH.LT.DRNH4NO3) THEN
158 SCASE = 'D1'
159 CALL CALCD12p1 ! NH42SO4,NH4NO3 ; case D1
160 !C
161 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH42S4) THEN
162 SCASE = 'D2'
163 CALL CALCD22p1 ! NH42S4 ; case D2
164 !C
165 ELSEIF (DRNH42S4.LE.RH) THEN
166 SCASE = 'D3'
167 CALL CALCD32p1 ! Only liquid ; case D3
168 ENDIF
169 ENDIF
170 !C
171 !C *** SULFATE RICH (NO ACID)
172 !C FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES,
173 !C THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM.
174 !C SUBROUTINES CALCB? ARE CALLED, AND THEN THE NITRIC ACID IS DISSOLVED
175 !C FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM.
176 !C
177 ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
178 !C
179 IF(METSTBL.EQ.1) THEN
180 SCASE = 'B4'
181 CALL CALCB42p1 ! Only liquid (metastable)
182 SCASE = 'E4'
183 ELSE
184 !C
185 IF (RH.LT.DRNH4HS4) THEN
186 SCASE = 'B1'
187 CALL CALCB12p1 ! NH4HSO4,LC,NH42SO4 ; case E1
188 SCASE = 'E1'
189 !C
190 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRLC) THEN
191 SCASE = 'B2'
192 CALL CALCB22p1 ! LC,NH42S4 ; case E2
193 SCASE = 'E2'
194 !C
195 ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
196 SCASE = 'B3'
197 CALL CALCB32p1 ! NH42S4 ; case E3
198 SCASE = 'E3'
199 !C
200 ELSEIF (DRNH42S4.LE.RH) THEN
201 SCASE = 'B4'
202 CALL CALCB42p1 ! Only liquid ; case E4
203 SCASE = 'E4'
204 ENDIF
205 ENDIF
206 !C
207 CALL CALCNA2p1 ! HNO3(g) DISSOLUTION
208 !C
209 !C *** SULFATE RICH (FREE ACID)
210 !C FOR SOLVING THIS CASE, NITRIC ACID IS ASSUMED A MINOR SPECIES,
211 !C THAT DOES NOT SIGNIFICANTLY PERTURB THE HSO4-SO4 EQUILIBRIUM
212 !C SUBROUTINE CALCC? IS CALLED, AND THEN THE NITRIC ACID IS DISSOLVED
213 !C FROM THE HNO3(G) -> (H+) + (NO3-) EQUILIBRIUM.
214 !C
215 ELSEIF (SULRAT.LT.1.0) THEN
216 !C
217 IF(METSTBL.EQ.1) THEN
218 SCASE = 'C2'
219 CALL CALCC22p1 ! Only liquid (metastable)
220 SCASE = 'F2'
221 ELSE
222 !C
223 IF (RH.LT.DRNH4HS4) THEN
224 SCASE = 'C1'
225 CALL CALCC12p1 ! NH4HSO4 ; case F1
226 SCASE = 'F1'
227 !C
228 ELSEIF (DRNH4HS4.LE.RH) THEN
229 SCASE = 'C2'
230 CALL CALCC22p1 ! Only liquid ; case F2
231 SCASE = 'F2'
232 ENDIF
233 ENDIF
234 !C
235 CALL CALCNA2p1 ! HNO3(g) DISSOLUTION
236 ENDIF
237 !C
238 !C *** RETURN POINT
239 !C
240 RETURN
241 !C
242 !C *** END OF SUBROUTINE ISRP2F *****************************************
243 !C
244 END
245 !C=======================================================================
246 !C
247 !C *** ISORROPIA CODE
248 !C *** SUBROUTINE ISRP3F
249 !C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF
250 !C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM AEROSOL SYSTEM.
251 !C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM
252 !C RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY.
253 !C
254 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
255 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
256 !C *** WRITTEN BY ATHANASIOS NENES
257 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
258 !C
259 !C=======================================================================
260 !C
261 SUBROUTINE ISRP3F2p1 (WI, RHI, TEMPI)
262 INCLUDE 'module_isrpia_inc.F'
263 DIMENSION WI(NCOMP)
267 !C
268 !C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE ***********************
269 !C
270 WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3
271 WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3
272 !C
273 !C *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ********
274 !C
275 IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN
276 WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3
277 WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3
278 ENDIF
279 !C
280 !C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
281 !C
282 CALL ISOINIT32p1 (WI, RHI, TEMPI)
283 !C
284 !C *** CHECK IF TOO MUCH SODIUM ; ADJUST AND ISSUE ERROR MESSAGE *********
285 !C
286 REST = 2.D0*W(2) + W(4) + W(5)
287 IF (W(1).GT.REST) THEN ! NA > 2*SO4+CL+NO3 ?
288 W(1) = (ONE-1D-6)*REST ! Adjust Na amount
289 CALL PUSHERR2p1 (0050, 'ISRP3F') ! Warning error: Na adjusted
290 ENDIF
291 !C
292 !C *** CALCULATE SULFATE & SODIUM RATIOS *********************************
293 !C
294 SULRAT = (W(1)+W(3))/W(2)
295 SODRAT = W(1)/W(2)
296 !C
297 !C *** FIND CALCULATION REGIME FROM (SULRAT,RH) **************************
299 !C *** SULFATE POOR ; SODIUM POOR
300 !C
301 IF (2.0.LE.SULRAT .AND. SODRAT.LT.2.0) THEN
302 !C
303 IF(METSTBL.EQ.1) THEN
304 SCASE = 'G5'
305 CALL CALCG52p1 ! Only liquid (metastable)
306 ELSE
307 !C
308 IF (RH.LT.DRNH4NO3) THEN
309 SCASE = 'G1'
310 CALL CALCG12p1 ! NH42SO4,NH4NO3,NH4CL,NA2SO4
311 !C
312 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN
313 SCASE = 'G2'
314 CALL CALCG22p1 ! NH42SO4,NH4CL,NA2SO4
315 !C
316 ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN
317 SCASE = 'G3'
318 CALL CALCG32p1 ! NH42SO4,NA2SO4
319 !C
320 ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
321 SCASE = 'G4'
322 CALL CALCG42p1 ! NA2SO4
323 !C
324 ELSEIF (DRNA2SO4.LE.RH) THEN
325 SCASE = 'G5'
326 CALL CALCG52p1 ! Only liquid
327 ENDIF
328 ENDIF
329 !C
330 !C *** SULFATE POOR ; SODIUM RICH
331 !C
332 ELSE IF (SULRAT.GE.2.0 .AND. SODRAT.GE.2.0) THEN
333 !C
334 IF(METSTBL.EQ.1) THEN
335 SCASE = 'H6'
336 CALL CALCH62p1 ! Only liquid (metastable)
337 ELSE
338 !C
339 IF (RH.LT.DRNH4NO3) THEN
340 SCASE = 'H1'
341 CALL CALCH12p1 ! NH4NO3,NH4CL,NA2SO4,NACL,NANO3
342 !C
343 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN
344 SCASE = 'H2'
345 CALL CALCH22p1 ! NH4CL,NA2SO4,NACL,NANO3
346 !C
347 ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN
348 SCASE = 'H3'
349 CALL CALCH32p1 ! NH4CL,NA2SO4,NACL
350 !C
351 ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4Cl) THEN
352 SCASE = 'H4'
353 CALL CALCH42p1 ! NH4CL,NA2SO4
354 !C
355 ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRNA2SO4) THEN
356 SCASE = 'H5'
357 CALL CALCH52p1 ! NA2SO4
358 !C
359 ELSEIF (DRNA2SO4.LE.RH) THEN
360 SCASE = 'H6'
361 CALL CALCH62p1 ! NO SOLID
362 ENDIF
363 ENDIF
364 !C
365 !C *** SULFATE RICH (NO ACID)
366 !C
367 ELSEIF (1.0.LE.SULRAT .AND. SULRAT.LT.2.0) THEN
368 !C
369 IF(METSTBL.EQ.1) THEN
370 SCASE = 'I6'
371 CALL CALCI62p1 ! Only liquid (metastable)
372 ELSE
373 !C
374 IF (RH.LT.DRNH4HS4) THEN
375 SCASE = 'I1'
376 CALL CALCI12p1 ! NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC
377 !C
378 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
379 SCASE = 'I2'
380 CALL CALCI22p1 ! NA2SO4,(NH4)2SO4,NAHSO4,LC
381 !C
382 ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN
383 SCASE = 'I3'
384 CALL CALCI32p1 ! NA2SO4,(NH4)2SO4,LC
385 !C
386 ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
387 SCASE = 'I4'
388 CALL CALCI42p1 ! NA2SO4,(NH4)2SO4
389 !C
390 ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
391 SCASE = 'I5'
392 CALL CALCI52p1 ! NA2SO4
393 !C
394 ELSEIF (DRNA2SO4.LE.RH) THEN
395 SCASE = 'I6'
396 CALL CALCI62p1 ! NO SOLIDS
397 ENDIF
398 ENDIF
399 !C
400 CALL CALCNHA2p1 ! MINOR SPECIES: HNO3, HCl
401 CALL CALCNH32p1 ! NH3
402 !C
403 !C *** SULFATE RICH (FREE ACID)
404 !C
405 ELSEIF (SULRAT.LT.1.0) THEN
406 !C
407 IF(METSTBL.EQ.1) THEN
408 SCASE = 'J3'
409 CALL CALCJ32p1 ! Only liquid (metastable)
410 ELSE
411 !C
412 IF (RH.LT.DRNH4HS4) THEN
413 SCASE = 'J1'
414 CALL CALCJ12p1 ! NH4HSO4,NAHSO4
415 !C
416 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
417 SCASE = 'J2'
418 CALL CALCJ22p1 ! NAHSO4
419 !C
420 ELSEIF (DRNAHSO4.LE.RH) THEN
421 SCASE = 'J3'
422 CALL CALCJ32p1
423 ENDIF
424 ENDIF
425 !C
426 CALL CALCNHA2p1 ! MINOR SPECIES: HNO3, HCl
427 CALL CALCNH32p1 ! NH3
428 ENDIF
429 !C
430 !C *** RETURN POINT
431 !C
432 RETURN
433 !C
434 !C *** END OF SUBROUTINE ISRP3F *****************************************
435 !C
436 END
437 !C
438 !C=======================================================================
439 !C
440 !C *** ISORROPIA CODE II
441 !C *** SUBROUTINE ISRP4F
442 !C *** THIS SUBROUTINE IS THE DRIVER ROUTINE FOR THE FORWARD PROBLEM OF
443 !C AN AMMONIUM-SULFATE-NITRATE-CHLORIDE-SODIUM-CALCIUM-POTASSIUM-MAGNESIUM
444 !C AEROSOL SYSTEM.
445 !C THE COMPOSITION REGIME IS DETERMINED BY THE SULFATE & SODIUM
446 !C RATIOS AND BY THE AMBIENT RELATIVE HUMIDITY.
447 !C
448 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
449 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
450 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
451 !C
452 !C=======================================================================
453 !C
454 SUBROUTINE ISRP4F2p1 (WI, RHI, TEMPI)
455 INCLUDE 'module_isrpia_inc.F'
456 DIMENSION WI(NCOMP)
457 DOUBLE PRECISION NAFRI, NO3FRI
458 !C
459 !C *** ADJUST FOR TOO LITTLE AMMONIUM AND CHLORIDE ***********************
460 !C
461 !C WI(3) = MAX (WI(3), 1.D-10) ! NH4+ : 1e-4 umoles/m3
462 !C WI(5) = MAX (WI(5), 1.D-10) ! Cl- : 1e-4 umoles/m3
463 !C
464 !C *** ADJUST FOR TOO LITTLE SODIUM, SULFATE AND NITRATE COMBINED ********
465 !C
466 !C IF (WI(1)+WI(2)+WI(4) .LE. 1d-10) THEN
467 !C WI(1) = 1.D-10 ! Na+ : 1e-4 umoles/m3
468 !C WI(2) = 1.D-10 ! SO4- : 1e-4 umoles/m3
469 !C ENDIF
470 !C
471 !C *** INITIALIZE ALL VARIABLES IN COMMON BLOCK **************************
472 !C
473 CALL INIT42p1 (WI, RHI, TEMPI)
474 !C
475 !C *** CHECK IF TOO MUCH SODIUM+CRUSTALS ; ADJUST AND ISSUE ERROR MESSAGE
476 !C
477 REST = 2.D0*W(2) + W(4) + W(5)
478 !C
479 IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
480 !C
481 CCASO4I = MIN (W(2),W(6))
482 FRSO4I = MAX (W(2) - CCASO4I, ZERO)
483 CAFRI = MAX (W(6) - CCASO4I, ZERO)
484 CCANO32I = MIN (CAFRI, 0.5D0*W(4))
485 CAFRI = MAX (CAFRI - CCANO32I, ZERO)
486 NO3FRI = MAX (W(4) - 2.D0*CCANO32I, ZERO)
487 CCACL2I = MIN (CAFRI, 0.5D0*W(5))
488 CLFRI = MAX (W(5) - 2.D0*CCACL2I, ZERO)
489 REST1 = 2.D0*FRSO4I + NO3FRI + CLFRI
490 !C
491 CNA2SO4I = MIN (FRSO4I, 0.5D0*W(1))
492 FRSO4I = MAX (FRSO4I - CNA2SO4I, ZERO)
493 NAFRI = MAX (W(1) - 2.D0*CNA2SO4I, ZERO)
494 CNACLI = MIN (NAFRI, CLFRI)
495 NAFRI = MAX (NAFRI - CNACLI, ZERO)
496 CLFRI = MAX (CLFRI - CNACLI, ZERO)
497 CNANO3I = MIN (NAFRI, NO3FRI)
498 NO3FR = MAX (NO3FRI - CNANO3I, ZERO)
499 REST2 = 2.D0*FRSO4I + NO3FRI + CLFRI
500 !C
501 CMGSO4I = MIN (FRSO4I, W(8))
502 FRMGI = MAX (W(8) - CMGSO4I, ZERO)
503 FRSO4I = MAX (FRSO4I - CMGSO4I, ZERO)
504 CMGNO32I = MIN (FRMGI, 0.5D0*NO3FRI)
505 FRMGI = MAX (FRMGI - CMGNO32I, ZERO)
506 NO3FRI = MAX (NO3FRI - 2.D0*CMGNO32I, ZERO)
507 CMGCL2I = MIN (FRMGI, 0.5D0*CLFRI)
508 CLFRI = MAX (CLFRI - 2.D0*CMGCL2I, ZERO)
509 REST3 = 2.D0*FRSO4I + NO3FRI + CLFRI
510 !C
511 IF (W(6).GT.REST) THEN ! Ca > 2*SO4+CL+NO3 ?
512 W(6) = (ONE-1D-6)*REST ! Adjust Ca amount
513 W(1)= ZERO ! Adjust Na amount
514 W(7)= ZERO ! Adjust K amount
515 W(8)= ZERO ! Adjust Mg amount
516 CALL PUSHERR2p1 (0051, 'ISRP4F') ! Warning error: Ca, Na, K, Mg in excess
517 !C
518 ELSE IF (W(1).GT.REST1) THEN ! Na > 2*FRSO4+FRCL+FRNO3 ?
519 W(1) = (ONE-1D-6)*REST1 ! Adjust Na amount
520 W(7)= ZERO ! Adjust K amount
521 W(8)= ZERO ! Adjust Mg amount
522 CALL PUSHERR2p1 (0052, 'ISRP4F') ! Warning error: Na, K, Mg in excess
523 !C
524 ELSE IF (W(8).GT.REST2) THEN ! Mg > 2*FRSO4+FRCL+FRNO3 ?
525 W(8) = (ONE-1D-6)*REST2 ! Adjust Mg amount
526 W(7)= ZERO ! Adjust K amount
527 CALL PUSHERR2p1 (0053, 'ISRP4F') ! Warning error: K, Mg in excess
528 !C
529 ELSE IF (W(7).GT.REST3) THEN ! K > 2*FRSO4+FRCL+FRNO3 ?
530 W(7) = (ONE-1D-6)*REST3 ! Adjust K amount
531 CALL PUSHERR2p1 (0054, 'ISRP4F') ! Warning error: K in excess
532 ENDIF
533 ENDIF
534 !C
535 !C *** CALCULATE RATIOS *************************************************
536 !C
537 SO4RAT = (W(1)+W(3)+W(6)+W(7)+W(8))/W(2)
538 CRNARAT = (W(1)+W(6)+W(7)+W(8))/W(2)
539 CRRAT = (W(6)+W(7)+W(8))/W(2)
540 !C
541 !C *** FIND CALCULATION REGIME FROM (SO4RAT, CRNARAT, CRRAT, RRH) ********
542 !C
543 !C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) POOR: R(Cr+Na)<2
544 !C
545 IF (2.0.LE.SO4RAT .AND. CRNARAT.LT.2.0) THEN
546 !C
547 IF(METSTBL.EQ.1) THEN
548 SCASE = 'O7'
549 CALL CALCO72p1 ! Only liquid (metastable)
550 ELSE
551 !C
552 IF (RH.LT.DRNH4NO3) THEN
553 SCASE = 'O1'
554 CALL CALCO12p1 ! CaSO4, NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4
555 !C
556 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNH4CL) THEN
557 SCASE = 'O2'
558 CALL CALCO22p1 ! CaSO4, NH4CL, (NH4)2SO4, MGSO4, NA2SO4, K2SO4
559 !C
560 ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRNH42S4) THEN
561 SCASE = 'O3'
562 CALL CALCO32p1 ! CaSO4, (NH4)2SO4, MGSO4, NA2SO4, K2SO4
563 !C
564 ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRMGSO4) THEN
565 SCASE = 'O4'
566 CALL CALCO42p1 ! CaSO4, MGSO4, NA2SO4, K2SO4
567 !C
568 ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
569 SCASE = 'O5'
570 CALL CALCO52p1 ! CaSO4, NA2SO4, K2SO4
571 !C
572 ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN
573 SCASE = 'O6'
574 CALL CALCO62p1 ! CaSO4, K2SO4
575 !C
576 ELSEIF (DRK2SO4.LE.RH) THEN
577 SCASE = 'O7'
578 CALL CALCO72p1 ! CaSO4
579 ENDIF
580 ENDIF
581 !C
582 !C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2.
583 !C
584 ELSEIF (SO4RAT.GE.2.0 .AND. CRNARAT.GE.2.0) THEN
585 !C
586 IF (CRRAT.LE.2.0) THEN
587 !C
588 IF(METSTBL.EQ.1) THEN
589 SCASE = 'M8'
590 CALL CALCM82p1 ! Only liquid (metastable)
591 ELSE
592 !C
593 IF (RH.LT.DRNH4NO3) THEN
594 SCASE = 'M1'
595 CALL CALCM12p1 ! CaSO4, NH4NO3, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3
596 !C
597 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN
598 SCASE = 'M2'
599 CALL CALCM22p1 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL, NANO3
600 !C
601 ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN
602 SCASE = 'M3'
603 CALL CALCM32p1 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4, NACL
604 !C
605 ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4Cl) THEN
606 SCASE = 'M4'
607 CALL CALCM42p1 ! CaSO4, NH4CL, MGSO4, NA2SO4, K2SO4
608 !C
609 ELSEIF (DRNH4Cl.LE.RH .AND. RH.LT.DRMGSO4) THEN
610 SCASE = 'M5'
611 CALL CALCM52p1 ! CaSO4, MGSO4, NA2SO4, K2SO4
612 !C
613 ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
614 SCASE = 'M6'
615 CALL CALCM62p1 ! CaSO4, NA2SO4, K2SO4
616 !C
617 ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN
618 SCASE = 'M7'
619 CALL CALCM72p1 ! CaSO4, K2SO4
620 !C
621 ELSEIF (DRK2SO4.LE.RH) THEN
622 SCASE = 'M8'
623 CALL CALCM82p1 ! CaSO4
624 ENDIF
625 ENDIF
626 !C CALL CALCHCO3
627 !C
628 !C *** SULFATE POOR: Rso4>2; (DUST + SODIUM) RICH: R(Cr+Na)>2; DUST POOR: Rcr<2.
629 !C
630 ELSEIF (CRRAT.GT.2.0) THEN
631 !C
632 IF(METSTBL.EQ.1) THEN
633 SCASE = 'P13'
634 CALL CALCP132p1 ! Only liquid (metastable)
635 ELSE
636 !C
637 IF (RH.LT.DRCACL2) THEN
638 SCASE = 'P1'
639 CALL CALCP12p1 ! CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4,
640 !C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
641 !C
642 ELSEIF (DRCACL2.LE.RH .AND. RH.LT.DRMGCL2) THEN
643 SCASE = 'P2'
644 CALL CALCP22p1 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4,
645 !C ! MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
646 !C
647 ELSEIF (DRMGCL2.LE.RH .AND. RH.LT.DRCANO32) THEN
648 SCASE = 'P3'
649 CALL CALCP32p1 ! CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4,
650 !C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL
651 !C
652 ELSEIF (DRCANO32.LE.RH .AND. RH.LT.DRMGNO32) THEN
653 SCASE = 'P4'
654 CALL CALCP42p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4,
655 !C ! MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL
656 !C
657 ELSEIF (DRMGNO32.LE.RH .AND. RH.LT.DRNH4NO3) THEN
658 SCASE = 'P5'
659 CALL CALCP52p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4,
660 !C ! NANO3, NACL, NH4NO3, NH4CL
661 !C
662 ELSEIF (DRNH4NO3.LE.RH .AND. RH.LT.DRNANO3) THEN
663 SCASE = 'P6'
664 CALL CALCP62p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NANO3, NACL, NH4CL
665 !C
666 ELSEIF (DRNANO3.LE.RH .AND. RH.LT.DRNACL) THEN
667 SCASE = 'P7'
668 CALL CALCP72p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NACL, NH4CL
669 !C
670 ELSEIF (DRNACL.LE.RH .AND. RH.LT.DRNH4CL) THEN
671 SCASE = 'P8'
672 CALL CALCP82p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4, NH4CL
673 !C
674 ELSEIF (DRNH4CL.LE.RH .AND. RH.LT.DRKCL) THEN
675 SCASE = 'P9'
676 CALL CALCP92p1 ! CaSO4, K2SO4, KNO3, KCL, MGSO4
677 !C
678 ELSEIF (DRKCL.LE.RH .AND. RH.LT.DRMGSO4) THEN
679 SCASE = 'P10'
680 CALL CALCP102p1 ! CaSO4, K2SO4, KNO3, MGSO4
681 !C
682 ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRKNO3) THEN
683 SCASE = 'P11'
684 CALL CALCP112p1 ! CaSO4, K2SO4, KNO3
685 !C
686 ELSEIF (DRKNO3.LE.RH .AND. RH.LT.DRK2SO4) THEN
687 SCASE = 'P12'
688 CALL CALCP122p1 ! CaSO4, K2SO4
689 !C
690 ELSEIF (DRK2SO4.LE.RH) THEN
691 SCASE = 'P13'
692 CALL CALCP132p1 ! CaSO4
693 ENDIF
694 ENDIF
695 !C CALL CALCHCO3
696 ENDIF
697 !C
698 !C *** SULFATE RICH (NO ACID): 1<Rso4<2;
699 !C
700 ELSEIF (1.0.LE.SO4RAT .AND. SO4RAT.LT.2.0) THEN
701 !C
702 IF(METSTBL.EQ.1) THEN
703 SCASE = 'L9'
704 CALL CALCL92p1 ! Only liquid (metastable)
705 ELSE
706 !C
707 IF (RH.LT.DRNH4HS4) THEN
708 SCASE = 'L1'
709 CALL CALCL12p1 ! CASO4,K2SO4,MGSO4,KHSO4,NA2SO4,(NH4)2SO4,NAHSO4,NH4HSO4,LC
710 !C
711 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
712 SCASE = 'L2'
713 CALL CALCL22p1 ! CASO4,K2SO4,MGSO4,KHSO4,NA2SO4,(NH4)2SO4,NAHSO4,LC
714 !C
715 ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRLC) THEN
716 SCASE = 'L3'
717 CALL CALCL32p1 ! CASO4,K2SO4,MGSO4,KHSO4,NA2SO4,(NH4)2SO4,LC
718 !C
719 ELSEIF (DRLC.LE.RH .AND. RH.LT.DRNH42S4) THEN
720 SCASE = 'L4'
721 CALL CALCL42p1 ! CASO4,K2SO4,MGSO4,KHSO4,NA2SO4,(NH4)2SO4
722 !C
723 ELSEIF (DRNH42S4.LE.RH .AND. RH.LT.DRKHSO4) THEN
724 SCASE = 'L5'
725 CALL CALCL52p1 ! CASO4,K2SO4,MGSO4,KHSO4,NA2SO4
726 !C
727 ELSEIF (DRKHSO4.LE.RH .AND. RH.LT.DRMGSO4) THEN
728 SCASE = 'L6'
729 CALL CALCL62p1 ! CASO4,K2SO4,MGSO4,NA2SO4
730 !C
731 ELSEIF (DRMGSO4.LE.RH .AND. RH.LT.DRNA2SO4) THEN
732 SCASE = 'L7'
733 CALL CALCL72p1 ! CASO4,K2SO4,NA2SO4
734 !C
735 ELSEIF (DRNA2SO4.LE.RH .AND. RH.LT.DRK2SO4) THEN
736 SCASE = 'L8'
737 CALL CALCL82p1 ! CASO4,K2SO4
738 !C
739 ELSEIF (DRK2SO4.LE.RH) THEN
740 SCASE = 'L9'
741 CALL CALCL92p1 ! CaSO4
742 ENDIF
743 ENDIF
744 !C
745 CALL CALCNHA2p1 ! MINOR SPECIES: HNO3, HCl
746 CALL CALCNH32p1 ! NH3
747 !C
748 !C *** SULFATE SUPER RICH (FREE ACID): Rso4<1;
749 !C
750 ELSEIF (SO4RAT.LT.1.0) THEN
751 !C
752 IF(METSTBL.EQ.1) THEN
753 SCASE = 'K4'
754 CALL CALCK42p1 ! Only liquid (metastable)
755 ELSE
756 !C
757 IF (RH.LT.DRNH4HS4) THEN ! RH < 0.4
758 SCASE = 'K1'
759 CALL CALCK12p1 ! NH4HSO4,NAHSO4,KHSO4,CASO4
760 !C
761 ELSEIF (DRNH4HS4.LE.RH .AND. RH.LT.DRNAHSO4) THEN
762 SCASE = 'K2'
763 CALL CALCK22p1 ! NAHSO4,KHSO4,CASO4
764 !C
765 ELSEIF (DRNAHSO4.LE.RH .AND. RH.LT.DRKHSO4) THEN
766 SCASE = 'K3'
767 CALL CALCK32p1 ! KHSO4,CASO4 0.52 < RH < 0.86
768 !C
769 ELSEIF (DRKHSO4.LE.RH) THEN
770 SCASE = 'K4'
771 CALL CALCK42p1 ! CASO4
772 ENDIF
773 ENDIF
774 !C
775 CALL CALCNHA2p1 ! MINOR SPECIES: HNO3, HCl
776 CALL CALCNH32p1 ! NH3
777 !C
778 ENDIF
779 !C
780 RETURN
781 END
782 !C
783 !C=======================================================================
784 !C
785 !C *** ISORROPIA CODE
786 !C *** SUBROUTINE CALCA2
787 !C *** CASE A2
788 !C
789 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
790 !C 1. SULFATE POOR (SULRAT >= 2.0)
791 !C 2. LIQUID AEROSOL PHASE ONLY POSSIBLE
792 !C
793 !C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS X, THE
794 !C AMOUNT OF HYDROGEN IONS (H+) FOUND IN THE LIQUID PHASE.
795 !C FOR EACH ESTIMATION OF H+, FUNCTION FUNCB2A CALCULATES THE
796 !C CONCENTRATION OF IONS FROM THE NH3(GAS) - NH4+(LIQ) EQUILIBRIUM.
797 !C ELECTRONEUTRALITY IS USED AS THE OBJECTIVE FUNCTION.
798 !C
799 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
800 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
801 !C *** WRITTEN BY ATHANASIOS NENES
802 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
803 !C
804 !C=======================================================================
805 !C
806 SUBROUTINE CALCA22p1
807 INCLUDE 'module_isrpia_inc.F'
808 !C
809 !C *** SETUP PARAMETERS ************************************************
810 !C
811 CALAOU =.TRUE. ! Outer loop activity calculation flag
812 OMELO = TINY ! Low limit: SOLUTION IS VERY BASIC
813 OMEHI = 2.0D0*W(2) ! High limit: FROM NH4+ -> NH3(g) + H+(aq)
814 !C
815 !C *** CALCULATE WATER CONTENT *****************************************
816 !C
817 MOLAL(5) = W(2)
818 MOLAL(6) = ZERO
819 CALL CALCMR2p1
820 !C
821 !C *** INITIAL VALUES FOR BISECTION ************************************
822 !C
823 X1 = OMEHI
824 Y1 = FUNCA22p1 (X1)
825 IF (ABS(Y1).LE.EPS) RETURN
826 !C
827 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
828 !C
829 DX = (OMEHI-OMELO)/FLOAT(NDIV)
830 DO 10 I=1,NDIV
831 X2 = MAX(X1-DX, OMELO)
832 Y2 = FUNCA22p1 (X2)
833 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
834 X1 = X2
835 Y1 = Y2
836 10 CONTINUE
837 IF (ABS(Y2).LE.EPS) THEN
838 RETURN
839 ELSE
840 CALL PUSHERR2p1 (0001, 'CALCA2') ! WARNING ERROR: NO SOLUTION
841 RETURN
842 ENDIF
843 !C
844 !C *** PERFORM BISECTION ***********************************************
845 !C
846 20 DO 30 I=1,MAXIT
847 X3 = 0.5*(X1+X2)
848 Y3 = FUNCA22p1 (X3)
849 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
850 Y2 = Y3
851 X2 = X3
852 ELSE
853 Y1 = Y3
854 X1 = X3
855 ENDIF
856 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
857 30 CONTINUE
858 CALL PUSHERR2p1 (0002, 'CALCA2') ! WARNING ERROR: NO CONVERGENCE
859 !C
860 !C *** CONVERGED ; RETURN **********************************************
861 !C
862 40 X3 = 0.5*(X1+X2)
863 Y3 = FUNCA22p1 (X3)
864 RETURN
865 !C
866 !C *** END OF SUBROUTINE CALCA2 ****************************************
867 !C
868 END
872 !C=======================================================================
873 !C
874 !C *** ISORROPIA CODE
875 !C *** FUNCTION FUNCA2
876 !C *** CASE A2
877 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE A2 ;
878 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA2.
879 !C
880 !C=======================================================================
881 !C
882 DOUBLE PRECISION FUNCTION FUNCA22p1 (OMEGI)
883 INCLUDE 'module_isrpia_inc.F'
884 DOUBLE PRECISION LAMDA
885 !C
886 !C *** SETUP PARAMETERS ************************************************
887 !C
888 FRST = .TRUE.
889 CALAIN = .TRUE.
890 PSI = W(2) ! INITIAL AMOUNT OF (NH4)2SO4 IN SOLUTION
891 !C
892 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
893 !C
894 DO 10 I=1,NSWEEP
895 A1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
896 A2 = XK2*R*TEMP/XKW*(GAMA(8)/GAMA(9))**2.
897 A3 = XKW*RH*WATER*WATER
898 !C
899 LAMDA = PSI/(A1/OMEGI+ONE)
900 ZETA = A3/OMEGI
901 !C
902 !C *** SPECIATION & WATER CONTENT ***************************************
903 !C
904 MOLAL (1) = OMEGI ! HI
905 MOLAL (5) = MAX(PSI-LAMDA,TINY) ! SO4I
906 MOLAL (3) = MAX(W(3)/(ONE/A2/OMEGI + ONE), 2.*MOLAL(5)) ! NH4I
907 MOLAL (6) = LAMDA ! HSO4I
908 GNH3 = MAX (W(3)-MOLAL(3), TINY) ! NH3GI
909 COH = ZETA ! OHI
910 !C
911 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
912 !C
913 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
914 CALL CALCACT2p1
915 ELSE
916 GOTO 20
917 ENDIF
918 10 CONTINUE
919 !C
920 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
921 !C
922 20 DENOM = (2.0*MOLAL(5)+MOLAL(6))
923 FUNCA22p1= (MOLAL(3)/DENOM - ONE) + MOLAL(1)/DENOM
924 RETURN
925 !C
926 !C *** END OF FUNCTION FUNCA2 ********************************************
927 !C
928 END
929 !C=======================================================================
930 !C
931 !C *** ISORROPIA CODE
932 !C *** SUBROUTINE CALCA1
933 !C *** CASE A1
934 !C
935 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
936 !C 1. SULFATE POOR (SULRAT > 2.0)
937 !C 2. SOLID AEROSOL ONLY
938 !C 3. SOLIDS POSSIBLE : (NH4)2SO4
939 !C
940 !C A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE SOLID (NH4)2SO4
941 !C IS CALCULATED FROM THE SULFATES. THE EXCESS AMMONIA REMAINS IN
942 !C THE GAS PHASE.
943 !C
944 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
945 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
946 !C *** WRITTEN BY ATHANASIOS NENES
947 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
948 !C
949 !C=======================================================================
950 !C
951 SUBROUTINE CALCA12p1
952 INCLUDE 'module_isrpia_inc.F'
953 !C
954 CNH42S4 = W(2)
955 GNH3 = MAX (W(3)-2.0*CNH42S4, ZERO)
956 RETURN
957 !C
958 !C *** END OF SUBROUTINE CALCA1 ******************************************
959 !C
960 END
964 !C=======================================================================
965 !C
966 !C *** ISORROPIA CODE
967 !C *** SUBROUTINE CALCB4
968 !C *** CASE B4
969 !C
970 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
971 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
972 !C 2. LIQUID AEROSOL PHASE ONLY POSSIBLE
973 !C
974 !C FOR CALCULATIONS, A BISECTION IS PERFORMED WITH RESPECT TO H+.
975 !C THE OBJECTIVE FUNCTION IS THE DIFFERENCE BETWEEN THE ESTIMATED H+
976 !C AND THAT CALCULATED FROM ELECTRONEUTRALITY.
977 !C
978 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
979 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
980 !C *** WRITTEN BY ATHANASIOS NENES
981 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
982 !C
983 !C=======================================================================
984 !C
985 SUBROUTINE CALCB42p1
986 INCLUDE 'module_isrpia_inc.F'
987 !C
988 !C *** SOLVE EQUATIONS **************************************************
989 !C
990 FRST = .TRUE.
991 CALAIN = .TRUE.
992 CALAOU = .TRUE.
993 !C
994 !C *** CALCULATE WATER CONTENT ******************************************
995 !C
996 CALL CALCB1A2p1 ! GET DRY SALT CONTENT, AND USE FOR WATER.
997 MOLALR(13) = CLC
998 MOLALR(9) = CNH4HS4
999 MOLALR(4) = CNH42S4
1000 CLC = ZERO
1001 CNH4HS4 = ZERO
1002 CNH42S4 = ZERO
1003 WATER = MOLALR(13)/M0(13)+MOLALR(9)/M0(9)+MOLALR(4)/M0(4)
1004 !C
1005 MOLAL(3) = W(3) ! NH4I
1006 !C
1007 DO 20 I=1,NSWEEP
1008 AK1 = XK1*((GAMA(8)/GAMA(7))**2.)*(WATER/GAMA(7))
1009 BET = W(2)
1010 GAM = MOLAL(3)
1011 !C
1012 BB = BET + AK1 - GAM
1013 CC =-AK1*BET
1014 DD = BB*BB - 4.D0*CC
1015 !C
1016 !C *** SPECIATION & WATER CONTENT ***************************************
1017 !C
1018 MOLAL (5) = MAX(TINY,MIN(0.5*(-BB + SQRT(DD)), W(2))) ! SO4I
1019 MOLAL (6) = MAX(TINY,MIN(W(2)-MOLAL(5),W(2))) ! HSO4I
1020 MOLAL (1) = MAX(TINY,MIN(AK1*MOLAL(6)/MOLAL(5),W(2))) ! HI
1021 CALL CALCMR2p1 ! Water content
1022 !C
1023 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
1024 !C
1025 IF (.NOT.CALAIN) GOTO 30
1026 CALL CALCACT2p1
1027 20 CONTINUE
1028 !C
1029 30 RETURN
1030 !C
1031 !C *** END OF SUBROUTINE CALCB4 ******************************************
1032 !C
1033 END
1034 !C=======================================================================
1035 !C
1036 !C *** ISORROPIA CODE
1037 !C *** SUBROUTINE CALCB3
1038 !C *** CASE B3
1039 !C
1040 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1041 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
1042 !C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
1043 !C 3. SOLIDS POSSIBLE: (NH4)2SO4
1044 !C
1045 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1046 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1047 !C *** WRITTEN BY ATHANASIOS NENES
1048 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1049 !C
1050 !C=======================================================================
1051 !C
1052 SUBROUTINE CALCB32p1
1053 INCLUDE 'module_isrpia_inc.F'
1054 !C
1055 !C *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 ***********************
1056 !C
1057 X = MAX(2*W(2)-W(3), ZERO) ! Equivalent NH4HSO4
1058 Y = MAX(W(3) -W(2), ZERO) ! Equivalent NH42SO4
1059 !C
1060 !C *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 *********
1061 !C
1062 IF (X.LT.Y) THEN ! LC is the MIN (x,y)
1063 SCASE = 'B3 ; SUBCASE 1'
1064 TLC = X
1065 TNH42S4 = Y-X
1066 CALL CALCB3A2p1 (TLC,TNH42S4) ! LC + (NH4)2SO4
1067 ELSE
1068 SCASE = 'B3 ; SUBCASE 2'
1069 TLC = Y
1070 TNH4HS4 = X-Y
1071 CALL CALCB3B2p1 (TLC,TNH4HS4) ! LC + NH4HSO4
1072 ENDIF
1073 !C
1074 RETURN
1075 !C
1076 !C *** END OF SUBROUTINE CALCB3 ******************************************
1077 !C
1078 END
1081 !C=======================================================================
1082 !C
1083 !C *** ISORROPIA CODE
1084 !C *** SUBROUTINE CALCB3A
1085 !C *** CASE B3 ; SUBCASE 1
1086 !C
1087 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1088 !C 1. SULFATE RICH (1.0 < SULRAT < 2.0)
1089 !C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
1090 !C 3. SOLIDS POSSIBLE: (NH4)2SO4
1091 !C
1092 !C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE
1093 !C AMOUNT OF SOLID (NH4)2SO4 DISSOLVED IN THE LIQUID PHASE.
1094 !C FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB3A CALCULATES THE
1095 !C AMOUNT OF H+ PRODUCED (BASED ON THE SO4 RELEASED INTO THE
1096 !C SOLUTION). THE SOLUBILITY PRODUCT OF (NH4)2SO4 IS USED AS THE
1097 !C OBJECTIVE FUNCTION.
1098 !C
1099 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1100 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1101 !C *** WRITTEN BY ATHANASIOS NENES
1102 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1103 !C
1104 !C=======================================================================
1105 !C
1106 SUBROUTINE CALCB3A2p1 (TLC, TNH42S4)
1107 INCLUDE 'module_isrpia_inc.F'
1108 !C
1109 CALAOU = .TRUE. ! Outer loop activity calculation flag
1110 ZLO = ZERO ! MIN DISSOLVED (NH4)2SO4
1111 ZHI = TNH42S4 ! MAX DISSOLVED (NH4)2SO4
1112 !C
1113 !C *** INITIAL VALUES FOR BISECTION (DISSOLVED (NH4)2SO4 ****************
1114 !C
1115 Z1 = ZLO
1116 Y1 = FUNCB3A2p1 (Z1, TLC, TNH42S4)
1117 IF (ABS(Y1).LE.EPS) RETURN
1118 YLO= Y1
1119 !C
1120 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
1121 !C
1122 DZ = (ZHI-ZLO)/FLOAT(NDIV)
1123 DO 10 I=1,NDIV
1124 Z2 = Z1+DZ
1125 Y2 = FUNCB3A2p1 (Z2, TLC, TNH42S4)
1126 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
1127 Z1 = Z2
1128 Y1 = Y2
1129 10 CONTINUE
1130 !C
1131 !C *** NO SUBDIVISION WITH SOLUTION FOUND
1132 !C
1133 YHI= Y1 ! Save Y-value at HI position
1134 IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
1135 RETURN
1136 !C
1137 !C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC
1138 !C
1139 ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
1140 Z1 = ZHI
1141 Z2 = ZHI
1142 GOTO 40
1143 !C
1144 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
1145 !C
1146 ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
1147 Z1 = ZLO
1148 Z2 = ZLO
1149 GOTO 40
1150 ELSE
1151 CALL PUSHERR2p1 (0001, 'CALCB3A') ! WARNING ERROR: NO SOLUTION
1152 RETURN
1153 ENDIF
1154 !C
1155 !C *** PERFORM BISECTION ***********************************************
1156 !C
1157 20 DO 30 I=1,MAXIT
1158 Z3 = 0.5*(Z1+Z2)
1159 Y3 = FUNCB3A2p1 (Z3, TLC, TNH42S4)
1160 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
1161 Y2 = Y3
1162 Z2 = Z3
1163 ELSE
1164 Y1 = Y3
1165 Z1 = Z3
1166 ENDIF
1167 IF (ABS(Z2-Z1) .LE. EPS*Z1) GOTO 40
1168 30 CONTINUE
1169 CALL PUSHERR2p1 (0002, 'CALCB3A') ! WARNING ERROR: NO CONVERGENCE
1170 !C
1171 !C *** CONVERGED ; RETURN ************************************************
1172 !C
1173 40 ZK = 0.5*(Z1+Z2)
1174 Y3 = FUNCB3A2p1 (ZK, TLC, TNH42S4)
1175 !C
1176 RETURN
1177 !C
1178 !C *** END OF SUBROUTINE CALCB3A ******************************************
1179 !C
1180 END
1184 !C=======================================================================
1185 !C
1186 !C *** ISORROPIA CODE
1187 !C *** FUNCTION FUNCB3A
1188 !C *** CASE B3 ; SUBCASE 1
1189 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B3
1190 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCA3.
1191 !C
1192 !C=======================================================================
1193 !C
1194 DOUBLE PRECISION FUNCTION FUNCB3A2p1 (ZK, Y, X)
1195 INCLUDE 'module_isrpia_inc.F'
1196 DOUBLE PRECISION KK
1197 !C
1198 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
1199 !C
1200 FRST = .TRUE.
1201 CALAIN = .TRUE.
1202 DO 20 I=1,NSWEEP
1203 GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
1204 DD = SQRT( (ZK+GRAT1+Y)**2. + 4.0*Y*GRAT1)
1205 KK = 0.5*(-(ZK+GRAT1+Y) + DD )
1206 !C
1207 !C *** SPECIATION & WATER CONTENT ***************************************
1208 !C
1209 MOLAL (1) = KK ! HI
1210 MOLAL (5) = KK+ZK+Y ! SO4I
1211 MOLAL (6) = MAX (Y-KK, TINY) ! HSO4I
1212 MOLAL (3) = 3.0*Y+2*ZK ! NH4I
1213 CNH42S4 = X-ZK ! Solid (NH4)2SO4
1214 CALL CALCMR2p1 ! Water content
1215 !C
1216 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
1217 !C
1218 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
1219 CALL CALCACT2p1
1220 ELSE
1221 GOTO 30
1222 ENDIF
1223 20 CONTINUE
1224 !C
1225 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
1226 !C
1227 !CCC30 FUNCB3A= ( SO4I*NH4I**2.0 )/( XK7*(WATER/GAMA(4))**3.0 )
1228 30 FUNCB3A2p1= MOLAL(5)*MOLAL(3)**2.0
1229 FUNCB3A2p1= FUNCB3A2p1/(XK7*(WATER/GAMA(4))**3.0) - ONE
1230 RETURN
1231 !C
1232 !C *** END OF FUNCTION FUNCB3A ********************************************
1233 !C
1234 END
1238 !C=======================================================================
1239 !C
1240 !C *** ISORROPIA CODE
1241 !C *** SUBROUTINE CALCB3B
1242 !C *** CASE B3 ; SUBCASE 2
1243 !C
1244 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1245 !C 1. SULFATE RICH (1.0 < SULRAT < 2.0)
1246 !C 2. LIQUID PHASE ONLY IS POSSIBLE
1247 !C
1248 !C SPECIATION CALCULATIONS IS BASED ON THE HSO4 <--> SO4 EQUILIBRIUM.
1249 !C
1250 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1251 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1252 !C *** WRITTEN BY ATHANASIOS NENES
1253 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1254 !C
1255 !C=======================================================================
1256 !C
1257 SUBROUTINE CALCB3B2p1 (Y, X)
1258 INCLUDE 'module_isrpia_inc.F'
1259 DOUBLE PRECISION KK
1260 !C
1261 CALAOU = .FALSE. ! Outer loop activity calculation flag
1262 FRST = .FALSE.
1263 CALAIN = .TRUE.
1264 !C
1265 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
1266 !C
1267 DO 20 I=1,NSWEEP
1268 GRAT1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
1269 DD = SQRT( (GRAT1+Y)**2. + 4.0*(X+Y)*GRAT1)
1270 KK = 0.5*(-(GRAT1+Y) + DD )
1271 !C
1272 !C *** SPECIATION & WATER CONTENT ***************************************
1273 !C
1274 MOLAL (1) = KK ! HI
1275 MOLAL (5) = Y+KK ! SO4I
1276 MOLAL (6) = MAX (X+Y-KK, TINY) ! HSO4I
1277 MOLAL (3) = 3.0*Y+X ! NH4I
1278 CALL CALCMR2p1 ! Water content
1279 !C
1280 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
1281 !C
1282 IF (.NOT.CALAIN) GOTO 30
1283 CALL CALCACT2p1
1284 20 CONTINUE
1285 !C
1286 30 RETURN
1287 !C
1288 !C *** END OF SUBROUTINE CALCB3B ******************************************
1289 !C
1290 END
1291 !C=======================================================================
1292 !C
1293 !C *** ISORROPIA CODE
1294 !C *** SUBROUTINE CALCB2
1295 !C *** CASE B2
1296 !C
1297 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1298 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
1299 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
1300 !C 3. SOLIDS POSSIBLE : LC, (NH4)2SO4
1301 !C
1302 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON THE SULFATE RATIO:
1303 !C 1. WHEN BOTH LC AND (NH4)2SO4 ARE POSSIBLE (SUBROUTINE CALCB2A)
1304 !C 2. WHEN ONLY LC IS POSSIBLE (SUBROUTINE CALCB2B).
1305 !C
1306 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1307 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1308 !C *** WRITTEN BY ATHANASIOS NENES
1309 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1310 !C
1311 !C=======================================================================
1312 !C
1313 SUBROUTINE CALCB22p1
1314 INCLUDE 'module_isrpia_inc.F'
1315 !C
1316 !C *** CALCULATE EQUIVALENT AMOUNT OF HSO4 AND SO4 ***********************
1317 !C
1318 X = MAX(2*W(2)-W(3), TINY) ! Equivalent NH4HSO4
1319 Y = MAX(W(3) -W(2), TINY) ! Equivalent NH42SO4
1320 !C
1321 !C *** CALCULATE SPECIES ACCORDING TO RELATIVE ABUNDANCE OF HSO4 *********
1322 !C
1323 IF (X.LE.Y) THEN ! LC is the MIN (x,y)
1324 SCASE = 'B2 ; SUBCASE 1'
1325 CALL CALCB2A2p1 (X,Y-X) ! LC + (NH4)2SO4 POSSIBLE
1326 ELSE
1327 SCASE = 'B2 ; SUBCASE 2'
1328 CALL CALCB2B2p1 (Y,X-Y) ! LC ONLY POSSIBLE
1329 ENDIF
1330 !C
1331 RETURN
1332 !C
1333 !C *** END OF SUBROUTINE CALCB2 ******************************************
1334 !C
1335 END
1339 !C=======================================================================
1340 !C
1341 !C *** ISORROPIA CODE
1342 !C *** SUBROUTINE CALCB2
1343 !C *** CASE B2 ; SUBCASE A.
1344 !C
1345 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1346 !C 1. SULFATE RICH (1.0 < SULRAT < 2.0)
1347 !C 2. SOLID PHASE ONLY POSSIBLE
1348 !C 3. SOLIDS POSSIBLE: LC, (NH4)2SO4
1349 !C
1350 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
1351 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
1352 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE
1353 !C
1354 !C FOR SOLID CALCULATIONS, A MATERIAL BALANCE BASED ON THE STOICHIMETRIC
1355 !C PROPORTION OF AMMONIUM AND SULFATE IS DONE TO CALCULATE THE AMOUNT
1356 !C OF LC AND (NH4)2SO4 IN THE SOLID PHASE.
1357 !C
1358 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1359 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1360 !C *** WRITTEN BY ATHANASIOS NENES
1361 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1362 !C
1363 !C=======================================================================
1364 !C
1365 SUBROUTINE CALCB2A2p1 (TLC, TNH42S4)
1366 INCLUDE 'module_isrpia_inc.F'
1367 !C
1368 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
1369 !C
1370 IF (RH.LT.DRMLCAS) THEN
1371 SCASE = 'B2 ; SUBCASE A1' ! SOLIDS POSSIBLE ONLY
1372 CLC = TLC
1373 CNH42S4 = TNH42S4
1374 SCASE = 'B2 ; SUBCASE A1'
1375 ELSE
1376 SCASE = 'B2 ; SUBCASE A2'
1377 CALL CALCB2A22p1 (TLC, TNH42S4) ! LIQUID & SOLID PHASE POSSIBLE
1378 SCASE = 'B2 ; SUBCASE A2'
1379 ENDIF
1380 !C
1381 RETURN
1382 !C
1383 !C *** END OF SUBROUTINE CALCB2A *****************************************
1384 !C
1385 END
1389 !C=======================================================================
1390 !C
1391 !C *** ISORROPIA CODE
1392 !C *** SUBROUTINE CALCB2A2
1393 !C *** CASE B2 ; SUBCASE A2.
1394 !C
1395 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1396 !C 1. SULFATE RICH (1.0 < SULRAT < 2.0)
1397 !C 2. SOLID PHASE ONLY POSSIBLE
1398 !C 3. SOLIDS POSSIBLE: LC, (NH4)2SO4
1399 !C
1400 !C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
1401 !C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
1402 !C SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB2A1) AND THE
1403 !C THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB3).
1404 !C
1405 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1406 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1407 !C *** WRITTEN BY ATHANASIOS NENES
1408 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1409 !C
1410 !C=======================================================================
1411 !C
1412 SUBROUTINE CALCB2A22p1 (TLC, TNH42S4)
1413 INCLUDE 'module_isrpia_inc.F'
1414 !C
1415 !C *** FIND WEIGHT FACTOR **********************************************
1416 !C
1417 IF (WFTYP.EQ.0) THEN
1418 WF = ZERO
1419 ELSEIF (WFTYP.EQ.1) THEN
1420 WF = 0.5D0
1421 ELSE
1422 WF = (DRLC-RH)/(DRLC-DRMLCAS)
1423 ENDIF
1424 ONEMWF = ONE - WF
1425 !C
1426 !C *** FIND FIRST SECTION ; DRY ONE ************************************
1427 !C
1428 CLCO = TLC ! FIRST (DRY) SOLUTION
1429 CNH42SO = TNH42S4
1430 !C
1431 !C *** FIND SECOND SECTION ; DRY & LIQUID ******************************
1432 !C
1433 CLC = ZERO
1434 CNH42S4 = ZERO
1435 CALL CALCB32p1 ! SECOND (LIQUID) SOLUTION
1436 !C
1437 !C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
1438 !C
1439 MOLAL(1)= ONEMWF*MOLAL(1) ! H+
1440 MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + 3.D0*(CLCO-CLC)) ! NH4+
1441 MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4--
1442 MOLAL(6)= ONEMWF*(CLCO-CLC) ! HSO4-
1443 !C
1444 WATER = ONEMWF*WATER
1445 !C
1446 CLC = WF*CLCO + ONEMWF*CLC
1447 CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
1448 !C
1449 RETURN
1450 !C
1451 !C *** END OF SUBROUTINE CALCB2A2 ****************************************
1452 !C
1453 END
1457 !C=======================================================================
1458 !C
1459 !C *** ISORROPIA CODE
1460 !C *** SUBROUTINE CALCB2
1461 !C *** CASE B2 ; SUBCASE B
1462 !C
1463 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1464 !C 1. SULFATE RICH (1.0 < SULRAT < 2.0)
1465 !C 2. BOTH LIQUID & SOLID PHASE IS POSSIBLE
1466 !C 3. SOLIDS POSSIBLE: LC
1467 !C
1468 !C FOR CALCULATIONS, A BISECTION IS PERFORMED TOWARDS ZETA, THE
1469 !C AMOUNT OF SOLID LC DISSOLVED IN THE LIQUID PHASE.
1470 !C FOR EACH ESTIMATION OF ZETA, FUNCTION FUNCB2A CALCULATES THE
1471 !C AMOUNT OF H+ PRODUCED (BASED ON THE HSO4, SO4 RELEASED INTO THE
1472 !C SOLUTION). THE SOLUBILITY PRODUCT OF LC IS USED AS THE OBJECTIVE
1473 !C FUNCTION.
1474 !C
1475 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1476 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1477 !C *** WRITTEN BY ATHANASIOS NENES
1478 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1479 !C
1480 !C=======================================================================
1481 !C
1482 SUBROUTINE CALCB2B2p1 (TLC,TNH4HS4)
1483 INCLUDE 'module_isrpia_inc.F'
1484 !C
1485 CALAOU = .TRUE. ! Outer loop activity calculation flag
1486 ZLO = ZERO
1487 ZHI = TLC ! High limit: all of it in liquid phase
1488 !C
1489 !C *** INITIAL VALUES FOR BISECTION **************************************
1490 !C
1491 X1 = ZHI
1492 Y1 = FUNCB2B2p1 (X1,TNH4HS4,TLC)
1493 IF (ABS(Y1).LE.EPS) RETURN
1494 YHI= Y1 ! Save Y-value at Hi position
1495 !C
1496 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ************************
1497 !C
1498 DX = (ZHI-ZLO)/NDIV
1499 DO 10 I=1,NDIV
1500 X2 = X1-DX
1501 Y2 = FUNCB2B2p1 (X2,TNH4HS4,TLC)
1502 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
1503 X1 = X2
1504 Y1 = Y2
1505 10 CONTINUE
1506 !C
1507 !C *** NO SUBDIVISION WITH SOLUTION FOUND
1508 !C
1509 YLO= Y1 ! Save Y-value at LO position
1510 IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
1511 RETURN
1512 !C
1513 !C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC
1514 !C
1515 ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
1516 X1 = ZHI
1517 X2 = ZHI
1518 GOTO 40
1519 !C
1520 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
1521 !C
1522 ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
1523 X1 = ZLO
1524 X2 = ZLO
1525 GOTO 40
1526 ELSE
1527 CALL PUSHERR2p1 (0001, 'CALCB2B') ! WARNING ERROR: NO SOLUTION
1528 RETURN
1529 ENDIF
1530 !C
1531 !C *** PERFORM BISECTION *************************************************
1532 !C
1533 20 DO 30 I=1,MAXIT
1534 X3 = 0.5*(X1+X2)
1535 Y3 = FUNCB2B2p1 (X3,TNH4HS4,TLC)
1536 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
1537 Y2 = Y3
1538 X2 = X3
1539 ELSE
1540 Y1 = Y3
1541 X1 = X3
1542 ENDIF
1543 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
1544 30 CONTINUE
1545 CALL PUSHERR2p1 (0002, 'CALCB2B') ! WARNING ERROR: NO CONVERGENCE
1546 !C
1547 !C *** CONVERGED ; RETURN ************************************************
1548 !C
1549 40 X3 = 0.5*(X1+X2)
1550 Y3 = FUNCB2B2p1 (X3,TNH4HS4,TLC)
1551 !C
1552 RETURN
1553 !C
1554 !C *** END OF SUBROUTINE CALCB2B *****************************************
1555 !C
1556 END
1560 !C=======================================================================
1561 !C
1562 !C *** ISORROPIA CODE
1563 !C *** FUNCTION FUNCB2B
1564 !C *** CASE B2 ;
1565 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE B2 ; SUBCASE 2
1566 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCB2B.
1567 !C
1568 !C=======================================================================
1569 !C
1570 DOUBLE PRECISION FUNCTION FUNCB2B2p1 (X,TNH4HS4,TLC)
1571 INCLUDE 'module_isrpia_inc.F'
1572 !C
1573 !C *** SOLVE EQUATIONS **************************************************
1574 !C
1575 FRST = .TRUE.
1576 CALAIN = .TRUE.
1577 DO 20 I=1,NSWEEP
1578 GRAT2 = XK1*WATER*(GAMA(8)/GAMA(7))**2./GAMA(7)
1579 PARM = X+GRAT2
1580 DELTA = PARM*PARM + 4.0*(X+TNH4HS4)*GRAT2 ! Diakrinousa
1581 OMEGA = 0.5*(-PARM + SQRT(DELTA)) ! Thetiki riza (ie:H+>0)
1582 !C
1583 !C *** SPECIATION & WATER CONTENT ***************************************
1584 !C
1585 MOLAL (1) = OMEGA ! HI
1586 MOLAL (3) = 3.0*X+TNH4HS4 ! NH4I
1587 MOLAL (5) = X+OMEGA ! SO4I
1588 MOLAL (6) = MAX (X+TNH4HS4-OMEGA, TINY) ! HSO4I
1589 CLC = MAX(TLC-X,ZERO) ! Solid LC
1590 CALL CALCMR2p1 ! Water content
1591 !C
1592 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP ******************
1593 !C
1594 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
1595 CALL CALCACT2p1
1596 ELSE
1597 GOTO 30
1598 ENDIF
1599 20 CONTINUE
1600 !C
1601 !C *** CALCULATE OBJECTIVE FUNCTION **************************************
1602 !C
1603 !CCC30 FUNCB2B= ( NH4I**3.*SO4I*HSO4I )/( XK13*(WATER/GAMA(13))**5. )
1604 30 FUNCB2B2p1= (MOLAL(3)**3.)*MOLAL(5)*MOLAL(6)
1605 FUNCB2B2p1= FUNCB2B2p1/(XK13*(WATER/GAMA(13))**5.) - ONE
1606 RETURN
1607 !C
1608 !C *** END OF FUNCTION FUNCB2B *******************************************
1609 !C
1610 END
1613 !C=======================================================================
1614 !C
1615 !C *** ISORROPIA CODE
1616 !C *** SUBROUTINE CALCB1
1617 !C *** CASE B1
1618 !C
1619 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1620 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
1621 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
1622 !C 3. SOLIDS POSSIBLE : LC, (NH4)2SO4, NH4HSO4
1623 !C
1624 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
1625 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
1626 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCB1A)
1627 !C
1628 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1629 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1630 !C *** WRITTEN BY ATHANASIOS NENES
1631 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1632 !C
1633 !C=======================================================================
1634 !C
1635 SUBROUTINE CALCB12p1
1636 INCLUDE 'module_isrpia_inc.F'
1637 !C
1638 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
1639 !C
1640 IF (RH.LT.DRMLCAB) THEN
1641 SCASE = 'B1 ; SUBCASE 1'
1642 CALL CALCB1A2p1 ! SOLID PHASE ONLY POSSIBLE
1643 SCASE = 'B1 ; SUBCASE 1'
1644 ELSE
1645 SCASE = 'B1 ; SUBCASE 2'
1646 CALL CALCB1B2p1 ! LIQUID & SOLID PHASE POSSIBLE
1647 SCASE = 'B1 ; SUBCASE 2'
1648 ENDIF
1649 !C
1650 RETURN
1651 !C
1652 !C *** END OF SUBROUTINE CALCB1 ******************************************
1653 !C
1654 END
1658 !C=======================================================================
1659 !C
1660 !C *** ISORROPIA CODE
1661 !C *** SUBROUTINE CALCB1A
1662 !C *** CASE B1 ; SUBCASE 1
1663 !C
1664 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1665 !C 1. SULFATE RICH
1666 !C 2. THERE IS NO LIQUID PHASE
1667 !C 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO
1668 !C BUT NOT BOTH)
1669 !C
1670 !C A SIMPLE MATERIAL BALANCE IS PERFORMED, AND THE AMOUNT OF LC
1671 !C IS CALCULATED FROM THE (NH4)2SO4 AND NH4HSO4 WHICH IS LEAST
1672 !C ABUNDANT (STOICHIMETRICALLY). THE REMAINING EXCESS OF SALT
1673 !C IS MIXED WITH THE LC.
1674 !C
1675 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1676 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1677 !C *** WRITTEN BY ATHANASIOS NENES
1678 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1679 !C
1680 !C=======================================================================
1681 !C
1682 SUBROUTINE CALCB1A2p1
1683 INCLUDE 'module_isrpia_inc.F'
1684 !C
1685 !C *** SETUP PARAMETERS ************************************************
1686 !C
1687 X = 2*W(2)-W(3) ! Equivalent NH4HSO4
1688 Y = W(3)-W(2) ! Equivalent (NH4)2SO4
1689 !C
1690 !C *** CALCULATE COMPOSITION *******************************************
1691 !C
1692 IF (X.LE.Y) THEN ! LC is the MIN (x,y)
1693 CLC = X ! NH4HSO4 >= (NH4)2S04
1694 CNH4HS4 = ZERO
1695 CNH42S4 = Y-X
1696 ELSE
1697 CLC = Y ! NH4HSO4 < (NH4)2S04
1698 CNH4HS4 = X-Y
1699 CNH42S4 = ZERO
1700 ENDIF
1701 RETURN
1702 !C
1703 !C *** END OF SUBROUTINE CALCB1 ******************************************
1704 !C
1705 END
1710 !C=======================================================================
1711 !C
1712 !C *** ISORROPIA CODE
1713 !C *** SUBROUTINE CALCB1B
1714 !C *** CASE B1 ; SUBCASE 2
1715 !C
1716 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1717 !C 1. SULFATE RICH
1718 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
1719 !C 3. SOLIDS POSSIBLE: LC, { (NH4)2SO4 XOR NH4HSO4 } (ONE OF TWO
1720 !C BUT NOT BOTH)
1721 !C
1722 !C THIS IS THE CASE WHERE THE RELATIVE HUMIDITY IS IN THE MUTUAL
1723 !C DRH REGION. THE SOLUTION IS ASSUMED TO BE THE SUM OF TWO WEIGHTED
1724 !C SOLUTIONS ; THE SOLID PHASE ONLY (SUBROUTINE CALCB1A) AND THE
1725 !C THE SOLID WITH LIQUID PHASE (SUBROUTINE CALCB2).
1726 !C
1727 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1728 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1729 !C *** WRITTEN BY ATHANASIOS NENES
1730 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1731 !C
1732 !C=======================================================================
1733 !C
1734 SUBROUTINE CALCB1B2p1
1735 INCLUDE 'module_isrpia_inc.F'
1736 !C
1737 !C *** FIND WEIGHT FACTOR **********************************************
1738 !C
1739 IF (WFTYP.EQ.0) THEN
1740 WF = ZERO
1741 ELSEIF (WFTYP.EQ.1) THEN
1742 WF = 0.5D0
1743 ELSE
1744 WF = (DRNH4HS4-RH)/(DRNH4HS4-DRMLCAB)
1745 ENDIF
1746 ONEMWF = ONE - WF
1747 !C
1748 !C *** FIND FIRST SECTION ; DRY ONE ************************************
1749 !C
1750 CALL CALCB1A2p1
1751 CLCO = CLC ! FIRST (DRY) SOLUTION
1752 CNH42SO = CNH42S4
1753 CNH4HSO = CNH4HS4
1754 !C
1755 !C *** FIND SECOND SECTION ; DRY & LIQUID ******************************
1756 !C
1757 CLC = ZERO
1758 CNH42S4 = ZERO
1759 CNH4HS4 = ZERO
1760 CALL CALCB22p1 ! SECOND (LIQUID) SOLUTION
1761 !C
1762 !C *** FIND SOLUTION AT MDRH BY WEIGHTING DRY & LIQUID SOLUTIONS.
1763 !C
1764 MOLAL(1)= ONEMWF*MOLAL(1) ! H+
1765 MOLAL(3)= ONEMWF*(2.D0*(CNH42SO-CNH42S4) + (CNH4HSO-CNH4HS4) &
1766 + 3.D0*(CLCO-CLC)) ! NH4+
1767 MOLAL(5)= ONEMWF*(CNH42SO-CNH42S4 + CLCO-CLC) ! SO4--
1768 MOLAL(6)= ONEMWF*(CNH4HSO-CNH4HS4 + CLCO-CLC) ! HSO4-
1769 !C
1770 WATER = ONEMWF*WATER
1771 !C
1772 CLC = WF*CLCO + ONEMWF*CLC
1773 CNH42S4 = WF*CNH42SO + ONEMWF*CNH42S4
1774 CNH4HS4 = WF*CNH4HSO + ONEMWF*CNH4HS4
1775 !C
1776 RETURN
1777 !C
1778 !C *** END OF SUBROUTINE CALCB1B *****************************************
1779 !C
1780 END
1783 !C=======================================================================
1784 !C
1785 !C *** ISORROPIA CODE
1786 !C *** SUBROUTINE CALCC2
1787 !C *** CASE C2
1788 !C
1789 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1790 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
1791 !C 2. THERE IS ONLY A LIQUID PHASE
1792 !C
1793 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1794 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1795 !C *** WRITTEN BY ATHANASIOS NENES
1796 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1797 !C
1798 !C=======================================================================
1799 !C
1800 SUBROUTINE CALCC22p1
1801 INCLUDE 'module_isrpia_inc.F'
1802 DOUBLE PRECISION LAMDA, KAPA
1803 !C
1804 CALAOU =.TRUE. ! Outer loop activity calculation flag
1805 FRST =.TRUE.
1806 CALAIN =.TRUE.
1807 !C
1808 !C *** SOLVE EQUATIONS **************************************************
1809 !C
1810 LAMDA = W(3) ! NH4HSO4 INITIALLY IN SOLUTION
1811 PSI = W(2)-W(3) ! H2SO4 IN SOLUTION
1812 DO 20 I=1,NSWEEP
1813 PARM = WATER*XK1/GAMA(7)*(GAMA(8)/GAMA(7))**2.
1814 BB = PSI+PARM
1815 CC =-PARM*(LAMDA+PSI)
1816 KAPA = 0.5*(-BB+SQRT(BB*BB-4.0*CC))
1817 !C
1818 !C *** SPECIATION & WATER CONTENT ***************************************
1819 !C
1820 MOLAL(1) = PSI+KAPA ! HI
1821 MOLAL(3) = LAMDA ! NH4I
1822 MOLAL(5) = KAPA ! SO4I
1823 MOLAL(6) = MAX(LAMDA+PSI-KAPA, TINY) ! HSO4I
1824 CH2SO4 = MAX(MOLAL(5)+MOLAL(6)-MOLAL(3), ZERO) ! Free H2SO4
1825 CALL CALCMR2p1 ! Water content
1826 !C
1827 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
1828 !C
1829 IF (.NOT.CALAIN) GOTO 30
1830 CALL CALCACT2p1
1831 20 CONTINUE
1832 !C
1833 30 RETURN
1834 !C
1835 !C *** END OF SUBROUTINE CALCC2 *****************************************
1836 !C
1837 END
1841 !C=======================================================================
1842 !C
1843 !C *** ISORROPIA CODE
1844 !C *** SUBROUTINE CALCC1
1845 !C *** CASE C1
1846 !C
1847 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
1848 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
1849 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
1850 !C 3. SOLIDS POSSIBLE: NH4HSO4
1851 !C
1852 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1853 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1854 !C *** WRITTEN BY ATHANASIOS NENES
1855 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1856 !C
1857 !C=======================================================================
1858 !C
1859 SUBROUTINE CALCC12p1
1860 INCLUDE 'module_isrpia_inc.F'
1861 DOUBLE PRECISION KLO, KHI
1862 !C
1863 CALAOU = .TRUE. ! Outer loop activity calculation flag
1864 KLO = TINY
1865 KHI = W(3)
1866 !C
1867 !C *** INITIAL VALUES FOR BISECTION *************************************
1868 !C
1869 X1 = KLO
1870 Y1 = FUNCC12p1 (X1)
1871 IF (ABS(Y1).LE.EPS) GOTO 50
1872 YLO= Y1
1873 !C
1874 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
1875 !C
1876 DX = (KHI-KLO)/FLOAT(NDIV)
1877 DO 10 I=1,NDIV
1878 X2 = X1+DX
1879 Y2 = FUNCC12p1 (X2)
1880 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2) .LT. ZERO) GOTO 20 ! (Y1*Y2 .LT. ZERO)
1881 X1 = X2
1882 Y1 = Y2
1883 10 CONTINUE
1884 !C
1885 !C *** NO SUBDIVISION WITH SOLUTION FOUND
1886 !C
1887 YHI= Y2 ! Save Y-value at HI position
1888 IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
1889 GOTO 50
1890 !C
1891 !C *** { YLO, YHI } < 0.0 SOLUTION IS ALWAYS UNDERSATURATED WITH NH4HS04
1892 !C
1893 ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
1894 GOTO 50
1895 !C
1896 !C *** { YLO, YHI } > 0.0 SOLUTION IS ALWAYS SUPERSATURATED WITH NH4HS04
1897 !C
1898 ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
1899 X1 = KLO
1900 X2 = KLO
1901 GOTO 40
1902 ELSE
1903 CALL PUSHERR2p1 (0001, 'CALCC1') ! WARNING ERROR: NO SOLUTION
1904 GOTO 50
1905 ENDIF
1906 !C
1907 !C *** PERFORM BISECTION OF DISSOLVED NH4HSO4 **************************
1908 !C
1909 20 DO 30 I=1,MAXIT
1910 X3 = 0.5*(X1+X2)
1911 Y3 = FUNCC12p1 (X3)
1912 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
1913 Y2 = Y3
1914 X2 = X3
1915 ELSE
1916 Y1 = Y3
1917 X1 = X3
1918 ENDIF
1919 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
1920 30 CONTINUE
1921 CALL PUSHERR2p1 (0002, 'CALCC1') ! WARNING ERROR: NO CONVERGENCE
1922 !C
1923 !C *** CONVERGED ; RETURN ***********************************************
1924 !C
1925 40 X3 = 0.5*(X1+X2)
1926 Y3 = FUNCC12p1 (X3)
1927 !C
1928 50 RETURN
1929 !C
1930 !C *** END OF SUBROUTINE CALCC1 *****************************************
1931 !C
1932 END
1936 !C=======================================================================
1937 !C
1938 !C *** ISORROPIA CODE
1939 !C *** FUNCTION FUNCC1
1940 !C *** CASE C1 ;
1941 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE C1
1942 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCC1.
1943 !C
1944 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
1945 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
1946 !C *** WRITTEN BY ATHANASIOS NENES
1947 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
1948 !C
1949 !C=======================================================================
1950 !C
1951 DOUBLE PRECISION FUNCTION FUNCC12p1 (KAPA)
1952 INCLUDE 'module_isrpia_inc.F'
1953 DOUBLE PRECISION KAPA, LAMDA
1954 !C
1955 !C *** SOLVE EQUATIONS **************************************************
1956 !C
1957 FRST = .TRUE.
1958 CALAIN = .TRUE.
1959 !C
1960 PSI = W(2)-W(3)
1961 DO 20 I=1,NSWEEP
1962 PAR1 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
1963 PAR2 = XK12*(WATER/GAMA(9))**2.0
1964 BB = PSI + PAR1
1965 CC =-PAR1*(PSI+KAPA)
1966 LAMDA = 0.5*(-BB+SQRT(BB*BB-4*CC))
1967 !C
1968 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY *******************************
1969 !C
1970 MOLAL(1) = PSI+LAMDA ! HI
1971 MOLAL(3) = KAPA ! NH4I
1972 MOLAL(5) = LAMDA ! SO4I
1973 MOLAL(6) = MAX (ZERO, PSI+KAPA-LAMDA) ! HSO4I
1974 CNH4HS4 = MAX(W(3)-MOLAL(3), ZERO) ! Solid NH4HSO4
1975 CH2SO4 = MAX(PSI, ZERO) ! Free H2SO4
1976 CALL CALCMR2p1 ! Water content
1977 !C
1978 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
1979 !C
1980 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
1981 CALL CALCACT2p1
1982 ELSE
1983 GOTO 30
1984 ENDIF
1985 20 CONTINUE
1986 !C
1987 !C *** CALCULATE ZERO FUNCTION *******************************************
1988 !C
1989 !CCC30 FUNCC1= (NH4I*HSO4I/PAR2) - ONE
1990 30 FUNCC12p1= (MOLAL(3)*MOLAL(6)/PAR2) - ONE
1991 RETURN
1992 !C
1993 !C *** END OF FUNCTION FUNCC1 ********************************************
1994 !C
1995 END
1997 !C=======================================================================
1998 !C
1999 !C *** ISORROPIA CODE
2000 !C *** SUBROUTINE CALCD3
2001 !C *** CASE D3
2002 !C
2003 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2004 !C 1. SULFATE POOR (SULRAT > 2.0)
2005 !C 2. THERE IS OLNY A LIQUID PHASE
2006 !C
2007 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2008 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2009 !C *** WRITTEN BY ATHANASIOS NENES
2010 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2011 !C
2012 !C=======================================================================
2013 !C
2014 SUBROUTINE CALCD32p1
2015 INCLUDE 'module_isrpia_inc.F'
2016 !C
2017 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
2018 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
2019 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
2020 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
2021 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6,&
2022 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
2023 !C
2024 !C *** FIND DRY COMPOSITION **********************************************
2025 !C
2026 CALL CALCD1A2p1
2027 !C
2028 !C *** SETUP PARAMETERS ************************************************
2029 !C
2030 CHI1 = CNH4NO3 ! Save from CALCD1 run
2031 CHI2 = CNH42S4
2032 CHI3 = GHNO3
2033 CHI4 = GNH3
2034 !C
2035 PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's
2036 PSI2 = CHI2
2037 PSI3 = ZERO
2038 PSI4 = ZERO
2039 !C
2040 MOLAL(5) = ZERO
2041 MOLAL(6) = ZERO
2042 MOLAL(3) = PSI1
2043 MOLAL(7) = PSI1
2044 CALL CALCMR2p1 ! Initial water
2045 !C
2046 CALAOU = .TRUE. ! Outer loop activity calculation flag
2047 PSI4LO = TINY ! Low limit
2048 PSI4HI = CHI4 ! High limit
2049 !C
2050 !C *** INITIAL VALUES FOR BISECTION ************************************
2051 !C
2052 60 X1 = PSI4LO
2053 Y1 = FUNCD32p1 (X1)
2054 IF (ABS(Y1).LE.EPS) RETURN
2055 YLO= Y1 ! Save Y-value at HI position
2056 !C
2057 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
2058 !C
2059 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
2060 DO 10 I=1,NDIV
2061 X2 = X1+DX
2062 Y2 = FUNCD32p1 (X2)
2063 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
2064 X1 = X2
2065 Y1 = Y2
2066 10 CONTINUE
2067 !C
2068 !C *** NO SUBDIVISION WITH SOLUTION FOUND
2069 !C
2070 YHI= Y1 ! Save Y-value at Hi position
2071 IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
2072 RETURN
2073 !C
2074 !C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3
2075 !C Physically I dont know when this might happen, but I have put this
2076 !C branch in for completeness. I assume there is no solution; all NO3 goes to the
2077 !C gas phase.
2078 !C
2079 ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
2080 P4 = TINY ! PSI4LO ! CHI4
2081 YY = FUNCD32p1(P4)
2082 GOTO 50
2083 !C
2084 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3
2085 !C This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates
2086 !C and goes to the gas phase ; so I redefine the LO and HI limits of PSI4
2087 !C and proceed again with root tracking.
2088 !C
2089 ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
2090 PSI4HI = PSI4LO
2091 PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates
2092 IF (PSI4LO.LT.-(PSI1+PSI2)) THEN
2093 CALL PUSHERR2p1 (0001, 'CALCD3') ! WARNING ERROR: NO SOLUTION
2094 RETURN
2095 ELSE
2096 MOLAL(5) = ZERO
2097 MOLAL(6) = ZERO
2098 MOLAL(3) = PSI1
2099 MOLAL(7) = PSI1
2100 CALL CALCMR2p1 ! Initial water
2101 GOTO 60 ! Redo root tracking
2102 ENDIF
2103 ENDIF
2104 !C
2105 !C *** PERFORM BISECTION ***********************************************
2106 !C
2107 20 DO 30 I=1,MAXIT
2108 X3 = 0.5*(X1+X2)
2109 Y3 = FUNCD32p1 (X3)
2110 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
2111 Y2 = Y3
2112 X2 = X3
2113 ELSE
2114 Y1 = Y3
2115 X1 = X3
2116 ENDIF
2117 IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40
2118 30 CONTINUE
2119 CALL PUSHERR2p1 (0002, 'CALCD3') ! WARNING ERROR: NO CONVERGENCE
2120 !C
2121 !C *** CONVERGED ; RETURN **********************************************
2122 !C
2123 40 X3 = 0.5*(X1+X2)
2124 Y3 = FUNCD32p1 (X3)
2125 !C
2126 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
2127 !C
2128 50 CONTINUE
2129 IF (MOLAL(1).GT.TINY) THEN
2130 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
2131 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
2132 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
2133 MOLAL(6) = DELTA ! HSO4 EFFECT
2134 ENDIF
2135 RETURN
2136 !C
2137 !C *** END OF SUBROUTINE CALCD3 ******************************************
2138 !C
2139 END
2143 !C=======================================================================
2144 !C
2145 !C *** ISORROPIA CODE
2146 !C *** FUNCTION FUNCD3
2147 !C *** CASE D3
2148 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D3 ;
2149 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD3.
2150 !C
2151 !C=======================================================================
2152 !C
2153 DOUBLE PRECISION FUNCTION FUNCD32p1 (P4)
2154 INCLUDE 'module_isrpia_inc.F'
2155 !C
2156 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
2157 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
2158 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
2159 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
2160 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6,&
2161 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
2162 !C
2163 !C *** SETUP PARAMETERS ************************************************
2164 !C
2165 FRST = .TRUE.
2166 CALAIN = .TRUE.
2167 PSI4 = P4
2168 !C
2169 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
2170 !C
2171 DO 10 I=1,NSWEEP
2172 A2 = XK7*(WATER/GAMA(4))**3.0
2173 A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0
2174 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2175 A7 = XKW *RH*WATER*WATER
2176 !C
2177 PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4)
2178 PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4)
2179 PSI3 = MIN(MAX(PSI3, ZERO), CHI3)
2180 !C
2181 BB = PSI4 - PSI3
2182 !CCCOLD AHI = 0.5*(-BB + SQRT(BB*BB + 4.d0*A7)) ! This is correct also
2183 !CCC AHI =2.0*A7/(BB+SQRT(BB*BB + 4.d0*A7)) ! Avoid overflow when HI->0
2184 DENM = BB+SQRT(BB*BB + 4.d0*A7)
2185 IF (DENM.LE.TINY) THEN ! Avoid overflow when HI->0
2186 ABB = ABS(BB)
2187 DENM = (BB+ABB) + 2.0*A7/ABB ! Taylor expansion of SQRT
2188 ENDIF
2189 AHI = 2.0*A7/DENM
2190 !C
2191 !C *** SPECIATION & WATER CONTENT ***************************************
2192 !C
2193 MOLAL (1) = AHI ! HI
2194 MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4I
2195 MOLAL (5) = PSI2 ! SO4I
2196 MOLAL (6) = ZERO ! HSO4I
2197 MOLAL (7) = PSI3 + PSI1 ! NO3I
2198 CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4
2199 CNH4NO3 = ZERO ! Solid NH4NO3
2200 GHNO3 = CHI3 - PSI3 ! Gas HNO3
2201 GNH3 = CHI4 - PSI4 ! Gas NH3
2202 CALL CALCMR2p1 ! Water content
2203 !C
2204 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
2205 !C
2206 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
2207 CALL CALCACT2p1
2208 ELSE
2209 GOTO 20
2210 ENDIF
2211 10 CONTINUE
2212 !C
2213 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
2214 !C
2215 20 CONTINUE
2216 !CCC FUNCD3= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE
2217 FUNCD32p1= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE
2218 RETURN
2219 !C
2220 !C *** END OF FUNCTION FUNCD3 ********************************************
2221 !C
2222 END
2223 !C=======================================================================
2224 !C
2225 !C *** ISORROPIA CODE
2226 !C *** SUBROUTINE CALCD2
2227 !C *** CASE D2
2228 !C
2229 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2230 !C 1. SULFATE POOR (SULRAT > 2.0)
2231 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
2232 !C 3. SOLIDS POSSIBLE : (NH4)2SO4
2233 !C
2234 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2235 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2236 !C *** WRITTEN BY ATHANASIOS NENES
2237 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2238 !C
2239 !C=======================================================================
2240 !C
2241 SUBROUTINE CALCD22p1
2242 INCLUDE 'module_isrpia_inc.F'
2243 !C
2244 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
2245 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
2246 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
2247 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
2248 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
2249 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
2250 !C
2251 !C *** FIND DRY COMPOSITION **********************************************
2252 !C
2253 CALL CALCD1A2p1
2254 !C
2255 !C *** SETUP PARAMETERS ************************************************
2256 !C
2257 CHI1 = CNH4NO3 ! Save from CALCD1 run
2258 CHI2 = CNH42S4
2259 CHI3 = GHNO3
2260 CHI4 = GNH3
2261 !C
2262 PSI1 = CNH4NO3 ! ASSIGN INITIAL PSI's
2263 PSI2 = CNH42S4
2264 PSI3 = ZERO
2265 PSI4 = ZERO
2266 !C
2267 MOLAL(5) = ZERO
2268 MOLAL(6) = ZERO
2269 MOLAL(3) = PSI1
2270 MOLAL(7) = PSI1
2271 CALL CALCMR2p1 ! Initial water
2272 !C
2273 CALAOU = .TRUE. ! Outer loop activity calculation flag
2274 PSI4LO = TINY ! Low limit
2275 PSI4HI = CHI4 ! High limit
2276 !C
2277 !C *** INITIAL VALUES FOR BISECTION ************************************
2278 !C
2279 60 X1 = PSI4LO
2280 Y1 = FUNCD22p1 (X1)
2281 IF (ABS(Y1).LE.EPS) RETURN
2282 YLO= Y1 ! Save Y-value at HI position
2283 !C
2284 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
2285 !C
2286 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
2287 DO 10 I=1,NDIV
2288 X2 = X1+DX
2289 Y2 = FUNCD22p1 (X2)
2290 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) THEN
2291 !C
2292 !C This is done, in case if Y(PSI4LO)>0, but Y(PSI4LO+DX) < 0 (i.e.undersat)
2293 !C
2294 IF (Y1 .LE. Y2) GOTO 20 ! (Y1*Y2.LT.ZERO)
2295 ENDIF
2296 X1 = X2
2297 Y1 = Y2
2298 10 CONTINUE
2299 !C
2300 !C *** NO SUBDIVISION WITH SOLUTION FOUND
2301 !C
2302 YHI= Y1 ! Save Y-value at Hi position
2303 IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
2304 RETURN
2305 !C
2306 !C *** { YLO, YHI } < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH3
2307 !C Physically I dont know when this might happen, but I have put this
2308 !C branch in for completeness. I assume there is no solution; all NO3 goes to the
2309 !C gas phase.
2310 !C
2311 ELSE IF (YLO.LT.ZERO .AND. YHI.LT.ZERO) THEN
2312 P4 = TINY ! PSI4LO ! CHI4
2313 YY = FUNCD22p1(P4)
2314 GOTO 50
2315 !C
2316 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH3
2317 !C This happens when Sul.Rat. = 2.0, so some NH4+ from sulfate evaporates
2318 !C and goes to the gas phase ; so I redefine the LO and HI limits of PSI4
2319 !C and proceed again with root tracking.
2320 !C
2321 ELSE IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
2322 PSI4HI = PSI4LO
2323 PSI4LO = PSI4LO - 0.1*(PSI1+PSI2) ! No solution; some NH3 evaporates
2324 IF (PSI4LO.LT.-(PSI1+PSI2)) THEN
2325 CALL PUSHERR2p1 (0001, 'CALCD2') ! WARNING ERROR: NO SOLUTION
2326 RETURN
2327 ELSE
2328 MOLAL(5) = ZERO
2329 MOLAL(6) = ZERO
2330 MOLAL(3) = PSI1
2331 MOLAL(7) = PSI1
2332 CALL CALCMR2p1 ! Initial water
2333 GOTO 60 ! Redo root tracking
2334 ENDIF
2335 ENDIF
2336 !C
2337 !C *** PERFORM BISECTION ***********************************************
2338 !C
2339 20 DO 30 I=1,MAXIT
2340 X3 = 0.5*(X1+X2)
2341 Y3 = FUNCD22p1 (X3)
2342 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
2343 Y2 = Y3
2344 X2 = X3
2345 ELSE
2346 Y1 = Y3
2347 X1 = X3
2348 ENDIF
2349 IF (ABS(X2-X1) .LE. EPS*ABS(X1)) GOTO 40
2350 30 CONTINUE
2351 CALL PUSHERR2p1 (0002, 'CALCD2') ! WARNING ERROR: NO CONVERGENCE
2352 !C
2353 !C *** CONVERGED ; RETURN **********************************************
2354 !C
2355 40 X3 = MIN(X1,X2) ! 0.5*(X1+X2) ! Get "low" side, it's acidic soln.
2356 Y3 = FUNCD22p1 (X3)
2357 !C
2358 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
2359 !C
2360 50 CONTINUE
2361 IF (MOLAL(1).GT.TINY) THEN
2362 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
2363 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
2364 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
2365 MOLAL(6) = DELTA ! HSO4 EFFECT
2366 ENDIF
2367 RETURN
2368 !C
2369 !C *** END OF SUBROUTINE CALCD2 ******************************************
2370 !C
2371 END
2375 !C=======================================================================
2376 !C
2377 !C *** ISORROPIA CODE
2378 !C *** FUNCTION FUNCD2
2379 !C *** CASE D2
2380 !C FUNCTION THAT SOLVES THE SYSTEM OF EQUATIONS FOR CASE D2 ;
2381 !C AND RETURNS THE VALUE OF THE ZEROED FUNCTION IN FUNCD2.
2382 !C
2383 !C=======================================================================
2384 !C
2385 DOUBLE PRECISION FUNCTION FUNCD22p1 (P4)
2386 INCLUDE 'module_isrpia_inc.F'
2387 !C
2388 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
2389 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
2390 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
2391 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
2392 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
2393 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
2394 !C
2395 !C *** SETUP PARAMETERS ************************************************
2396 !C
2397 CALL RSTGAM2p1 ! Reset activity coefficients to 0.1
2398 FRST = .TRUE.
2399 CALAIN = .TRUE.
2400 PSI4 = P4
2401 PSI2 = CHI2
2402 !C
2403 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
2404 !C
2405 DO 10 I=1,NSWEEP
2406 A2 = XK7*(WATER/GAMA(4))**3.0
2407 A3 = XK4*R*TEMP*(WATER/GAMA(10))**2.0
2408 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2409 A7 = XKW *RH*WATER*WATER
2410 !C
2411 IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
2412 PSI14 = PSI1+PSI4
2413 CALL POLY32p1 (PSI14,0.25*PSI14**2.,-A2/4.D0, PSI2, ISLV) ! PSI2
2414 IF (ISLV.EQ.0) THEN
2415 PSI2 = MIN (PSI2, CHI2)
2416 ELSE
2417 PSI2 = TINY
2418 ENDIF
2419 ENDIF
2420 !C
2421 PSI3 = A3*A4*CHI3*(CHI4-PSI4) - PSI1*(2.D0*PSI2+PSI1+PSI4)
2422 PSI3 = PSI3/(A3*A4*(CHI4-PSI4) + 2.D0*PSI2+PSI1+PSI4)
2423 !ccc PSI3 = MIN(MAX(PSI3, ZERO), CHI3)
2424 !C
2425 BB = PSI4-PSI3 ! (BB > 0, acidic solution, <0 alkaline)
2426 !C
2427 !C Do not change computation scheme for H+, all others did not work well.
2428 !C
2429 DENM = BB+SQRT(BB*BB + 4.d0*A7)
2430 IF (DENM.LE.TINY) THEN ! Avoid overflow when HI->0
2431 ABB = ABS(BB)
2432 DENM = (BB+ABB) + 2.d0*A7/ABB ! Taylor expansion of SQRT
2433 ENDIF
2434 AHI = 2.d0*A7/DENM
2435 !C
2436 !C *** SPECIATION & WATER CONTENT ***************************************
2437 !C
2438 MOLAL (1) = AHI ! HI
2439 MOLAL (3) = PSI1 + PSI4 + 2.D0*PSI2 ! NH4
2440 MOLAL (5) = PSI2 ! SO4
2441 MOLAL (6) = ZERO ! HSO4
2442 MOLAL (7) = PSI3 + PSI1 ! NO3
2443 CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4
2444 CNH4NO3 = ZERO ! Solid NH4NO3
2445 GHNO3 = CHI3 - PSI3 ! Gas HNO3
2446 GNH3 = CHI4 - PSI4 ! Gas NH3
2447 CALL CALCMR2p1 ! Water content
2448 !C
2449 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
2450 !C
2451 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
2452 CALL CALCACT2p1
2453 ELSE
2454 GOTO 20
2455 ENDIF
2456 10 CONTINUE
2457 !C
2458 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
2459 !C
2460 20 CONTINUE
2461 !CCC FUNCD2= NH4I/HI/MAX(GNH3,TINY)/A4 - ONE
2462 FUNCD22p1= MOLAL(3)/MOLAL(1)/MAX(GNH3,TINY)/A4 - ONE
2463 RETURN
2464 !C
2465 !C *** END OF FUNCTION FUNCD2 ********************************************
2466 !C
2467 END
2468 !C=======================================================================
2469 !C
2470 !C *** ISORROPIA CODE
2471 !C *** SUBROUTINE CALCD1
2472 !C *** CASE D1
2473 !C
2474 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2475 !C 1. SULFATE POOR (SULRAT > 2.0)
2476 !C 2. SOLID AEROSOL ONLY
2477 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
2478 !C
2479 !C THERE ARE TWO REGIMES DEFINED BY RELATIVE HUMIDITY:
2480 !C 1. RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCD1A)
2481 !C 2. RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
2482 !C
2483 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2484 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2485 !C *** WRITTEN BY ATHANASIOS NENES
2486 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2487 !C
2488 !C=======================================================================
2489 !C
2490 SUBROUTINE CALCD12p1
2491 INCLUDE 'module_isrpia_inc.F'
2492 EXTERNAL CALCD1A2p1, CALCD22p1
2493 !C
2494 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
2495 !C
2496 IF (RH.LT.DRMASAN) THEN
2497 SCASE = 'D1 ; SUBCASE 1' ! SOLID PHASE ONLY POSSIBLE
2498 CALL CALCD1A2p1
2499 SCASE = 'D1 ; SUBCASE 1'
2500 ELSE
2501 SCASE = 'D1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
2502 CALL CALCMDRH2p1 (RH, DRMASAN, DRNH4NO3, CALCD1A2p1, CALCD22p1)
2503 SCASE = 'D1 ; SUBCASE 2'
2504 ENDIF
2505 !C
2506 RETURN
2507 !C
2508 !C *** END OF SUBROUTINE CALCD1 ******************************************
2509 !C
2510 END
2513 !C=======================================================================
2514 !C
2515 !C *** ISORROPIA CODE
2516 !C *** SUBROUTINE CALCD1A
2517 !C *** CASE D1 ; SUBCASE 1
2518 !C
2519 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2520 !C 1. SULFATE POOR (SULRAT > 2.0)
2521 !C 2. SOLID AEROSOL ONLY
2522 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
2523 !C
2524 !C THE SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3
2525 !C IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF
2526 !C NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN
2527 !C THE SOLID PHASE.
2528 !C
2529 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2530 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2531 !C *** WRITTEN BY ATHANASIOS NENES
2532 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2533 !C
2534 !C=======================================================================
2535 !C
2536 SUBROUTINE CALCD1A2p1
2537 INCLUDE 'module_isrpia_inc.F'
2538 !C
2539 !C *** SETUP PARAMETERS ************************************************
2540 !C
2541 PARM = XK10/(R*TEMP)/(R*TEMP)
2542 !C
2543 !C *** CALCULATE NH4NO3 THAT VOLATIZES *********************************
2544 !C
2545 CNH42S4 = W(2)
2546 X = MAX(ZERO, MIN(W(3)-2.0*CNH42S4, W(4))) ! MAX NH4NO3
2547 PS = MAX(W(3) - X - 2.0*CNH42S4, ZERO)
2548 OM = MAX(W(4) - X, ZERO)
2549 !C
2550 OMPS = OM+PS
2551 DIAK = SQRT(OMPS*OMPS + 4.0*PARM) ! DIAKRINOUSA
2552 ZE = MIN(X, 0.5*(-OMPS + DIAK)) ! THETIKI RIZA
2553 !C
2554 !C *** SPECIATION *******************************************************
2555 !C
2556 CNH4NO3 = X - ZE ! Solid NH4NO3
2557 GNH3 = PS + ZE ! Gas NH3
2558 GHNO3 = OM + ZE ! Gas HNO3
2559 !C
2560 RETURN
2561 !C
2562 !C *** END OF SUBROUTINE CALCD1A *****************************************
2563 !C
2564 END
2565 !C=======================================================================
2566 !C
2567 !C *** ISORROPIA CODE
2568 !C *** SUBROUTINE CALCG5
2569 !C *** CASE G5
2570 !C
2571 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2572 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
2573 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
2574 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
2575 !C
2576 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2577 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2578 !C *** WRITTEN BY ATHANASIOS NENES
2579 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2580 !C
2581 !C=======================================================================
2582 !C
2583 SUBROUTINE CALCG52p1
2584 INCLUDE 'module_isrpia_inc.F'
2585 !C
2586 DOUBLE PRECISION LAMDA
2587 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
2588 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
2589 A1, A2, A3, A4, A5, A6, A7
2590 !C
2591 !C *** SETUP PARAMETERS ************************************************
2592 !C
2593 CALAOU = .TRUE.
2594 CHI1 = 0.5*W(1)
2595 CHI2 = MAX (W(2)-CHI1, ZERO)
2596 CHI3 = ZERO
2597 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
2598 CHI5 = W(4)
2599 CHI6 = W(5)
2600 !C
2601 PSI1 = CHI1
2602 PSI2 = CHI2
2603 PSI6LO = TINY
2604 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
2605 !C
2606 WATER = CHI2/M0(4) + CHI1/M0(2)
2607 !C
2608 !C *** INITIAL VALUES FOR BISECTION ************************************
2609 !C
2610 X1 = PSI6LO
2611 Y1 = FUNCG5A2p1 (X1)
2612 IF (CHI6.LE.TINY) GOTO 50
2613 !ccc IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
2614 !ccc IF (WATER .LE. TINY) RETURN ! No water
2615 !C
2616 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
2617 !C
2618 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
2619 DO 10 I=1,NDIV
2620 X2 = X1+DX
2621 Y2 = FUNCG5A2p1 (X2)
2622 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
2623 X1 = X2
2624 Y1 = Y2
2625 10 CONTINUE
2626 !C
2627 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
2628 !C
2629 IF (ABS(Y2) .GT. EPS) Y2 = FUNCG5A2p1 (PSI6LO)
2630 GOTO 50
2631 !C
2632 !C *** PERFORM BISECTION ***********************************************
2633 !C
2634 20 DO 30 I=1,MAXIT
2635 X3 = 0.5*(X1+X2)
2636 Y3 = FUNCG5A2p1 (X3)
2637 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
2638 Y2 = Y3
2639 X2 = X3
2640 ELSE
2641 Y1 = Y3
2642 X1 = X3
2643 ENDIF
2644 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
2645 30 CONTINUE
2646 CALL PUSHERR2p1 (0002, 'CALCG5') ! WARNING ERROR: NO CONVERGENCE
2647 !C
2648 !C *** CONVERGED ; RETURN **********************************************
2649 !C
2650 40 X3 = 0.5*(X1+X2)
2651 Y3 = FUNCG5A2p1 (X3)
2652 !C
2653 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
2654 !C
2655 50 CONTINUE
2656 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN ! If quadrat.called
2657 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
2658 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
2659 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
2660 MOLAL(6) = DELTA ! HSO4 EFFECT
2661 ENDIF
2662 !C
2663 RETURN
2664 !C
2665 !C *** END OF SUBROUTINE CALCG5 *******************************************
2666 !C
2667 END
2672 !C=======================================================================
2673 !C
2674 !C *** ISORROPIA CODE
2675 !C *** SUBROUTINE FUNCG5A
2676 !C *** CASE G5
2677 !C
2678 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2679 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
2680 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
2681 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
2682 !C
2683 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2684 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2685 !C *** WRITTEN BY ATHANASIOS NENES
2686 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2687 !C
2688 !C=======================================================================
2689 !C
2690 DOUBLE PRECISION FUNCTION FUNCG5A2p1 (X)
2691 INCLUDE 'module_isrpia_inc.F'
2692 !C
2693 DOUBLE PRECISION LAMDA
2694 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
2695 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
2696 A1, A2, A3, A4, A5, A6, A7
2697 !C
2698 !C *** SETUP PARAMETERS ************************************************
2699 !C
2700 PSI6 = X
2701 FRST = .TRUE.
2702 CALAIN = .TRUE.
2703 !C
2704 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
2705 !C
2706 DO 10 I=1,NSWEEP
2707 !C
2708 A1 = XK5 *(WATER/GAMA(2))**3.0
2709 A2 = XK7 *(WATER/GAMA(4))**3.0
2710 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2711 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
2712 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
2713 AKK = A4*A6
2714 !C
2715 !C CALCULATE DISSOCIATION QUANTITIES
2716 !C
2717 IF (CHI5.GE.TINY) THEN
2718 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
2719 ELSE
2720 PSI5 = TINY
2721 ENDIF
2722 !C
2723 !CCC IF(CHI4.GT.TINY) THEN
2724 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
2725 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
2726 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
2727 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
2728 PSI4 =0.5d0*(-BB - SQRT(DD))
2729 ELSE
2730 PSI4 = TINY
2731 ENDIF
2732 !C
2733 !C *** CALCULATE SPECIATION ********************************************
2734 !C
2735 MOLAL (2) = 2.0D0*PSI1 ! NAI
2736 MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I
2737 MOLAL (4) = PSI6 ! CLI
2738 MOLAL (5) = PSI2 + PSI1 ! SO4I
2739 MOLAL (6) = ZERO
2740 MOLAL (7) = PSI5 ! NO3I
2741 !C
2742 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
2743 CALL CALCPH2p1 (SMIN, HI, OHI)
2744 MOLAL (1) = HI
2745 !C
2746 GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3
2747 GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3
2748 GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl
2749 !C
2750 CNH42S4 = ZERO ! Solid (NH4)2SO4
2751 CNH4NO3 = ZERO ! Solid NH4NO3
2752 CNH4CL = ZERO ! Solid NH4Cl
2753 !C
2754 CALL CALCMR2p1 ! Water content
2755 !C
2756 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
2757 !C
2758 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
2759 CALL CALCACT2p1
2760 ELSE
2761 GOTO 20
2762 ENDIF
2763 10 CONTINUE
2764 !C
2765 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
2766 !C
2767 20 FUNCG5A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
2768 !CCC FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
2769 !C
2770 RETURN
2771 !C
2772 !C *** END OF FUNCTION FUNCG5A *******************************************
2773 !C
2774 END
2776 !C=======================================================================
2777 !C
2778 !C *** ISORROPIA CODE
2779 !C *** SUBROUTINE CALCG4
2780 !C *** CASE G4
2781 !C
2782 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2783 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
2784 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
2785 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
2786 !C
2787 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2788 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2789 !C *** WRITTEN BY ATHANASIOS NENES
2790 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2791 !C
2792 !C=======================================================================
2793 !C
2794 SUBROUTINE CALCG42p1
2795 INCLUDE 'module_isrpia_inc.F'
2796 !C
2797 DOUBLE PRECISION LAMDA
2798 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
2799 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
2800 A1, A2, A3, A4, A5, A6, A7
2801 !C
2802 !C *** SETUP PARAMETERS ************************************************
2803 !C
2804 CALAOU = .TRUE.
2805 CHI1 = 0.5*W(1)
2806 CHI2 = MAX (W(2)-CHI1, ZERO)
2807 CHI3 = ZERO
2808 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
2809 CHI5 = W(4)
2810 CHI6 = W(5)
2811 !C
2812 PSI2 = CHI2
2813 PSI6LO = TINY
2814 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
2815 !C
2816 WATER = CHI2/M0(4) + CHI1/M0(2)
2817 !C
2818 !C *** INITIAL VALUES FOR BISECTION ************************************
2819 !C
2820 X1 = PSI6LO
2821 Y1 = FUNCG4A2p1 (X1)
2822 IF (CHI6.LE.TINY) GOTO 50
2823 !CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50
2824 !CCC IF (WATER .LE. TINY) RETURN ! No water
2825 !C
2826 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
2827 !C
2828 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
2829 DO 10 I=1,NDIV
2830 X2 = X1+DX
2831 Y2 = FUNCG4A2p1 (X2)
2832 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
2833 X1 = X2
2834 Y1 = Y2
2835 10 CONTINUE
2836 !C
2837 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
2838 !C
2839 IF (ABS(Y2) .GT. EPS) Y2 = FUNCG4A2p1 (PSI6LO)
2840 GOTO 50
2841 !C
2842 !C *** PERFORM BISECTION ***********************************************
2843 !C
2844 20 DO 30 I=1,MAXIT
2845 X3 = 0.5*(X1+X2)
2846 Y3 = FUNCG4A2p1 (X3)
2847 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
2848 Y2 = Y3
2849 X2 = X3
2850 ELSE
2851 Y1 = Y3
2852 X1 = X3
2853 ENDIF
2854 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
2855 30 CONTINUE
2856 CALL PUSHERR2p1 (0002, 'CALCG4') ! WARNING ERROR: NO CONVERGENCE
2857 !C
2858 !C *** CONVERGED ; RETURN **********************************************
2859 !C
2860 40 X3 = 0.5*(X1+X2)
2861 Y3 = FUNCG4A2p1 (X3)
2862 !C
2863 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
2864 !C
2865 50 CONTINUE
2866 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
2867 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
2868 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
2869 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
2870 MOLAL(6) = DELTA ! HSO4 EFFECT
2871 ENDIF
2872 !C
2873 RETURN
2874 !C
2875 !C *** END OF SUBROUTINE CALCG4 *******************************************
2876 !C
2877 END
2882 !C=======================================================================
2883 !C
2884 !C *** ISORROPIA CODE
2885 !C *** SUBROUTINE FUNCG4A
2886 !C *** CASE G4
2887 !C
2888 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
2889 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
2890 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
2891 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
2892 !C
2893 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
2894 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
2895 !C *** WRITTEN BY ATHANASIOS NENES
2896 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
2897 !C
2898 !C=======================================================================
2899 !C
2900 DOUBLE PRECISION FUNCTION FUNCG4A2p1 (X)
2901 INCLUDE 'module_isrpia_inc.F'
2902 !C
2903 DOUBLE PRECISION LAMDA, NAI, NH4I, NO3I
2904 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
2905 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
2906 A1, A2, A3, A4, A5, A6, A7
2907 !C
2908 !C *** SETUP PARAMETERS ************************************************
2909 !C
2910 PSI6 = X
2911 PSI1 = CHI1
2912 FRST = .TRUE.
2913 CALAIN = .TRUE.
2914 !C
2915 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
2916 !C
2917 DO 10 I=1,NSWEEP
2918 !C
2919 A1 = XK5 *(WATER/GAMA(2))**3.0
2920 A2 = XK7 *(WATER/GAMA(4))**3.0
2921 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
2922 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
2923 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
2924 !C
2925 !C CALCULATE DISSOCIATION QUANTITIES
2926 !C
2927 IF (CHI5.GE.TINY) THEN
2928 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
2929 ELSE
2930 PSI5 = TINY
2931 ENDIF
2932 !C
2933 !CCC IF(CHI4.GT.TINY) THEN
2934 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
2935 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
2936 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
2937 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma shankar, 19/11/2001
2938 PSI4 =0.5d0*(-BB - SQRT(DD))
2939 ELSE
2940 PSI4 = TINY
2941 ENDIF
2942 !C
2943 !C CALCULATE CONCENTRATIONS
2944 !C
2945 NH4I = 2.0*PSI2 + PSI4
2946 CLI = PSI6
2947 SO4I = PSI2 + PSI1
2948 NO3I = PSI5
2949 NAI = 2.0D0*PSI1
2950 !C
2951 CALL CALCPH2p1(2.d0*SO4I+NO3I+CLI-NAI-NH4I, HI, OHI)
2952 !C
2953 !C *** Na2SO4 DISSOLUTION
2954 !C
2955 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
2956 CALL POLY32p1 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
2957 IF (ISLV.EQ.0) THEN
2958 PSI1 = MIN (PSI1, CHI1)
2959 ELSE
2960 PSI1 = ZERO
2961 ENDIF
2962 ELSE
2963 PSI1 = ZERO
2964 ENDIF
2965 !C
2966 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
2967 !C
2968 MOLAL (1) = HI
2969 MOLAL (2) = NAI
2970 MOLAL (3) = NH4I
2971 MOLAL (4) = CLI
2972 MOLAL (5) = SO4I
2973 MOLAL (6) = ZERO
2974 MOLAL (7) = NO3I
2975 !C
2976 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
2977 !C
2978 GNH3 = MAX(CHI4 - PSI4, TINY)
2979 GHNO3 = MAX(CHI5 - PSI5, TINY)
2980 GHCL = MAX(CHI6 - PSI6, TINY)
2981 !C
2982 CNH42S4 = ZERO
2983 CNH4NO3 = ZERO
2984 CNH4CL = ZERO
2985 CNA2SO4 = MAX(CHI1-PSI1,ZERO)
2986 !C
2987 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
2988 !C
2989 CALL CALCMR2p1
2990 !C
2991 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
2992 !C
2993 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
2994 CALL CALCACT2p1
2995 ELSE
2996 GOTO 20
2997 ENDIF
2998 10 CONTINUE
2999 !C
3000 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
3001 !C
3002 20 FUNCG4A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
3003 !CCC FUNCG4A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
3004 !C
3005 RETURN
3006 !C
3007 !C *** END OF FUNCTION FUNCG4A *******************************************
3008 !C
3009 END
3011 !C=======================================================================
3012 !C
3013 !C *** ISORROPIA CODE
3014 !C *** SUBROUTINE CALCG3
3015 !C *** CASE G3
3016 !C
3017 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3018 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3019 !C 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE
3020 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3021 !C
3022 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3023 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3024 !C *** WRITTEN BY ATHANASIOS NENES
3025 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3026 !C
3027 !C=======================================================================
3028 !C
3029 SUBROUTINE CALCG32p1
3030 INCLUDE 'module_isrpia_inc.F'
3031 EXTERNAL CALCG1A2p1, CALCG42p1
3032 !C
3033 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
3034 !C
3035 IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE
3036 SCASE = 'G3 ; SUBCASE 1'
3037 CALL CALCG3A2p1
3038 SCASE = 'G3 ; SUBCASE 1'
3039 ELSE ! NO3, CL NON EXISTANT
3040 SCASE = 'G1 ; SUBCASE 1'
3041 CALL CALCG1A2p1
3042 SCASE = 'G1 ; SUBCASE 1'
3043 ENDIF
3044 !C
3045 IF (WATER.LE.TINY) THEN
3046 IF (RH.LT.DRMG3) THEN ! ONLY SOLIDS
3047 WATER = TINY
3048 DO 10 I=1,NIONS
3049 MOLAL(I) = ZERO
3050 10 CONTINUE
3051 CALL CALCG1A2p1
3052 SCASE = 'G3 ; SUBCASE 2'
3053 RETURN
3054 ELSE
3055 SCASE = 'G3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4)
3056 CALL CALCMDRH2p1 (RH, DRMG3, DRNH42S4, CALCG1A2p1, CALCG42p1)
3057 SCASE = 'G3 ; SUBCASE 3'
3058 ENDIF
3059 ENDIF
3060 !C
3061 RETURN
3062 !C
3063 !C *** END OF SUBROUTINE CALCG3 ******************************************
3064 !C
3065 END
3068 !C=======================================================================
3069 !C
3070 !C *** ISORROPIA CODE
3071 !C *** SUBROUTINE CALCG3A
3072 !C *** CASE G3 ; SUBCASE 1
3073 !C
3074 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3075 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3076 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3077 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3078 !C
3079 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3080 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3081 !C *** WRITTEN BY ATHANASIOS NENES
3082 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3083 !C
3084 !C=======================================================================
3085 !C
3086 SUBROUTINE CALCG3A2p1
3087 INCLUDE 'module_isrpia_inc.F'
3088 !C
3089 DOUBLE PRECISION LAMDA
3090 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
3091 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
3092 A1, A2, A3, A4, A5, A6, A7
3093 !C
3094 !C *** SETUP PARAMETERS ************************************************
3095 !C
3096 CALAOU = .TRUE.
3097 CHI1 = 0.5*W(1)
3098 CHI2 = MAX (W(2)-CHI1, ZERO)
3099 CHI3 = ZERO
3100 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
3101 CHI5 = W(4)
3102 CHI6 = W(5)
3103 !C
3104 PSI6LO = TINY
3105 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
3106 !C
3107 WATER = TINY
3108 !C
3109 !C *** INITIAL VALUES FOR BISECTION ************************************
3110 !C
3111 X1 = PSI6LO
3112 Y1 = FUNCG3A2p1 (X1)
3113 IF (CHI6.LE.TINY) GOTO 50
3114 !CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY .OR. WATER .LE. TINY) GOTO 50
3115 !CCC IF (WATER .LE. TINY) RETURN ! No water
3116 !C
3117 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
3118 !C
3119 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
3120 DO 10 I=1,NDIV
3121 X2 = X1+DX
3122 Y2 = FUNCG3A2p1 (X2)
3123 !C
3124 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
3125 X1 = X2
3126 Y1 = Y2
3127 10 CONTINUE
3128 !C
3129 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
3130 !C
3131 IF (ABS(Y2) .GT. EPS) Y2 = FUNCG3A2p1 (PSI6LO)
3132 GOTO 50
3133 !C
3134 !C *** PERFORM BISECTION ***********************************************
3135 !C
3136 20 DO 30 I=1,MAXIT
3137 X3 = 0.5*(X1+X2)
3138 Y3 = FUNCG3A2p1 (X3)
3139 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
3140 Y2 = Y3
3141 X2 = X3
3142 ELSE
3143 Y1 = Y3
3144 X1 = X3
3145 ENDIF
3146 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
3147 30 CONTINUE
3148 CALL PUSHERR2p1 (0002, 'CALCG3A') ! WARNING ERROR: NO CONVERGENCE
3149 !C
3150 !C *** CONVERGED ; RETURN **********************************************
3151 !C
3152 40 X3 = 0.5*(X1+X2)
3153 Y3 = FUNCG3A2p1 (X3)
3154 !C
3155 !C *** FINAL CALCULATIONS *************************************************
3156 !C
3157 50 CONTINUE
3158 !C
3159 !C *** Na2SO4 DISSOLUTION
3160 !C
3161 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
3162 CALL POLY32p1 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
3163 IF (ISLV.EQ.0) THEN
3164 PSI1 = MIN (PSI1, CHI1)
3165 ELSE
3166 PSI1 = ZERO
3167 ENDIF
3168 ELSE
3169 PSI1 = ZERO
3170 ENDIF
3171 MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT
3172 MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT
3173 CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion
3174 !C
3175 !C *** HSO4 equilibrium
3176 !C
3177 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
3178 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
3179 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
3180 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
3181 MOLAL(6) = DELTA ! HSO4 EFFECT
3182 ENDIF
3183 !C
3184 RETURN
3185 !C
3186 !C *** END OF SUBROUTINE CALCG3A ******************************************
3187 !C
3188 END
3193 !C=======================================================================
3194 !C
3195 !C *** ISORROPIA CODE
3196 !C *** SUBROUTINE FUNCG3A
3197 !C *** CASE G3 ; SUBCASE 1
3198 !C
3199 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3200 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3201 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3202 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3203 !C
3204 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3205 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3206 !C *** WRITTEN BY ATHANASIOS NENES
3207 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3208 !C
3209 !C=======================================================================
3210 !C
3211 DOUBLE PRECISION FUNCTION FUNCG3A2p1 (X)
3212 INCLUDE 'module_isrpia_inc.F'
3213 !C
3214 DOUBLE PRECISION LAMDA
3215 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
3216 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
3217 A1, A2, A3, A4, A5, A6, A7
3218 !C
3219 !C *** SETUP PARAMETERS ************************************************
3220 !C
3221 PSI6 = X
3222 PSI2 = CHI2
3223 FRST = .TRUE.
3224 CALAIN = .TRUE.
3225 !C
3226 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
3227 !C
3228 DO 10 I=1,NSWEEP
3229 !C
3230 A1 = XK5 *(WATER/GAMA(2))**3.0
3231 A2 = XK7 *(WATER/GAMA(4))**3.0
3232 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
3233 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
3234 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
3235 !C
3236 !C CALCULATE DISSOCIATION QUANTITIES
3237 !C
3238 IF (CHI5.GE.TINY) THEN
3239 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
3240 ELSE
3241 PSI5 = TINY
3242 ENDIF
3243 !C
3244 !CCC IF(CHI4.GT.TINY) THEN
3245 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
3246 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
3247 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
3248 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
3249 PSI4 =0.5d0*(-BB - SQRT(DD))
3250 ELSE
3251 PSI4 = TINY
3252 ENDIF
3253 !C
3254 IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
3255 CALL POLY32p1 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV)
3256 IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2)
3257 ENDIF
3258 !C
3259 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
3260 !C
3261 MOLAL (2) = ZERO ! Na
3262 MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I
3263 MOLAL (4) = PSI6 ! CLI
3264 MOLAL (5) = PSI2 ! SO4I
3265 MOLAL (6) = ZERO ! HSO4
3266 MOLAL (7) = PSI5 ! NO3I
3267 !C
3268 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
3269 CALL CALCPH2p1 (SMIN, HI, OHI)
3270 MOLAL (1) = HI
3271 !c
3272 GNH3 = MAX(CHI4 - PSI4, TINY) ! Gas NH3
3273 GHNO3 = MAX(CHI5 - PSI5, TINY) ! Gas HNO3
3274 GHCL = MAX(CHI6 - PSI6, TINY) ! Gas HCl
3275 !C
3276 CNH42S4 = CHI2 - PSI2 ! Solid (NH4)2SO4
3277 CNH4NO3 = ZERO ! Solid NH4NO3
3278 CNH4CL = ZERO ! Solid NH4Cl
3279 !C
3280 CALL CALCMR2p1 ! Water content
3281 !C
3282 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
3283 !C
3284 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
3285 CALL CALCACT2p1
3286 ELSE
3287 GOTO 20
3288 ENDIF
3289 10 CONTINUE
3290 !C
3291 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
3292 !C
3293 20 FUNCG3A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
3294 !CCC FUNCG3A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
3295 !C
3296 RETURN
3297 !C
3298 !C *** END OF FUNCTION FUNCG3A *******************************************
3299 !C
3300 END
3302 !C=======================================================================
3303 !C
3304 !C *** ISORROPIA CODE
3305 !C *** SUBROUTINE CALCG2
3306 !C *** CASE G2
3307 !C
3308 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3309 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3310 !C 2. LIQUID & SOLID PHASE ARE BOTH POSSIBLE
3311 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3312 !C
3313 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3314 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3315 !C *** WRITTEN BY ATHANASIOS NENES
3316 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3317 !C
3318 !C=======================================================================
3319 !C
3320 SUBROUTINE CALCG22p1
3321 INCLUDE 'module_isrpia_inc.F'
3322 EXTERNAL CALCG1A2p1, CALCG3A2p1, CALCG42p1
3323 !C
3324 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
3325 !C
3326 IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE
3327 SCASE = 'G2 ; SUBCASE 1'
3328 CALL CALCG2A2p1
3329 SCASE = 'G2 ; SUBCASE 1'
3330 ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE
3331 SCASE = 'G1 ; SUBCASE 1'
3332 CALL CALCG1A2p1
3333 SCASE = 'G1 ; SUBCASE 1'
3334 ENDIF
3335 !C
3336 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
3337 !C
3338 IF (WATER.LE.TINY) THEN
3339 IF (RH.LT.DRMG2) THEN ! ONLY SOLIDS
3340 WATER = TINY
3341 DO 10 I=1,NIONS
3342 MOLAL(I) = ZERO
3343 10 CONTINUE
3344 CALL CALCG1A2p1
3345 SCASE = 'G2 ; SUBCASE 2'
3346 ELSE
3347 IF (W(5).GT. TINY) THEN
3348 SCASE = 'G2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4)
3349 CALL CALCMDRH2p1 (RH, DRMG2, DRNH4CL, CALCG1A2p1, CALCG3A2p1)
3350 SCASE = 'G2 ; SUBCASE 3'
3351 ENDIF
3352 IF (WATER.LE.TINY .AND. RH.GE.DRMG3) THEN
3353 SCASE = 'G2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4)
3354 CALL CALCMDRH2p1 (RH, DRMG3, DRNH42S4, CALCG1A2p1, CALCG42p1)
3355 SCASE = 'G2 ; SUBCASE 4'
3356 ELSE
3357 WATER = TINY
3358 DO 20 I=1,NIONS
3359 MOLAL(I) = ZERO
3360 20 CONTINUE
3361 CALL CALCG1A2p1
3362 SCASE = 'G2 ; SUBCASE 2'
3363 ENDIF
3364 ENDIF
3365 ENDIF
3366 !C
3367 RETURN
3368 !C
3369 !C *** END OF SUBROUTINE CALCG2 ******************************************
3370 !C
3371 END
3374 !C=======================================================================
3375 !C
3376 !C *** ISORROPIA CODE
3377 !C *** SUBROUTINE CALCG2A
3378 !C *** CASE G2 ; SUBCASE 1
3379 !C
3380 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3381 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3382 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3383 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3384 !C
3385 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3386 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3387 !C *** WRITTEN BY ATHANASIOS NENES
3388 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3389 !C
3390 !C=======================================================================
3391 !C
3392 SUBROUTINE CALCG2A2p1
3393 INCLUDE 'module_isrpia_inc.F'
3394 !C
3395 DOUBLE PRECISION LAMDA
3396 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
3397 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
3398 A1, A2, A3, A4, A5, A6, A7
3399 !C
3400 !C *** SETUP PARAMETERS ************************************************
3401 !C
3402 CALAOU = .TRUE.
3403 CHI1 = 0.5*W(1)
3404 CHI2 = MAX (W(2)-CHI1, ZERO)
3405 CHI3 = ZERO
3406 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
3407 CHI5 = W(4)
3408 CHI6 = W(5)
3409 !C
3410 PSI6LO = TINY
3411 PSI6HI = CHI6-TINY
3412 !C
3413 WATER = TINY
3414 !C
3415 !C *** INITIAL VALUES FOR BISECTION ************************************
3416 !C
3417 X1 = PSI6LO
3418 Y1 = FUNCG2A2p1 (X1)
3419 IF (CHI6.LE.TINY) GOTO 50
3420 !CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
3421 !CCC IF (WATER .LE. TINY) GOTO 50 ! No water
3422 !C
3423 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
3424 !C
3425 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
3426 DO 10 I=1,NDIV
3427 X2 = X1+DX
3428 Y2 = FUNCG2A2p1 (X2)
3429 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
3430 X1 = X2
3431 Y1 = Y2
3432 10 CONTINUE
3433 !C
3434 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
3435 !C
3436 IF (ABS(Y2) .GT. EPS) WATER = TINY
3437 GOTO 50
3438 !C
3439 !C *** PERFORM BISECTION ***********************************************
3440 !C
3441 20 DO 30 I=1,MAXIT
3442 X3 = 0.5*(X1+X2)
3443 Y3 = FUNCG2A2p1 (X3)
3444 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
3445 Y2 = Y3
3446 X2 = X3
3447 ELSE
3448 Y1 = Y3
3449 X1 = X3
3450 ENDIF
3451 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
3452 30 CONTINUE
3453 CALL PUSHERR2p1 (0002, 'CALCG2A') ! WARNING ERROR: NO CONVERGENCE
3454 !C
3455 !C *** CONVERGED ; RETURN **********************************************
3456 !C
3457 40 X3 = 0.5*(X1+X2)
3458 IF (X3.LE.TINY2) THEN ! PRACTICALLY NO NITRATES, SO DRY SOLUTION
3459 WATER = TINY
3460 ELSE
3461 Y3 = FUNCG2A2p1 (X3)
3462 ENDIF
3463 !C
3464 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
3465 !C
3466 50 CONTINUE
3467 !C
3468 !C *** Na2SO4 DISSOLUTION
3469 !C
3470 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
3471 CALL POLY32p1 (PSI2, ZERO, -A1/4.D0, PSI1, ISLV)
3472 IF (ISLV.EQ.0) THEN
3473 PSI1 = MIN (PSI1, CHI1)
3474 ELSE
3475 PSI1 = ZERO
3476 ENDIF
3477 ELSE
3478 PSI1 = ZERO
3479 ENDIF
3480 MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT
3481 MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT
3482 CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion
3483 !C
3484 !C *** HSO4 equilibrium
3485 !C
3486 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
3487 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
3488 MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT
3489 MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT
3490 MOLAL(6) = DELTA ! HSO4 AFFECT
3491 ENDIF
3492 !C
3493 RETURN
3494 !C
3495 !C *** END OF SUBROUTINE CALCG2A ******************************************
3496 !C
3497 END
3502 !C=======================================================================
3503 !C
3504 !C *** ISORROPIA CODE
3505 !C *** SUBROUTINE FUNCG2A
3506 !C *** CASE G2
3507 !C
3508 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3509 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3510 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3511 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3512 !C
3513 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3514 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3515 !C *** WRITTEN BY ATHANASIOS NENES
3516 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3517 !C
3518 !C=======================================================================
3519 !C
3520 DOUBLE PRECISION FUNCTION FUNCG2A2p1 (X)
3521 INCLUDE 'module_isrpia_inc.F'
3522 !C
3523 DOUBLE PRECISION LAMDA
3524 COMMON /CASEG2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, LAMDA, &
3525 PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, PSI7, &
3526 A1, A2, A3, A4, A5, A6, A7
3527 !C
3528 !C *** SETUP PARAMETERS ************************************************
3529 !C
3530 PSI6 = X
3531 PSI2 = CHI2
3532 PSI3 = ZERO
3533 FRST = .TRUE.
3534 CALAIN = .TRUE.
3535 !C
3536 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
3537 !C
3538 DO 10 I=1,NSWEEP
3539 !C
3540 A1 = XK5 *(WATER/GAMA(2))**3.0
3541 A2 = XK7 *(WATER/GAMA(4))**3.0
3542 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
3543 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
3544 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
3545 !C
3546 DENO = MAX(CHI6-PSI6-PSI3, ZERO)
3547 PSI5 = CHI5/((A6/A5)*(DENO/PSI6) + ONE)
3548 !C
3549 PSI4 = MIN(PSI5+PSI6,CHI4)
3550 !C
3551 IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
3552 CALL POLY32p1 (PSI4, PSI4*PSI4/4.D0, -A2/4.D0, PSI20, ISLV)
3553 IF (ISLV.EQ.0) PSI2 = MIN (PSI20, CHI2)
3554 ENDIF
3555 !C
3556 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
3557 !C
3558 MOLAL (2) = ZERO ! NA
3559 MOLAL (3) = 2.0*PSI2 + PSI4 ! NH4I
3560 MOLAL (4) = PSI6 ! CLI
3561 MOLAL (5) = PSI2 ! SO4I
3562 MOLAL (6) = ZERO ! HSO4
3563 MOLAL (7) = PSI5 ! NO3I
3564 !C
3565 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
3566 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
3567 CALL CALCPH2p1 (SMIN, HI, OHI)
3568 MOLAL (1) = HI
3569 !C
3570 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
3571 !C
3572 GNH3 = MAX(CHI4 - PSI4, TINY)
3573 GHNO3 = MAX(CHI5 - PSI5, TINY)
3574 GHCL = MAX(CHI6 - PSI6, TINY)
3575 !C
3576 CNH42S4 = MAX(CHI2 - PSI2, ZERO)
3577 CNH4NO3 = ZERO
3578 !C
3579 !C *** NH4Cl(s) calculations
3580 !C
3581 A3 = XK6 /(R*TEMP*R*TEMP)
3582 IF (GNH3*GHCL.GT.A3) THEN
3583 DELT = MIN(GNH3, GHCL)
3584 BB = -(GNH3+GHCL)
3585 CC = GNH3*GHCL-A3
3586 DD = BB*BB - 4.D0*CC
3587 PSI31 = 0.5D0*(-BB + SQRT(DD))
3588 PSI32 = 0.5D0*(-BB - SQRT(DD))
3589 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
3590 PSI3 = PSI31
3591 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
3592 PSI3 = PSI32
3593 ELSE
3594 PSI3 = ZERO
3595 ENDIF
3596 ELSE
3597 PSI3 = ZERO
3598 ENDIF
3599 !C
3600 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
3601 !C
3602 GNH3 = MAX(GNH3 - PSI3, TINY)
3603 GHCL = MAX(GHCL - PSI3, TINY)
3604 CNH4CL = PSI3
3605 !C
3606 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
3607 !C
3608 CALL CALCMR2p1
3609 !C
3610 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
3611 !C
3612 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
3613 CALL CALCACT2p1
3614 ELSE
3615 GOTO 20
3616 ENDIF
3617 10 CONTINUE
3618 !C
3619 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
3620 !C
3621 20 IF (CHI4.LE.TINY) THEN
3622 FUNCG2A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
3623 ELSE
3624 FUNCG2A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
3625 ENDIF
3626 !C
3627 RETURN
3628 !C
3629 !C *** END OF FUNCTION FUNCG2A *******************************************
3630 !C
3631 END
3633 !C=======================================================================
3634 !C
3635 !C *** ISORROPIA CODE
3636 !C *** SUBROUTINE CALCG1
3637 !C *** CASE G1
3638 !C
3639 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3640 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
3641 !C 2. SOLID AEROSOL ONLY
3642 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4CL, NA2SO4
3643 !C
3644 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
3645 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
3646 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCG1A)
3647 !C
3648 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3649 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3650 !C *** WRITTEN BY ATHANASIOS NENES
3651 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3652 !C
3653 !C=======================================================================
3654 !C
3655 SUBROUTINE CALCG12p1
3656 INCLUDE 'module_isrpia_inc.F'
3657 EXTERNAL CALCG1A2p1, CALCG2A2p1
3658 !C
3659 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
3660 !C
3661 IF (RH.LT.DRMG1) THEN
3662 SCASE = 'G1 ; SUBCASE 1'
3663 CALL CALCG1A2p1 ! SOLID PHASE ONLY POSSIBLE
3664 SCASE = 'G1 ; SUBCASE 1'
3665 ELSE
3666 SCASE = 'G1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
3667 CALL CALCMDRH2p1 (RH, DRMG1, DRNH4NO3, CALCG1A2p1, CALCG2A2p1)
3668 SCASE = 'G1 ; SUBCASE 2'
3669 ENDIF
3670 !C
3671 RETURN
3672 !C
3673 !C *** END OF SUBROUTINE CALCG1 ******************************************
3674 !C
3675 END
3678 !C=======================================================================
3679 !C
3680 !C *** ISORROPIA CODE
3681 !C *** SUBROUTINE CALCG1A
3682 !C *** CASE G1 ; SUBCASE 1
3683 !C
3684 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3685 !C 1. SULFATE POOR (SULRAT > 2.0)
3686 !C 2. SOLID AEROSOL ONLY
3687 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3
3688 !C
3689 !C SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3
3690 !C IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF
3691 !C NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN
3692 !C THE SOLID PHASE.
3693 !C
3694 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3695 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3696 !C *** WRITTEN BY ATHANASIOS NENES
3697 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3698 !C
3699 !C=======================================================================
3700 !C
3701 SUBROUTINE CALCG1A2p1
3702 INCLUDE 'module_isrpia_inc.F'
3703 DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2
3704 !C
3705 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
3706 !C
3707 CNA2SO4 = MIN (0.5*W(1), W(2))
3708 FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO)
3709 SO4FR = MAX(W(2) - CNA2SO4, ZERO)
3710 !C CNH42S4 = W(2) - CNA2SO4
3711 CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4
3712 !C
3713 !C *** CALCULATE VOLATILE SPECIES **************************************
3714 !C
3715 ALF = W(3) - 2.0*CNH42S4
3716 BET = W(5)
3717 GAM = W(4)
3718 !C
3719 RTSQ = R*TEMP*R*TEMP
3720 A1 = XK6/RTSQ
3721 A2 = XK10/RTSQ
3722 !C
3723 THETA1 = GAM - BET*(A2/A1)
3724 THETA2 = A2/A1
3725 !C
3726 !C QUADRATIC EQUATION SOLUTION
3727 !C
3728 BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
3729 CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
3730 DD = BB*BB - 4.0D0*CC
3731 IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately
3732 !C
3733 !C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
3734 !C
3735 SQDD = SQRT(DD)
3736 KAPA1 = 0.5D0*(-BB+SQDD)
3737 KAPA2 = 0.5D0*(-BB-SQDD)
3738 LAMDA1 = THETA1 + THETA2*KAPA1
3739 LAMDA2 = THETA1 + THETA2*KAPA2
3740 !C
3741 IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
3742 IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. &
3743 BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
3744 KAPA = KAPA1
3745 LAMDA= LAMDA1
3746 GOTO 200
3747 ENDIF
3748 ENDIF
3749 !C
3750 IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
3751 IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
3752 BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
3753 KAPA = KAPA2
3754 LAMDA= LAMDA2
3755 GOTO 200
3756 ENDIF
3757 ENDIF
3758 !C
3759 !C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
3760 !C
3761 100 KAPA = ZERO
3762 LAMDA = ZERO
3763 DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
3764 DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
3765 !C
3766 !C NH4CL EQUILIBRIUM
3767 !C
3768 IF (DD1.GE.ZERO) THEN
3769 SQDD1 = SQRT(DD1)
3770 KAPA1 = 0.5D0*(ALF+BET + SQDD1)
3771 KAPA2 = 0.5D0*(ALF+BET - SQDD1)
3772 !C
3773 IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
3774 KAPA = KAPA1
3775 ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
3776 KAPA = KAPA2
3777 ELSE
3778 KAPA = ZERO
3779 ENDIF
3780 ENDIF
3781 !C
3782 !C NH4NO3 EQUILIBRIUM
3783 !C
3784 IF (DD2.GE.ZERO) THEN
3785 SQDD2 = SQRT(DD2)
3786 LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
3787 LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
3788 !C
3789 IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
3790 LAMDA = LAMDA1
3791 ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
3792 LAMDA = LAMDA2
3793 ELSE
3794 LAMDA = ZERO
3795 ENDIF
3796 ENDIF
3797 !C
3798 !C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
3799 !C
3800 IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
3801 IF (BET .LT. LAMDA/THETA1) THEN
3802 KAPA = ZERO
3803 ELSE
3804 LAMDA= ZERO
3805 ENDIF
3806 ENDIF
3807 !C
3808 !C *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
3809 !C
3810 200 CONTINUE
3811 CNH4NO3 = LAMDA
3812 CNH4CL = KAPA
3813 !C
3814 GNH3 = MAX(ALF - KAPA - LAMDA, ZERO)
3815 GHNO3 = MAX(GAM - LAMDA, ZERO)
3816 GHCL = MAX(BET - KAPA, ZERO)
3817 !C
3818 RETURN
3819 !C
3820 !C *** END OF SUBROUTINE CALCG1A *****************************************
3821 !C
3822 END
3823 !C=======================================================================
3824 !C
3825 !C *** ISORROPIA CODE
3826 !C *** SUBROUTINE CALCH6
3827 !C *** CASE H6
3828 !C
3829 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3830 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
3831 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3832 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3833 !C
3834 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3835 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3836 !C *** WRITTEN BY ATHANASIOS NENES
3837 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3838 !C
3839 !C=======================================================================
3840 !C
3841 SUBROUTINE CALCH62p1
3842 INCLUDE 'module_isrpia_inc.F'
3843 !C
3844 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
3845 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
3846 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
3847 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
3848 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
3849 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
3850 !C
3851 !C *** SETUP PARAMETERS ************************************************
3852 !C
3853 CALAOU = .TRUE.
3854 CHI1 = W(2) ! CNA2SO4
3855 CHI2 = ZERO ! CNH42S4
3856 CHI3 = ZERO ! CNH4CL
3857 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
3858 CHI8 = MIN (FRNA, W(4)) ! CNANO3
3859 CHI4 = W(3) ! NH3(g)
3860 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
3861 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
3862 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
3863 !C
3864 PSI6LO = TINY
3865 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
3866 !C
3867 !C *** INITIAL VALUES FOR BISECTION ************************************
3868 !C
3869 X1 = PSI6LO
3870 Y1 = FUNCH6A2p1 (X1)
3871 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
3872 !C
3873 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
3874 !C
3875 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
3876 DO 10 I=1,NDIV
3877 X2 = X1+DX
3878 Y2 = FUNCH6A2p1 (X2)
3879 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
3880 X1 = X2
3881 Y1 = Y2
3882 10 CONTINUE
3883 !C
3884 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
3885 !C
3886 IF (ABS(Y2) .GT. EPS) Y2 = FUNCH6A2p1 (PSI6LO)
3887 GOTO 50
3888 !C
3889 !C *** PERFORM BISECTION ***********************************************
3890 !C
3891 20 DO 30 I=1,MAXIT
3892 X3 = 0.5*(X1+X2)
3893 Y3 = FUNCH6A2p1 (X3)
3894 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
3895 Y2 = Y3
3896 X2 = X3
3897 ELSE
3898 Y1 = Y3
3899 X1 = X3
3900 ENDIF
3901 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
3902 30 CONTINUE
3903 CALL PUSHERR2p1 (0002, 'CALCH6') ! WARNING ERROR: NO CONVERGENCE
3904 !C
3905 !C *** CONVERGED ; RETURN **********************************************
3906 !C
3907 40 X3 = 0.5*(X1+X2)
3908 Y3 = FUNCH6A2p1 (X3)
3909 !C
3910 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
3911 !C
3912 50 CONTINUE
3913 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
3914 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
3915 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
3916 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
3917 MOLAL(6) = DELTA ! HSO4 EFFECT
3918 ENDIF
3919 !C
3920 RETURN
3921 !C
3922 !C *** END OF SUBROUTINE CALCH6 ******************************************
3923 !C
3924 END
3929 !C=======================================================================
3930 !C
3931 !C *** ISORROPIA CODE
3932 !C *** SUBROUTINE FUNCH6A
3933 !C *** CASE H6
3934 !C
3935 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
3936 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
3937 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
3938 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
3939 !C
3940 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
3941 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
3942 !C *** WRITTEN BY ATHANASIOS NENES
3943 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
3944 !C
3945 !C=======================================================================
3946 !C
3947 DOUBLE PRECISION FUNCTION FUNCH6A2p1 (X)
3948 INCLUDE 'module_isrpia_inc.F'
3949 !C
3950 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
3951 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
3952 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
3953 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
3954 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
3955 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
3956 !C
3957 !C *** SETUP PARAMETERS ************************************************
3958 !C
3959 PSI6 = X
3960 PSI1 = CHI1
3961 PSI2 = ZERO
3962 PSI3 = ZERO
3963 PSI7 = CHI7
3964 PSI8 = CHI8
3965 FRST = .TRUE.
3966 CALAIN = .TRUE.
3967 !C
3968 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
3969 !C
3970 DO 10 I=1,NSWEEP
3971 !C
3972 A1 = XK5 *(WATER/GAMA(2))**3.0
3973 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
3974 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
3975 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
3976 A7 = XK8 *(WATER/GAMA(1))**2.0
3977 A8 = XK9 *(WATER/GAMA(3))**2.0
3978 A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
3979 !C
3980 !C CALCULATE DISSOCIATION QUANTITIES
3981 !C
3982 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
3983 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
3984 PSI5 = MAX(PSI5, TINY)
3985 !C
3986 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
3987 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
3988 CC = CHI4*(PSI5+PSI6)
3989 DD = BB*BB-4.d0*CC
3990 PSI4 =0.5d0*(-BB - SQRT(DD))
3991 PSI4 = MIN(PSI4,CHI4)
3992 ELSE
3993 PSI4 = TINY
3994 ENDIF
3995 !C
3996 !C *** CALCULATE SPECIATION ********************************************
3997 !C
3998 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
3999 MOLAL (3) = PSI4 ! NH4I
4000 MOLAL (4) = PSI6 + PSI7 ! CLI
4001 MOLAL (5) = PSI2 + PSI1 ! SO4I
4002 MOLAL (6) = ZERO ! HSO4I
4003 MOLAL (7) = PSI5 + PSI8 ! NO3I
4004 !C
4005 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
4006 CALL CALCPH2p1 (SMIN, HI, OHI)
4007 MOLAL (1) = HI
4008 !C
4009 GNH3 = MAX(CHI4 - PSI4, TINY)
4010 GHNO3 = MAX(CHI5 - PSI5, TINY)
4011 GHCL = MAX(CHI6 - PSI6, TINY)
4012 !C
4013 CNH42S4 = ZERO
4014 CNH4NO3 = ZERO
4015 CNACL = MAX(CHI7 - PSI7, ZERO)
4016 CNANO3 = MAX(CHI8 - PSI8, ZERO)
4017 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
4018 !C
4019 CALL CALCMR2p1 ! Water content
4020 !C
4021 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
4022 !C
4023 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
4024 CALL CALCACT2p1
4025 ELSE
4026 GOTO 20
4027 ENDIF
4028 10 CONTINUE
4029 !C
4030 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
4031 !C
4032 20 FUNCH6A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
4033 !C
4034 RETURN
4035 !C
4036 !C *** END OF FUNCTION FUNCH6A *******************************************
4037 !C
4038 END
4040 !C=======================================================================
4041 !C
4042 !C *** ISORROPIA CODE
4043 !C *** SUBROUTINE CALCH5
4044 !C *** CASE H5
4045 !C
4046 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4047 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4048 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4049 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
4050 !C
4051 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4052 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4053 !C *** WRITTEN BY ATHANASIOS NENES
4054 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4055 !C
4056 !C=======================================================================
4057 !C
4058 SUBROUTINE CALCH52p1
4059 INCLUDE 'module_isrpia_inc.F'
4060 !C
4061 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4062 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4063 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4064 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4065 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4066 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4067 !C
4068 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
4069 !C
4070 IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN
4071 SCASE = 'H5'
4072 CALL CALCH1A2p1
4073 SCASE = 'H5'
4074 RETURN
4075 ENDIF
4076 !C
4077 !C *** SETUP PARAMETERS ************************************************
4078 !C
4079 CALAOU = .TRUE.
4080 CHI1 = W(2) ! CNA2SO4
4081 CHI2 = ZERO ! CNH42S4
4082 CHI3 = ZERO ! CNH4CL
4083 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
4084 CHI8 = MIN (FRNA, W(4)) ! CNANO3
4085 CHI4 = W(3) ! NH3(g)
4086 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
4087 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
4088 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
4089 !C
4090 PSI6LO = TINY
4091 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
4092 !C
4093 !C *** INITIAL VALUES FOR BISECTION ************************************
4094 !C
4095 X1 = PSI6LO
4096 Y1 = FUNCH5A2p1 (X1)
4097 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
4098 !C
4099 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
4100 !C
4101 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
4102 DO 10 I=1,NDIV
4103 X2 = X1+DX
4104 Y2 = FUNCH5A2p1 (X2)
4105 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
4106 X1 = X2
4107 Y1 = Y2
4108 10 CONTINUE
4109 !C
4110 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
4111 !C
4112 IF (ABS(Y2) .GT. EPS) Y2 = FUNCH5A2p1 (PSI6LO)
4113 GOTO 50
4114 !C
4115 !C *** PERFORM BISECTION ***********************************************
4116 !C
4117 20 DO 30 I=1,MAXIT
4118 X3 = 0.5*(X1+X2)
4119 Y3 = FUNCH5A2p1 (X3)
4120 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
4121 Y2 = Y3
4122 X2 = X3
4123 ELSE
4124 Y1 = Y3
4125 X1 = X3
4126 ENDIF
4127 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
4128 30 CONTINUE
4129 CALL PUSHERR2p1 (0002, 'CALCH5') ! WARNING ERROR: NO CONVERGENCE
4130 !C
4131 !C *** CONVERGED ; RETURN **********************************************
4132 !C
4133 40 X3 = 0.5*(X1+X2)
4134 Y3 = FUNCH5A2p1 (X3)
4135 !C
4136 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
4137 !C
4138 50 CONTINUE
4139 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
4140 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
4141 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFECT
4142 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
4143 MOLAL(6) = DELTA ! HSO4 EFFECT
4144 ENDIF
4145 !C
4146 RETURN
4147 !C
4148 !C *** END OF SUBROUTINE CALCH5 ******************************************
4149 !C
4150 END
4155 !C=======================================================================
4156 !C
4157 !C *** ISORROPIA CODE
4158 !C *** SUBROUTINE FUNCH5A
4159 !C *** CASE H5
4160 !C
4161 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4162 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4163 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4164 !C 3. SOLIDS POSSIBLE : NONE
4165 !C
4166 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4167 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4168 !C *** WRITTEN BY ATHANASIOS NENES
4169 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4170 !C
4171 !C=======================================================================
4172 !C
4173 DOUBLE PRECISION FUNCTION FUNCH5A2p1 (X)
4174 INCLUDE 'module_isrpia_inc.F'
4175 !C
4176 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4177 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4178 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4179 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4180 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4181 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4182 !C
4183 !C *** SETUP PARAMETERS ************************************************
4184 !C
4185 PSI6 = X
4186 PSI1 = CHI1
4187 PSI2 = ZERO
4188 PSI3 = ZERO
4189 PSI7 = CHI7
4190 PSI8 = CHI8
4191 FRST = .TRUE.
4192 CALAIN = .TRUE.
4193 !C
4194 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
4195 !C
4196 DO 10 I=1,NSWEEP
4197 !C
4198 A1 = XK5 *(WATER/GAMA(2))**3.0
4199 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
4200 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
4201 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
4202 A7 = XK8 *(WATER/GAMA(1))**2.0
4203 A8 = XK9 *(WATER/GAMA(3))**2.0
4204 A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
4205 !C
4206 !C CALCULATE DISSOCIATION QUANTITIES
4207 !C
4208 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
4209 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
4210 PSI5 = MAX(PSI5, TINY)
4211 !C
4212 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
4213 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
4214 CC = CHI4*(PSI5+PSI6)
4215 DD = BB*BB-4.d0*CC
4216 PSI4 =0.5d0*(-BB - SQRT(DD))
4217 PSI4 = MIN(PSI4,CHI4)
4218 ELSE
4219 PSI4 = TINY
4220 ENDIF
4221 !C
4222 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION
4223 AA = PSI7+PSI8
4224 BB = AA*AA
4225 CC =-A1/4.D0
4226 CALL POLY32p1 (AA, BB, CC, PSI1, ISLV)
4227 IF (ISLV.EQ.0) THEN
4228 PSI1 = MIN (PSI1, CHI1)
4229 ELSE
4230 PSI1 = ZERO
4231 ENDIF
4232 ENDIF
4233 !C
4234 !C *** CALCULATE SPECIATION ********************************************
4235 !C
4236 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
4237 MOLAL (3) = PSI4 ! NH4I
4238 MOLAL (4) = PSI6 + PSI7 ! CLI
4239 MOLAL (5) = PSI2 + PSI1 ! SO4I
4240 MOLAL (6) = ZERO
4241 MOLAL (7) = PSI5 + PSI8 ! NO3I
4242 !C
4243 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
4244 CALL CALCPH2p1 (SMIN, HI, OHI)
4245 MOLAL (1) = HI
4246 !C
4247 GNH3 = MAX(CHI4 - PSI4, TINY)
4248 GHNO3 = MAX(CHI5 - PSI5, TINY)
4249 GHCL = MAX(CHI6 - PSI6, TINY)
4250 !C
4251 CNH42S4 = ZERO
4252 CNH4NO3 = ZERO
4253 CNACL = MAX(CHI7 - PSI7, ZERO)
4254 CNANO3 = MAX(CHI8 - PSI8, ZERO)
4255 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
4256 !C
4257 CALL CALCMR2p1 ! Water content
4258 !C
4259 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
4260 !C
4261 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
4262 CALL CALCACT2p1
4263 ELSE
4264 GOTO 20
4265 ENDIF
4266 10 CONTINUE
4267 !C
4268 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
4269 !C
4270 20 FUNCH5A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
4271 !C
4272 RETURN
4273 !C
4274 !C *** END OF FUNCTION FUNCH5A *******************************************
4275 !C
4276 END
4278 !C=======================================================================
4279 !C
4280 !C *** ISORROPIA CODE
4281 !C *** SUBROUTINE CALCH4
4282 !C *** CASE H4
4283 !C
4284 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4285 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4286 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4287 !C 3. SOLIDS POSSIBLE : NA2SO4
4288 !C
4289 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4290 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4291 !C *** WRITTEN BY ATHANASIOS NENES
4292 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4293 !C
4294 !C=======================================================================
4295 !C
4296 SUBROUTINE CALCH42p1
4297 INCLUDE 'module_isrpia_inc.F'
4298 !C
4299 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4300 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4301 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4302 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4303 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4304 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4305 !C
4306 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
4307 !C
4308 IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN
4309 SCASE = 'H4'
4310 CALL CALCH1A2p1
4311 SCASE = 'H4'
4312 RETURN
4313 ENDIF
4314 !C
4315 !C *** SETUP PARAMETERS ************************************************
4316 !C
4317 CALAOU = .TRUE.
4318 CHI1 = W(2) ! CNA2SO4
4319 CHI2 = ZERO ! CNH42S4
4320 CHI3 = ZERO ! CNH4CL
4321 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
4322 CHI8 = MIN (FRNA, W(4)) ! CNANO3
4323 CHI4 = W(3) ! NH3(g)
4324 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
4325 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
4326 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
4327 !C
4328 PSI6LO = TINY
4329 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
4330 !C
4331 !C *** INITIAL VALUES FOR BISECTION ************************************
4332 !C
4333 X1 = PSI6LO
4334 Y1 = FUNCH4A2p1 (X1)
4335 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
4336 !C
4337 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
4338 !C
4339 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
4340 DO 10 I=1,NDIV
4341 X2 = X1+DX
4342 Y2 = FUNCH4A2p1 (X2)
4343 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
4344 X1 = X2
4345 Y1 = Y2
4346 10 CONTINUE
4347 !C
4348 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
4349 !C
4350 IF (ABS(Y2) .GT. EPS) Y2 = FUNCH4A2p1 (PSI6LO)
4351 GOTO 50
4352 !C
4353 !C *** PERFORM BISECTION ***********************************************
4354 !C
4355 20 DO 30 I=1,MAXIT
4356 X3 = 0.5*(X1+X2)
4357 Y3 = FUNCH4A2p1 (X3)
4358 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
4359 Y2 = Y3
4360 X2 = X3
4361 ELSE
4362 Y1 = Y3
4363 X1 = X3
4364 ENDIF
4365 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
4366 30 CONTINUE
4367 CALL PUSHERR2p1 (0002, 'CALCH4') ! WARNING ERROR: NO CONVERGENCE
4368 !C
4369 !C *** CONVERGED ; RETURN **********************************************
4370 !C
4371 40 X3 = 0.5*(X1+X2)
4372 Y3 = FUNCH4A2p1 (X3)
4373 !C
4374 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
4375 !C
4376 50 CONTINUE
4377 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
4378 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
4379 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
4380 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
4381 MOLAL(6) = DELTA ! HSO4 EFFECT
4382 ENDIF
4383 !C
4384 RETURN
4385 !C
4386 !C *** END OF SUBROUTINE CALCH4 ******************************************
4387 !C
4388 END
4393 !C=======================================================================
4394 !C
4395 !C *** ISORROPIA CODE
4396 !C *** SUBROUTINE FUNCH4A
4397 !C *** CASE H4
4398 !C
4399 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4400 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4401 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4402 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
4403 !C
4404 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4405 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4406 !C *** WRITTEN BY ATHANASIOS NENES
4407 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4408 !C
4409 !C=======================================================================
4410 !C
4411 DOUBLE PRECISION FUNCTION FUNCH4A2p1 (X)
4412 INCLUDE 'module_isrpia_inc.F'
4413 !C
4414 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4415 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4416 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4417 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4418 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4419 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4420 !C
4421 !C *** SETUP PARAMETERS ************************************************
4422 !C
4423 PSI6 = X
4424 PSI1 = CHI1
4425 PSI2 = ZERO
4426 PSI3 = ZERO
4427 PSI7 = CHI7
4428 PSI8 = CHI8
4429 FRST = .TRUE.
4430 CALAIN = .TRUE.
4431 !C
4432 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
4433 !C
4434 DO 10 I=1,NSWEEP
4435 !C
4436 A1 = XK5 *(WATER/GAMA(2))**3.0
4437 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
4438 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
4439 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
4440 A7 = XK8 *(WATER/GAMA(1))**2.0
4441 A8 = XK9 *(WATER/GAMA(3))**2.0
4442 A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
4443 !C
4444 !C CALCULATE DISSOCIATION QUANTITIES
4445 !C
4446 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
4447 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
4448 PSI5 = MAX(PSI5, TINY)
4449 !C
4450 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
4451 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
4452 CC = CHI4*(PSI5+PSI6)
4453 DD = BB*BB-4.d0*CC
4454 PSI4 =0.5d0*(-BB - SQRT(DD))
4455 PSI4 = MIN(PSI4,CHI4)
4456 ELSE
4457 PSI4 = TINY
4458 ENDIF
4459 !C
4460 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION
4461 AA = PSI7+PSI8
4462 BB = AA*AA
4463 CC =-A1/4.D0
4464 CALL POLY32p1 (AA, BB, CC, PSI1, ISLV)
4465 IF (ISLV.EQ.0) THEN
4466 PSI1 = MIN (PSI1, CHI1)
4467 ELSE
4468 PSI1 = ZERO
4469 ENDIF
4470 ENDIF
4471 !C
4472 !C *** CALCULATE SPECIATION ********************************************
4473 !C
4474 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
4475 MOLAL (3) = PSI4 ! NH4I
4476 MOLAL (4) = PSI6 + PSI7 ! CLI
4477 MOLAL (5) = PSI2 + PSI1 ! SO4I
4478 MOLAL (6) = ZERO
4479 MOLAL (7) = PSI5 + PSI8 ! NO3I
4480 !C
4481 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
4482 CALL CALCPH2p1 (SMIN, HI, OHI)
4483 MOLAL (1) = HI
4484 !C
4485 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
4486 !C
4487 GNH3 = MAX(CHI4 - PSI4, TINY)
4488 GHNO3 = MAX(CHI5 - PSI5, TINY)
4489 GHCL = MAX(CHI6 - PSI6, TINY)
4490 !C
4491 CNH42S4 = ZERO
4492 CNH4NO3 = ZERO
4493 CNACL = MAX(CHI7 - PSI7, ZERO)
4494 CNANO3 = MAX(CHI8 - PSI8, ZERO)
4495 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
4496 !C
4497 !C *** NH4Cl(s) calculations
4498 !C
4499 A3 = XK6 /(R*TEMP*R*TEMP)
4500 DELT = MIN(GNH3, GHCL)
4501 BB = -(GNH3+GHCL)
4502 CC = GNH3*GHCL-A3
4503 DD = BB*BB - 4.D0*CC
4504 PSI31 = 0.5D0*(-BB + SQRT(DD))
4505 PSI32 = 0.5D0*(-BB - SQRT(DD))
4506 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
4507 PSI3 = PSI31
4508 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
4509 PSI3 = PSI32
4510 ELSE
4511 PSI3 = ZERO
4512 ENDIF
4513 !C
4514 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
4515 !C
4516 GNH3 = MAX(GNH3 - PSI3, TINY)
4517 GHCL = MAX(GHCL - PSI3, TINY)
4518 CNH4CL = PSI3
4519 !C
4520 CALL CALCMR2p1 ! Water content
4521 !C
4522 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
4523 !C
4524 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
4525 CALL CALCACT2p1
4526 ELSE
4527 GOTO 20
4528 ENDIF
4529 10 CONTINUE
4530 !C
4531 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
4532 !C
4533 20 FUNCH4A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
4534 !C
4535 RETURN
4536 !C
4537 !C *** END OF FUNCTION FUNCH4A *******************************************
4538 !C
4539 END
4541 !C=======================================================================
4542 !C
4543 !C *** ISORROPIA CODE
4544 !C *** SUBROUTINE CALCH3
4545 !C *** CASE H3
4546 !C
4547 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4548 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4549 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4550 !C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4
4551 !C
4552 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4553 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4554 !C *** WRITTEN BY ATHANASIOS NENES
4555 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4556 !C
4557 !C=======================================================================
4558 !C
4559 SUBROUTINE CALCH32p1
4560 INCLUDE 'module_isrpia_inc.F'
4561 !C
4562 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4563 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4564 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4565 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4566 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4567 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4568 !C
4569 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
4570 !C
4571 IF (W(4).LE.TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE
4572 SCASE = 'H3'
4573 CALL CALCH1A2p1
4574 SCASE = 'H3'
4575 RETURN
4576 ENDIF
4577 !C
4578 !C *** SETUP PARAMETERS ************************************************
4579 !C
4580 CALAOU = .TRUE.
4581 CHI1 = W(2) ! CNA2SO4
4582 CHI2 = ZERO ! CNH42S4
4583 CHI3 = ZERO ! CNH4CL
4584 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
4585 CHI8 = MIN (FRNA, W(4)) ! CNANO3
4586 CHI4 = W(3) ! NH3(g)
4587 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
4588 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
4589 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
4590 !C
4591 PSI6LO = TINY
4592 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
4593 !C
4594 !C *** INITIAL VALUES FOR BISECTION ************************************
4595 !C
4596 X1 = PSI6LO
4597 Y1 = FUNCH3A2p1 (X1)
4598 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
4599 !C
4600 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
4601 !C
4602 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
4603 DO 10 I=1,NDIV
4604 X2 = X1+DX
4605 Y2 = FUNCH3A2p1 (X2)
4606 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
4607 X1 = X2
4608 Y1 = Y2
4609 10 CONTINUE
4610 !C
4611 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
4612 !C
4613 IF (ABS(Y2) .GT. EPS) Y2 = FUNCH3A2p1 (PSI6LO)
4614 GOTO 50
4615 !C
4616 !C *** PERFORM BISECTION ***********************************************
4617 !C
4618 20 DO 30 I=1,MAXIT
4619 X3 = 0.5*(X1+X2)
4620 Y3 = FUNCH3A2p1 (X3)
4621 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
4622 Y2 = Y3
4623 X2 = X3
4624 ELSE
4625 Y1 = Y3
4626 X1 = X3
4627 ENDIF
4628 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
4629 30 CONTINUE
4630 CALL PUSHERR2p1 (0002, 'CALCH3') ! WARNING ERROR: NO CONVERGENCE
4631 !C
4632 !C *** CONVERGED ; RETURN **********************************************
4633 !C
4634 40 X3 = 0.5*(X1+X2)
4635 Y3 = FUNCH3A2p1 (X3)
4636 !C
4637 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
4638 !C
4639 50 CONTINUE
4640 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
4641 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
4642 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
4643 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
4644 MOLAL(6) = DELTA ! HSO4 EFFECT
4645 ENDIF
4646 !C
4647 RETURN
4648 !C
4649 !C *** END OF SUBROUTINE CALCH3 ******************************************
4650 !C
4651 END
4656 !C=======================================================================
4657 !C
4658 !C *** ISORROPIA CODE
4659 !C *** SUBROUTINE FUNCH3A
4660 !C *** CASE H3
4661 !C
4662 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4663 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4664 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4665 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
4666 !C
4667 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4668 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4669 !C *** WRITTEN BY ATHANASIOS NENES
4670 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4671 !C
4672 !C=======================================================================
4673 !C
4674 DOUBLE PRECISION FUNCTION FUNCH3A2p1 (X)
4675 INCLUDE 'module_isrpia_inc.F'
4676 !C
4677 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4678 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4679 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4680 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4681 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4682 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4683 !C
4684 !C *** SETUP PARAMETERS ************************************************
4685 !C
4686 PSI6 = X
4687 PSI1 = CHI1
4688 PSI2 = ZERO
4689 PSI3 = ZERO
4690 PSI7 = CHI7
4691 PSI8 = CHI8
4692 FRST = .TRUE.
4693 CALAIN = .TRUE.
4694 !C
4695 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
4696 !C
4697 DO 10 I=1,NSWEEP
4698 !C
4699 A1 = XK5 *(WATER/GAMA(2))**3.0
4700 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
4701 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
4702 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
4703 A7 = XK8 *(WATER/GAMA(1))**2.0
4704 A8 = XK9 *(WATER/GAMA(3))**2.0
4705 A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
4706 !C
4707 !C CALCULATE DISSOCIATION QUANTITIES
4708 !C
4709 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
4710 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
4711 PSI5 = MAX(PSI5, TINY)
4712 !C
4713 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
4714 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
4715 CC = CHI4*(PSI5+PSI6)
4716 DD = BB*BB-4.d0*CC
4717 PSI4 =0.5d0*(-BB - SQRT(DD))
4718 PSI4 = MIN(PSI4,CHI4)
4719 ELSE
4720 PSI4 = TINY
4721 ENDIF
4722 !C
4723 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
4724 DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
4725 PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
4726 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
4727 ENDIF
4728 !C
4729 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION
4730 AA = PSI7+PSI8
4731 BB = AA*AA
4732 CC =-A1/4.D0
4733 CALL POLY32p1 (AA, BB, CC, PSI1, ISLV)
4734 IF (ISLV.EQ.0) THEN
4735 PSI1 = MIN (PSI1, CHI1)
4736 ELSE
4737 PSI1 = ZERO
4738 ENDIF
4739 ENDIF
4740 !C
4741 !C *** CALCULATE SPECIATION ********************************************
4742 !C
4743 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
4744 MOLAL (3) = PSI4 ! NH4I
4745 MOLAL (4) = PSI6 + PSI7 ! CLI
4746 MOLAL (5) = PSI2 + PSI1 ! SO4I
4747 MOLAL (6) = ZERO
4748 MOLAL (7) = PSI5 + PSI8 ! NO3I
4749 !C
4750 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
4751 CALL CALCPH2p1 (SMIN, HI, OHI)
4752 MOLAL (1) = HI
4753 !C
4754 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
4755 !C
4756 GNH3 = MAX(CHI4 - PSI4, TINY)
4757 GHNO3 = MAX(CHI5 - PSI5, TINY)
4758 GHCL = MAX(CHI6 - PSI6, TINY)
4759 !C
4760 CNH42S4 = ZERO
4761 CNH4NO3 = ZERO
4762 CNACL = MAX(CHI7 - PSI7, ZERO)
4763 CNANO3 = MAX(CHI8 - PSI8, ZERO)
4764 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
4765 !C
4766 !C *** NH4Cl(s) calculations
4767 !C
4768 A3 = XK6 /(R*TEMP*R*TEMP)
4769 DELT = MIN(GNH3, GHCL)
4770 BB = -(GNH3+GHCL)
4771 CC = GNH3*GHCL-A3
4772 DD = BB*BB - 4.D0*CC
4773 PSI31 = 0.5D0*(-BB + SQRT(DD))
4774 PSI32 = 0.5D0*(-BB - SQRT(DD))
4775 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
4776 PSI3 = PSI31
4777 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
4778 PSI3 = PSI32
4779 ELSE
4780 PSI3 = ZERO
4781 ENDIF
4782 !C
4783 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
4784 !C
4785 GNH3 = MAX(GNH3 - PSI3, TINY)
4786 GHCL = MAX(GHCL - PSI3, TINY)
4787 CNH4CL = PSI3
4788 !C
4789 CALL CALCMR2p1 ! Water content
4790 !C
4791 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
4792 !C
4793 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
4794 CALL CALCACT2p1
4795 ELSE
4796 GOTO 20
4797 ENDIF
4798 10 CONTINUE
4799 !C
4800 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
4801 !C
4802 20 FUNCH3A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
4803 !C
4804 RETURN
4805 !C
4806 !C *** END OF FUNCTION FUNCH3A *******************************************
4807 !C
4808 END
4810 !C=======================================================================
4811 !C
4812 !C *** ISORROPIA CODE
4813 !C *** SUBROUTINE CALCH2
4814 !C *** CASE H2
4815 !C
4816 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4817 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4818 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
4819 !C 3. SOLIDS POSSIBLE : NH4Cl, NA2SO4, NANO3, NACL
4820 !C
4821 !C THERE ARE THREE REGIMES IN THIS CASE:
4822 !C 1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A)
4823 !C 2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
4824 !C 3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION)
4825 !C
4826 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES H1A, H2B
4827 !C RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE).
4828 !C
4829 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4830 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4831 !C *** WRITTEN BY ATHANASIOS NENES
4832 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4833 !C
4834 !C=======================================================================
4835 !C
4836 SUBROUTINE CALCH22p1
4837 INCLUDE 'module_isrpia_inc.F'
4838 EXTERNAL CALCH1A2p1, CALCH32p1
4839 !C
4840 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
4841 !C
4842 IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE
4843 SCASE = 'H2 ; SUBCASE 1'
4844 CALL CALCH2A2p1
4845 SCASE = 'H2 ; SUBCASE 1'
4846 ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE
4847 SCASE = 'H2 ; SUBCASE 1'
4848 CALL CALCH1A2p1
4849 SCASE = 'H2 ; SUBCASE 1'
4850 ENDIF
4851 !C
4852 IF (WATER.LE.TINY .AND. RH.LT.DRMH2) THEN ! DRY AEROSOL
4853 SCASE = 'H2 ; SUBCASE 2'
4854 !C
4855 ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMH2) THEN ! MDRH OF H2
4856 SCASE = 'H2 ; SUBCASE 3'
4857 CALL CALCMDRH2p1 (RH, DRMH2, DRNANO3, CALCH1A2p1, CALCH32p1)
4858 SCASE = 'H2 ; SUBCASE 3'
4859 ENDIF
4860 !C
4861 RETURN
4862 !C
4863 !C *** END OF SUBROUTINE CALCH2 ******************************************
4864 !C
4865 END
4870 !C=======================================================================
4871 !C
4872 !C *** ISORROPIA CODE
4873 !C *** SUBROUTINE CALCH2A
4874 !C *** CASE H2 ; SUBCASE 1
4875 !C
4876 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4877 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4878 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4879 !C 3. SOLIDS POSSIBLE : NH4CL, NA2SO4
4880 !C
4881 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4882 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4883 !C *** WRITTEN BY ATHANASIOS NENES
4884 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4885 !C
4886 !C=======================================================================
4887 !C
4888 SUBROUTINE CALCH2A2p1
4889 INCLUDE 'module_isrpia_inc.F'
4890 !C
4891 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4892 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4893 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
4894 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
4895 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
4896 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
4897 !C
4898 !C *** SETUP PARAMETERS ************************************************
4899 !C
4900 CALAOU = .TRUE.
4901 CHI1 = W(2) ! CNA2SO4
4902 CHI2 = ZERO ! CNH42S4
4903 CHI3 = ZERO ! CNH4CL
4904 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
4905 CHI8 = MIN (FRNA, W(4)) ! CNANO3
4906 CHI4 = W(3) ! NH3(g)
4907 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
4908 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
4909 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
4910 !C
4911 PSI6LO = TINY
4912 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
4913 !C
4914 !C *** INITIAL VALUES FOR BISECTION ************************************
4915 !C
4916 X1 = PSI6LO
4917 Y1 = FUNCH2A2p1 (X1)
4918 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
4919 !C
4920 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
4921 !C
4922 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
4923 DO 10 I=1,NDIV
4924 X2 = X1+DX
4925 Y2 = FUNCH2A2p1 (X2)
4926 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
4927 X1 = X2
4928 Y1 = Y2
4929 10 CONTINUE
4930 !C
4931 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
4932 !C
4933 IF (Y2 .GT. EPS) Y2 = FUNCH2A2p1 (PSI6LO)
4934 GOTO 50
4935 !C
4936 !C *** PERFORM BISECTION ***********************************************
4937 !C
4938 20 DO 30 I=1,MAXIT
4939 X3 = 0.5*(X1+X2)
4940 Y3 = FUNCH2A2p1 (X3)
4941 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
4942 Y2 = Y3
4943 X2 = X3
4944 ELSE
4945 Y1 = Y3
4946 X1 = X3
4947 ENDIF
4948 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
4949 30 CONTINUE
4950 CALL PUSHERR2p1 (0002, 'CALCH2A') ! WARNING ERROR: NO CONVERGENCE
4951 !C
4952 !C *** CONVERGED ; RETURN **********************************************
4953 !C
4954 40 X3 = 0.5*(X1+X2)
4955 Y3 = FUNCH2A2p1 (X3)
4956 !C
4957 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
4958 !C
4959 50 CONTINUE
4960 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
4961 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
4962 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
4963 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
4964 MOLAL(6) = DELTA ! HSO4 EFFECT
4965 ENDIF
4966 !C
4967 RETURN
4968 !C
4969 !C *** END OF SUBROUTINE CALCH2A ******************************************
4970 !C
4971 END
4976 !C=======================================================================
4977 !C
4978 !C *** ISORROPIA CODE
4979 !C *** SUBROUTINE FUNCH2A
4980 !C *** CASE H2 ; SUBCASE 1
4981 !C
4982 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
4983 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
4984 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
4985 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
4986 !C
4987 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
4988 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
4989 !C *** WRITTEN BY ATHANASIOS NENES
4990 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
4991 !C
4992 !C=======================================================================
4993 !C
4994 DOUBLE PRECISION FUNCTION FUNCH2A2p1 (X)
4995 INCLUDE 'module_isrpia_inc.F'
4996 !C
4997 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
4998 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
4999 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5000 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5001 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5002 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5003 !C
5004 !C *** SETUP PARAMETERS ************************************************
5005 !C
5006 PSI6 = X
5007 PSI1 = CHI1
5008 PSI2 = ZERO
5009 PSI3 = ZERO
5010 PSI7 = CHI7
5011 PSI8 = CHI8
5012 FRST = .TRUE.
5013 CALAIN = .TRUE.
5014 !C
5015 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5016 !C
5017 DO 10 I=1,NSWEEP
5018 !C
5019 A1 = XK5 *(WATER/GAMA(2))**3.0
5020 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
5021 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
5022 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
5023 A7 = XK8 *(WATER/GAMA(1))**2.0
5024 A8 = XK9 *(WATER/GAMA(3))**2.0
5025 A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0
5026 A64 = A64*(R*TEMP*WATER)**2.0
5027 A9 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
5028 !C
5029 !C CALCULATE DISSOCIATION QUANTITIES
5030 !C
5031 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
5032 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
5033 PSI5 = MAX(PSI5, TINY)
5034 !C
5035 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
5036 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
5037 CC = CHI4*(PSI5+PSI6)
5038 DD = BB*BB-4.d0*CC
5039 PSI4 =0.5d0*(-BB - SQRT(DD))
5040 PSI4 = MIN(PSI4,CHI4)
5041 ELSE
5042 PSI4 = TINY
5043 ENDIF
5044 !C
5045 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
5046 DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
5047 PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
5048 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
5049 ENDIF
5050 !C
5051 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
5052 DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8
5053 PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) )
5054 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
5055 ENDIF
5056 !C
5057 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! NA2SO4 DISSOLUTION
5058 AA = PSI7+PSI8
5059 BB = AA*AA
5060 CC =-A1/4.D0
5061 CALL POLY32p1 (AA, BB, CC, PSI1, ISLV)
5062 IF (ISLV.EQ.0) THEN
5063 PSI1 = MIN (PSI1, CHI1)
5064 ELSE
5065 PSI1 = ZERO
5066 ENDIF
5067 ENDIF
5068 !C
5069 !C *** CALCULATE SPECIATION ********************************************
5070 !C
5071 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
5072 MOLAL (3) = PSI4 ! NH4I
5073 MOLAL (4) = PSI6 + PSI7 ! CLI
5074 MOLAL (5) = PSI2 + PSI1 ! SO4I
5075 MOLAL (6) = ZERO ! HSO4I
5076 MOLAL (7) = PSI5 + PSI8 ! NO3I
5077 !C
5078 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3)
5079 CALL CALCPH2p1 (SMIN, HI, OHI)
5080 MOLAL (1) = HI
5081 !C
5082 GNH3 = MAX(CHI4 - PSI4, TINY)
5083 GHNO3 = MAX(CHI5 - PSI5, TINY)
5084 GHCL = MAX(CHI6 - PSI6, TINY)
5085 !C
5086 CNH42S4 = ZERO
5087 CNH4NO3 = ZERO
5088 CNACL = MAX(CHI7 - PSI7, ZERO)
5089 CNANO3 = MAX(CHI8 - PSI8, ZERO)
5090 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
5091 !C
5092 !C *** NH4Cl(s) calculations
5093 !C
5094 A3 = XK6 /(R*TEMP*R*TEMP)
5095 DELT = MIN(GNH3, GHCL)
5096 BB = -(GNH3+GHCL)
5097 CC = GNH3*GHCL-A3
5098 DD = BB*BB - 4.D0*CC
5099 PSI31 = 0.5D0*(-BB + SQRT(DD))
5100 PSI32 = 0.5D0*(-BB - SQRT(DD))
5101 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
5102 PSI3 = PSI31
5103 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
5104 PSI3 = PSI32
5105 ELSE
5106 PSI3 = ZERO
5107 ENDIF
5108 !C
5109 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
5110 !C
5111 GNH3 = MAX(GNH3 - PSI3, TINY)
5112 GHCL = MAX(GHCL - PSI3, TINY)
5113 CNH4CL = PSI3
5114 !C
5115 CALL CALCMR2p1 ! Water content
5116 !C
5117 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5118 !C
5119 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5120 CALL CALCACT2p1
5121 ELSE
5122 GOTO 20
5123 ENDIF
5124 10 CONTINUE
5125 !C
5126 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
5127 !C
5128 20 FUNCH2A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE
5129 !C
5130 RETURN
5131 !C
5132 !C *** END OF FUNCTION FUNCH2A *******************************************
5133 !C
5134 END
5137 !C=======================================================================
5138 !C
5139 !C *** ISORROPIA CODE
5140 !C *** SUBROUTINE CALCH1
5141 !C *** CASE H1
5142 !C
5143 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5144 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
5145 !C 2. SOLID AEROSOL ONLY
5146 !C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4
5147 !C
5148 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
5149 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
5150 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A)
5151 !C
5152 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5153 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5154 !C *** WRITTEN BY ATHANASIOS NENES
5155 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5156 !C
5157 !C=======================================================================
5158 !C
5159 SUBROUTINE CALCH12p1
5160 INCLUDE 'module_isrpia_inc.F'
5161 EXTERNAL CALCH1A2p1, CALCH2A2p1
5162 !C
5163 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
5164 !C
5165 IF (RH.LT.DRMH1) THEN
5166 SCASE = 'H1 ; SUBCASE 1'
5167 CALL CALCH1A2p1 ! SOLID PHASE ONLY POSSIBLE
5168 SCASE = 'H1 ; SUBCASE 1'
5169 ELSE
5170 SCASE = 'H1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
5171 CALL CALCMDRH2p1 (RH, DRMH1, DRNH4NO3, CALCH1A2p1, CALCH2A2p1)
5172 SCASE = 'H1 ; SUBCASE 2'
5173 ENDIF
5174 !C
5175 RETURN
5176 !C
5177 !C *** END OF SUBROUTINE CALCH1 ******************************************
5178 !C
5179 END
5182 !C=======================================================================
5183 !C
5184 !C *** ISORROPIA CODE
5185 !C *** SUBROUTINE CALCH1A
5186 !C *** CASE H1 ; SUBCASE 1
5187 !C
5188 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5189 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM RICH (SODRAT >= 2.0)
5190 !C 2. SOLID AEROSOL ONLY
5191 !C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NANO3, NA2SO4
5192 !C
5193 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5194 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5195 !C *** WRITTEN BY ATHANASIOS NENES
5196 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5197 !C
5198 !C=======================================================================
5199 !C
5200 SUBROUTINE CALCH1A2p1
5201 INCLUDE 'module_isrpia_inc.F'
5202 DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, &
5203 NO3FR
5204 !C
5205 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
5206 !C
5207 CNA2SO4 = W(2)
5208 CNH42S4 = ZERO
5209 NAFR = MAX (W(1)-2*CNA2SO4, ZERO)
5210 CNANO3 = MIN (NAFR, W(4))
5211 NO3FR = MAX (W(4)-CNANO3, ZERO)
5212 CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5))
5213 CLFR = MAX (W(5)-CNACL, ZERO)
5214 !C
5215 !C *** CALCULATE VOLATILE SPECIES **************************************
5216 !C
5217 ALF = W(3) ! FREE NH3
5218 BET = CLFR ! FREE CL
5219 GAM = NO3FR ! FREE NO3
5220 !C
5221 RTSQ = R*TEMP*R*TEMP
5222 A1 = XK6/RTSQ
5223 A2 = XK10/RTSQ
5224 !C
5225 THETA1 = GAM - BET*(A2/A1)
5226 THETA2 = A2/A1
5227 !C
5228 !C QUADRATIC EQUATION SOLUTION
5229 !C
5230 BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
5231 CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
5232 DD = BB*BB - 4.0D0*CC
5233 IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately
5234 !C
5235 !C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
5236 !C
5237 SQDD = SQRT(DD)
5238 KAPA1 = 0.5D0*(-BB+SQDD)
5239 KAPA2 = 0.5D0*(-BB-SQDD)
5240 LAMDA1 = THETA1 + THETA2*KAPA1
5241 LAMDA2 = THETA1 + THETA2*KAPA2
5242 !C
5243 IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
5244 IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. &
5245 BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
5246 KAPA = KAPA1
5247 LAMDA= LAMDA1
5248 GOTO 200
5249 ENDIF
5250 ENDIF
5251 !C
5252 IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
5253 IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
5254 BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
5255 KAPA = KAPA2
5256 LAMDA= LAMDA2
5257 GOTO 200
5258 ENDIF
5259 ENDIF
5260 !C
5261 !C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
5262 !C
5263 100 KAPA = ZERO
5264 LAMDA = ZERO
5265 DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
5266 DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
5267 !C
5268 !C NH4CL EQUILIBRIUM
5269 !C
5270 IF (DD1.GE.ZERO) THEN
5271 SQDD1 = SQRT(DD1)
5272 KAPA1 = 0.5D0*(ALF+BET + SQDD1)
5273 KAPA2 = 0.5D0*(ALF+BET - SQDD1)
5274 !C
5275 IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
5276 KAPA = KAPA1
5277 ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
5278 KAPA = KAPA2
5279 ELSE
5280 KAPA = ZERO
5281 ENDIF
5282 ENDIF
5283 !C
5284 !C NH4NO3 EQUILIBRIUM
5285 !C
5286 IF (DD2.GE.ZERO) THEN
5287 SQDD2 = SQRT(DD2)
5288 LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
5289 LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
5290 !C
5291 IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
5292 LAMDA = LAMDA1
5293 ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
5294 LAMDA = LAMDA2
5295 ELSE
5296 LAMDA = ZERO
5297 ENDIF
5298 ENDIF
5299 !C
5300 !C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
5301 !C
5302 IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
5303 IF (BET .LT. LAMDA/THETA1) THEN
5304 KAPA = ZERO
5305 ELSE
5306 LAMDA= ZERO
5307 ENDIF
5308 ENDIF
5309 !C
5310 !C *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
5311 !C
5312 200 CONTINUE
5313 CNH4NO3 = LAMDA
5314 CNH4CL = KAPA
5315 !C
5316 GNH3 = ALF - KAPA - LAMDA
5317 GHNO3 = GAM - LAMDA
5318 GHCL = BET - KAPA
5319 !C
5320 RETURN
5321 !C
5322 !C *** END OF SUBROUTINE CALCH1A *****************************************
5323 !C
5324 END
5325 !C=======================================================================
5326 !C
5327 !C *** ISORROPIA CODE
5328 !C *** SUBROUTINE CALCI6
5329 !C *** CASE I6
5330 !C
5331 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5332 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5333 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5334 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
5335 !C
5336 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5337 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5338 !C *** WRITTEN BY ATHANASIOS NENES
5339 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5340 !C
5341 !C=======================================================================
5342 !C
5343 SUBROUTINE CALCI62p1
5344 INCLUDE 'module_isrpia_inc.F'
5345 !C
5346 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5347 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5348 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5349 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5350 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5351 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5352 !C
5353 !C *** FIND DRY COMPOSITION **********************************************
5354 !C
5355 CALL CALCI1A2p1
5356 !C
5357 !C *** SETUP PARAMETERS ************************************************
5358 !C
5359 CHI1 = CNH4HS4 ! Save from CALCI1 run
5360 CHI2 = CLC
5361 CHI3 = CNAHSO4
5362 CHI4 = CNA2SO4
5363 CHI5 = CNH42S4
5364 !C
5365 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
5366 PSI2 = CLC
5367 PSI3 = CNAHSO4
5368 PSI4 = CNA2SO4
5369 PSI5 = CNH42S4
5370 !C
5371 CALAOU = .TRUE. ! Outer loop activity calculation flag
5372 FRST = .TRUE.
5373 CALAIN = .TRUE.
5374 !C
5375 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5376 !C
5377 DO 10 I=1,NSWEEP
5378 !C
5379 A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
5380 !C
5381 !C CALCULATE DISSOCIATION QUANTITIES
5382 !C
5383 BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6
5384 CC =-A6*(PSI2 + PSI3 + PSI1)
5385 DD = BB*BB - 4.D0*CC
5386 PSI6 = 0.5D0*(-BB + SQRT(DD))
5387 !C
5388 !C *** CALCULATE SPECIATION ********************************************
5389 !C
5390 MOLAL (1) = PSI6 ! HI
5391 MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI
5392 MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
5393 MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I
5394 MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I
5395 CLC = ZERO
5396 CNAHSO4 = ZERO
5397 CNA2SO4 = CHI4 - PSI4
5398 CNH42S4 = ZERO
5399 CNH4HS4 = ZERO
5400 CALL CALCMR2p1 ! Water content
5401 !C
5402 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5403 !C
5404 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5405 CALL CALCACT2p1
5406 ELSE
5407 GOTO 20
5408 ENDIF
5409 10 CONTINUE
5410 !C
5411 20 RETURN
5412 !C
5413 !C *** END OF SUBROUTINE CALCI6 *****************************************
5414 !C
5415 END
5417 !C=======================================================================
5418 !C
5419 !C *** ISORROPIA CODE
5420 !C *** SUBROUTINE CALCI5
5421 !C *** CASE I5
5422 !C
5423 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5424 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5425 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5426 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
5427 !C
5428 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5429 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5430 !C *** WRITTEN BY ATHANASIOS NENES
5431 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5432 !C
5433 !C=======================================================================
5434 !C
5435 SUBROUTINE CALCI52p1
5436 INCLUDE 'module_isrpia_inc.F'
5437 !C
5438 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5439 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5440 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5441 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5442 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5443 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5444 !C
5445 !C *** FIND DRY COMPOSITION **********************************************
5446 !C
5447 CALL CALCI1A2p1
5448 !C
5449 !C *** SETUP PARAMETERS ************************************************
5450 !C
5451 CHI1 = CNH4HS4 ! Save from CALCI1 run
5452 CHI2 = CLC
5453 CHI3 = CNAHSO4
5454 CHI4 = CNA2SO4
5455 CHI5 = CNH42S4
5456 !C
5457 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
5458 PSI2 = CLC
5459 PSI3 = CNAHSO4
5460 PSI4 = ZERO
5461 PSI5 = CNH42S4
5462 !C
5463 CALAOU =.TRUE. ! Outer loop activity calculation flag
5464 PSI4LO = ZERO ! Low limit
5465 PSI4HI = CHI4 ! High limit
5466 !C
5467 !C *** IF NA2SO4(S) =0, CALL FUNCI5B FOR Y4=0 ***************************
5468 !C
5469 IF (CHI4.LE.TINY) THEN
5470 Y1 = FUNCI5A2p1 (ZERO)
5471 GOTO 50
5472 ENDIF
5473 !C
5474 !C *** INITIAL VALUES FOR BISECTION ************************************
5475 !C
5476 X1 = PSI4HI
5477 Y1 = FUNCI5A2p1 (X1)
5478 YHI= Y1 ! Save Y-value at HI position
5479 !C
5480 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 **
5481 !C
5482 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
5483 !C
5484 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
5485 !C
5486 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
5487 DO 10 I=1,NDIV
5488 X2 = X1-DX
5489 Y2 = FUNCI5A2p1 (X2)
5490 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
5491 X1 = X2
5492 Y1 = Y2
5493 10 CONTINUE
5494 !C
5495 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL
5496 !C
5497 YLO= Y1 ! Save Y-value at Hi position
5498 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
5499 Y3 = FUNCI5A2p1 (ZERO)
5500 GOTO 50
5501 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
5502 GOTO 50
5503 ELSE
5504 CALL PUSHERR2p1 (0001, 'CALCI5') ! WARNING ERROR: NO SOLUTION
5505 GOTO 50
5506 ENDIF
5507 !C
5508 !C *** PERFORM BISECTION ***********************************************
5509 !C
5510 20 DO 30 I=1,MAXIT
5511 X3 = 0.5*(X1+X2)
5512 Y3 = FUNCI5A2p1 (X3)
5513 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
5514 Y2 = Y3
5515 X2 = X3
5516 ELSE
5517 Y1 = Y3
5518 X1 = X3
5519 ENDIF
5520 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
5521 30 CONTINUE
5522 CALL PUSHERR2p1 (0002, 'CALCI5') ! WARNING ERROR: NO CONVERGENCE
5523 !C
5524 !C *** CONVERGED ; RETURN **********************************************
5525 !C
5526 40 X3 = 0.5*(X1+X2)
5527 Y3 = FUNCI5A2p1 (X3)
5528 !C
5529 50 RETURN
5531 !C *** END OF SUBROUTINE CALCI5 *****************************************
5532 !C
5533 END
5538 !C=======================================================================
5539 !C
5540 !C *** ISORROPIA CODE
5541 !C *** SUBROUTINE FUNCI5A
5542 !C *** CASE I5
5543 !C
5544 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5545 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5546 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5547 !C 3. SOLIDS POSSIBLE : NA2SO4
5548 !C
5549 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5550 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5551 !C *** WRITTEN BY ATHANASIOS NENES
5552 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5553 !C
5554 !C=======================================================================
5555 !C
5556 DOUBLE PRECISION FUNCTION FUNCI5A2p1 (P4)
5557 INCLUDE 'module_isrpia_inc.F'
5558 !C
5559 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5560 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5561 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5562 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5563 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5564 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5565 !C
5566 !C *** SETUP PARAMETERS ************************************************
5567 !C
5568 PSI4 = P4 ! PSI3 already assigned in FUNCI5A
5569 FRST = .TRUE.
5570 CALAIN = .TRUE.
5571 !C
5572 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5573 !C
5574 DO 10 I=1,NSWEEP
5575 !C
5576 A4 = XK5 *(WATER/GAMA(2))**3.0
5577 A5 = XK7 *(WATER/GAMA(4))**3.0
5578 A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
5579 !C
5580 !C CALCULATE DISSOCIATION QUANTITIES
5581 !C
5582 BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6
5583 CC =-A6*(PSI2 + PSI3 + PSI1)
5584 DD = BB*BB - 4.D0*CC
5585 PSI6 = 0.5D0*(-BB + SQRT(DD))
5586 !C
5587 !C *** CALCULATE SPECIATION ********************************************
5588 !C
5589 MOLAL (1) = PSI6 ! HI
5590 MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI
5591 MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
5592 MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I
5593 MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I
5594 CLC = ZERO
5595 CNAHSO4 = ZERO
5596 CNA2SO4 = CHI4 - PSI4
5597 CNH42S4 = ZERO
5598 CNH4HS4 = ZERO
5599 CALL CALCMR2p1 ! Water content
5600 !C
5601 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5602 !C
5603 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5604 CALL CALCACT2p1
5605 ELSE
5606 GOTO 20
5607 ENDIF
5608 10 CONTINUE
5609 !C
5610 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
5611 !C
5612 20 A4 = XK5 *(WATER/GAMA(2))**3.0
5613 FUNCI5A2p1= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
5614 RETURN
5615 !C
5616 !C *** END OF FUNCTION FUNCI5A ********************************************
5617 !C
5618 END
5619 !C=======================================================================
5620 !C
5621 !C *** ISORROPIA CODE
5622 !C *** SUBROUTINE CALCI4
5623 !C *** CASE I4
5624 !C
5625 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5626 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5627 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5628 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
5629 !C
5630 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5631 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5632 !C *** WRITTEN BY ATHANASIOS NENES
5633 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5634 !C
5635 !C=======================================================================
5636 !C
5637 SUBROUTINE CALCI42p1
5638 INCLUDE 'module_isrpia_inc.F'
5639 !C
5640 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5641 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5642 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5643 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5644 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5645 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5646 !C
5647 !C *** FIND DRY COMPOSITION **********************************************
5648 !C
5649 CALL CALCI1A2p1
5650 !C
5651 !C *** SETUP PARAMETERS ************************************************
5652 !C
5653 CHI1 = CNH4HS4 ! Save from CALCI1 run
5654 CHI2 = CLC
5655 CHI3 = CNAHSO4
5656 CHI4 = CNA2SO4
5657 CHI5 = CNH42S4
5658 !C
5659 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
5660 PSI2 = CLC
5661 PSI3 = CNAHSO4
5662 PSI4 = ZERO
5663 PSI5 = ZERO
5664 !C
5665 CALAOU = .TRUE. ! Outer loop activity calculation flag
5666 PSI4LO = ZERO ! Low limit
5667 PSI4HI = CHI4 ! High limit
5668 !C
5669 !C *** IF NA2SO4(S) =0, CALL FUNCI4B FOR Y4=0 ***************************
5670 !C
5671 IF (CHI4.LE.TINY) THEN
5672 Y1 = FUNCI4A2p1 (ZERO)
5673 GOTO 50
5674 ENDIF
5675 !C
5676 !C *** INITIAL VALUES FOR BISECTION ************************************
5677 !C
5678 X1 = PSI4HI
5679 Y1 = FUNCI4A2p1 (X1)
5680 YHI= Y1 ! Save Y-value at HI position
5681 !C
5682 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 **
5683 !C
5684 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
5685 !C
5686 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
5687 !C
5688 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
5689 DO 10 I=1,NDIV
5690 X2 = X1-DX
5691 Y2 = FUNCI4A2p1 (X2)
5692 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
5693 X1 = X2
5694 Y1 = Y2
5695 10 CONTINUE
5696 !C
5697 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH4CL
5698 !C
5699 YLO= Y1 ! Save Y-value at Hi position
5700 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
5701 Y3 = FUNCI4A2p1 (ZERO)
5702 GOTO 50
5703 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
5704 GOTO 50
5705 ELSE
5706 CALL PUSHERR2p1 (0001, 'CALCI4') ! WARNING ERROR: NO SOLUTION
5707 GOTO 50
5708 ENDIF
5709 !C
5710 !C *** PERFORM BISECTION ***********************************************
5711 !C
5712 20 DO 30 I=1,MAXIT
5713 X3 = 0.5*(X1+X2)
5714 Y3 = FUNCI4A2p1 (X3)
5715 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
5716 Y2 = Y3
5717 X2 = X3
5718 ELSE
5719 Y1 = Y3
5720 X1 = X3
5721 ENDIF
5722 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
5723 30 CONTINUE
5724 CALL PUSHERR2p1 (0002, 'CALCI4') ! WARNING ERROR: NO CONVERGENCE
5725 !C
5726 !C *** CONVERGED ; RETURN **********************************************
5727 !C
5728 40 X3 = 0.5*(X1+X2)
5729 Y3 = FUNCI4A2p1 (X3)
5730 !C
5731 50 RETURN
5733 !C *** END OF SUBROUTINE CALCI4 *****************************************
5734 !C
5735 END
5740 !C=======================================================================
5741 !C
5742 !C *** ISORROPIA CODE
5743 !C *** SUBROUTINE FUNCI4A
5744 !C *** CASE I4
5745 !C
5746 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5747 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5748 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5749 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4
5750 !C
5751 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5752 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5753 !C *** WRITTEN BY ATHANASIOS NENES
5754 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5755 !C
5756 !C=======================================================================
5757 !C
5758 DOUBLE PRECISION FUNCTION FUNCI4A2p1 (P4)
5759 INCLUDE 'module_isrpia_inc.F'
5760 !C
5761 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5762 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5763 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5764 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5765 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5766 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5767 !C
5768 !C *** SETUP PARAMETERS ************************************************
5769 !C
5770 PSI4 = P4 ! PSI3 already assigned in FUNCI4A
5771 FRST = .TRUE.
5772 CALAIN = .TRUE.
5773 !C
5774 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
5775 !C
5776 DO 10 I=1,NSWEEP
5777 !C
5778 A4 = XK5 *(WATER/GAMA(2))**3.0
5779 A5 = XK7 *(WATER/GAMA(4))**3.0
5780 A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
5781 A7 = SQRT(A4/A5)
5782 !C
5783 !C CALCULATE DISSOCIATION QUANTITIES
5784 !C
5785 BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6
5786 CC =-A6*(PSI2 + PSI3 + PSI1)
5787 DD = BB*BB - 4.D0*CC
5788 PSI6 = 0.5D0*(-BB + SQRT(DD))
5789 !C
5790 PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
5791 PSI5 = MAX (MIN (PSI5, CHI5), ZERO)
5792 !C
5793 !C *** CALCULATE SPECIATION ********************************************
5794 !C
5795 MOLAL (1) = PSI6 ! HI
5796 MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI
5797 MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
5798 MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I
5799 MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I
5800 CLC = ZERO
5801 CNAHSO4 = ZERO
5802 CNA2SO4 = CHI4 - PSI4
5803 CNH42S4 = CHI5 - PSI5
5804 CNH4HS4 = ZERO
5805 CALL CALCMR2p1 ! Water content
5806 !C
5807 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
5808 !C
5809 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
5810 CALL CALCACT2p1
5811 ELSE
5812 GOTO 20
5813 ENDIF
5814 10 CONTINUE
5815 !C
5816 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
5817 !C
5818 20 A4 = XK5 *(WATER/GAMA(2))**3.0
5819 FUNCI4A2p1= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
5820 RETURN
5821 !C
5822 !C *** END OF FUNCTION FUNCI4A ********************************************
5823 !C
5824 END
5825 !C=======================================================================
5826 !C
5827 !C *** ISORROPIA CODE
5828 !C *** SUBROUTINE CALCI3
5829 !C *** CASE I3
5830 !C
5831 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5832 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5833 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5834 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
5835 !C
5836 !C THERE ARE THREE REGIMES IN THIS CASE:
5837 !C 1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A)
5838 !C 2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
5839 !C 3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
5840 !C
5841 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B
5842 !C RESPECTIVELY
5843 !C
5844 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5845 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5846 !C *** WRITTEN BY ATHANASIOS NENES
5847 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5848 !C
5849 !C=======================================================================
5850 !C
5851 SUBROUTINE CALCI32p1
5852 INCLUDE 'module_isrpia_inc.F'
5853 EXTERNAL CALCI1A2p1, CALCI42p1
5854 !C
5855 !C *** FIND DRY COMPOSITION **********************************************
5856 !C
5857 CALL CALCI1A2p1
5858 !C
5859 !C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
5860 !C
5861 IF (CNH4HS4.GT.TINY .OR. CNAHSO4.GT.TINY) THEN
5862 SCASE = 'I3 ; SUBCASE 1'
5863 CALL CALCI3A2p1 ! FULL SOLUTION
5864 SCASE = 'I3 ; SUBCASE 1'
5865 ENDIF
5866 !C
5867 IF (WATER.LE.TINY) THEN
5868 IF (RH.LT.DRMI3) THEN ! SOLID SOLUTION
5869 WATER = TINY
5870 DO 10 I=1,NIONS
5871 MOLAL(I) = ZERO
5872 10 CONTINUE
5873 CALL CALCI1A2p1
5874 SCASE = 'I3 ; SUBCASE 2'
5875 !C
5876 ELSEIF (RH.GE.DRMI3) THEN ! MDRH OF I3
5877 SCASE = 'I3 ; SUBCASE 3'
5878 CALL CALCMDRH2p1 (RH, DRMI3, DRLC, CALCI1A2p1, CALCI42p1)
5879 SCASE = 'I3 ; SUBCASE 3'
5880 ENDIF
5881 ENDIF
5882 !C
5883 RETURN
5884 !C
5885 !C *** END OF SUBROUTINE CALCI3 ******************************************
5886 !C
5887 END
5891 !C=======================================================================
5892 !C
5893 !C *** ISORROPIA CODE
5894 !C *** SUBROUTINE CALCI3A
5895 !C *** CASE I3 ; SUBCASE 1
5896 !C
5897 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
5898 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
5899 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
5900 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
5901 !C
5902 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
5903 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
5904 !C *** WRITTEN BY ATHANASIOS NENES
5905 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
5906 !C
5907 !C=======================================================================
5908 !C
5909 SUBROUTINE CALCI3A2p1
5910 INCLUDE 'module_isrpia_inc.F'
5911 !C
5912 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
5913 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
5914 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
5915 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
5916 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
5917 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
5918 !C
5919 !C *** FIND DRY COMPOSITION **********************************************
5920 !C
5921 CALL CALCI1A2p1 ! Needed when called from CALCMDRH
5922 !C
5923 !C *** SETUP PARAMETERS ************************************************
5924 !C
5925 CHI1 = CNH4HS4 ! Save from CALCI1 run
5926 CHI2 = CLC
5927 CHI3 = CNAHSO4
5928 CHI4 = CNA2SO4
5929 CHI5 = CNH42S4
5930 !C
5931 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
5932 PSI2 = ZERO
5933 PSI3 = CNAHSO4
5934 PSI4 = ZERO
5935 PSI5 = ZERO
5936 !C
5937 CALAOU = .TRUE. ! Outer loop activity calculation flag
5938 PSI2LO = ZERO ! Low limit
5939 PSI2HI = CHI2 ! High limit
5940 !C
5941 !C *** INITIAL VALUES FOR BISECTION ************************************
5942 !C
5943 X1 = PSI2HI
5944 Y1 = FUNCI3A2p1 (X1)
5945 YHI= Y1 ! Save Y-value at HI position
5946 !C
5947 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
5948 !C
5949 IF (YHI.LT.EPS) GOTO 50
5950 !C
5951 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
5952 !C
5953 DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
5954 DO 10 I=1,NDIV
5955 X2 = MAX(X1-DX, PSI2LO)
5956 Y2 = FUNCI3A2p1 (X2)
5957 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
5958 X1 = X2
5959 Y1 = Y2
5960 10 CONTINUE
5961 !C
5962 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
5963 !C
5964 IF (Y2.GT.EPS) Y2 = FUNCI3A2p1 (ZERO)
5965 GOTO 50
5966 !C
5967 !C *** PERFORM BISECTION ***********************************************
5968 !C
5969 20 DO 30 I=1,MAXIT
5970 X3 = 0.5*(X1+X2)
5971 Y3 = FUNCI3A2p1 (X3)
5972 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
5973 Y2 = Y3
5974 X2 = X3
5975 ELSE
5976 Y1 = Y3
5977 X1 = X3
5978 ENDIF
5979 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
5980 30 CONTINUE
5981 CALL PUSHERR2p1 (0002, 'CALCI3A') ! WARNING ERROR: NO CONVERGENCE
5982 !C
5983 !C *** CONVERGED ; RETURN **********************************************
5984 !C
5985 40 X3 = 0.5*(X1+X2)
5986 Y3 = FUNCI3A2p1 (X3)
5987 !C
5988 50 RETURN
5990 !C *** END OF SUBROUTINE CALCI3A *****************************************
5991 !C
5992 END
5993 !C
5994 !C=======================================================================
5995 !C
5996 !C *** ISORROPIA CODE
5997 !C *** SUBROUTINE FUNCI3A
5998 !C *** CASE I3 ; SUBCASE 1
5999 !C
6000 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6001 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6002 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
6003 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
6004 !C
6005 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6006 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6007 !C *** WRITTEN BY ATHANASIOS NENES
6008 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6009 !C
6010 !C=======================================================================
6011 !C
6012 DOUBLE PRECISION FUNCTION FUNCI3A2p1 (P2)
6013 INCLUDE 'module_isrpia_inc.F'
6014 !C
6015 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
6016 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
6017 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
6018 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
6019 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
6020 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
6021 !C
6022 !C *** SETUP PARAMETERS ************************************************
6023 !C
6024 PSI2 = P2 ! Save PSI2 in COMMON BLOCK
6025 PSI4LO = ZERO ! Low limit for PSI4
6026 PSI4HI = CHI4 ! High limit for PSI4
6027 !C
6028 !C *** IF NH3 =0, CALL FUNCI3B FOR Y4=0 ********************************
6029 !C
6030 IF (CHI4.LE.TINY) THEN
6031 FUNCI3A2p1 = FUNCI3B2p1 (ZERO)
6032 GOTO 50
6033 ENDIF
6034 !C
6035 !C *** INITIAL VALUES FOR BISECTION ************************************
6036 !C
6037 X1 = PSI4HI
6038 Y1 = FUNCI3B2p1 (X1)
6039 IF (ABS(Y1).LE.EPS) GOTO 50
6040 YHI= Y1 ! Save Y-value at HI position
6041 !C
6042 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *****
6043 !C
6044 IF (YHI.LT.ZERO) GOTO 50
6045 !C
6046 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
6047 !C
6048 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
6049 DO 10 I=1,NDIV
6050 X2 = MAX(X1-DX, PSI4LO)
6051 Y2 = FUNCI3B2p1 (X2)
6052 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
6053 X1 = X2
6054 Y1 = Y2
6055 10 CONTINUE
6056 !C
6057 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4
6058 !C
6059 IF (Y2.GT.EPS) Y2 = FUNCI3B2p1 (PSI4LO)
6060 GOTO 50
6061 !C
6062 !C *** PERFORM BISECTION ***********************************************
6063 !C
6064 20 DO 30 I=1,MAXIT
6065 X3 = 0.5*(X1+X2)
6066 Y3 = FUNCI3B2p1 (X3)
6067 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
6068 Y2 = Y3
6069 X2 = X3
6070 ELSE
6071 Y1 = Y3
6072 X1 = X3
6073 ENDIF
6074 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
6075 30 CONTINUE
6076 CALL PUSHERR2p1 (0004, 'FUNCI3A2p1') ! WARNING ERROR: NO CONVERGENCE
6077 !C
6078 !C *** INNER LOOP CONVERGED **********************************************
6079 !C
6080 40 X3 = 0.5*(X1+X2)
6081 Y3 = FUNCI3B2p1 (X3)
6082 !C
6083 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
6084 !C
6085 50 A2 = XK13*(WATER/GAMA(13))**5.0
6086 FUNCI3A2p1 = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE
6087 RETURN
6088 !C
6089 !C *** END OF FUNCTION FUNCI3A *******************************************
6090 !C
6091 END
6095 !C=======================================================================
6096 !C
6097 !C *** ISORROPIA CODE
6098 !C *** FUNCTION FUNCI3B
6099 !C *** CASE I3 ; SUBCASE 2
6100 !C
6101 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6102 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6103 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
6104 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, LC
6105 !C
6106 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
6107 !C
6108 !C=======================================================================
6109 !C
6110 DOUBLE PRECISION FUNCTION FUNCI3B2p1 (P4)
6111 INCLUDE 'module_isrpia_inc.F'
6112 !C
6113 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
6114 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
6115 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
6116 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
6117 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
6118 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
6119 !C
6120 !C *** SETUP PARAMETERS ************************************************
6121 !C
6122 PSI4 = P4
6123 !C
6124 !C *** SETUP PARAMETERS ************************************************
6125 !C
6126 FRST = .TRUE.
6127 CALAIN = .TRUE.
6128 !C
6129 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6130 !C
6131 DO 10 I=1,NSWEEP
6132 !C
6133 A4 = XK5*(WATER/GAMA(2))**3.0
6134 A5 = XK7*(WATER/GAMA(4))**3.0
6135 A6 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
6136 A7 = SQRT(A4/A5)
6137 !C
6138 !C CALCULATE DISSOCIATION QUANTITIES
6139 !C
6140 BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6
6141 CC =-A6*(PSI2 + PSI3 + PSI1)
6142 DD = BB*BB - 4.D0*CC
6143 PSI6 = 0.5D0*(-BB + SQRT(DD))
6144 !C
6145 PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
6146 PSI5 = MAX (MIN (PSI5, CHI5), ZERO)
6147 !C
6148 !C *** CALCULATE SPECIATION ********************************************
6149 !C
6150 MOLAL(1) = PSI6 ! HI
6151 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
6152 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
6153 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I
6154 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 - PSI6, TINY) ! HSO4I
6155 CLC = MAX(CHI2 - PSI2, ZERO)
6156 CNAHSO4 = ZERO
6157 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
6158 CNH42S4 = MAX(CHI5 - PSI5, ZERO)
6159 CNH4HS4 = ZERO
6160 CALL CALCMR2p1 ! Water content
6161 !C
6162 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6163 !C
6164 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6165 CALL CALCACT2p1
6166 ELSE
6167 GOTO 20
6168 ENDIF
6169 10 CONTINUE
6170 !C
6171 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
6172 !C
6173 20 A4 = XK5 *(WATER/GAMA(2))**3.0
6174 FUNCI3B2p1= MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
6175 RETURN
6176 !C
6177 !C *** END OF FUNCTION FUNCI3B ********************************************
6178 !C
6179 END
6180 !C=======================================================================
6181 !C
6182 !C *** ISORROPIA CODE
6183 !C *** SUBROUTINE CALCI2
6184 !C *** CASE I2
6185 !C
6186 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6187 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6188 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
6189 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
6190 !C
6191 !C THERE ARE THREE REGIMES IN THIS CASE:
6192 !C 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI2A)
6193 !C 2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
6194 !C 3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
6195 !C
6196 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B
6197 !C RESPECTIVELY
6198 !C
6199 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6200 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6201 !C *** WRITTEN BY ATHANASIOS NENES
6202 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6203 !C
6204 !C=======================================================================
6205 !C
6206 SUBROUTINE CALCI22p1
6207 INCLUDE 'module_isrpia_inc.F'
6208 EXTERNAL CALCI1A2p1, CALCI3A2p1
6209 !C
6210 !C *** FIND DRY COMPOSITION **********************************************
6211 !C
6212 CALL CALCI1A2p1
6213 !C
6214 !C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
6215 !C
6216 IF (CNH4HS4.GT.TINY) THEN
6217 SCASE = 'I2 ; SUBCASE 1'
6218 CALL CALCI2A2p1
6219 SCASE = 'I2 ; SUBCASE 1'
6220 ENDIF
6221 !C
6222 IF (WATER.LE.TINY) THEN
6223 IF (RH.LT.DRMI2) THEN ! SOLID SOLUTION ONLY
6224 WATER = TINY
6225 DO 10 I=1,NIONS
6226 MOLAL(I) = ZERO
6227 10 CONTINUE
6228 CALL CALCI1A2p1
6229 SCASE = 'I2 ; SUBCASE 2'
6230 !C
6231 ELSEIF (RH.GE.DRMI2) THEN ! MDRH OF I2
6232 SCASE = 'I2 ; SUBCASE 3'
6233 CALL CALCMDRH2p1 (RH, DRMI2, DRNAHSO4, CALCI1A2p1, CALCI3A2p1)
6234 SCASE = 'I2 ; SUBCASE 3'
6235 ENDIF
6236 ENDIF
6237 !C
6238 RETURN
6239 !C
6240 !C *** END OF SUBROUTINE CALCI2 ******************************************
6241 !C
6242 END
6245 !C=======================================================================
6246 !C
6247 !C *** ISORROPIA CODE
6248 !C *** SUBROUTINE CALCI2A
6249 !C *** CASE I2 ; SUBCASE A
6250 !C
6251 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6252 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6253 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
6254 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
6255 !C
6256 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6257 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6258 !C *** WRITTEN BY ATHANASIOS NENES
6259 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6260 !C
6261 !C=======================================================================
6262 !C
6263 SUBROUTINE CALCI2A2p1
6264 INCLUDE 'module_isrpia_inc.F'
6265 !C
6266 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
6267 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
6268 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
6269 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
6270 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
6271 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
6272 !C
6273 !C *** FIND DRY COMPOSITION **********************************************
6274 !C
6275 CALL CALCI1A2p1 ! Needed when called from CALCMDRH
6276 !C
6277 !C *** SETUP PARAMETERS ************************************************
6278 !C
6279 CHI1 = CNH4HS4 ! Save from CALCI1 run
6280 CHI2 = CLC
6281 CHI3 = CNAHSO4
6282 CHI4 = CNA2SO4
6283 CHI5 = CNH42S4
6284 !C
6285 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
6286 PSI2 = ZERO
6287 PSI3 = ZERO
6288 PSI4 = ZERO
6289 PSI5 = ZERO
6290 !C
6291 CALAOU = .TRUE. ! Outer loop activity calculation flag
6292 PSI2LO = ZERO ! Low limit
6293 PSI2HI = CHI2 ! High limit
6294 !C
6295 !C *** INITIAL VALUES FOR BISECTION ************************************
6296 !C
6297 X1 = PSI2HI
6298 Y1 = FUNCI2A2p1 (X1)
6299 YHI= Y1 ! Save Y-value at HI position
6300 !C
6301 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
6302 !C
6303 IF (YHI.LT.EPS) GOTO 50
6304 !C
6305 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
6306 !C
6307 DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
6308 DO 10 I=1,NDIV
6309 X2 = MAX(X1-DX, PSI2LO)
6310 Y2 = FUNCI2A2p1 (X2)
6311 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
6312 X1 = X2
6313 Y1 = Y2
6314 10 CONTINUE
6315 !C
6316 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
6317 !C
6318 IF (Y2.GT.EPS) Y2 = FUNCI2A2p1 (ZERO)
6319 GOTO 50
6320 !C
6321 !C *** PERFORM BISECTION ***********************************************
6322 !C
6323 20 DO 30 I=1,MAXIT
6324 X3 = 0.5*(X1+X2)
6325 Y3 = FUNCI2A2p1 (X3)
6326 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
6327 Y2 = Y3
6328 X2 = X3
6329 ELSE
6330 Y1 = Y3
6331 X1 = X3
6332 ENDIF
6333 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
6334 30 CONTINUE
6335 CALL PUSHERR2p1 (0002, 'CALCI2A') ! WARNING ERROR: NO CONVERGENCE
6336 !C
6337 !C *** CONVERGED ; RETURN **********************************************
6338 !C
6339 40 X3 = 0.5*(X1+X2)
6340 Y3 = FUNCI2A2p1 (X3)
6341 !C
6342 50 RETURN
6344 !C *** END OF SUBROUTINE CALCI2A *****************************************
6345 !C
6346 END
6351 !C=======================================================================
6352 !C
6353 !C *** ISORROPIA CODE
6354 !C *** SUBROUTINE FUNCI2A
6355 !C *** CASE I2 ; SUBCASE 1
6356 !C
6357 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6358 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6359 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
6360 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, NAHSO4, LC
6361 !C
6362 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6363 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6364 !C *** WRITTEN BY ATHANASIOS NENES
6365 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6366 !C
6367 !C=======================================================================
6368 !C
6369 DOUBLE PRECISION FUNCTION FUNCI2A2p1 (P2)
6370 INCLUDE 'module_isrpia_inc.F'
6371 !C
6372 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
6373 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
6374 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
6375 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
6376 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6,&
6377 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
6378 !C
6379 !C *** SETUP PARAMETERS ************************************************
6380 !C
6381 FRST = .TRUE.
6382 CALAIN = .TRUE.
6383 PSI2 = P2 ! Save PSI2 in COMMON BLOCK
6384 PSI3 = CHI3
6385 PSI4 = CHI4
6386 PSI5 = CHI5
6387 PSI6 = ZERO
6388 !C
6389 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6390 !C
6391 DO 10 I=1,NSWEEP
6392 !C
6393 A3 = XK11*(WATER/GAMA(12))**2.0
6394 A4 = XK5 *(WATER/GAMA(2))**3.0
6395 A5 = XK7 *(WATER/GAMA(4))**3.0
6396 A6 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
6397 A7 = SQRT(A4/A5)
6398 !C
6399 !C CALCULATE DISSOCIATION QUANTITIES
6400 !C
6401 IF (CHI5.GT.TINY .AND. WATER.GT.TINY) THEN
6402 PSI5 = (PSI3 + 2.D0*PSI4 - A7*(3.D0*PSI2 + PSI1))/2.D0/A7
6403 PSI5 = MAX(MIN (PSI5, CHI5), TINY)
6404 ENDIF
6405 !C
6406 IF (CHI4.GT.TINY .AND. WATER.GT.TINY) THEN
6407 AA = PSI2+PSI5+PSI6+PSI3
6408 BB = PSI3*AA
6409 CC = 0.25D0*(PSI3*PSI3*(PSI2+PSI5+PSI6)-A4)
6410 CALL POLY32p1 (AA, BB, CC, PSI4, ISLV)
6411 IF (ISLV.EQ.0) THEN
6412 PSI4 = MIN (PSI4, CHI4)
6413 ELSE
6414 PSI4 = ZERO
6415 ENDIF
6416 ENDIF
6417 !C
6418 IF (CHI3.GT.TINY .AND. WATER.GT.TINY) THEN
6419 AA = 2.D0*PSI4 + PSI2 + PSI1 - PSI6
6420 BB = 2.D0*PSI4*(PSI2 + PSI1 - PSI6) - A3
6421 CC = ZERO
6422 CALL POLY32p1 (AA, BB, CC, PSI3, ISLV)
6423 IF (ISLV.EQ.0) THEN
6424 PSI3 = MIN (PSI3, CHI3)
6425 ELSE
6426 PSI3 = ZERO
6427 ENDIF
6428 ENDIF
6429 !C
6430 BB = PSI2 + PSI4 + PSI5 + A6 ! PSI6
6431 CC =-A6*(PSI2 + PSI3 + PSI1)
6432 DD = BB*BB - 4.D0*CC
6433 PSI6 = 0.5D0*(-BB + SQRT(DD))
6434 !C
6435 !C *** CALCULATE SPECIATION ********************************************
6436 !C
6437 MOLAL (1) = PSI6 ! HI
6438 MOLAL (2) = 2.D0*PSI4 + PSI3 ! NAI
6439 MOLAL (3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
6440 MOLAL (5) = PSI2 + PSI4 + PSI5 + PSI6 ! SO4I
6441 MOLAL (6) = PSI2 + PSI3 + PSI1 - PSI6 ! HSO4I
6442 CLC = CHI2 - PSI2
6443 CNAHSO4 = CHI3 - PSI3
6444 CNA2SO4 = CHI4 - PSI4
6445 CNH42S4 = CHI5 - PSI5
6446 CNH4HS4 = ZERO
6447 CALL CALCMR2p1 ! Water content
6448 !C
6449 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6450 !C
6451 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6452 CALL CALCACT2p1
6453 ELSE
6454 GOTO 20
6455 ENDIF
6456 10 CONTINUE
6457 !C
6458 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
6459 !C
6460 20 A2 = XK13*(WATER/GAMA(13))**5.0
6461 FUNCI2A2p1 = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.D0/A2 - ONE
6462 RETURN
6463 !C
6464 !C *** END OF FUNCTION FUNCI2A *******************************************
6465 !C
6466 END
6468 !C=======================================================================
6469 !C
6470 !C *** ISORROPIA CODE
6471 !C *** SUBROUTINE CALCI1
6472 !C *** CASE I1
6473 !C
6474 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6475 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6476 !C 2. SOLID AEROSOL ONLY
6477 !C 3. SOLIDS POSSIBLE : NH4NO3, NH4CL, NA2SO4
6478 !C
6479 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
6480 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
6481 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A)
6482 !C
6483 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6484 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6485 !C *** WRITTEN BY ATHANASIOS NENES
6486 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6487 !C
6488 !C=======================================================================
6489 !C
6490 SUBROUTINE CALCI12p1
6491 INCLUDE 'module_isrpia_inc.F'
6492 EXTERNAL CALCI1A2p1, CALCI2A2p1
6493 !C
6494 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
6495 !C
6496 IF (RH.LT.DRMI1) THEN
6497 SCASE = 'I1 ; SUBCASE 1'
6498 CALL CALCI1A2p1 ! SOLID PHASE ONLY POSSIBLE
6499 SCASE = 'I1 ; SUBCASE 1'
6500 ELSE
6501 SCASE = 'I1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
6502 CALL CALCMDRH2p1 (RH, DRMI1, DRNH4HS4, CALCI1A2p1, CALCI2A2p1)
6503 SCASE = 'I1 ; SUBCASE 2'
6504 ENDIF
6505 !C
6506 !C *** AMMONIA IN GAS PHASE **********************************************
6507 !C
6508 !C CALL CALCNH3
6509 !C
6510 RETURN
6511 !C
6512 !C *** END OF SUBROUTINE CALCI1 ******************************************
6513 !C
6514 END
6517 !C=======================================================================
6518 !C
6519 !C *** ISORROPIA CODE
6520 !C *** SUBROUTINE CALCI1A
6521 !C *** CASE I1 ; SUBCASE 1
6522 !C
6523 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6524 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
6525 !C 2. SOLID AEROSOL ONLY
6526 !C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
6527 !C
6528 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6529 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6530 !C *** WRITTEN BY ATHANASIOS NENES
6531 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6532 !C
6533 !C=======================================================================
6534 !C
6535 SUBROUTINE CALCI1A2p1
6536 INCLUDE 'module_isrpia_inc.F'
6537 !C
6538 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
6539 !C
6540 CNA2SO4 = 0.5D0*W(1)
6541 CNH4HS4 = ZERO
6542 CNAHSO4 = ZERO
6543 CNH42S4 = ZERO
6544 FRSO4 = MAX(W(2)-CNA2SO4, ZERO)
6545 !C
6546 CLC = MIN(W(3)/3.D0, FRSO4/2.D0)
6547 FRSO4 = MAX(FRSO4-2.D0*CLC, ZERO)
6548 FRNH4 = MAX(W(3)-3.D0*CLC, ZERO)
6549 !C
6550 IF (FRSO4.LE.TINY) THEN
6551 CLC = MAX(CLC - FRNH4, ZERO)
6552 CNH42S4 = 2.D0*FRNH4
6554 ELSEIF (FRNH4.LE.TINY) THEN
6555 CNH4HS4 = 3.D0*MIN(FRSO4, CLC)
6556 CLC = MAX(CLC-FRSO4, ZERO)
6557 IF (CNA2SO4.GT.TINY) THEN
6558 FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO)
6559 CNAHSO4 = 2.D0*FRSO4
6560 CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO)
6561 ENDIF
6562 ENDIF
6563 !C
6564 !C *** CALCULATE GAS SPECIES *********************************************
6565 !C
6566 GHNO3 = W(4)
6567 GHCL = W(5)
6568 GNH3 = ZERO
6569 !C
6570 RETURN
6571 !C
6572 !C *** END OF SUBROUTINE CALCI1A *****************************************
6573 !C
6574 END
6575 !C=======================================================================
6576 !C
6577 !C *** ISORROPIA CODE
6578 !C *** SUBROUTINE CALCJ3
6579 !C *** CASE J3
6580 !C
6581 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6582 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
6583 !C 2. THERE IS ONLY A LIQUID PHASE
6584 !C
6585 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6586 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6587 !C *** WRITTEN BY ATHANASIOS NENES
6588 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6589 !C
6590 !C=======================================================================
6591 !C
6592 SUBROUTINE CALCJ32p1
6593 INCLUDE 'module_isrpia_inc.F'
6594 !C
6595 DOUBLE PRECISION LAMDA, KAPA
6596 !C
6597 !C *** SETUP PARAMETERS ************************************************
6598 !C
6599 CALAOU = .TRUE. ! Outer loop activity calculation flag
6600 FRST = .TRUE.
6601 CALAIN = .TRUE.
6602 !C
6603 LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4
6604 CHI1 = W(1) ! NA TOTAL as NaHSO4
6605 CHI2 = W(3) ! NH4 TOTAL as NH4HSO4
6606 PSI1 = CHI1
6607 PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED
6608 !C
6609 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6610 !C
6611 DO 10 I=1,NSWEEP
6612 !C
6613 A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
6614 !C
6615 !C CALCULATE DISSOCIATION QUANTITIES
6616 !C
6617 BB = A3+LAMDA ! KAPA
6618 CC =-A3*(LAMDA + PSI1 + PSI2)
6619 DD = BB*BB-4.D0*CC
6620 KAPA = 0.5D0*(-BB+SQRT(DD))
6621 !C
6622 !C *** CALCULATE SPECIATION ********************************************
6623 !C
6624 MOLAL (1) = LAMDA + KAPA ! HI
6625 MOLAL (2) = PSI1 ! NAI
6626 MOLAL (3) = PSI2 ! NH4I
6627 MOLAL (4) = ZERO ! CLI
6628 MOLAL (5) = KAPA ! SO4I
6629 MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I
6630 MOLAL (7) = ZERO ! NO3I
6631 !C
6632 CNAHSO4 = ZERO
6633 CNH4HS4 = ZERO
6634 !C
6635 CALL CALCMR2p1 ! Water content
6636 !C
6637 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6638 !C
6639 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6640 CALL CALCACT2p1
6641 ELSE
6642 GOTO 50
6643 ENDIF
6644 10 CONTINUE
6645 !C
6646 50 RETURN
6647 !C
6648 !C *** END OF SUBROUTINE CALCJ3 ******************************************
6649 !C
6650 END
6651 !C=======================================================================
6652 !C
6653 !C *** ISORROPIA CODE
6654 !C *** SUBROUTINE CALCJ2
6655 !C *** CASE J2
6656 !C
6657 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6658 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
6659 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
6660 !C 3. SOLIDS POSSIBLE : NAHSO4
6661 !C
6662 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6663 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6664 !C *** WRITTEN BY ATHANASIOS NENES
6665 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6666 !C
6667 !C=======================================================================
6668 !C
6669 SUBROUTINE CALCJ22p1
6670 INCLUDE 'module_isrpia_inc.F'
6671 !C
6672 DOUBLE PRECISION LAMDA, KAPA
6673 COMMON /CASEJ2p1/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, &
6674 A1, A2, A3
6675 !C
6676 !C *** SETUP PARAMETERS ************************************************
6677 !C
6678 CALAOU = .TRUE. ! Outer loop activity calculation flag
6679 CHI1 = W(1) ! NA TOTAL
6680 CHI2 = W(3) ! NH4 TOTAL
6681 PSI1LO = TINY ! Low limit
6682 PSI1HI = CHI1 ! High limit
6683 !C
6684 !C *** INITIAL VALUES FOR BISECTION ************************************
6685 !C
6686 X1 = PSI1HI
6687 Y1 = FUNCJ22p1 (X1)
6688 YHI= Y1 ! Save Y-value at HI position
6689 !C
6690 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 ****
6691 !C
6692 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
6693 !C
6694 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
6695 !C
6696 DX = (PSI1HI-PSI1LO)/FLOAT(NDIV)
6697 DO 10 I=1,NDIV
6698 X2 = X1-DX
6699 Y2 = FUNCJ22p1 (X2)
6700 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
6701 X1 = X2
6702 Y1 = Y2
6703 10 CONTINUE
6704 !C
6705 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4
6706 !C
6707 YLO= Y1 ! Save Y-value at Hi position
6708 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
6709 Y3 = FUNCJ22p1 (ZERO)
6710 GOTO 50
6711 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
6712 GOTO 50
6713 ELSE
6714 CALL PUSHERR2p1 (0001, 'CALCJ2') ! WARNING ERROR: NO SOLUTION
6715 GOTO 50
6716 ENDIF
6717 !C
6718 !C *** PERFORM BISECTION ***********************************************
6719 !C
6720 20 DO 30 I=1,MAXIT
6721 X3 = 0.5*(X1+X2)
6722 Y3 = FUNCJ22p1 (X3)
6723 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
6724 Y2 = Y3
6725 X2 = X3
6726 ELSE
6727 Y1 = Y3
6728 X1 = X3
6729 ENDIF
6730 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
6731 30 CONTINUE
6732 CALL PUSHERR2p1 (0002, 'CALCJ2') ! WARNING ERROR: NO CONVERGENCE
6733 !C
6734 !C *** CONVERGED ; RETURN **********************************************
6735 !C
6736 40 X3 = 0.5*(X1+X2)
6737 Y3 = FUNCJ22p1 (X3)
6738 !C
6739 50 RETURN
6740 !C
6741 !C *** END OF SUBROUTINE CALCJ2 ******************************************
6742 !C
6743 END
6748 !C=======================================================================
6749 !C
6750 !C *** ISORROPIA CODE
6751 !C *** SUBROUTINE FUNCJ2
6752 !C *** CASE J2
6753 !C
6754 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6755 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
6756 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
6757 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
6758 !C
6759 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6760 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6761 !C *** WRITTEN BY ATHANASIOS NENES
6762 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6763 !C
6764 !C=======================================================================
6765 !C
6766 DOUBLE PRECISION FUNCTION FUNCJ22p1 (P1)
6767 INCLUDE 'module_isrpia_inc.F'
6768 !C
6769 DOUBLE PRECISION LAMDA, KAPA
6770 COMMON /CASEJ2p1/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, &
6771 A1, A2, A3
6772 !C
6773 !C *** SETUP PARAMETERS ************************************************
6774 !C
6775 FRST = .TRUE.
6776 CALAIN = .TRUE.
6777 !C
6778 LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4
6779 PSI1 = P1
6780 PSI2 = CHI2 ! ALL NH4HSO4 DELIQUESCED
6781 !C
6782 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6783 !C
6784 DO 10 I=1,NSWEEP
6785 !C
6786 A1 = XK11 *(WATER/GAMA(12))**2.0
6787 A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
6788 !C
6789 !C CALCULATE DISSOCIATION QUANTITIES
6790 !C
6791 BB = A3+LAMDA ! KAPA
6792 CC =-A3*(LAMDA + PSI1 + PSI2)
6793 DD = BB*BB-4.D0*CC
6794 KAPA = 0.5D0*(-BB+SQRT(DD))
6795 !C
6796 !C *** CALCULATE SPECIATION ********************************************
6797 !C
6798 MOLAL (1) = LAMDA + KAPA ! HI
6799 MOLAL (2) = PSI1 ! NAI
6800 MOLAL (3) = PSI2 ! NH4I
6801 MOLAL (4) = ZERO ! CLI
6802 MOLAL (5) = KAPA ! SO4I
6803 MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I
6804 MOLAL (7) = ZERO ! NO3I
6805 !C
6806 CNAHSO4 = MAX(CHI1-PSI1,ZERO)
6807 CNH4HS4 = ZERO
6808 !C
6809 CALL CALCMR2p1 ! Water content
6810 !C
6811 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6812 !C
6813 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6814 CALL CALCACT2p1
6815 ELSE
6816 GOTO 20
6817 ENDIF
6818 10 CONTINUE
6819 !C
6820 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
6821 !C
6822 20 FUNCJ22p1 = MOLAL(2)*MOLAL(6)/A1 - ONE
6823 !C
6824 !C *** END OF FUNCTION FUNCJ2 *******************************************
6825 !C
6826 END
6828 !C=======================================================================
6829 !C
6830 !C *** ISORROPIA CODE
6831 !C *** SUBROUTINE CALCJ1
6832 !C *** CASE J1
6833 !C
6834 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6835 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
6836 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
6837 !C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4
6838 !C
6839 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6840 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6841 !C *** WRITTEN BY ATHANASIOS NENES
6842 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6843 !C
6844 !C=======================================================================
6845 !C
6846 SUBROUTINE CALCJ12p1
6847 INCLUDE 'module_isrpia_inc.F'
6848 !C
6849 DOUBLE PRECISION LAMDA, KAPA
6850 COMMON /CASEJ2p1/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, &
6851 A1, A2, A3
6852 !C
6853 !C *** SETUP PARAMETERS ************************************************
6854 !C
6855 CALAOU =.TRUE. ! Outer loop activity calculation flag
6856 CHI1 = W(1) ! Total NA initially as NaHSO4
6857 CHI2 = W(3) ! Total NH4 initially as NH4HSO4
6858 !C
6859 PSI1LO = TINY ! Low limit
6860 PSI1HI = CHI1 ! High limit
6861 !C
6862 !C *** INITIAL VALUES FOR BISECTION ************************************
6863 !C
6864 X1 = PSI1HI
6865 Y1 = FUNCJ12p1 (X1)
6866 YHI= Y1 ! Save Y-value at HI position
6867 !C
6868 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NH42SO4 ****
6869 !C
6870 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
6871 !C
6872 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
6873 !C
6874 DX = (PSI1HI-PSI1LO)/FLOAT(NDIV)
6875 DO 10 I=1,NDIV
6876 X2 = X1-DX
6877 Y2 = FUNCJ12p1 (X2)
6878 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
6879 X1 = X2
6880 Y1 = Y2
6881 10 CONTINUE
6882 !C
6883 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NH42SO4
6884 !C
6885 YLO= Y1 ! Save Y-value at Hi position
6886 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
6887 Y3 = FUNCJ12p1 (ZERO)
6888 GOTO 50
6889 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
6890 GOTO 50
6891 ELSE
6892 CALL PUSHERR2p1 (0001, 'CALCJ1') ! WARNING ERROR: NO SOLUTION
6893 GOTO 50
6894 ENDIF
6895 !C
6896 !C *** PERFORM BISECTION ***********************************************
6897 !C
6898 20 DO 30 I=1,MAXIT
6899 X3 = 0.5*(X1+X2)
6900 Y3 = FUNCJ12p1 (X3)
6901 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
6902 Y2 = Y3
6903 X2 = X3
6904 ELSE
6905 Y1 = Y3
6906 X1 = X3
6907 ENDIF
6908 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
6909 30 CONTINUE
6910 CALL PUSHERR2p1 (0002, 'CALCJ1') ! WARNING ERROR: NO CONVERGENCE
6911 !C
6912 !C *** CONVERGED ; RETURN **********************************************
6913 !C
6914 40 X3 = 0.5*(X1+X2)
6915 Y3 = FUNCJ12p1 (X3)
6916 !C
6917 50 RETURN
6918 !C
6919 !C *** END OF SUBROUTINE CALCJ1 ******************************************
6920 !C
6921 END
6926 !C=======================================================================
6927 !C
6928 !C *** ISORROPIA CODE
6929 !C *** SUBROUTINE FUNCJ1
6930 !C *** CASE J1
6931 !C
6932 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
6933 !C 1. SULFATE RICH, FREE ACID (SULRAT < 1.0)
6934 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
6935 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
6936 !C
6937 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
6938 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
6939 !C *** WRITTEN BY ATHANASIOS NENES
6940 !C *** UPDATED BY CHRISTOS FOUNTOUKIS
6941 !C
6942 !C=======================================================================
6943 !C
6944 DOUBLE PRECISION FUNCTION FUNCJ12p1 (P1)
6945 INCLUDE 'module_isrpia_inc.F'
6946 DOUBLE PRECISION LAMDA, KAPA
6947 COMMON /CASEJ2p1/ CHI1, CHI2, CHI3, LAMDA, KAPA, PSI1, PSI2, PSI3, &
6948 A1, A2, A3
6949 !C
6950 !C *** SETUP PARAMETERS ************************************************
6951 !C
6952 FRST = .TRUE.
6953 CALAIN = .TRUE.
6954 !C
6955 LAMDA = MAX(W(2) - W(3) - W(1), TINY) ! FREE H2SO4
6956 PSI1 = P1
6957 !C
6958 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
6959 !C
6960 DO 10 I=1,NSWEEP
6961 !C
6962 A1 = XK11 *(WATER/GAMA(12))**2.0
6963 A2 = XK12 *(WATER/GAMA(09))**2.0
6964 A3 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
6965 !C
6966 PSI2 = 0.5*(-(LAMDA+PSI1) + SQRT((LAMDA+PSI1)**2.D0+4.D0*A2)) ! PSI2
6967 PSI2 = MIN (PSI2, CHI2)
6968 !C
6969 BB = A3+LAMDA ! KAPA
6970 CC =-A3*(LAMDA + PSI2 + PSI1)
6971 DD = BB*BB-4.D0*CC
6972 KAPA = 0.5D0*(-BB+SQRT(DD))
6973 !C
6974 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
6975 !C
6976 MOLAL (1) = LAMDA + KAPA ! HI
6977 MOLAL (2) = PSI1 ! NAI
6978 MOLAL (3) = PSI2 ! NH4I
6979 MOLAL (4) = ZERO
6980 MOLAL (5) = KAPA ! SO4I
6981 MOLAL (6) = LAMDA + PSI1 + PSI2 - KAPA ! HSO4I
6982 MOLAL (7) = ZERO
6983 !C
6984 CNAHSO4 = MAX(CHI1-PSI1,ZERO)
6985 CNH4HS4 = MAX(CHI2-PSI2,ZERO)
6986 !C
6987 CALL CALCMR2p1 ! Water content
6988 !C
6989 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
6990 !C
6991 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
6992 CALL CALCACT2p1
6993 ELSE
6994 GOTO 20
6995 ENDIF
6996 10 CONTINUE
6997 !C
6998 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
6999 !C
7000 20 FUNCJ12p1 = MOLAL(2)*MOLAL(6)/A1 - ONE
7001 !C
7002 !C *** END OF FUNCTION FUNCJ1 *******************************************
7003 !C
7004 END
7005 !C
7006 !C=======================================================================
7007 !C
7008 !C *** ISORROPIA CODE II
7009 !C *** SUBROUTINE CALCO7
7010 !C *** CASE O7
7011 !C
7012 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7013 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7014 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7015 !C 3. SOLIDS POSSIBLE : CaSO4
7016 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4
7017 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7018 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7019 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7020 !C
7021 !C=======================================================================
7022 !C
7023 SUBROUTINE CALCO72p1
7024 INCLUDE 'module_isrpia_inc.F'
7025 !C
7026 DOUBLE PRECISION LAMDA
7027 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7028 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7029 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7030 A5, A6, A7, A8, A9
7031 !C
7032 !C *** SETUP PARAMETERS ************************************************
7033 !C
7034 CALAOU = .TRUE.
7035 CHI9 = MIN (W(6), W(2)) ! CCASO4
7036 SO4FR = MAX (W(2)-CHI9, ZERO)
7037 CAFR = MAX (W(6)-CHI9, ZERO)
7038 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
7039 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
7040 SO4FR = MAX (SO4FR - CHI7, ZERO)
7041 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
7042 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
7043 SO4FR = MAX (SO4FR - CHI1, ZERO)
7044 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
7045 FRMG = MAX(W(8) - CHI8, ZERO)
7046 SO4FR = MAX(SO4FR - CHI8, ZERO)
7047 CHI3 = ZERO
7048 CHI5 = W(4)
7049 CHI6 = W(5)
7050 CHI2 = MAX (SO4FR, ZERO)
7051 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
7052 !C
7053 PSI1 = CHI1
7054 PSI2 = CHI2
7055 PSI3 = ZERO
7056 PSI4 = ZERO
7057 PSI5 = ZERO
7058 PSI6 = ZERO
7059 PSI7 = CHI7
7060 PSI8 = CHI8
7061 PSI6LO = TINY
7062 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
7063 !C
7064 WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21)
7065 WATER = MAX (WATER , TINY)
7066 !C
7067 !C *** INITIAL VALUES FOR BISECTION ************************************
7068 !C
7069 X1 = PSI6LO
7070 Y1 = FUNCO72p1 (X1)
7071 IF (CHI6.LE.TINY) GOTO 50
7072 !ccc IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
7073 !ccc IF (WATER .LE. TINY) RETURN ! No water
7074 !C
7075 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
7076 !C
7077 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
7078 DO 10 I=1,NDIV
7079 X2 = X1+DX
7080 Y2 = FUNCO72p1 (X2)
7081 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
7082 X1 = X2
7083 Y1 = Y2
7084 10 CONTINUE
7085 !C
7086 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
7087 !C
7088 IF (ABS(Y2) .GT. EPS) Y2 = FUNCO72p1 (PSI6LO)
7089 GOTO 50
7090 !C
7091 !C *** PERFORM BISECTION ***********************************************
7092 !C
7093 20 DO 30 I=1,MAXIT
7094 X3 = 0.5*(X1+X2)
7095 Y3 = FUNCO72p1 (X3)
7096 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
7097 Y2 = Y3
7098 X2 = X3
7099 ELSE
7100 Y1 = Y3
7101 X1 = X3
7102 ENDIF
7103 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
7104 30 CONTINUE
7105 CALL PUSHERR2p1 (0002, 'CALCO7') ! WARNING ERROR: NO CONVERGENCE
7106 !C
7107 !C *** CONVERGED ; RETURN **********************************************
7108 !C
7109 40 X3 = 0.5*(X1+X2)
7110 Y3 = FUNCO72p1 (X3)
7111 !C
7112 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7113 !C
7114 50 CONTINUE
7115 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN ! If quadrat.called
7116 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
7117 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
7118 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
7119 MOLAL(6) = DELTA ! HSO4 EFFECT
7120 ENDIF
7121 !C
7122 RETURN
7123 !C
7124 !C *** END OF SUBROUTINE CALCO7 *******************************************
7125 !C
7126 END
7127 !C
7128 !C=======================================================================
7129 !C
7130 !C *** ISORROPIA CODE II
7131 !C *** SUBROUTINE FUNCO7
7132 !C *** CASE O7
7133 !C
7134 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7135 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7136 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7137 !C 3. SOLIDS POSSIBLE : CaSO4
7138 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4, K2SO4
7139 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7140 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7141 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7142 !C
7143 !C=======================================================================
7144 !C
7145 DOUBLE PRECISION FUNCTION FUNCO72p1 (X)
7146 INCLUDE 'module_isrpia_inc.F'
7147 !C
7148 DOUBLE PRECISION LAMDA
7149 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7150 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7151 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7152 A5, A6, A7, A8, A9
7153 !C
7154 !C *** SETUP PARAMETERS ************************************************
7155 !C
7156 PSI6 = X
7157 FRST = .TRUE.
7158 CALAIN = .TRUE.
7159 !C
7160 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7161 !C
7162 DO 10 I=1,NSWEEP
7163 !C
7164 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
7165 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
7166 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
7167 !C
7168 !C
7169 IF (CHI5.GE.TINY) THEN
7170 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
7171 PSI5 = MIN (PSI5,CHI5)
7172 ELSE
7173 PSI5 = TINY
7174 ENDIF
7175 !C
7176 !CCC IF(CHI4.GT.TINY) THEN
7177 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
7178 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
7179 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
7180 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
7181 PSI4 =0.5d0*(-BB - SQRT(DD))
7182 PSI4 = MAX (MIN (PSI4,CHI4), ZERO)
7183 ELSE
7184 PSI4 = TINY
7185 ENDIF
7186 !C
7187 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7188 !C
7189 MOLAL (2) = 2.0D0*PSI1 ! Na+
7190 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
7191 MOLAL (4) = PSI6 ! CLI
7192 MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I
7193 MOLAL (6) = ZERO ! HSO4
7194 MOLAL (7) = PSI5 ! NO3I
7195 MOLAL (8) = ZERO ! CaI
7196 MOLAL (9) = 2.0D0*PSI7 ! KI
7197 MOLAL (10)= PSI8 ! Mg
7198 !C
7199 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7200 !C
7201 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
7202 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
7203 -MOLAL(9)-2.D0*MOLAL(10)
7204 CALL CALCPH2p1 (SMIN, HI, OHI)
7205 MOLAL (1) = HI
7206 !C
7207 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7208 !C
7209 GNH3 = MAX(CHI4 - PSI4, TINY)
7210 GHNO3 = MAX(CHI5 - PSI5, TINY)
7211 GHCL = MAX(CHI6 - PSI6, TINY)
7212 !C
7213 CNA2SO4 = ZERO
7214 CNH42S4 = ZERO
7215 CNH4NO3 = ZERO
7216 CNH4Cl = ZERO
7217 CK2SO4 = ZERO
7218 CMGSO4 = ZERO
7219 CCASO4 = CHI9
7220 !C
7221 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
7222 !C
7223 CALL CALCMR2p1
7224 !C
7225 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7226 !C
7227 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7228 CALL CALCACT2p1
7229 ELSE
7230 GOTO 20
7231 ENDIF
7232 10 CONTINUE
7233 !C
7234 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
7235 !C
7236 20 FUNCO72p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
7237 !CCC FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
7238 !C
7239 RETURN
7240 !C
7241 !C *** END OF FUNCTION FUNCO7 *******************************************
7242 !C
7243 END
7244 !C
7245 !C=======================================================================
7246 !C
7247 !C *** ISORROPIA CODE II
7248 !C *** SUBROUTINE CALCO6
7249 !C *** CASE O6
7250 !C
7251 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7252 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7253 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7254 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4
7255 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4, NA2SO4
7256 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7257 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7258 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7259 !C
7260 !C=======================================================================
7261 !C
7262 SUBROUTINE CALCO62p1
7263 INCLUDE 'module_isrpia_inc.F'
7264 !C
7265 DOUBLE PRECISION LAMDA
7266 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7267 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7268 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7269 A5, A6, A7, A8, A9
7270 !C
7271 !C *** SETUP PARAMETERS ************************************************
7272 !C
7273 CALAOU = .TRUE.
7274 CHI9 = MIN (W(6), W(2)) ! CCASO4
7275 SO4FR = MAX (W(2)-CHI9, ZERO)
7276 CAFR = MAX (W(6)-CHI9, ZERO)
7277 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
7278 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
7279 SO4FR = MAX (SO4FR - CHI7, ZERO)
7280 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
7281 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
7282 SO4FR = MAX (SO4FR - CHI1, ZERO)
7283 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
7284 FRMG = MAX(W(8) - CHI8, ZERO)
7285 SO4FR = MAX(SO4FR - CHI8, ZERO)
7286 CHI3 = ZERO
7287 CHI5 = W(4)
7288 CHI6 = W(5)
7289 CHI2 = MAX (SO4FR, ZERO)
7290 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
7291 !C
7292 !C
7293 PSI1 = CHI1
7294 PSI2 = CHI2
7295 PSI3 = ZERO
7296 PSI7 = ZERO
7297 PSI8 = CHI8
7298 PSI6LO = TINY
7299 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
7300 !C
7301 WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21)
7302 WATER = MAX (WATER , TINY)
7303 !C
7304 !C *** INITIAL VALUES FOR BISECTION ************************************
7305 !C
7306 X1 = PSI6LO
7307 Y1 = FUNCO62p1 (X1)
7308 IF (CHI6.LE.TINY) GOTO 50
7309 !ccc IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
7310 !ccc IF (WATER .LE. TINY) RETURN ! No water
7311 !C
7312 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
7313 !C
7314 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
7315 DO 10 I=1,NDIV
7316 X2 = X1+DX
7317 Y2 = FUNCO62p1 (X2)
7318 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
7319 X1 = X2
7320 Y1 = Y2
7321 10 CONTINUE
7322 !C
7323 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
7324 !C
7325 IF (ABS(Y2) .GT. EPS) Y2 = FUNCO62p1 (PSI6LO)
7326 GOTO 50
7327 !C
7328 !C *** PERFORM BISECTION ***********************************************
7329 !C
7330 20 DO 30 I=1,MAXIT
7331 X3 = 0.5*(X1+X2)
7332 Y3 = FUNCO62p1 (X3)
7333 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
7334 Y2 = Y3
7335 X2 = X3
7336 ELSE
7337 Y1 = Y3
7338 X1 = X3
7339 ENDIF
7340 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
7341 30 CONTINUE
7342 CALL PUSHERR2p1 (0002, 'CALCO6') ! WARNING ERROR: NO CONVERGENCE
7343 !C
7344 !C *** CONVERGED ; RETURN **********************************************
7345 !C
7346 40 X3 = 0.5*(X1+X2)
7347 Y3 = FUNCO62p1 (X3)
7348 !C
7349 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7350 !C
7351 50 CONTINUE
7352 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN ! If quadrat.called
7353 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
7354 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
7355 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
7356 MOLAL(6) = DELTA ! HSO4 EFFECT
7357 ENDIF
7358 !C
7359 RETURN
7360 !C
7361 !C *** END OF SUBROUTINE CALCO6 *******************************************
7362 !C
7363 END
7364 !C
7365 !C=======================================================================
7366 !C
7367 !C *** ISORROPIA CODE II
7368 !C *** SUBROUTINE FUNCO6
7369 !C *** CASE O6
7370 !C
7371 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7372 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7373 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7374 !C 3. SOLIDS POSSIBLE : CaSO4 , K2SO4
7375 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MgSO4, NA2SO4
7376 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7377 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7378 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7379 !C
7380 !C=======================================================================
7381 !C
7382 DOUBLE PRECISION FUNCTION FUNCO62p1 (X)
7383 INCLUDE 'module_isrpia_inc.F'
7384 !C
7385 DOUBLE PRECISION LAMDA
7386 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7387 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7388 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7389 A5, A6, A7, A8, A9
7390 !C
7391 !C *** SETUP PARAMETERS ************************************************
7392 !C
7393 PSI6 = X
7394 FRST = .TRUE.
7395 CALAIN = .TRUE.
7396 !C
7397 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7398 !C
7399 DO 10 I=1,NSWEEP
7400 !C
7401 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
7402 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
7403 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
7404 A7 = XK17 *(WATER/GAMA(17))**3.0
7405 !C
7406 !C
7407 IF (CHI5.GE.TINY) THEN
7408 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
7409 PSI5 = MIN (PSI5,CHI5)
7410 ELSE
7411 PSI5 = TINY
7412 ENDIF
7413 !C
7414 !CCC IF(CHI4.GT.TINY) THEN
7415 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
7416 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
7417 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
7418 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
7419 PSI4 =0.5d0*(-BB - SQRT(DD))
7420 PSI4 = MAX (MIN (PSI4,CHI4), ZERO)
7421 ELSE
7422 PSI4 = TINY
7423 ENDIF
7424 !C
7425 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7
7426 CALL POLY32p1 (PSI1+PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV)
7427 IF (ISLV.EQ.0) THEN
7428 PSI7 = MAX (MIN (PSI7, CHI7), ZERO)
7429 ELSE
7430 PSI7 = ZERO
7431 ENDIF
7432 ELSE
7433 PSI7 = ZERO
7434 ENDIF
7435 !C
7436 !C
7437 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7438 !C
7439 MOLAL (2) = 2.0D0*PSI1 ! Na+
7440 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
7441 MOLAL (4) = PSI6 ! CLI
7442 MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I
7443 MOLAL (6) = ZERO ! HSO4
7444 MOLAL (7) = PSI5 ! NO3I
7445 MOLAL (8) = ZERO ! CaI
7446 MOLAL (9) = 2.0D0*PSI7 ! KI
7447 MOLAL (10)= PSI8 ! Mg
7449 !C
7450 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7452 !C
7453 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
7454 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
7455 -MOLAL(9)-2.D0*MOLAL(10)
7456 CALL CALCPH2p1 (SMIN, HI, OHI)
7457 MOLAL (1) = HI
7458 !C
7459 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7460 !C
7461 GNH3 = MAX(CHI4 - PSI4, TINY)
7462 GHNO3 = MAX(CHI5 - PSI5, TINY)
7463 GHCL = MAX(CHI6 - PSI6, TINY)
7464 !C
7465 CNA2SO4 = ZERO
7466 CNH42S4 = ZERO
7467 CNH4NO3 = ZERO
7468 CNH4Cl = ZERO
7469 CK2SO4 = MAX(CHI7 - PSI7, TINY)
7470 CMGSO4 = ZERO
7471 CCASO4 = CHI9
7472 !C
7473 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
7474 !C
7475 CALL CALCMR2p1
7476 !C
7477 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7478 !C
7479 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7480 CALL CALCACT2p1
7481 ELSE
7482 GOTO 20
7483 ENDIF
7484 10 CONTINUE
7485 !C
7486 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
7487 !C
7488 20 FUNCO62p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
7489 !CCC FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
7490 !C
7491 RETURN
7492 !C
7493 !C *** END OF FUNCTION FUNCO6 *******************************************
7494 !C
7495 END
7496 !C
7497 !C
7498 !C=======================================================================
7499 !C
7500 !C *** ISORROPIA CODE II
7501 !C *** SUBROUTINE CALCO5
7502 !C *** CASE O5
7503 !C
7504 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7505 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7506 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7507 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4
7508 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4
7509 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7510 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7511 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7512 !C
7513 !C=======================================================================
7514 !C
7515 SUBROUTINE CALCO52p1
7516 INCLUDE 'module_isrpia_inc.F'
7517 !C
7518 DOUBLE PRECISION LAMDA
7519 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7520 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7521 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7522 A5, A6, A7, A8, A9
7523 !C
7524 !C *** SETUP PARAMETERS ************************************************
7525 !C
7526 CALAOU = .TRUE.
7527 CHI9 = MIN (W(6), W(2)) ! CCASO4
7528 SO4FR = MAX (W(2)-CHI9, ZERO)
7529 CAFR = MAX (W(6)-CHI9, ZERO)
7530 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
7531 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
7532 SO4FR = MAX (SO4FR - CHI7, ZERO)
7533 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
7534 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
7535 SO4FR = MAX (SO4FR - CHI1, ZERO)
7536 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
7537 FRMG = MAX(W(8) - CHI8, ZERO)
7538 SO4FR = MAX(SO4FR - CHI8, ZERO)
7539 CHI3 = ZERO
7540 CHI5 = W(4)
7541 CHI6 = W(5)
7542 CHI2 = MAX (SO4FR, ZERO)
7543 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
7544 !C
7545 PSI1 = ZERO
7546 PSI2 = CHI2
7547 PSI3 = ZERO
7548 PSI7 = ZERO
7549 PSI8 = CHI8
7550 PSI6LO = TINY
7551 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
7552 !C
7553 WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21)
7554 WATER = MAX (WATER , TINY)
7555 !C
7556 !C *** INITIAL VALUES FOR BISECTION ************************************
7557 !C
7558 X1 = PSI6LO
7559 Y1 = FUNCO52p1 (X1)
7560 IF (CHI6.LE.TINY) GOTO 50
7561 !ccc IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
7562 !ccc IF (WATER .LE. TINY) RETURN ! No water
7563 !C
7564 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
7565 !C
7566 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
7567 DO 10 I=1,NDIV
7568 X2 = X1+DX
7569 Y2 = FUNCO52p1 (X2)
7570 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
7571 X1 = X2
7572 Y1 = Y2
7573 10 CONTINUE
7574 !C
7575 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
7576 !C
7577 IF (ABS(Y2) .GT. EPS) Y2 = FUNCO52p1 (PSI6LO)
7578 GOTO 50
7579 !C
7580 !C *** PERFORM BISECTION ***********************************************
7581 !C
7582 20 DO 30 I=1,MAXIT
7583 X3 = 0.5*(X1+X2)
7584 Y3 = FUNCO52p1 (X3)
7585 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
7586 Y2 = Y3
7587 X2 = X3
7588 ELSE
7589 Y1 = Y3
7590 X1 = X3
7591 ENDIF
7592 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
7593 30 CONTINUE
7594 CALL PUSHERR2p1 (0002, 'CALCO5') ! WARNING ERROR: NO CONVERGENCE
7595 !C
7596 !C *** CONVERGED ; RETURN **********************************************
7597 !C
7598 40 X3 = 0.5*(X1+X2)
7599 Y3 = FUNCO52p1 (X3)
7600 !C
7601 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7602 !C
7603 50 CONTINUE
7604 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN ! If quadrat.called
7605 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
7606 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
7607 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
7608 MOLAL(6) = DELTA ! HSO4 EFFECT
7609 ENDIF
7610 !C
7611 RETURN
7612 !C
7613 !C *** END OF SUBROUTINE CALCO5 *******************************************
7614 !C
7615 END
7616 !C
7617 !C=======================================================================
7618 !C
7619 !C *** ISORROPIA CODE II
7620 !C *** SUBROUTINE FUNCO5
7621 !C *** CASE O5
7622 !C
7623 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7624 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7625 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7626 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4
7627 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4, MGSO4
7628 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7629 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7630 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7631 !C
7632 !C=======================================================================
7633 !C
7634 DOUBLE PRECISION FUNCTION FUNCO52p1 (X)
7635 INCLUDE 'module_isrpia_inc.F'
7636 !C
7637 DOUBLE PRECISION LAMDA
7638 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7639 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7640 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7641 A5, A6, A7, A8, A9
7642 !C
7643 !C *** SETUP PARAMETERS ************************************************
7644 !C
7645 PSI6 = X
7646 FRST = .TRUE.
7647 CALAIN = .TRUE.
7648 !C
7649 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7650 !C
7651 DO 10 I=1,NSWEEP
7652 !C
7653 A1 = XK5 *(WATER/GAMA(2))**3.0
7654 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
7655 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
7656 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
7657 A7 = XK17 *(WATER/GAMA(17))**3.0
7658 !C
7659 !C
7660 IF (CHI5.GE.TINY) THEN
7661 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
7662 PSI5 = MIN (PSI5,CHI5)
7663 ELSE
7664 PSI5 = TINY
7665 ENDIF
7666 !C
7667 !CCC IF(CHI4.GT.TINY) THEN
7668 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
7669 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
7670 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
7671 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
7672 PSI4 =0.5d0*(-BB - SQRT(DD))
7673 PSI4 = MAX (MIN (PSI4,CHI4), ZERO)
7674 ELSE
7675 PSI4 = TINY
7676 ENDIF
7677 !C
7678 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7
7679 CALL POLY32p1 ((PSI2+PSI8)/(SQRT(A1/A7)+1.D0), ZERO, &
7680 -A7/4.D0/(SQRT(A1/A7)+1.D0), PSI7, ISLV)
7681 IF (ISLV.EQ.0) THEN
7682 PSI7 = MAX (MIN (PSI7, CHI7), ZERO)
7683 ELSE
7684 PSI7 = ZERO
7685 ENDIF
7686 ELSE
7687 PSI7 = ZERO
7688 ENDIF
7689 !C
7690 IF (CHI1.GE.TINY) THEN ! PSI1
7691 PSI1 = SQRT(A1/A7)*PSI7
7692 PSI1 = MIN(PSI1,CHI1)
7693 ELSE
7694 PSI1 = ZERO
7695 ENDIF
7696 !C
7697 !C
7698 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
7699 !C
7700 MOLAL (2) = 2.0D0*PSI1 ! NaI
7701 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
7702 MOLAL (4) = PSI6 ! CLI
7703 MOLAL (5) = PSI1+PSI2+PSI7+PSI8 ! SO4I
7704 MOLAL (6) = ZERO ! HSO4
7705 MOLAL (7) = PSI5 ! NO3I
7706 MOLAL (8) = ZERO ! CaI
7707 MOLAL (9) = 2.0D0*PSI7 ! KI
7708 MOLAL (10)= PSI8 ! Mg
7710 !C
7711 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7713 !C
7714 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
7715 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
7716 -MOLAL(9)-2.D0*MOLAL(10)
7717 CALL CALCPH2p1 (SMIN, HI, OHI)
7718 MOLAL (1) = HI
7719 !C
7720 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7721 !C
7722 GNH3 = MAX(CHI4 - PSI4, TINY)
7723 GHNO3 = MAX(CHI5 - PSI5, TINY)
7724 GHCL = MAX(CHI6 - PSI6, TINY)
7725 !C
7726 CNA2SO4 = MAX(CHI1 - PSI1, TINY)
7727 CNH42S4 = ZERO
7728 CNH4NO3 = ZERO
7729 CNH4Cl = ZERO
7730 CK2SO4 = MAX(CHI7 - PSI7, TINY)
7731 CMGSO4 = ZERO
7732 CCASO4 = CHI9
7733 !C
7734 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
7735 !C
7736 CALL CALCMR2p1
7737 !C
7738 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
7739 !C
7740 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
7741 CALL CALCACT2p1
7742 ELSE
7743 GOTO 20
7744 ENDIF
7745 10 CONTINUE
7746 !C
7747 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
7748 !C
7749 20 FUNCO52p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
7750 !CCC FUNCG5A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
7751 !C
7752 RETURN
7753 !C
7754 !C *** END OF FUNCTION FUNCO5 *******************************************
7755 !C
7756 END
7757 !C
7758 !C
7759 !C=======================================================================
7760 !C
7761 !C *** ISORROPIA CODE II
7762 !C *** SUBROUTINE CALCO4
7763 !C *** CASE O4
7764 !C
7765 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7766 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
7767 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7768 !C 3. SOLIDS POSSIBLE : NA2SO4, K2SO4, MGSO4, CASO4
7769 !C 4. Completely dissolved: NH4NO3, NH4CL, (NH4)2SO4
7770 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7771 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7772 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7773 !C
7774 !C=======================================================================
7775 !C
7776 SUBROUTINE CALCO42p1
7777 INCLUDE 'module_isrpia_inc.F'
7778 !C
7779 DOUBLE PRECISION LAMDA
7780 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7781 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7782 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7783 A5, A6, A7, A8, A9
7784 !C
7785 !C *** SETUP PARAMETERS ************************************************
7786 !C
7787 CALAOU = .TRUE.
7788 CHI9 = MIN (W(6), W(2)) ! CCASO4
7789 SO4FR = MAX (W(2)-CHI9, ZERO)
7790 CAFR = MAX (W(6)-CHI9, ZERO)
7791 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
7792 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
7793 SO4FR = MAX (SO4FR - CHI7, ZERO)
7794 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
7795 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
7796 SO4FR = MAX (SO4FR - CHI1, ZERO)
7797 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
7798 FRMG = MAX(W(8) - CHI8, ZERO)
7799 SO4FR = MAX(SO4FR - CHI8, ZERO)
7800 CHI3 = ZERO
7801 CHI5 = W(4)
7802 CHI6 = W(5)
7803 CHI2 = MAX (SO4FR, ZERO)
7804 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
7805 !C
7806 PSI2 = CHI2
7807 PSI3 = ZERO
7808 PSI7 = ZERO
7809 PSI8 = CHI8
7810 PSI6LO = TINY
7811 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
7812 !C
7813 WATER = CHI2/M0(4) + CHI1/M0(2) + CHI7/M0(17) + CHI8/M0(21)
7814 WATER = MAX (WATER , TINY)
7815 !C
7816 !C *** INITIAL VALUES FOR BISECTION ************************************
7817 !C
7818 X1 = PSI6LO
7819 Y1 = FUNCO42p1 (X1)
7820 IF (CHI6.LE.TINY) GOTO 50
7821 !CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
7822 !CCC IF (WATER .LE. TINY) GOTO 50 ! No water
7823 !C
7824 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
7825 !C
7826 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
7827 DO 10 I=1,NDIV
7828 X2 = X1+DX
7829 Y2 = FUNCO42p1 (X2)
7830 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
7831 X1 = X2
7832 Y1 = Y2
7833 10 CONTINUE
7834 !C
7835 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
7836 !C
7837 IF (ABS(Y2) .GT. EPS) Y2 = FUNCO42p1 (PSI6LO)
7838 GOTO 50
7839 !C
7840 !C *** PERFORM BISECTION ***********************************************
7841 !C
7842 20 DO 30 I=1,MAXIT
7843 X3 = 0.5*(X1+X2)
7844 Y3 = FUNCO42p1 (X3)
7845 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
7846 Y2 = Y3
7847 X2 = X3
7848 ELSE
7849 Y1 = Y3
7850 X1 = X3
7851 ENDIF
7852 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
7853 30 CONTINUE
7854 CALL PUSHERR2p1 (0002, 'CALCO42p1') ! WARNING ERROR: NO CONVERGENCE
7855 !C
7856 !C *** CONVERGED ; RETURN **********************************************
7857 !C
7858 40 X3 = 0.5*(X1+X2)
7859 Y3 = FUNCO42p1 (X3)
7860 !C
7861 !C *** FINAL CALCULATIONS **********************************************
7862 !C
7863 50 CONTINUE
7864 !C
7865 !C *** Na2SO4 DISSOLUTION
7866 !C
7867 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
7868 CALL POLY32p1 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV)
7869 IF (ISLV.EQ.0) THEN
7870 PSI1 = MIN (PSI1, CHI1)
7871 ELSE
7872 PSI1 = ZERO
7873 ENDIF
7874 ELSE
7875 PSI1 = ZERO
7876 ENDIF
7877 MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT
7878 MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT
7879 CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion
7880 !C
7881 !C *** HSO4 equilibrium
7882 !C
7884 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
7885 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
7886 MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT
7887 MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT
7888 MOLAL(6) = DELTA ! HSO4 AFFECT
7889 ENDIF
7890 !C
7891 RETURN
7892 !C
7893 !C *** END OF SUBROUTINE CALCO4 ******************************************
7894 !C
7895 END
7896 !C
7897 !C
7898 !C=======================================================================
7899 !C
7900 !C *** ISORROPIA CODE
7901 !C *** SUBROUTINE FUNCO4
7902 !C *** CASE O4 ; SUBCASE 1
7903 !C
7904 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
7905 !C 1. SULFATE POOR (SULRAT > 2.0) ; SODIUM POOR (SODRAT < 2.0)
7906 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
7907 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4
7908 !C
7909 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
7910 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
7911 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
7912 !C
7913 !C=======================================================================
7914 !C
7915 DOUBLE PRECISION FUNCTION FUNCO42p1 (X)
7916 INCLUDE 'module_isrpia_inc.F'
7917 !C
7918 DOUBLE PRECISION LAMDA
7919 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
7920 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
7921 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
7922 A5, A6, A7, A8, A9
7923 !C
7924 !C *** SETUP PARAMETERS ************************************************
7925 !C
7926 PSI6 = X
7927 PSI2 = CHI2
7928 FRST = .TRUE.
7929 CALAIN = .TRUE.
7930 !C
7931 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
7932 !C
7933 DO 10 I=1,NSWEEP
7934 !C
7935 A1 = XK5 *(WATER/GAMA(2))**3.0
7936 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
7937 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
7938 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
7939 A7 = XK17 *(WATER/GAMA(17))**3.0
7940 !C A8 = XK23 *(WATER/GAMA(21))**2.0
7941 !C
7942 !C CALCULATE DISSOCIATION QUANTITIES
7943 !C
7944 IF (CHI5.GE.TINY) THEN
7945 PSI5 = PSI6*CHI5/(A6/A5*(CHI6-PSI6) + PSI6)
7946 PSI5 = MIN (PSI5,CHI5)
7947 ELSE
7948 PSI5 = TINY
7949 ENDIF
7950 !C
7951 !CCC IF(CHI4.GT.TINY) THEN
7952 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
7953 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
7954 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
7955 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
7956 PSI4 =0.5d0*(-BB - SQRT(DD))
7957 PSI4 = MAX (MIN (PSI4,CHI4), ZERO)
7958 ELSE
7959 PSI4 = TINY
7960 ENDIF
7961 !C
7962 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7
7963 CALL POLY32p1 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV)
7964 IF (ISLV.EQ.0) THEN
7965 PSI7 = MAX (MIN (PSI7, CHI7), ZERO)
7966 ELSE
7967 PSI7 = ZERO
7968 ENDIF
7969 ELSE
7970 PSI7 = ZERO
7971 ENDIF
7972 !C
7973 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7974 !C
7975 MOLAL (2) = ZERO ! NAI
7976 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
7977 MOLAL (4) = PSI6 ! CLI
7978 MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I
7979 MOLAL (6) = ZERO ! HSO4
7980 MOLAL (7) = PSI5 ! NO3I
7981 MOLAL (8) = ZERO ! CAI
7982 MOLAL (9) = 2.0D0*PSI7 ! KI
7983 MOLAL (10)= PSI8 ! MGI
7985 !C
7986 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
7988 !C
7989 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
7990 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
7991 -MOLAL(9)-2.D0*MOLAL(10)
7992 CALL CALCPH2p1 (SMIN, HI, OHI)
7993 MOLAL (1) = HI
7994 !C
7995 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
7996 !C
7997 GNH3 = MAX(CHI4 - PSI4, TINY)
7998 GHNO3 = MAX(CHI5 - PSI5, TINY)
7999 GHCL = MAX(CHI6 - PSI6, TINY)
8000 !C
8001 CNH42S4 = ZERO
8002 CNH4NO3 = ZERO
8003 CNH4Cl = ZERO
8004 CK2SO4 = MAX(CHI7 - PSI7, TINY)
8005 CMGSO4 = ZERO
8006 CCASO4 = CHI9
8007 !C
8008 CALL CALCMR2p1 ! Water content
8009 !C
8010 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8011 !C
8012 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
8013 CALL CALCACT2p1
8014 ELSE
8015 GOTO 20
8016 ENDIF
8017 10 CONTINUE
8018 !C
8019 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
8020 !C
8021 20 FUNCO42p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
8022 !CCC FUNCO4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
8023 !C
8024 RETURN
8025 !C
8026 !C *** END OF FUNCTION FUNCO4 *******************************************
8027 !C
8028 END
8029 !C
8030 !C=======================================================================
8031 !C
8032 !C *** ISORROPIA CODE II
8033 !C *** SUBROUTINE CALCO3
8034 !C *** CASE O3
8035 !C
8036 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8037 !C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2)
8038 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
8039 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4
8040 !C
8041 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8042 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8043 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
8044 !C
8045 !C=======================================================================
8046 !C
8047 SUBROUTINE CALCO32p1
8048 INCLUDE 'module_isrpia_inc.F'
8049 EXTERNAL CALCO1A2p1, CALCO42p1
8050 !C
8051 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
8052 !C
8053 IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE
8054 SCASE = 'O3 ; SUBCASE 1'
8055 CALL CALCO3A2p1
8056 SCASE = 'O3 ; SUBCASE 1'
8057 ELSE ! NO3, CL NON EXISTANT
8058 SCASE = 'O1 ; SUBCASE 1'
8059 CALL CALCO1A2p1
8060 SCASE = 'O1 ; SUBCASE 1'
8061 ENDIF
8062 !C
8063 IF (WATER.LE.TINY) THEN
8064 IF (RH.LT.DRMO3) THEN ! ONLY SOLIDS
8065 WATER = TINY
8066 DO 10 I=1,NIONS
8067 MOLAL(I) = ZERO
8068 10 CONTINUE
8069 CALL CALCO1A2p1
8070 SCASE = 'O3 ; SUBCASE 2'
8071 RETURN
8072 ELSE
8073 SCASE = 'O3 ; SUBCASE 3' ! MDRH REGION (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4)
8074 CALL CALCMDRH22p1 (RH, DRMO3, DRNH42S4, CALCO1A2p1, CALCO42p1)
8075 SCASE = 'O3 ; SUBCASE 3'
8076 ENDIF
8077 ENDIF
8078 !C
8079 RETURN
8080 !C
8081 !C *** END OF SUBROUTINE CALCO3 ******************************************
8082 !C
8083 END
8084 !C
8085 !C=======================================================================
8086 !C
8087 !C *** ISORROPIA CODE II
8088 !C *** SUBROUTINE CALCO3A
8089 !C *** CASE O3 ; SUBCASE 1
8090 !C
8091 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8092 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
8093 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
8094 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MGSO4, CASO4
8095 !C 4. Completely dissolved: NH4NO3, NH4CL
8096 !C
8097 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8098 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8099 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8100 !C
8101 !C=======================================================================
8102 !C
8103 SUBROUTINE CALCO3A2p1
8104 INCLUDE 'module_isrpia_inc.F'
8105 !C
8106 DOUBLE PRECISION LAMDA
8107 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
8108 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
8109 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
8110 A5, A6, A7, A8, A9
8111 !C
8112 !C *** SETUP PARAMETERS ************************************************
8113 !C
8114 CALAOU = .TRUE.
8115 CHI9 = MIN (W(6), W(2)) ! CCASO4
8116 SO4FR = MAX (W(2)-CHI9, ZERO)
8117 CAFR = MAX (W(6)-CHI9, ZERO)
8118 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
8119 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
8120 SO4FR = MAX (SO4FR - CHI7, ZERO)
8121 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
8122 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
8123 SO4FR = MAX (SO4FR - CHI1, ZERO)
8124 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
8125 FRMG = MAX(W(8) - CHI8, ZERO)
8126 SO4FR = MAX(SO4FR - CHI8, ZERO)
8127 CHI3 = ZERO
8128 CHI5 = W(4)
8129 CHI6 = W(5)
8130 CHI2 = MAX (SO4FR, ZERO)
8131 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
8132 !C
8133 PSI8 = CHI8
8134 PSI6LO = TINY
8135 PSI6HI = CHI6-TINY
8136 !C
8137 WATER = TINY
8138 !C
8139 !C *** INITIAL VALUES FOR BISECTION ************************************
8140 !C
8141 X1 = PSI6LO
8142 Y1 = FUNCO3A2p1 (X1)
8143 IF (CHI6.LE.TINY) GOTO 50
8144 !CCC IF (ABS(Y1).LE.EPS .OR. CHI7.LE.TINY) GOTO 50
8145 !CCC IF (WATER .LE. TINY) GOTO 50 ! No water
8146 !C
8147 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
8148 !C
8149 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
8150 DO 10 I=1,NDIV
8151 X2 = X1+DX
8152 Y2 = FUNCO3A2p1 (X2)
8153 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
8154 X1 = X2
8155 Y1 = Y2
8156 10 CONTINUE
8157 !C
8158 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
8159 !C
8160 IF (ABS(Y2) .GT. EPS) Y2 = FUNCO3A2p1 (PSI6LO)
8161 GOTO 50
8162 !C
8163 !C *** PERFORM BISECTION ***********************************************
8164 !C
8165 20 DO 30 I=1,MAXIT
8166 X3 = 0.5*(X1+X2)
8167 Y3 = FUNCO3A2p1 (X3)
8168 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
8169 Y2 = Y3
8170 X2 = X3
8171 ELSE
8172 Y1 = Y3
8173 X1 = X3
8174 ENDIF
8175 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
8176 30 CONTINUE
8177 CALL PUSHERR2p1 (0002, 'CALCO3A2p1') ! WARNING ERROR: NO CONVERGENCE
8178 !C
8179 !C *** CONVERGED ; RETURN **********************************************
8180 !C
8181 40 X3 = 0.5*(X1+X2)
8182 Y3 = FUNCO3A2p1 (X3)
8183 !C
8184 !C *** FINAL CALCULATIONS *************************************************
8185 !C
8186 50 CONTINUE
8187 !C
8188 !C *** Na2SO4 DISSOLUTION
8189 !C
8190 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
8191 CALL POLY32p1 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV)
8192 IF (ISLV.EQ.0) THEN
8193 PSI1 = MIN (max (PSI1, zero), CHI1)
8194 ELSE
8195 PSI1 = ZERO
8196 ENDIF
8197 ELSE
8198 PSI1 = ZERO
8199 ENDIF
8200 MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT
8201 MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT
8202 CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion
8203 !C
8204 !C *** HSO4 equilibrium
8205 !C
8206 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
8207 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
8208 MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT
8209 MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT
8210 MOLAL(6) = DELTA ! HSO4 AFFECT
8211 ENDIF
8212 !C
8213 RETURN
8214 !C
8215 !C *** END OF SUBROUTINE CALCO3A ******************************************
8216 !C
8217 END
8218 !C
8219 !C=======================================================================
8220 !C
8221 !C *** ISORROPIA CODE II
8222 !C *** SUBROUTINE FUNCO3A
8223 !C *** CASE O3; SUBCASE 1
8224 !C
8225 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8226 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
8227 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
8228 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NA2SO4, K2SO4, MgSO4, CaSO4
8229 !C 4. Completely dissolved: NH4NO3, NH4CL
8230 !C
8231 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8232 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8233 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8234 !C
8235 !C=======================================================================
8236 !C
8237 DOUBLE PRECISION FUNCTION FUNCO3A2p1 (X)
8238 INCLUDE 'module_isrpia_inc.F'
8239 !C
8240 DOUBLE PRECISION LAMDA
8241 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
8242 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
8243 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
8244 A5, A6, A7, A8, A9
8245 !C
8246 !C *** SETUP PARAMETERS ************************************************
8247 !C
8248 PSI2 = CHI2
8249 PSI8 = CHI8
8250 PSI3 = ZERO
8251 PSI6 = X
8252 !C
8253 FRST = .TRUE.
8254 CALAIN = .TRUE.
8255 !C
8256 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
8257 !C
8258 DO 10 I=1,NSWEEP
8259 !C
8260 A1 = XK5 *(WATER/GAMA(2))**3.0D0
8261 A2 = XK7 *(WATER/GAMA(4))**3.0D0
8262 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0
8263 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0
8264 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0
8265 A7 = XK17 *(WATER/GAMA(17))**3.0D0
8266 !C A8 = XK23 *(WATER/GAMA(21))**2.0D0
8267 A65 = A6/A5
8268 !C
8269 !C CALCULATE DISSOCIATION QUANTITIES
8270 !C
8271 DENO = MAX(CHI6-PSI6-PSI3, ZERO)
8272 PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6)
8273 PSI5 = MIN(MAX(PSI5,ZERO),CHI5)
8274 !C
8275 !CCC IF(CHI4.GT.TINY) THEN ! PSI4
8276 IF(W(2).GT.TINY) THEN ! Accounts for NH3 evaporation
8277 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
8278 CC = CHI4*(PSI5+PSI6) - 2.d0*PSI2/A4
8279 DD = MAX(BB*BB-4.d0*CC,ZERO) ! Patch proposed by Uma Shankar, 19/11/01
8280 PSI4 =0.5d0*(-BB - SQRT(DD))
8281 ELSE
8282 PSI4 = TINY
8283 ENDIF
8284 PSI4 = MIN (MAX (PSI4,ZERO), CHI4)
8285 !C
8286 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7
8287 CALL POLY32p1 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV)
8288 IF (ISLV.EQ.0) THEN
8289 PSI7 = MAX (MIN (PSI7, CHI7), ZERO)
8290 ELSE
8291 PSI7 = ZERO
8292 ENDIF
8293 ELSE
8294 PSI7 = ZERO
8295 ENDIF
8296 !C
8297 IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
8298 CALL POLY32p1 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ &
8299 PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) &
8300 /4.D0,PSI20, ISLV)
8301 IF (ISLV.EQ.0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2)
8302 ENDIF
8303 !C PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4)
8304 !C PSI2 = MIN (MAX(PSI2, ZERO), CHI2)
8305 !C ENDIF
8306 !C
8307 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
8308 !C
8309 MOLAL (2) = ZERO ! NaI
8310 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
8311 MOLAL (4) = PSI6 ! CLI
8312 MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I
8313 MOLAL (6) = ZERO ! HSO4
8314 MOLAL (7) = PSI5 ! NO3I
8315 MOLAL (8) = ZERO ! CAI
8316 MOLAL (9) = 2.0D0*PSI7 ! KI
8317 MOLAL (10)= PSI8 ! MGI
8318 !C
8319 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
8320 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
8321 -MOLAL(9)-2.D0*MOLAL(10)
8322 CALL CALCPH2p1 (SMIN, HI, OHI)
8323 MOLAL (1) = HI
8324 !C
8325 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
8326 !C
8327 GNH3 = MAX(CHI4 - PSI4, TINY)
8328 GHNO3 = MAX(CHI5 - PSI5, TINY)
8329 GHCL = MAX(CHI6 - PSI6, TINY)
8330 !C
8331 !C CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
8332 CNH42S4 = MAX(CHI2 - PSI2, ZERO)
8333 CNH4NO3 = ZERO
8334 CNH4Cl = ZERO
8335 CK2SO4 = MAX(CHI7 - PSI7, ZERO)
8336 CMGSO4 = ZERO
8337 CCASO4 = CHI9
8338 !C
8339 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES **********************
8340 !C
8341 CALL CALCMR2p1
8342 !C
8343 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8344 !C
8345 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
8346 CALL CALCACT2p1
8347 ELSE
8348 GOTO 20
8349 ENDIF
8350 10 CONTINUE
8351 !C
8352 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
8353 !C
8354 20 FUNCO3A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
8355 !C
8356 !C
8357 RETURN
8358 !C
8359 !C *** END OF FUNCTION FUNCO3A *******************************************
8360 !C
8361 END
8363 !C
8364 !C=======================================================================
8365 !C
8366 !C *** ISORROPIA CODE II
8367 !C *** SUBROUTINE CALCO2
8368 !C *** CASE O2
8369 !C
8370 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8371 !C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2)
8372 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
8373 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4
8374 !C
8375 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8376 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8377 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
8378 !C
8379 !C=======================================================================
8380 !C
8381 SUBROUTINE CALCO22p1
8382 INCLUDE 'module_isrpia_inc.F'
8383 EXTERNAL CALCO1A2p1, CALCO3A2p1, CALCO42p1
8384 !C
8385 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
8386 !C
8387 IF (W(4).GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE
8388 SCASE = 'O2 ; SUBCASE 1'
8389 CALL CALCO2A2p1
8390 SCASE = 'O2 ; SUBCASE 1'
8391 ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE
8392 SCASE = 'O1 ; SUBCASE 1'
8393 CALL CALCO1A2p1
8394 SCASE = 'O1 ; SUBCASE 1'
8395 ENDIF
8396 !C
8397 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
8398 !C
8399 IF (WATER.LE.TINY) THEN
8400 IF (RH.LT.DRMO2) THEN ! ONLY SOLIDS
8401 WATER = TINY
8402 DO 10 I=1,NIONS
8403 MOLAL(I) = ZERO
8404 10 CONTINUE
8405 CALL CALCO1A2p1
8406 SCASE = 'O2 ; SUBCASE 2'
8407 ELSE
8408 IF (W(5).GT. TINY) THEN
8409 SCASE = 'O2 ; SUBCASE 3' ! MDRH (NH4CL, NA2SO4, NH42S4, K2SO4, MGSO4, CASO4)
8410 CALL CALCMDRH22p1 (RH, DRMO2, DRNH4CL, CALCO1A2p1, CALCO3A2p1)
8411 SCASE = 'O2 ; SUBCASE 3'
8412 ENDIF
8413 IF (WATER.LE.TINY .AND. RH.GE.DRMO3) THEN
8414 SCASE = 'O2 ; SUBCASE 4' ! MDRH (NA2SO4, NH42S4, K2SO4, MGSO4, CASO4)
8415 CALL CALCMDRH22p1 (RH, DRMO3, DRNH42S4, CALCO1A2p1, CALCO42p1)
8416 SCASE = 'O2 ; SUBCASE 4'
8417 ELSE
8418 WATER = TINY
8419 DO 20 I=1,NIONS
8420 MOLAL(I) = ZERO
8421 20 CONTINUE
8422 CALL CALCO1A2p1
8423 SCASE = 'O2 ; SUBCASE 2'
8424 ENDIF
8425 ENDIF
8426 ENDIF
8427 !C
8428 RETURN
8429 !C
8430 !C *** END OF SUBROUTINE CALCO2 ******************************************
8431 !C
8432 END
8433 !C
8434 !C=======================================================================
8435 !C
8436 !C *** ISORROPIA CODE II
8437 !C *** SUBROUTINE CALCO2A
8438 !C *** CASE O2 ; SUBCASE 1
8439 !C
8440 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8441 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
8442 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
8443 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4
8444 !C 4. Completely dissolved: NH4NO3
8445 !C
8446 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8447 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8448 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8449 !C
8450 !C=======================================================================
8451 !C
8452 SUBROUTINE CALCO2A2p1
8453 INCLUDE 'module_isrpia_inc.F'
8454 !C
8455 DOUBLE PRECISION LAMDA
8456 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
8457 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
8458 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
8459 A5, A6, A7, A8, A9
8460 !C
8461 !C *** SETUP PARAMETERS *************************************************
8462 !C
8463 CALAOU = .TRUE.
8464 CHI9 = MIN (W(6), W(2)) ! CCASO4
8465 SO4FR = MAX (W(2)-CHI9, ZERO)
8466 CAFR = MAX (W(6)-CHI9, ZERO)
8467 CHI7 = MIN (0.5D0*W(7), SO4FR) ! CK2SO4
8468 FRK = MAX (W(7) - 2.D0*CHI7, ZERO)
8469 SO4FR = MAX (SO4FR - CHI7, ZERO)
8470 CHI1 = MIN (0.5D0*W(1), SO4FR) ! NA2SO4
8471 NAFR = MAX (W(1) - 2.D0*CHI1, ZERO)
8472 SO4FR = MAX (SO4FR - CHI1, ZERO)
8473 CHI8 = MIN (W(8), SO4FR) ! CMGSO4
8474 FRMG = MAX(W(8) - CHI8, ZERO)
8475 SO4FR = MAX(SO4FR - CHI8, ZERO)
8476 CHI3 = ZERO
8477 CHI5 = W(4)
8478 CHI6 = W(5)
8479 CHI2 = MAX (SO4FR, ZERO)
8480 CHI4 = MAX (W(3)-2.D0*CHI2, ZERO)
8481 !C
8482 PSI8 = CHI8
8483 PSI6LO = TINY
8484 PSI6HI = CHI6-TINY
8485 !C
8486 WATER = TINY
8487 !C
8488 !C *** INITIAL VALUES FOR BISECTION *************************************
8489 !C
8490 X1 = PSI6LO
8491 Y1 = FUNCO2A2p1 (X1)
8492 IF (CHI6.LE.TINY) GOTO 50
8493 !CCC IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
8494 !CCC IF (WATER .LE. TINY) GOTO 50 ! No water
8495 !C
8496 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO ***********************
8497 !C
8498 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
8499 DO 10 I=1,NDIV
8500 X2 = X1+DX
8501 Y2 = FUNCO2A2p1 (X2)
8502 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
8503 X1 = X2
8504 Y1 = Y2
8505 10 CONTINUE
8506 !C
8507 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
8508 !C
8509 IF (ABS(Y2) .GT. EPS) WATER = TINY
8510 GOTO 50
8511 !C
8512 !C *** PERFORM BISECTION ************************************************
8513 !C
8514 20 DO 30 I=1,MAXIT
8515 X3 = 0.5*(X1+X2)
8516 Y3 = FUNCO2A2p1 (X3)
8517 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
8518 Y2 = Y3
8519 X2 = X3
8520 ELSE
8521 Y1 = Y3
8522 X1 = X3
8523 ENDIF
8524 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
8525 30 CONTINUE
8526 CALL PUSHERR2p1 (0002, 'CALCO2A') ! WARNING ERROR: NO CONVERGENCE
8527 !C
8528 !C *** CONVERGED ; RETURN ***********************************************
8529 !C
8530 40 X3 = 0.5*(X1+X2)
8531 IF (X3.LE.TINY2) THEN ! PRACTICALLY NO NITRATES, SO DRY SOLUTION
8532 WATER = TINY
8533 ELSE
8534 Y3 = FUNCO2A2p1 (X3)
8535 ENDIF
8536 !C
8537 !C *** FINAL CALCULATIONS *************************************************
8538 !C
8539 50 CONTINUE
8540 !C
8541 !C *** Na2SO4 DISSOLUTION
8542 !C
8543 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI1
8544 CALL POLY32p1 (PSI2+PSI7+PSI8, ZERO, -A1/4.D0, PSI1, ISLV)
8545 IF (ISLV.EQ.0) THEN
8546 PSI1 = MIN (PSI1, CHI1)
8547 ELSE
8548 PSI1 = ZERO
8549 ENDIF
8550 ELSE
8551 PSI1 = ZERO
8552 ENDIF
8553 MOLAL(2) = 2.0D0*PSI1 ! Na+ EFFECT
8554 MOLAL(5) = MOLAL(5) + PSI1 ! SO4 EFFECT
8555 CNA2SO4 = MAX(CHI1 - PSI1, ZERO) ! NA2SO4(s) depletion
8556 !C
8557 !C *** HSO4 equilibrium
8558 !C
8559 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
8560 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
8561 MOLAL(1) = MOLAL(1) - DELTA ! H+ AFFECT
8562 MOLAL(5) = MOLAL(5) - DELTA ! SO4 AFFECT
8563 MOLAL(6) = DELTA ! HSO4 AFFECT
8564 ENDIF
8565 !C
8566 RETURN
8567 !C
8568 !C *** END OF SUBROUTINE CALCO2A ******************************************
8569 !C
8570 END
8571 !C
8572 !C=======================================================================
8573 !C
8574 !C *** ISORROPIA CODE II
8575 !C *** SUBROUTINE FUNCO2A
8576 !C *** CASE O2; SUBCASE 1
8577 !C
8578 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8579 !C 1. (Rsulfate > 2.0 ; R(Cr+Na) < 2.0)
8580 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
8581 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4CL, NA2SO4, K2SO4, MgSO4, CaSO4
8582 !C 4. Completely dissolved: NH4NO3
8583 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8584 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8585 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8586 !C
8587 !C=======================================================================
8588 !C
8589 DOUBLE PRECISION FUNCTION FUNCO2A2p1 (X)
8590 INCLUDE 'module_isrpia_inc.F'
8591 !C
8592 DOUBLE PRECISION LAMDA
8593 COMMON /CASEO2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
8594 CHI9, LAMDA, PSI1, PSI2, PSI3, PSI4, PSI5, &
8595 PSI6, PSI7, PSI8, PSI9, A1, A2, A3, A4, &
8596 A5, A6, A7, A8, A9
8597 !C
8598 !C *** SETUP PARAMETERS ************************************************
8599 !C
8600 PSI6 = X
8601 PSI2 = CHI2
8602 PSI3 = ZERO
8603 !C
8604 FRST = .TRUE.
8605 CALAIN = .TRUE.
8606 !C
8607 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
8608 !C
8609 DO 10 I=1,NSWEEP
8610 !C
8611 A1 = XK5 *(WATER/GAMA(2))**3.0D0
8612 A2 = XK7 *(WATER/GAMA(4))**3.0D0
8613 A3 = XK6 /(R*TEMP*R*TEMP)
8614 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0D0
8615 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0D0
8616 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0D0
8617 A65 = A6/A5
8618 A7 = XK17 *(WATER/GAMA(17))**3.0D0
8619 !C A8 = XK23 *(WATER/GAMA(21))**2.0D0
8620 !C
8621 DENO = MAX(CHI6-PSI6-PSI3, ZERO)
8622 PSI5 = PSI6*CHI5/(A6/A5*DENO + PSI6)
8623 PSI5 = MIN(PSI5,CHI5)
8624 !C
8625 PSI4 = MIN(PSI5+PSI6,CHI4)
8626 !C
8627 !C
8628 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! PSI7
8629 CALL POLY32p1 (PSI2+PSI8, ZERO, -A7/4.D0, PSI7, ISLV)
8630 IF (ISLV.EQ.0) THEN
8631 PSI7 = MAX (MIN (PSI7, CHI7), ZERO)
8632 ELSE
8633 PSI7 = ZERO
8634 ENDIF
8635 ELSE
8636 PSI7 = ZERO
8637 ENDIF
8638 !C
8639 IF (CHI2.GT.TINY .AND. WATER.GT.TINY) THEN
8640 CALL POLY32p1 (PSI7+PSI8+PSI4, PSI4*(PSI7+PSI8)+ &
8641 PSI4*PSI4/4.D0, (PSI4*PSI4*(PSI7+PSI8)-A2) &
8642 /4.D0,PSI20, ISLV)
8643 IF (ISLV.EQ.0) PSI2 = MIN (MAX(PSI20,ZERO), CHI2)
8644 ENDIF
8645 !C PSI2 = 0.5D0*(2.0D0*SQRT(A2/A7)*PSI7 - PSI4)
8646 !C PSI2 = MIN (PSI2, CHI2)
8647 !C ENDIF
8648 !C
8649 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
8650 !C
8651 MOLAL (2) = ZERO ! NaI
8652 MOLAL (3) = 2.0D0*PSI2 + PSI4 ! NH4I
8653 MOLAL (4) = PSI6 ! CLI
8654 MOLAL (5) = PSI2+PSI7+PSI8 ! SO4I
8655 MOLAL (6) = ZERO ! HSO4
8656 MOLAL (7) = PSI5 ! NO3I
8657 MOLAL (8) = ZERO ! CAI
8658 MOLAL (9) = 2.0D0*PSI7 ! KI
8659 MOLAL (10)= PSI8 ! MGI
8660 !C
8661 !CCC MOLAL (1) = MAX(CHI5 - PSI5, TINY)*A5/PSI5 ! HI
8662 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
8663 -MOLAL(9)-2.D0*MOLAL(10)
8664 CALL CALCPH2p1 (SMIN, HI, OHI)
8665 MOLAL (1) = HI
8666 !C
8667 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
8668 !C
8669 GNH3 = MAX(CHI4 - PSI4, TINY)
8670 GHNO3 = MAX(CHI5 - PSI5, TINY)
8671 GHCL = MAX(CHI6 - PSI6, TINY)
8672 !C
8673 !C CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
8674 CNH42S4 = MAX(CHI2 - PSI2, ZERO)
8675 CNH4NO3 = ZERO
8676 CK2SO4 = MAX(CHI7 - PSI7, ZERO)
8677 CMGSO4 = ZERO
8678 CCASO4 = CHI9
8680 !C
8681 !C *** NH4Cl(s) calculations
8682 !C
8683 A3 = XK6 /(R*TEMP*R*TEMP)
8684 IF (GNH3*GHCL.GT.A3) THEN
8685 DELT = MIN(GNH3, GHCL)
8686 BB = -(GNH3+GHCL)
8687 CC = GNH3*GHCL-A3
8688 DD = BB*BB - 4.D0*CC
8689 PSI31 = 0.5D0*(-BB + SQRT(DD))
8690 PSI32 = 0.5D0*(-BB - SQRT(DD))
8691 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
8692 PSI3 = PSI31
8693 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
8694 PSI3 = PSI32
8695 ELSE
8696 PSI3 = ZERO
8697 ENDIF
8698 ELSE
8699 PSI3 = ZERO
8700 ENDIF
8701 PSI3 = MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6)
8702 !C
8703 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
8704 !C
8705 GNH3 = MAX(GNH3 - PSI3, TINY)
8706 GHCL = MAX(GHCL - PSI3, TINY)
8707 CNH4CL = PSI3
8708 !C
8709 !C *** CALCULATE MOLALR ARRAY, WATER AND ACTIVITIES *********************
8710 !C
8711 CALL CALCMR2p1
8712 !C
8713 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
8714 !C
8715 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
8716 CALL CALCACT2p1
8717 ELSE
8718 GOTO 20
8719 ENDIF
8720 10 CONTINUE
8721 !C
8722 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP **************************
8723 !C
8725 !C20 IF (CHI4.LE.TINY) THEN
8726 !C FUNCO2A = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
8727 !C ELSE
8728 20 FUNCO2A2p1 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
8729 !C ENDIF
8730 !C
8731 RETURN
8732 !C
8733 !C *** END OF FUNCTION FUNCO2A ****************************************
8734 !C
8735 END
8736 !C
8737 !C=======================================================================
8738 !C
8739 !C *** ISORROPIA CODE II
8740 !C *** SUBROUTINE CALCO1
8741 !C *** CASE O1
8742 !C
8743 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8744 !C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2)
8745 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
8746 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4
8747 !C
8748 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
8749 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
8750 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCO1A)
8751 !C
8752 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
8753 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8754 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
8755 !C
8756 !C=======================================================================
8757 !C
8758 SUBROUTINE CALCO12p1
8759 INCLUDE 'module_isrpia_inc.F'
8760 EXTERNAL CALCO1A2p1, CALCO2A2p1
8761 !C
8762 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
8763 !C
8764 IF (RH.LT.DRMO1) THEN
8765 SCASE = 'O1 ; SUBCASE 1'
8766 CALL CALCO1A2p1 ! SOLID PHASE ONLY POSSIBLE
8767 SCASE = 'O1 ; SUBCASE 1'
8768 ELSE
8769 SCASE = 'O1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
8770 CALL CALCMDRH22p1 (RH, DRMO1, DRNH4NO3, CALCO1A2p1, CALCO2A2p1)
8771 SCASE = 'O1 ; SUBCASE 2'
8772 ENDIF
8773 !C
8774 RETURN
8775 !C
8776 !C *** END OF SUBROUTINE CALCO1 ******************************************
8777 !C
8778 END
8779 !C=======================================================================
8780 !C
8781 !C *** ISORROPIA CODE II
8782 !C *** SUBROUTINE CALCO1A
8783 !C *** CASE O1A
8784 !C
8785 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8786 !C 1. SULFATE POOR (SO4RAT > 2.0), Cr+NA poor (CRNARAT < 2)
8787 !C 2. SOLID AEROSOL ONLY
8788 !C 3. SOLIDS POSSIBLE : (NH4)2SO4, NH4NO3, NH4Cl, NA2SO4, K2SO4, MGSO4, CASO4
8789 !C
8790 !C SOLID (NH4)2SO4 IS CALCULATED FROM THE SULFATES, WHILE NH4NO3
8791 !C IS CALCULATED FROM NH3-HNO3 EQUILIBRIUM. 'ZE' IS THE AMOUNT OF
8792 !C NH4NO3 THAT VOLATIZES WHEN ALL POSSILBE NH4NO3 IS INITIALLY IN
8793 !C THE SOLID PHASE.
8794 !C
8795 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8796 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8797 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8798 !C
8799 !C=======================================================================
8800 !C
8801 SUBROUTINE CALCO1A2p1
8802 INCLUDE 'module_isrpia_inc.F'
8803 DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2
8804 !C
8805 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
8806 !C
8807 CCASO4 = MIN (W(6), W(2)) ! CCASO4
8808 SO4FR = MAX(W(2) - CCASO4, ZERO)
8809 CAFR = MAX(W(6) - CCASO4, ZERO)
8810 CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
8811 FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO)
8812 SO4FR = MAX(SO4FR - CK2SO4, ZERO)
8813 CNA2SO4 = MIN (0.5D0*W(1), SO4FR) ! CNA2SO4
8814 FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO)
8815 SO4FR = MAX(SO4FR - CNA2SO4, ZERO)
8816 CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4
8817 FRMG = MAX(W(8) - CMGSO4, ZERO)
8818 SO4FR = MAX(SO4FR - CMGSO4, ZERO)
8819 !C
8820 CNH42S4 = MAX (SO4FR , ZERO) ! CNH42S4
8821 !C
8822 !C *** CALCULATE VOLATILE SPECIES **************************************
8823 !C
8824 ALF = W(3) - 2.0D0*CNH42S4
8825 BET = W(5)
8826 GAM = W(4)
8827 !C
8828 RTSQ = R*TEMP*R*TEMP
8829 A1 = XK6/RTSQ
8830 A2 = XK10/RTSQ
8831 ! print *, A2
8832 !C
8833 THETA1 = GAM - BET*(A2/A1)
8834 THETA2 = A2/A1
8835 !C
8836 !C QUADRATIC EQUATION SOLUTION
8837 !C
8838 BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
8839 CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
8840 DD = BB*BB - 4.0D0*CC
8841 IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately
8842 !C
8843 !C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
8844 !C
8845 SQDD = SQRT(DD)
8846 KAPA1 = 0.5D0*(-BB+SQDD)
8847 KAPA2 = 0.5D0*(-BB-SQDD)
8848 LAMDA1 = THETA1 + THETA2*KAPA1
8849 LAMDA2 = THETA1 + THETA2*KAPA2
8850 !C
8851 IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
8852 IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. &
8853 BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
8854 KAPA = KAPA1
8855 LAMDA= LAMDA1
8856 GOTO 200
8857 ENDIF
8858 ENDIF
8859 !C
8860 IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
8861 IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
8862 BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
8863 KAPA = KAPA2
8864 LAMDA= LAMDA2
8865 GOTO 200
8866 ENDIF
8867 ENDIF
8868 !C
8869 !C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
8870 !C
8871 100 KAPA = ZERO
8872 LAMDA = ZERO
8873 DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
8874 DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
8875 !C
8876 !C NH4CL EQUILIBRIUM
8877 !C
8878 IF (DD1.GE.ZERO) THEN
8879 SQDD1 = SQRT(DD1)
8880 KAPA1 = 0.5D0*(ALF+BET + SQDD1)
8881 KAPA2 = 0.5D0*(ALF+BET - SQDD1)
8882 !C
8883 IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
8884 KAPA = KAPA1
8885 ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
8886 KAPA = KAPA2
8887 ELSE
8888 KAPA = ZERO
8889 ENDIF
8890 ENDIF
8891 !C
8892 !C NH4NO3 EQUILIBRIUM
8893 !C
8894 IF (DD2.GE.ZERO) THEN
8895 SQDD2 = SQRT(DD2)
8896 LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
8897 LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
8898 !C
8899 IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
8900 LAMDA = LAMDA1
8901 ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
8902 LAMDA = LAMDA2
8903 ELSE
8904 LAMDA = ZERO
8905 ENDIF
8906 ENDIF
8907 !C
8908 !C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
8909 !C
8910 IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
8911 IF (BET .LT. LAMDA/THETA1) THEN
8912 KAPA = ZERO
8913 ELSE
8914 LAMDA= ZERO
8915 ENDIF
8916 ENDIF
8917 !C
8918 !C *** CALCULATE COMPOSITION OF VOLATILE SPECIES ************************
8919 !C
8920 200 CONTINUE
8921 CNH4NO3 = LAMDA
8922 CNH4CL = KAPA
8923 !C
8924 GNH3 = MAX(ALF - KAPA - LAMDA, ZERO)
8925 GHNO3 = MAX(GAM - LAMDA, ZERO)
8926 GHCL = MAX(BET - KAPA, ZERO)
8927 !C
8928 RETURN
8929 !C
8930 !C *** END OF SUBROUTINE CALCO1A *****************************************
8931 !C
8932 END
8933 !C
8934 !C=======================================================================
8935 !C
8936 !C *** ISORROPIA CODE II
8937 !C *** SUBROUTINE CALCM8
8938 !C *** CASE M8
8939 !C
8940 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
8941 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
8942 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
8943 !C 3. SOLIDS POSSIBLE : CaSO4
8944 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4
8945 !C
8946 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
8947 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
8948 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
8949 !C
8950 !C=======================================================================
8951 !C
8952 SUBROUTINE CALCM82p1
8953 INCLUDE 'module_isrpia_inc.F'
8954 !C
8955 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
8956 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
8957 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
8958 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
8959 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
8960 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
8961 !C
8962 !C *** SETUP PARAMETERS ************************************************
8963 !C
8964 CALAOU = .TRUE.
8965 CHI11 = MIN (W(6), W(2)) ! CCASO4
8966 SO4FR = MAX(W(2)-CHI11, ZERO)
8967 CAFR = MAX(W(6)-CHI11, ZERO)
8968 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
8969 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
8970 SO4FR = MAX(SO4FR-CHI9, ZERO)
8971 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
8972 FRMG = MAX(W(8)-CHI10, ZERO)
8973 SO4FR = MAX(SO4FR-CHI10, ZERO)
8974 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
8975 CHI2 = ZERO ! CNH42S4
8976 CHI3 = ZERO ! CNH4CL
8977 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
8978 CHI8 = MIN (FRNA, W(4)) ! CNANO3
8979 CHI4 = W(3) ! NH3(g)
8980 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
8981 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
8982 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
8983 !C
8984 PSI6LO = TINY
8985 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
8986 !C
8987 !C *** INITIAL VALUES FOR BISECTION ************************************
8988 !C
8989 X1 = PSI6LO
8990 Y1 = FUNCM82p1 (X1)
8991 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
8992 !C
8993 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
8994 !C
8995 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
8996 DO 10 I=1,NDIV
8997 X2 = X1+DX
8998 Y2 = FUNCM82p1 (X2)
8999 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
9000 X1 = X2
9001 Y1 = Y2
9002 10 CONTINUE
9003 !C
9004 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
9005 !C
9006 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM82p1 (PSI6LO)
9007 GOTO 50
9008 !C
9009 !C *** PERFORM BISECTION ***********************************************
9010 !C
9011 20 DO 30 I=1,MAXIT
9012 X3 = 0.5*(X1+X2)
9013 Y3 = FUNCM82p1 (X3)
9014 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
9015 Y2 = Y3
9016 X2 = X3
9017 ELSE
9018 Y1 = Y3
9019 X1 = X3
9020 ENDIF
9021 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9022 30 CONTINUE
9023 CALL PUSHERR2p1 (0002, 'CALCM8') ! WARNING ERROR: NO CONVERGENCE
9024 !C
9025 !C *** CONVERGED ; RETURN **********************************************
9026 !C
9027 40 X3 = 0.5*(X1+X2)
9028 Y3 = FUNCM82p1 (X3)
9029 !C
9030 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
9031 !C
9032 50 CONTINUE
9033 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
9034 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
9035 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
9036 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
9037 MOLAL(6) = DELTA ! HSO4 EFFECT
9038 ENDIF
9039 !C
9040 RETURN
9041 !C
9042 !C *** END OF SUBROUTINE CALCM8 ******************************************
9043 !C
9044 END
9049 !C=======================================================================
9050 !C
9051 !C *** ISORROPIA CODE II
9052 !C *** SUBROUTINE FUNCM8
9053 !C *** CASE M8
9054 !C
9055 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9056 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9057 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9058 !C 3. SOLIDS POSSIBLE : CaSO4
9059 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4, K2SO4
9060 !C
9061 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9062 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9063 !C
9064 !C=======================================================================
9065 !C
9066 DOUBLE PRECISION FUNCTION FUNCM82p1 (X)
9067 INCLUDE 'module_isrpia_inc.F'
9068 !C
9069 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9070 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9071 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9072 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9073 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9074 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9075 !C
9076 !C *** SETUP PARAMETERS ************************************************
9077 !C
9078 PSI6 = X
9079 PSI1 = CHI1
9080 PSI2 = ZERO
9081 PSI3 = ZERO
9082 PSI7 = CHI7
9083 PSI8 = CHI8
9084 PSI9 = CHI9
9085 PSI10 = CHI10
9086 PSI11 = ZERO
9087 FRST = .TRUE.
9088 CALAIN = .TRUE.
9089 !C
9090 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9091 !C
9092 DO 10 I=1,NSWEEP
9093 !C
9094 !C A1 = XK5 *(WATER/GAMA(2))**3.0
9095 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
9096 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
9097 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
9098 !C A7 = XK8 *(WATER/GAMA(1))**2.0
9099 !C A8 = XK9 *(WATER/GAMA(3))**2.0
9100 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9101 !C
9102 !C CALCULATE DISSOCIATION QUANTITIES
9103 !C
9104 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
9105 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
9106 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
9107 !C
9108 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
9109 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
9110 CC = CHI4*(PSI5+PSI6)
9111 DD = MAX(BB*BB-4.d0*CC,ZERO)
9112 PSI4 =0.5d0*(-BB - SQRT(DD))
9113 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
9114 ELSE
9115 PSI4 = TINY
9116 ENDIF
9117 !C
9118 !C *** CALCULATE SPECIATION ********************************************
9119 !C
9120 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
9121 MOLAL (3) = PSI4 ! NH4I
9122 MOLAL (4) = PSI6 + PSI7 ! CLI
9123 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
9124 MOLAL (6) = ZERO ! HSO4I
9125 MOLAL (7) = PSI5 + PSI8 ! NO3I
9126 MOLAL (8) = PSI11 ! CAI
9127 MOLAL (9) = 2.D0*PSI9 ! KI
9128 MOLAL (10)= PSI10 ! MGI
9129 !C
9130 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
9131 - MOLAL(9) - 2.D0*MOLAL(10)
9132 CALL CALCPH2p1 (SMIN, HI, OHI)
9133 MOLAL (1) = HI
9134 !C
9135 GNH3 = MAX(CHI4 - PSI4, TINY)
9136 GHNO3 = MAX(CHI5 - PSI5, TINY)
9137 GHCL = MAX(CHI6 - PSI6, TINY)
9138 !C
9139 CNH42S4 = ZERO
9140 CNH4NO3 = ZERO
9141 CNACL = ZERO
9142 CNANO3 = ZERO
9143 CNA2SO4 = ZERO
9144 CK2SO4 = ZERO
9145 CMGSO4 = ZERO
9146 CCASO4 = CHI11
9147 !C
9148 CALL CALCMR2p1 ! Water content
9149 !C
9150 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9151 !C
9152 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9153 CALL CALCACT2p1
9154 ELSE
9155 GOTO 20
9156 ENDIF
9157 10 CONTINUE
9158 !C
9159 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
9160 !C
9161 !C20 FUNCM8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
9162 20 FUNCM82p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
9163 !C
9164 RETURN
9165 !C
9166 !C *** END OF FUNCTION FUNCM8 *******************************************
9167 !C
9168 END
9171 !C=======================================================================
9172 !C
9173 !C *** ISORROPIA CODE II
9174 !C *** SUBROUTINE CALCM7
9175 !C *** CASE M7
9176 !C
9177 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9178 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9179 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9180 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4
9181 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4
9182 !C
9183 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9184 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9185 !C
9186 !C=======================================================================
9187 !C
9188 SUBROUTINE CALCM72p1
9189 INCLUDE 'module_isrpia_inc.F'
9190 !C
9191 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9192 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9193 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9194 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9195 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9196 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9197 !C
9198 !C *** SETUP PARAMETERS ************************************************
9199 !C
9200 CALAOU = .TRUE.
9201 CHI11 = MIN (W(6), W(2)) ! CCASO4
9202 SO4FR = MAX(W(2)-CHI11, ZERO)
9203 CAFR = MAX(W(6)-CHI11, ZERO)
9204 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
9205 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
9206 SO4FR = MAX(SO4FR-CHI9, ZERO)
9207 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
9208 FRMG = MAX(W(8)-CHI10, ZERO)
9209 SO4FR = MAX(SO4FR-CHI10, ZERO)
9210 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
9211 CHI2 = ZERO ! CNH42S4
9212 CHI3 = ZERO ! CNH4CL
9213 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
9214 CHI8 = MIN (FRNA, W(4)) ! CNANO3
9215 CHI4 = W(3) ! NH3(g)
9216 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
9217 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
9218 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
9219 !C
9220 PSI6LO = TINY
9221 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
9222 !C
9223 !C *** INITIAL VALUES FOR BISECTION ************************************
9224 !C
9225 X1 = PSI6LO
9226 Y1 = FUNCM72p1 (X1)
9227 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
9228 !C
9229 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
9230 !C
9231 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
9232 DO 10 I=1,NDIV
9233 X2 = X1+DX
9234 Y2 = FUNCM72p1 (X2)
9235 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
9236 X1 = X2
9237 Y1 = Y2
9238 10 CONTINUE
9239 !C
9240 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
9241 !C
9242 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM72p1 (PSI6LO)
9243 GOTO 50
9244 !C
9245 !C *** PERFORM BISECTION ***********************************************
9246 !C
9247 20 DO 30 I=1,MAXIT
9248 X3 = 0.5*(X1+X2)
9249 Y3 = FUNCM72p1 (X3)
9250 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
9251 Y2 = Y3
9252 X2 = X3
9253 ELSE
9254 Y1 = Y3
9255 X1 = X3
9256 ENDIF
9257 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9258 30 CONTINUE
9259 CALL PUSHERR2p1 (0002, 'CALCM7') ! WARNING ERROR: NO CONVERGENCE
9260 !C
9261 !C *** CONVERGED ; RETURN **********************************************
9262 !C
9263 40 X3 = 0.5*(X1+X2)
9264 Y3 = FUNCM72p1 (X3)
9265 !C
9266 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
9267 !C
9268 50 CONTINUE
9269 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
9270 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
9271 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
9272 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
9273 MOLAL(6) = DELTA ! HSO4 EFFECT
9274 ENDIF
9275 !C
9276 RETURN
9277 !C
9278 !C *** END OF SUBROUTINE CALCM7 ******************************************
9279 !C
9280 END
9282 !C
9283 !C=======================================================================
9284 !C
9285 !C *** ISORROPIA CODE II
9286 !C *** SUBROUTINE FUNCM7
9287 !C *** CASE M7
9288 !C
9289 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9290 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9291 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9292 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4
9293 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4, NA2SO4
9294 !C
9295 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9296 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9297 !C
9298 !C=======================================================================
9299 !C
9300 DOUBLE PRECISION FUNCTION FUNCM72p1 (X)
9301 INCLUDE 'module_isrpia_inc.F'
9302 !C
9303 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9304 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9305 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9306 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9307 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9308 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9309 !C
9310 !C *** SETUP PARAMETERS ************************************************
9311 !C
9312 PSI6 = X
9313 PSI1 = CHI1
9314 PSI2 = ZERO
9315 PSI3 = ZERO
9316 PSI7 = CHI7
9317 PSI8 = CHI8
9318 PSI9 = ZERO
9319 PSI10 = CHI10
9320 PSI11 = ZERO
9321 FRST = .TRUE.
9322 CALAIN = .TRUE.
9323 !C
9324 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9325 !C
9326 DO 10 I=1,NSWEEP
9327 !C
9328 !C A1 = XK5 *(WATER/GAMA(2))**3.0
9329 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
9330 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
9331 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
9332 A9 = XK17 *(WATER/GAMA(17))**3.0
9333 !C A7 = XK8 *(WATER/GAMA(1))**2.0
9334 !C A8 = XK9 *(WATER/GAMA(3))**2.0
9335 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9336 !C
9337 !C CALCULATE DISSOCIATION QUANTITIES
9338 !C
9339 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
9340 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
9341 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
9342 !C
9343 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
9344 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
9345 CC = CHI4*(PSI5+PSI6)
9346 DD = MAX(BB*BB-4.d0*CC,ZERO)
9347 PSI4 =0.5d0*(-BB - SQRT(DD))
9348 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
9349 ELSE
9350 PSI4 = TINY
9351 ENDIF
9352 !C
9353 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
9354 CALL POLY32p1 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
9355 IF (ISLV.EQ.0) THEN
9356 PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
9357 ELSE
9358 PSI9 = ZERO
9359 ENDIF
9360 ENDIF
9361 !C
9362 !C *** CALCULATE SPECIATION ********************************************
9363 !C
9364 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
9365 MOLAL (3) = PSI4 ! NH4I
9366 MOLAL (4) = PSI6 + PSI7 ! CLI
9367 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
9368 MOLAL (6) = ZERO ! HSO4I
9369 MOLAL (7) = PSI5 + PSI8 ! NO3I
9370 MOLAL (8) = PSI11 ! CAI
9371 MOLAL (9) = 2.D0*PSI9 ! KI
9372 MOLAL (10)= PSI10 ! MGI
9373 !C
9374 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
9375 - MOLAL(9) - 2.D0*MOLAL(10)
9376 CALL CALCPH2p1 (SMIN, HI, OHI)
9377 MOLAL (1) = HI
9378 !C
9379 GNH3 = MAX(CHI4 - PSI4, TINY)
9380 GHNO3 = MAX(CHI5 - PSI5, TINY)
9381 GHCL = MAX(CHI6 - PSI6, TINY)
9382 !C
9383 CNH42S4 = ZERO
9384 CNH4NO3 = ZERO
9385 CNACL = ZERO
9386 CNANO3 = ZERO
9387 CNA2SO4 = ZERO
9388 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
9389 CMGSO4 = ZERO
9390 CCASO4 = CHI11
9391 !C
9392 CALL CALCMR2p1 ! Water content
9393 !C
9394 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9395 !C
9396 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9397 CALL CALCACT2p1
9398 ELSE
9399 GOTO 20
9400 ENDIF
9401 10 CONTINUE
9402 !C
9403 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
9404 !C
9405 !C20 FUNCM7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
9406 20 FUNCM72p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
9407 !C
9408 RETURN
9409 !C
9410 !C *** END OF FUNCTION FUNCM7 *******************************************
9411 !C
9412 END
9413 !C=======================================================================
9414 !C
9415 !C *** ISORROPIA CODE II
9416 !C *** SUBROUTINE CALCM6
9417 !C *** CASE M6
9418 !C
9419 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9420 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9421 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9422 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4
9423 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4
9424 !C
9425 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9426 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9427 !C
9428 !C=======================================================================
9429 !C
9430 SUBROUTINE CALCM62p1
9431 INCLUDE 'module_isrpia_inc.F'
9432 !C
9433 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9434 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9435 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9436 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9437 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9438 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9439 !C
9440 !C *** SETUP PARAMETERS ************************************************
9441 !C
9442 CALAOU = .TRUE.
9443 CHI11 = MIN (W(6), W(2)) ! CCASO4
9444 SO4FR = MAX(W(2)-CHI11, ZERO)
9445 CAFR = MAX(W(6)-CHI11, ZERO)
9446 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
9447 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
9448 SO4FR = MAX(SO4FR-CHI9, ZERO)
9449 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
9450 FRMG = MAX(W(8)-CHI10, ZERO)
9451 SO4FR = MAX(SO4FR-CHI10, ZERO)
9452 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
9453 CHI2 = ZERO ! CNH42S4
9454 CHI3 = ZERO ! CNH4CL
9455 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
9456 CHI8 = MIN (FRNA, W(4)) ! CNANO3
9457 CHI4 = W(3) ! NH3(g)
9458 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
9459 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
9460 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
9461 !C
9462 PSI6LO = TINY
9463 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
9464 !C
9465 !C *** INITIAL VALUES FOR BISECTION ************************************
9466 !C
9467 X1 = PSI6LO
9468 Y1 = FUNCM62p1 (X1)
9469 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
9470 !C
9471 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
9472 !C
9473 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
9474 DO 10 I=1,NDIV
9475 X2 = X1+DX
9476 Y2 = FUNCM62p1 (X2)
9477 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
9478 X1 = X2
9479 Y1 = Y2
9480 10 CONTINUE
9481 !C
9482 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
9483 !C
9484 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM62p1 (PSI6LO)
9485 GOTO 50
9486 !C
9487 !C *** PERFORM BISECTION ***********************************************
9488 !C
9489 20 DO 30 I=1,MAXIT
9490 X3 = 0.5*(X1+X2)
9491 Y3 = FUNCM62p1 (X3)
9492 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
9493 Y2 = Y3
9494 X2 = X3
9495 ELSE
9496 Y1 = Y3
9497 X1 = X3
9498 ENDIF
9499 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9500 30 CONTINUE
9501 CALL PUSHERR2p1 (0002, 'CALCM6') ! WARNING ERROR: NO CONVERGENCE
9502 !C
9503 !C *** CONVERGED ; RETURN **********************************************
9504 !C
9505 40 X3 = 0.5*(X1+X2)
9506 Y3 = FUNCM62p1 (X3)
9507 !C
9508 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
9509 !C
9510 50 CONTINUE
9511 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
9512 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
9513 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
9514 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
9515 MOLAL(6) = DELTA ! HSO4 EFFECT
9516 ENDIF
9517 !C
9518 RETURN
9519 !C
9520 !C *** END OF SUBROUTINE CALCM6 ******************************************
9521 !C
9522 END
9523 !C
9524 !C=======================================================================
9525 !C
9526 !C *** ISORROPIA CODE II
9527 !C *** SUBROUTINE FUNCM6
9528 !C *** CASE M6
9529 !C
9530 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9531 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9532 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9533 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4
9534 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL, MgSO4
9535 !C
9536 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9537 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9538 !C
9539 !C=======================================================================
9540 !C
9541 DOUBLE PRECISION FUNCTION FUNCM62p1 (X)
9542 INCLUDE 'module_isrpia_inc.F'
9543 !C
9544 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9545 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9546 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9547 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9548 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9549 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9550 !C
9551 !C *** SETUP PARAMETERS ************************************************
9552 !C
9553 PSI6 = X
9554 PSI1 = CHI1
9555 PSI2 = ZERO
9556 PSI3 = ZERO
9557 PSI7 = CHI7
9558 PSI8 = CHI8
9559 PSI9 = ZERO
9560 PSI10 = CHI10
9561 PSI11 = ZERO
9562 FRST = .TRUE.
9563 CALAIN = .TRUE.
9564 !C
9565 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9566 !C
9567 DO 10 I=1,NSWEEP
9568 !C
9569 A1 = XK5 *(WATER/GAMA(2))**3.0
9570 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
9571 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
9572 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
9573 A9 = XK17 *(WATER/GAMA(17))**3.0
9574 !C A7 = XK8 *(WATER/GAMA(1))**2.0
9575 !C A8 = XK9 *(WATER/GAMA(3))**2.0
9576 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9577 !C
9578 !C CALCULATE DISSOCIATION QUANTITIES
9579 !C
9580 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
9581 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
9582 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
9583 !C
9584 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
9585 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
9586 CC = CHI4*(PSI5+PSI6)
9587 DD = MAX(BB*BB-4.d0*CC,ZERO)
9588 PSI4 =0.5d0*(-BB - SQRT(DD))
9589 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
9590 ELSE
9591 PSI4 = TINY
9592 ENDIF
9593 !C
9594 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4
9595 RIZ = SQRT(A9/A1)
9596 AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) &
9597 /(1.D0+RIZ)
9598 BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* &
9599 (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ)
9600 CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) &
9601 -A1/4.D0)/(1.D0+RIZ)
9602 !C AA = PSI7+PSI8+PSI9+PSI10
9603 !C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2.
9604 !C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0
9605 !C
9606 CALL POLY32p1 (AA,BB,CC,PSI1,ISLV)
9607 IF (ISLV.EQ.0) THEN
9608 PSI1 = MIN (PSI1,CHI1)
9609 ELSE
9610 PSI1 = ZERO
9611 ENDIF
9612 ENDIF
9613 !C
9614 !C IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN
9615 !C PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
9616 !C PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
9617 !C ELSE
9618 !C PSI9 = ZERO
9619 !C ENDIF
9620 !C
9621 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
9622 CALL POLY32p1 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
9623 IF (ISLV.EQ.0) THEN
9624 PSI9 = MIN (PSI9,CHI9)
9625 ELSE
9626 PSI9 = ZERO
9627 ENDIF
9628 ENDIF
9629 !C
9630 !C *** CALCULATE SPECIATION ********************************************
9631 !C
9632 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
9633 MOLAL (3) = PSI4 ! NH4I
9634 MOLAL (4) = PSI6 + PSI7 ! CLI
9635 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
9636 MOLAL (6) = ZERO ! HSO4I
9637 MOLAL (7) = PSI5 + PSI8 ! NO3I
9638 MOLAL (8) = PSI11 ! CAI
9639 MOLAL (9) = 2.D0*PSI9 ! KI
9640 MOLAL (10)= PSI10 ! MGI
9641 !C
9642 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
9643 - MOLAL(9) - 2.D0*MOLAL(10)
9644 CALL CALCPH2p1 (SMIN, HI, OHI)
9645 MOLAL (1) = HI
9646 !C
9647 GNH3 = MAX(CHI4 - PSI4, TINY)
9648 GHNO3 = MAX(CHI5 - PSI5, TINY)
9649 GHCL = MAX(CHI6 - PSI6, TINY)
9650 !C
9651 CNH42S4 = ZERO
9652 CNH4NO3 = ZERO
9653 CNACL = ZERO
9654 CNANO3 = ZERO
9655 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
9656 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
9657 CMGSO4 = ZERO
9658 CCASO4 = CHI11
9659 !C
9660 CALL CALCMR2p1 ! Water content
9661 !C
9662 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9663 !C
9664 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9665 CALL CALCACT2p1
9666 ELSE
9667 GOTO 20
9668 ENDIF
9669 10 CONTINUE
9670 !C
9671 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
9672 !C
9673 !C20 FUNCM6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
9674 20 FUNCM62p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
9675 !C
9676 RETURN
9677 !C
9678 !C *** END OF FUNCTION FUNCM6 *******************************************
9679 !C
9680 END
9682 !C=======================================================================
9683 !C
9684 !C *** ISORROPIA CODE II
9685 !C *** SUBROUTINE CALCM5
9686 !C *** CASE M5
9687 !C
9688 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9689 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9690 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9691 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4
9692 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL
9693 !C
9694 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9695 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9696 !C
9697 !C=======================================================================
9698 !C
9699 SUBROUTINE CALCM52p1
9700 INCLUDE 'module_isrpia_inc.F'
9701 !C
9702 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9703 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9704 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9705 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9706 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9707 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9708 !C
9709 !C *** SETUP PARAMETERS ************************************************
9710 !C
9711 CALAOU = .TRUE.
9712 CHI11 = MIN (W(6), W(2)) ! CCASO4
9713 SO4FR = MAX(W(2)-CHI11, ZERO)
9714 CAFR = MAX(W(6)-CHI11, ZERO)
9715 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
9716 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
9717 SO4FR = MAX(SO4FR-CHI9, ZERO)
9718 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
9719 FRMG = MAX(W(8)-CHI10, ZERO)
9720 SO4FR = MAX(SO4FR-CHI10, ZERO)
9721 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
9722 CHI2 = ZERO ! CNH42S4
9723 CHI3 = ZERO ! CNH4CL
9724 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
9725 CHI8 = MIN (FRNA, W(4)) ! CNANO3
9726 CHI4 = W(3) ! NH3(g)
9727 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
9728 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
9729 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
9730 !C
9731 PSI6LO = TINY
9732 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
9733 !C
9734 !C *** INITIAL VALUES FOR BISECTION ************************************
9735 !C
9736 X1 = PSI6LO
9737 Y1 = FUNCM52p1 (X1)
9738 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
9739 !C
9740 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
9741 !C
9742 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
9743 DO 10 I=1,NDIV
9744 X2 = X1+DX
9745 Y2 = FUNCM52p1 (X2)
9746 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
9747 X1 = X2
9748 Y1 = Y2
9749 10 CONTINUE
9750 !C
9751 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
9752 !C
9753 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM52p1 (PSI6LO)
9754 GOTO 50
9755 !C
9756 !C *** PERFORM BISECTION ***********************************************
9757 !C
9758 20 DO 30 I=1,MAXIT
9759 X3 = 0.5*(X1+X2)
9760 Y3 = FUNCM52p1 (X3)
9761 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
9762 Y2 = Y3
9763 X2 = X3
9764 ELSE
9765 Y1 = Y3
9766 X1 = X3
9767 ENDIF
9768 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
9769 30 CONTINUE
9770 CALL PUSHERR2p1 (0002, 'CALCM5') ! WARNING ERROR: NO CONVERGENCE
9771 !C
9772 !C *** CONVERGED ; RETURN **********************************************
9773 !C
9774 40 X3 = 0.5*(X1+X2)
9775 Y3 = FUNCM52p1 (X3)
9776 !C
9777 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
9778 !C
9779 50 CONTINUE
9780 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
9781 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
9782 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
9783 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
9784 MOLAL(6) = DELTA ! HSO4 EFFECT
9785 ENDIF
9786 !C
9787 RETURN
9788 !C
9789 !C *** END OF SUBROUTINE CALCM5 ******************************************
9790 !C
9791 END
9792 !C
9793 !C=======================================================================
9794 !C
9795 !C *** ISORROPIA CODE II
9796 !C *** SUBROUTINE FUNCM5
9797 !C *** CASE M5
9798 !C
9799 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9800 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9801 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9802 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4
9803 !C 4. Completely dissolved: NH4NO3, NH4CL, NANO3, NACL
9804 !C
9805 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9806 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9807 !C
9808 !C=======================================================================
9809 !C
9810 DOUBLE PRECISION FUNCTION FUNCM52p1 (X)
9811 INCLUDE 'module_isrpia_inc.F'
9812 !C
9813 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9814 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9815 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9816 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9817 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6,&
9818 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9819 !C
9820 !C *** SETUP PARAMETERS ************************************************
9821 !C
9822 PSI6 = X
9823 PSI1 = CHI1
9824 PSI2 = ZERO
9825 PSI3 = ZERO
9826 PSI7 = CHI7
9827 PSI8 = CHI8
9828 PSI9 = ZERO
9829 PSI10 = CHI10
9830 PSI11 = ZERO
9831 FRST = .TRUE.
9832 CALAIN = .TRUE.
9833 !C
9834 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
9835 !C
9836 DO 10 I=1,NSWEEP
9837 !C
9838 A1 = XK5 *(WATER/GAMA(2))**3.0
9839 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
9840 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
9841 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
9842 A9 = XK17 *(WATER/GAMA(17))**3.0
9843 !C A7 = XK8 *(WATER/GAMA(1))**2.0
9844 !C A8 = XK9 *(WATER/GAMA(3))**2.0
9845 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
9846 !C
9847 !C CALCULATE DISSOCIATION QUANTITIES
9848 !C
9849 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
9850 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
9851 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
9852 !C
9853 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
9854 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
9855 CC = CHI4*(PSI5+PSI6)
9856 DD = MAX(BB*BB-4.d0*CC,ZERO)
9857 PSI4 =0.5d0*(-BB - SQRT(DD))
9858 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
9859 ELSE
9860 PSI4 = TINY
9861 ENDIF
9862 !C
9863 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4
9864 RIZ = SQRT(A9/A1)
9865 AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) &
9866 /(1.D0+RIZ)
9867 BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* &
9868 (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ)
9869 CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) &
9870 -A1/4.D0)/(1.D0+RIZ)
9871 !C AA = PSI7+PSI8+PSI9+PSI10
9872 !C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2.
9873 !C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0
9874 !C
9875 CALL POLY32p1 (AA,BB,CC,PSI1,ISLV)
9876 IF (ISLV.EQ.0) THEN
9877 PSI1 = MIN (PSI1,CHI1)
9878 ELSE
9879 PSI1 = ZERO
9880 ENDIF
9881 ENDIF
9882 !C
9883 IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN
9884 PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
9885 PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
9886 ELSE
9887 PSI9 = ZERO
9888 ENDIF
9889 !C
9890 !C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
9891 !C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
9892 !C IF (ISLV.EQ.0) THEN
9893 !C PSI9 = MIN (PSI9,CHI9)
9894 !C ELSE
9895 !C PSI9 = ZERO
9896 !C ENDIF
9897 !C ENDIF
9898 !C
9899 !C *** CALCULATE SPECIATION ********************************************
9900 !C
9901 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
9902 MOLAL (3) = PSI4 ! NH4I
9903 MOLAL (4) = PSI6 + PSI7 ! CLI
9904 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
9905 MOLAL (6) = ZERO ! HSO4I
9906 MOLAL (7) = PSI5 + PSI8 ! NO3I
9907 MOLAL (8) = PSI11 ! CAI
9908 MOLAL (9) = 2.D0*PSI9 ! KI
9909 MOLAL (10)= PSI10 ! MGI
9910 !C
9911 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
9912 - MOLAL(9) - 2.D0*MOLAL(10)
9913 CALL CALCPH2p1 (SMIN, HI, OHI)
9914 MOLAL (1) = HI
9915 !C
9916 GNH3 = MAX(CHI4 - PSI4, TINY)
9917 GHNO3 = MAX(CHI5 - PSI5, TINY)
9918 GHCL = MAX(CHI6 - PSI6, TINY)
9919 !C
9920 CNH42S4 = ZERO
9921 CNH4NO3 = ZERO
9922 CNACL = ZERO
9923 CNANO3 = ZERO
9924 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
9925 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
9926 CMGSO4 = ZERO
9927 CCASO4 = CHI11
9928 !C
9929 CALL CALCMR2p1 ! Water content
9930 !C
9931 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
9932 !C
9933 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
9934 CALL CALCACT2p1
9935 ELSE
9936 GOTO 20
9937 ENDIF
9938 10 CONTINUE
9939 !C
9940 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
9941 !C
9942 !C20 FUNCM5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
9943 20 FUNCM52p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
9944 !C
9945 RETURN
9946 !C
9947 !C *** END OF FUNCTION FUNCM5 *******************************************
9948 !C
9949 END
9951 !C=======================================================================
9952 !C
9953 !C *** ISORROPIA CODE II
9954 !C *** SUBROUTINE CALCM4
9955 !C *** CASE M4
9956 !C
9957 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
9958 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
9959 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
9960 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL
9961 !C 4. Completely dissolved: NH4NO3, NANO3, NACL
9962 !C
9963 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
9964 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
9965 !C
9966 !C=======================================================================
9967 !C
9968 SUBROUTINE CALCM42p1
9969 INCLUDE 'module_isrpia_inc.F'
9970 !C
9971 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
9972 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
9973 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
9974 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
9975 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
9976 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
9977 !C
9978 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
9979 !C
9980 IF (W(4).LE.TINY .AND. W(5).LE.TINY) THEN
9981 SCASE = 'M4 ; SUBCASE 1'
9982 CALL CALCM1A2p1
9983 SCASE = 'M4 ; SUBCASE 1'
9984 RETURN
9985 ENDIF
9986 !C
9987 !C *** SETUP PARAMETERS ************************************************
9988 !C
9989 CALAOU = .TRUE.
9990 CHI11 = MIN (W(6), W(2)) ! CCASO4
9991 SO4FR = MAX(W(2)-CHI11, ZERO)
9992 CAFR = MAX(W(6)-CHI11, ZERO)
9993 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
9994 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
9995 SO4FR = MAX(SO4FR-CHI9, ZERO)
9996 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
9997 FRMG = MAX(W(8)-CHI10, ZERO)
9998 SO4FR = MAX(SO4FR-CHI10, ZERO)
9999 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
10000 CHI2 = ZERO ! CNH42S4
10001 CHI3 = ZERO ! CNH4CL
10002 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
10003 CHI8 = MIN (FRNA, W(4)) ! CNANO3
10004 CHI4 = W(3) ! NH3(g)
10005 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
10006 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
10007 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
10008 !C
10009 PSI6LO = TINY
10010 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
10011 !C
10012 !C *** INITIAL VALUES FOR BISECTION ************************************
10013 !C
10014 X1 = PSI6LO
10015 Y1 = FUNCM42p1 (X1)
10016 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
10017 !C
10018 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10019 !C
10020 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
10021 DO 10 I=1,NDIV
10022 X2 = X1+DX
10023 Y2 = FUNCM42p1 (X2)
10024 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
10025 X1 = X2
10026 Y1 = Y2
10027 10 CONTINUE
10028 !C
10029 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
10030 !C
10031 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM42p1 (PSI6LO)
10032 GOTO 50
10033 !C
10034 !C *** PERFORM BISECTION ***********************************************
10035 !C
10036 20 DO 30 I=1,MAXIT
10037 X3 = 0.5*(X1+X2)
10038 Y3 = FUNCM42p1 (X3)
10039 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
10040 Y2 = Y3
10041 X2 = X3
10042 ELSE
10043 Y1 = Y3
10044 X1 = X3
10045 ENDIF
10046 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
10047 30 CONTINUE
10048 CALL PUSHERR2p1 (0002, 'CALCM4') ! WARNING ERROR: NO CONVERGENCE
10049 !C
10050 !C *** CONVERGED ; RETURN **********************************************
10051 !C
10052 40 X3 = 0.5*(X1+X2)
10053 Y3 = FUNCM42p1 (X3)
10054 !C
10055 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10056 !C
10057 50 CONTINUE
10058 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
10059 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10060 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
10061 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
10062 MOLAL(6) = DELTA ! HSO4 EFFECT
10063 ENDIF
10064 !C
10065 RETURN
10066 !C
10067 !C *** END OF SUBROUTINE CALCM4 ******************************************
10068 !C
10069 END
10070 !C
10071 !C=======================================================================
10072 !C
10073 !C *** ISORROPIA CODE II
10074 !C *** SUBROUTINE FUNCM4
10075 !C *** CASE M4
10076 !C
10077 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10078 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10079 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
10080 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL
10081 !C 4. Completely dissolved: NH4NO3, NANO3, NACL
10082 !C
10083 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
10084 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10085 !C
10086 !C=======================================================================
10087 !C
10088 DOUBLE PRECISION FUNCTION FUNCM42p1 (X)
10089 INCLUDE 'module_isrpia_inc.F'
10090 !C
10091 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
10092 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
10093 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
10094 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
10095 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
10096 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
10097 !C
10098 !C *** SETUP PARAMETERS ************************************************
10099 !C
10100 PSI6 = X
10101 PSI1 = CHI1
10102 PSI2 = ZERO
10103 PSI3 = ZERO
10104 PSI7 = CHI7
10105 PSI8 = CHI8
10106 PSI9 = ZERO
10107 PSI10 = CHI10
10108 PSI11 = ZERO
10109 FRST = .TRUE.
10110 CALAIN = .TRUE.
10111 !C
10112 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10113 !C
10114 DO 10 I=1,NSWEEP
10115 !C
10116 A1 = XK5 *(WATER/GAMA(2))**3.0
10117 A3 = XK6 /(R*TEMP*R*TEMP)
10118 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10119 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
10120 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
10121 A9 = XK17 *(WATER/GAMA(17))**3.0
10122 !C A7 = XK8 *(WATER/GAMA(1))**2.0
10123 !C A8 = XK9 *(WATER/GAMA(3))**2.0
10124 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
10125 !C
10126 !C CALCULATE DISSOCIATION QUANTITIES
10127 !C
10128 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
10129 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
10130 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
10131 !C
10132 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
10133 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
10134 CC = CHI4*(PSI5+PSI6)
10135 DD = MAX(BB*BB-4.d0*CC,ZERO)
10136 PSI4 =0.5d0*(-BB - SQRT(DD))
10137 PSI4 = MIN(MAX(PSI4,TINY),CHI4)
10138 ELSE
10139 PSI4 = TINY
10140 ENDIF
10141 !C
10142 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4
10143 RIZ = SQRT(A9/A1)
10144 AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) &
10145 /(1.D0+RIZ)
10146 BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* &
10147 (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ)
10148 CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) &
10149 -A1/4.D0)/(1.D0+RIZ)
10150 !C AA = PSI7+PSI8+PSI9+PSI10
10151 !C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2.
10152 !C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0
10153 !C
10154 CALL POLY32p1 (AA,BB,CC,PSI1,ISLV)
10155 IF (ISLV.EQ.0) THEN
10156 PSI1 = MIN (PSI1,CHI1)
10157 ELSE
10158 PSI1 = ZERO
10159 ENDIF
10160 ENDIF
10161 !C
10162 IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN
10163 PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
10164 PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
10165 ELSE
10166 PSI9 = ZERO
10167 ENDIF
10168 !C
10169 !C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
10170 !C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
10171 !C IF (ISLV.EQ.0) THEN
10172 !C PSI9 = MIN (PSI9,CHI9)
10173 !C ELSE
10174 !C PSI9 = ZERO
10175 !C ENDIF
10176 !C ENDIF
10177 !C
10178 !C *** CALCULATE SPECIATION ********************************************
10179 !C
10180 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
10181 MOLAL (3) = PSI4 ! NH4I
10182 MOLAL (4) = PSI6 + PSI7 ! CLI
10183 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
10184 MOLAL (6) = ZERO ! HSO4I
10185 MOLAL (7) = PSI5 + PSI8 ! NO3I
10186 MOLAL (8) = PSI11 ! CAI
10187 MOLAL (9) = 2.D0*PSI9 ! KI
10188 MOLAL (10)= PSI10 ! MGI
10189 !C
10190 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
10191 - MOLAL(9) - 2.D0*MOLAL(10)
10192 CALL CALCPH2p1 (SMIN, HI, OHI)
10193 MOLAL (1) = HI
10194 !C
10195 GNH3 = MAX(CHI4 - PSI4, TINY)
10196 GHNO3 = MAX(CHI5 - PSI5, TINY)
10197 GHCL = MAX(CHI6 - PSI6, TINY)
10198 !C
10199 CNH42S4 = ZERO
10200 CNH4NO3 = ZERO
10201 CNACL = ZERO
10202 CNANO3 = ZERO
10203 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
10204 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
10205 CMGSO4 = ZERO
10206 CCASO4 = CHI11
10207 !C
10208 !C *** NH4Cl(s) calculations
10209 !C
10210 A3 = XK6 /(R*TEMP*R*TEMP)
10211 IF (GNH3*GHCL.GT.A3) THEN
10212 DELT = MIN(GNH3, GHCL)
10213 BB = -(GNH3+GHCL)
10214 CC = GNH3*GHCL-A3
10215 DD = BB*BB - 4.D0*CC
10216 PSI31 = 0.5D0*(-BB + SQRT(DD))
10217 PSI32 = 0.5D0*(-BB - SQRT(DD))
10218 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
10219 PSI3 = PSI31
10220 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
10221 PSI3 = PSI32
10222 ELSE
10223 PSI3 = ZERO
10224 ENDIF
10225 ELSE
10226 PSI3 = ZERO
10227 ENDIF
10228 PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO)
10229 !C
10230 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
10231 !C
10232 GNH3 = MAX(GNH3 - PSI3, TINY)
10233 GHCL = MAX(GHCL - PSI3, TINY)
10234 CNH4CL = PSI3
10235 !C
10236 CALL CALCMR2p1 ! Water content
10237 !C
10238 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10239 !C
10240 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10241 CALL CALCACT2p1
10242 ELSE
10243 GOTO 20
10244 ENDIF
10245 10 CONTINUE
10246 !C
10247 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
10248 !C
10249 !C20 FUNCM4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
10250 20 FUNCM42p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
10251 !C
10252 RETURN
10253 !C
10254 !C *** END OF FUNCTION FUNCM4 *******************************************
10255 !C
10256 END
10257 !C
10258 !C=======================================================================
10259 !C
10260 !C *** ISORROPIA CODE II
10261 !C *** SUBROUTINE CALCM3
10262 !C *** CASE M3
10263 !C
10264 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10265 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10266 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
10267 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL
10268 !C 4. Completely dissolved: NH4NO3, NANO3
10269 !C
10270 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
10271 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10272 !C
10273 !C=======================================================================
10274 !C
10275 SUBROUTINE CALCM32p1
10276 INCLUDE 'module_isrpia_inc.F'
10277 !C
10278 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
10279 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
10280 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
10281 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
10282 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
10283 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
10284 !C
10285 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
10286 !C
10287 IF (W(4).LE.TINY) THEN ! NO3 NOT EXIST, WATER NOT POSSIBLE
10288 SCASE = 'M3 ; SUBCASE 1'
10289 CALL CALCM1A2p1
10290 SCASE = 'M3 ; SUBCASE 1'
10291 RETURN
10292 ENDIF
10293 !C
10294 !C *** SETUP PARAMETERS ************************************************
10295 !C
10296 CALAOU = .TRUE.
10297 CHI11 = MIN (W(6), W(2)) ! CCASO4
10298 SO4FR = MAX(W(2)-CHI11, ZERO)
10299 CAFR = MAX(W(6)-CHI11, ZERO)
10300 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
10301 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
10302 SO4FR = MAX(SO4FR-CHI9, ZERO)
10303 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
10304 FRMG = MAX(W(8)-CHI10, ZERO)
10305 SO4FR = MAX(SO4FR-CHI10, ZERO)
10306 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
10307 CHI2 = ZERO ! CNH42S4
10308 CHI3 = ZERO ! CNH4CL
10309 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
10310 CHI8 = MIN (FRNA, W(4)) ! CNANO3
10311 CHI4 = W(3) ! NH3(g)
10312 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
10313 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
10314 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
10315 !C
10316 PSI6LO = TINY
10317 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
10318 !C
10319 !C *** INITIAL VALUES FOR BISECTION ************************************
10320 !C
10321 X1 = PSI6LO
10322 Y1 = FUNCM32p1 (X1)
10323 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
10324 !C
10325 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10326 !C
10327 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
10328 DO 10 I=1,NDIV
10329 X2 = X1+DX
10330 Y2 = FUNCM32p1 (X2)
10331 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
10332 X1 = X2
10333 Y1 = Y2
10334 10 CONTINUE
10335 !C
10336 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
10337 !C
10338 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM32p1 (PSI6LO)
10339 GOTO 50
10340 !C
10341 !C *** PERFORM BISECTION ***********************************************
10342 !C
10343 20 DO 30 I=1,MAXIT
10344 X3 = 0.5*(X1+X2)
10345 Y3 = FUNCM32p1 (X3)
10346 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
10347 Y2 = Y3
10348 X2 = X3
10349 ELSE
10350 Y1 = Y3
10351 X1 = X3
10352 ENDIF
10353 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
10354 30 CONTINUE
10355 CALL PUSHERR2p1 (0002, 'CALCM3') ! WARNING ERROR: NO CONVERGENCE
10356 !C
10357 !C *** CONVERGED ; RETURN **********************************************
10358 !C
10359 40 X3 = 0.5*(X1+X2)
10360 Y3 = FUNCM32p1 (X3)
10361 !C
10362 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10363 !C
10364 50 CONTINUE
10365 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
10366 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10367 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
10368 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
10369 MOLAL(6) = DELTA ! HSO4 EFFECT
10370 ENDIF
10371 !C
10372 RETURN
10373 !C
10374 !C *** END OF SUBROUTINE CALCM3 ******************************************
10375 !C
10376 END
10377 !C
10378 !C=======================================================================
10379 !C
10380 !C *** ISORROPIA CODE II
10381 !C *** SUBROUTINE FUNCM3
10382 !C *** CASE M3
10383 !C
10384 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10385 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10386 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
10387 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL
10388 !C 4. Completely dissolved: NH4NO3, NANO3
10389 !C
10390 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
10391 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10392 !C
10393 !C=======================================================================
10394 !C
10395 DOUBLE PRECISION FUNCTION FUNCM32p1 (X)
10396 INCLUDE 'module_isrpia_inc.F'
10397 !C
10398 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
10399 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
10400 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
10401 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
10402 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
10403 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
10404 !C
10405 !C *** SETUP PARAMETERS ************************************************
10406 !C
10407 PSI6 = X
10408 PSI1 = CHI1
10409 PSI2 = ZERO
10410 PSI3 = ZERO
10411 PSI7 = CHI7
10412 PSI8 = CHI8
10413 PSI9 = ZERO
10414 PSI10 = CHI10
10415 PSI11 = ZERO
10416 FRST = .TRUE.
10417 CALAIN = .TRUE.
10418 !C
10419 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10420 !C
10421 DO 10 I=1,NSWEEP
10422 !C
10423 A1 = XK5 *(WATER/GAMA(2))**3.0
10424 A3 = XK6 /(R*TEMP*R*TEMP)
10425 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10426 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
10427 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
10428 A7 = XK8 *(WATER/GAMA(1))**2.0
10429 A9 = XK17 *(WATER/GAMA(17))**3.0
10430 A10 = XK23 *(WATER/GAMA(21))**2.0
10431 !C A8 = XK9 *(WATER/GAMA(3))**2.0
10432 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
10433 !C
10434 !C CALCULATE DISSOCIATION QUANTITIES
10435 !C
10436 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
10437 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
10438 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
10439 !C
10440 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
10441 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
10442 CC = CHI4*(PSI5+PSI6)
10443 DD = MAX(BB*BB-4.d0*CC,ZERO)
10444 PSI4 =0.5d0*(-BB - SQRT(DD))
10445 PSI4 = MIN(MAX(PSI4,TINY),CHI4)
10446 ELSE
10447 PSI4 = TINY
10448 ENDIF
10449 !C
10450 !C IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
10451 !C VITA = 2.D0*PSI1+PSI8+PSI6 ! AN DE DOULEPSEI KALA VGALE PSI1 APO DW
10452 !C GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7
10453 !C DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO)
10454 !C PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
10455 !C PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
10456 !C ENDIF
10457 !C
10458 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
10459 DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
10460 PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
10461 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
10462 ENDIF
10463 !CC
10464 !C
10465 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4
10466 RIZ = SQRT(A9/A1)
10467 AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) &
10468 /(1.D0+RIZ)
10469 BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* &
10470 (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ)
10471 CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) &
10472 -A1/4.D0)/(1.D0+RIZ)
10473 !C AA = PSI7+PSI8+PSI9+PSI10
10474 !C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2.
10475 !C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0
10476 !C
10477 CALL POLY32p1 (AA,BB,CC,PSI1,ISLV)
10478 IF (ISLV.EQ.0) THEN
10479 PSI1 = MIN (PSI1,CHI1)
10480 ELSE
10481 PSI1 = ZERO
10482 ENDIF
10483 ENDIF
10484 !C
10485 IF (CHI9.GE.TINY) THEN
10486 PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
10487 PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
10488 ELSE
10489 PSI9 = ZERO
10490 ENDIF
10491 !C
10492 !C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
10493 !C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
10494 !C IF (ISLV.EQ.0) THEN
10495 !C PSI9 = MIN (PSI9,CHI9)
10496 !C ELSE
10497 !C PSI9 = ZERO
10498 !C ENDIF
10499 !C ENDIF
10500 !C
10501 !C *** CALCULATE SPECIATION ********************************************
10502 !C
10503 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
10504 MOLAL (3) = PSI4 ! NH4I
10505 MOLAL (4) = PSI6 + PSI7 ! CLI
10506 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
10507 MOLAL (6) = ZERO ! HSO4I
10508 MOLAL (7) = PSI5 + PSI8 ! NO3I
10509 MOLAL (8) = PSI11 ! CAI
10510 MOLAL (9) = 2.D0*PSI9 ! KI
10511 MOLAL (10)= PSI10 ! MGI
10512 !C
10513 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
10514 - MOLAL(9) - 2.D0*MOLAL(10)
10515 CALL CALCPH2p1 (SMIN, HI, OHI)
10516 MOLAL (1) = HI
10517 !C
10518 GNH3 = MAX(CHI4 - PSI4, TINY)
10519 GHNO3 = MAX(CHI5 - PSI5, TINY)
10520 GHCL = MAX(CHI6 - PSI6, TINY)
10521 !C
10522 CNH42S4 = ZERO
10523 CNH4NO3 = ZERO
10524 CNACL = MAX(CHI7 - PSI7, ZERO)
10525 CNANO3 = ZERO
10526 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
10527 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
10528 CMGSO4 = ZERO
10529 CCASO4 = CHI11
10530 !C
10531 !C *** NH4Cl(s) calculations
10532 !C
10533 A3 = XK6 /(R*TEMP*R*TEMP)
10534 IF (GNH3*GHCL.GT.A3) THEN
10535 DELT = MIN(GNH3, GHCL)
10536 BB = -(GNH3+GHCL)
10537 CC = GNH3*GHCL-A3
10538 DD = BB*BB - 4.D0*CC
10539 PSI31 = 0.5D0*(-BB + SQRT(DD))
10540 PSI32 = 0.5D0*(-BB - SQRT(DD))
10541 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
10542 PSI3 = PSI31
10543 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
10544 PSI3 = PSI32
10545 ELSE
10546 PSI3 = ZERO
10547 ENDIF
10548 ELSE
10549 PSI3 = ZERO
10550 ENDIF
10551 PSI3 = MAX (MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO)
10552 !C
10553 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
10554 !C
10555 GNH3 = MAX(GNH3 - PSI3, TINY)
10556 GHCL = MAX(GHCL - PSI3, TINY)
10557 CNH4CL = PSI3
10558 !C
10559 CALL CALCMR2p1 ! Water content
10560 !C
10561 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10562 !C
10563 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10564 CALL CALCACT2p1
10565 ELSE
10566 GOTO 20
10567 ENDIF
10568 10 CONTINUE
10569 !C
10570 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
10571 !C
10572 !C20 FUNCM3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
10573 20 FUNCM32p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
10574 !!C
10575 RETURN
10576 !!C
10577 !!C *** END OF FUNCTION FUNCM3 *******************************************
10578 !!C
10579 END
10582 !C=======================================================================
10583 !C
10584 !C *** ISORROPIA CODE II
10585 !C *** SUBROUTINE CALCM2
10586 !C *** CASE M2
10587 !C
10588 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10589 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10590 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
10591 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3
10592 !C
10593 !C THERE ARE THREE REGIMES IN THIS CASE:
10594 !C 1. NH4NO3(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCH2A)
10595 !C 2. NH4NO3(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
10596 !C 3. NH4NO3(s) NOT POSSIBLE, AND RH >= MDRH. (MDRH REGION)
10597 !C
10598 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES M1A, M2B
10599 !C RESPECTIVELY (BECAUSE MDRH POINTS COINCIDE).
10600 !C
10601 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10602 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
10603 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10604 !C
10605 !C=======================================================================
10606 !C
10607 SUBROUTINE CALCM22p1
10608 INCLUDE 'module_isrpia_inc.F'
10609 EXTERNAL CALCM1A2p1, CALCM32p1
10610 !C
10611 !C *** REGIME DEPENDS ON THE EXISTANCE OF NITRATES ***********************
10612 !C
10613 CALL CALCM1A2p1
10614 !C
10615 IF (CNH4NO3.GT.TINY) THEN ! NO3 EXISTS, WATER POSSIBLE
10616 SCASE = 'M2 ; SUBCASE 1'
10617 CALL CALCM2A2p1
10618 SCASE = 'M2 ; SUBCASE 1'
10619 ELSE ! NO3 NON EXISTANT, WATER NOT POSSIBLE
10620 SCASE = 'M2 ; SUBCASE 1'
10621 CALL CALCM1A2p1
10622 SCASE = 'M2 ; SUBCASE 1'
10623 ENDIF
10624 !C
10625 IF (WATER.LE.TINY .AND. RH.LT.DRMM2) THEN ! DRY AEROSOL
10626 SCASE = 'M2 ; SUBCASE 2'
10627 !C
10628 ELSEIF (WATER.LE.TINY .AND. RH.GE.DRMM2) THEN ! MDRH OF M2
10629 SCASE = 'M2 ; SUBCASE 3'
10630 CALL CALCMDRH22p1 (RH, DRMM2, DRNANO3, CALCM1A2p1, CALCM32p1)
10631 SCASE = 'M2 ; SUBCASE 3'
10632 ENDIF
10633 !C
10634 RETURN
10635 !C
10636 !C *** END OF SUBROUTINE CALCM2 ******************************************
10637 !C
10638 END
10639 !C
10640 !C=======================================================================
10641 !C
10642 !C *** ISORROPIA CODE II
10643 !C *** SUBROUTINE CALCM2A
10644 !C *** CASE M2A
10645 !C
10646 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10647 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10648 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
10649 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3
10650 !C 4. Completely dissolved: NH4NO3
10651 !C
10652 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
10653 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10654 !C
10655 !C=======================================================================
10656 !C
10657 SUBROUTINE CALCM2A2p1
10658 INCLUDE 'module_isrpia_inc.F'
10659 !C
10660 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
10661 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
10662 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
10663 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
10664 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
10665 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
10666 !C
10667 !C *** SETUP PARAMETERS ************************************************
10668 !C
10669 CALAOU = .TRUE.
10670 CHI11 = MIN (W(6), W(2)) ! CCASO4
10671 SO4FR = MAX(W(2)-CHI11, ZERO)
10672 CAFR = MAX(W(6)-CHI11, ZERO)
10673 CHI9 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
10674 FRK = MAX(W(7)-2.D0*CHI9, ZERO)
10675 SO4FR = MAX(SO4FR-CHI9, ZERO)
10676 CHI10 = MIN (W(8), SO4FR) ! CMGSO4
10677 FRMG = MAX(W(8)-CHI10, ZERO)
10678 SO4FR = MAX(SO4FR-CHI10, ZERO)
10679 CHI1 = MAX (SO4FR,ZERO) ! CNA2SO4
10680 CHI2 = ZERO ! CNH42S4
10681 CHI3 = ZERO ! CNH4CL
10682 FRNA = MAX (W(1)-2.D0*CHI1, ZERO)
10683 CHI8 = MIN (FRNA, W(4)) ! CNANO3
10684 CHI4 = W(3) ! NH3(g)
10685 CHI5 = MAX (W(4)-CHI8, ZERO) ! HNO3(g)
10686 CHI7 = MIN (MAX(FRNA-CHI8, ZERO), W(5)) ! CNACL
10687 CHI6 = MAX (W(5)-CHI7, ZERO) ! HCL(g)
10688 !C
10689 PSI6LO = TINY
10690 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
10691 !C
10692 !C *** INITIAL VALUES FOR BISECTION ************************************
10693 !C
10694 X1 = PSI6LO
10695 Y1 = FUNCM2A2p1 (X1)
10696 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
10697 !C
10698 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
10699 !C
10700 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
10701 DO 10 I=1,NDIV
10702 X2 = X1+DX
10703 Y2 = FUNCM2A2p1 (X2)
10704 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
10705 X1 = X2
10706 Y1 = Y2
10707 10 CONTINUE
10708 !C
10709 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
10710 !C
10711 IF (ABS(Y2) .GT. EPS) Y2 = FUNCM2A2p1 (PSI6LO)
10712 GOTO 50
10713 !C
10714 !C *** PERFORM BISECTION ***********************************************
10715 !C
10716 20 DO 30 I=1,MAXIT
10717 X3 = 0.5*(X1+X2)
10718 Y3 = FUNCM2A2p1 (X3)
10719 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
10720 Y2 = Y3
10721 X2 = X3
10722 ELSE
10723 Y1 = Y3
10724 X1 = X3
10725 ENDIF
10726 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
10727 30 CONTINUE
10728 CALL PUSHERR2p1 (0002, 'CALCM2A') ! WARNING ERROR: NO CONVERGENCE
10729 !C
10730 !C *** CONVERGED ; RETURN **********************************************
10731 !C
10732 40 X3 = 0.5*(X1+X2)
10733 Y3 = FUNCM2A2p1 (X3)
10734 !C
10735 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
10736 !C
10737 50 CONTINUE
10738 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
10739 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
10740 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
10741 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
10742 MOLAL(6) = DELTA ! HSO4 EFFECT
10743 ENDIF
10744 !C
10745 RETURN
10746 !C
10747 !C *** END OF SUBROUTINE CALCM2A ******************************************
10748 !C
10749 END
10750 !C
10751 !C=======================================================================
10752 !C
10753 !C *** ISORROPIA CODE II
10754 !C *** SUBROUTINE FUNCM2A
10755 !C *** CASE M2A
10756 !C
10757 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10758 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10759 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
10760 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3
10761 !C 4. Completely dissolved: NH4NO3
10762 !C
10763 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
10764 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10765 !C
10766 !C=======================================================================
10767 !C
10768 DOUBLE PRECISION FUNCTION FUNCM2A2p1 (X)
10769 INCLUDE 'module_isrpia_inc.F'
10770 !C
10771 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
10772 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
10773 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
10774 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
10775 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
10776 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
10777 !C
10778 !C *** SETUP PARAMETERS ************************************************
10779 !C
10780 PSI6 = X
10781 PSI1 = CHI1
10782 PSI2 = ZERO
10783 PSI3 = ZERO
10784 PSI7 = CHI7
10785 PSI8 = CHI8
10786 PSI9 = ZERO
10787 PSI10 = CHI10
10788 PSI11 = ZERO
10789 FRST = .TRUE.
10790 CALAIN = .TRUE.
10791 !C
10792 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
10793 !C
10794 DO 10 I=1,NSWEEP
10795 !C
10796 A1 = XK5 *(WATER/GAMA(2))**3.0
10797 A3 = XK6 /(R*TEMP*R*TEMP)
10798 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
10799 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
10800 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
10801 A7 = XK8 *(WATER/GAMA(1))**2.0
10802 A8 = XK9 *(WATER/GAMA(3))**2.0
10803 A9 = XK17 *(WATER/GAMA(17))**3.0
10804 A64 = (XK3*XK2/XKW)*(GAMA(10)/GAMA(5)/GAMA(11))**2.0
10805 A64 = A64*(R*TEMP*WATER)**2.0
10806 !C A11 = XK1*WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
10807 !C
10808 !C CALCULATE DISSOCIATION QUANTITIES
10809 !C
10810 PSI5 = CHI5*(PSI6+PSI7) - A6/A5*PSI8*(CHI6-PSI6-PSI3)
10811 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7)
10812 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
10813 !C
10814 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
10815 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
10816 CC = CHI4*(PSI5+PSI6)
10817 DD = MAX(BB*BB-4.d0*CC,ZERO)
10818 PSI4 =0.5d0*(-BB - SQRT(DD))
10819 PSI4 = MIN(MAX(PSI4,TINY),CHI4)
10820 ELSE
10821 PSI4 = TINY
10822 ENDIF
10823 !C
10824 !C IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
10825 !C VITA = 2.D0*PSI1+PSI8+PSI6
10826 !C GKAMA= PSI6*(2.D0*PSI1+PSI8)-A7
10827 !C DIAK = MAX(VITA**2.0 - 4.0D0*GKAMA,ZERO)
10828 !C PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
10829 !C PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
10830 !C ENDIF
10831 !CC
10832 !C IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
10833 !C BIT = 2.D0*PSI1+PSI7+PSI5
10834 !C GKAM = PSI5*(2.D0*PSI1+PSI8)-A8
10835 !C DIA = BIT**2.0 - 4.0D0*GKAM
10836 !C PSI8 = 0.5D0*( -BIT + SQRT(DIA) )
10837 !C PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
10838 !C ENDIF
10839 !CC
10840 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
10841 DIAK = (PSI8-PSI6)**2.D0 + 4.D0*A7
10842 PSI7 = 0.5D0*( -(PSI8+PSI6) + SQRT(DIAK) )
10843 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
10844 ENDIF
10845 !C
10846 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
10847 DIAK = (PSI7-PSI5)**2.D0 + 4.D0*A8
10848 PSI8 = 0.5D0*( -(PSI7+PSI5) + SQRT(DIAK) )
10849 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
10850 ENDIF
10851 !C
10852 IF (CHI1.GT.TINY .AND. WATER.GT.TINY) THEN !NA2SO4
10853 RIZ = SQRT(A9/A1)
10854 AA = (0.5D0*RIZ*(PSI7+PSI8)+PSI10+(1.D0+RIZ)*(PSI7+PSI8)) &
10855 /(1.D0+RIZ)
10856 BB = ((PSI7+PSI8)*(0.5D0*RIZ*(PSI7+PSI8)+PSI10)+0.25D0* &
10857 (PSI7+PSI8)**2.0*(1.D0+RIZ))/(1.D0+RIZ)
10858 CC = (0.25D0*(PSI7+PSI8)**2.0*(0.5D0*RIZ*(PSI7+PSI8)+PSI10) &
10859 -A1/4.D0)/(1.D0+RIZ)
10860 !C
10861 !C AA = PSI7+PSI8+PSI9+PSI10
10862 !C BB = (PSI7+PSI8)*(PSI9+PSI10)+0.25D0*(PSI7+PSI8)**2.
10863 !C CC = ((PSI7+PSI8)**2.*(PSI9+PSI10)-A1)/4.0D0
10864 !CC
10865 CALL POLY32p1 (AA,BB,CC,PSI1,ISLV)
10866 IF (ISLV.EQ.0) THEN
10867 PSI1 = MIN (PSI1,CHI1)
10868 ELSE
10869 PSI1 = ZERO
10870 ENDIF
10871 ENDIF
10872 !C
10873 IF (CHI9.GE.TINY .AND. WATER.GT.TINY) THEN
10874 !C PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
10875 PSI9 = 0.5D0*SQRT(A9/A1)*(2.0D0*PSI1+PSI7+PSI8)
10876 PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
10877 ELSE
10878 PSI9 = ZERO
10879 ENDIF
10880 !C
10881 !C IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
10882 !C CALL POLY3 (PSI1+PSI10,ZERO,-A9/4.D0, PSI9, ISLV)
10883 !C IF (ISLV.EQ.0) THEN
10884 !C PSI9 = MAX (MIN (PSI9,CHI9), ZERO)
10885 !C ELSE
10886 !C PSI9 = ZERO
10887 !C ENDIF
10888 !C ENDIF
10889 !C
10890 !C *** CALCULATE SPECIATION ********************************************
10891 !C
10892 MOLAL (2) = PSI8 + PSI7 + 2.D0*PSI1 ! NAI
10893 MOLAL (3) = PSI4 ! NH4I
10894 MOLAL (4) = PSI6 + PSI7 ! CLI
10895 MOLAL (5) = PSI2 + PSI1 + PSI9 + PSI10 ! SO4I
10896 MOLAL (6) = ZERO ! HSO4I
10897 MOLAL (7) = PSI5 + PSI8 ! NO3I
10898 MOLAL (8) = PSI11 ! CAI
10899 MOLAL (9) = 2.D0*PSI9 ! KI
10900 MOLAL (10)= PSI10 ! MGI
10901 !C
10902 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
10903 - MOLAL(9) - 2.D0*MOLAL(10)
10904 CALL CALCPH2p1 (SMIN, HI, OHI)
10905 MOLAL (1) = HI
10906 !C
10907 GNH3 = MAX(CHI4 - PSI4, TINY)
10908 GHNO3 = MAX(CHI5 - PSI5, TINY)
10909 GHCL = MAX(CHI6 - PSI6, TINY)
10910 !C
10911 CNH42S4 = ZERO
10912 CNH4NO3 = ZERO
10913 CNACL = MAX(CHI7 - PSI7, ZERO)
10914 CNANO3 = MAX(CHI8 - PSI8, ZERO)
10915 CNA2SO4 = MAX(CHI1 - PSI1, ZERO)
10916 CK2SO4 = MAX(CHI9 - PSI9, ZERO)
10917 CMGSO4 = ZERO
10918 CCASO4 = CHI11
10919 !C
10920 !C *** NH4Cl(s) calculations
10921 !C
10922 A3 = XK6 /(R*TEMP*R*TEMP)
10923 IF (GNH3*GHCL.GT.A3) THEN
10924 DELT = MIN(GNH3, GHCL)
10925 BB = -(GNH3+GHCL)
10926 CC = GNH3*GHCL-A3
10927 DD = BB*BB - 4.D0*CC
10928 PSI31 = 0.5D0*(-BB + SQRT(DD))
10929 PSI32 = 0.5D0*(-BB - SQRT(DD))
10930 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
10931 PSI3 = PSI31
10932 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
10933 PSI3 = PSI32
10934 ELSE
10935 PSI3 = ZERO
10936 ENDIF
10937 ELSE
10938 PSI3 = ZERO
10939 ENDIF
10940 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO)
10941 !C
10942 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
10943 !C
10944 GNH3 = MAX(GNH3 - PSI3, TINY)
10945 GHCL = MAX(GHCL - PSI3, TINY)
10946 CNH4CL = PSI3
10947 !C
10948 CALL CALCMR2p1 ! Water content
10949 !C
10950 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
10951 !C
10952 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
10953 CALL CALCACT2p1
10954 ELSE
10955 GOTO 20
10956 ENDIF
10957 10 CONTINUE
10958 !C
10959 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
10960 !C
10961 !C20 FUNCM2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A64 - ONE
10962 20 FUNCM2A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
10963 !!C
10964 RETURN
10965 !C
10966 !C *** END OF FUNCTION FUNCM2A *******************************************
10967 !C
10968 END
10969 !C
10970 !C=======================================================================
10971 !C
10972 !C *** ISORROPIA CODE II
10973 !C *** SUBROUTINE CALCM1
10974 !C *** CASE M1
10975 !C
10976 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
10977 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
10978 !C 2. SOLID AEROSOL ONLY
10979 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3
10980 !C
10981 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
10982 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
10983 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCH1A)
10984 !C
10985 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
10986 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
10987 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
10988 !C
10989 !C=======================================================================
10990 !C
10991 SUBROUTINE CALCM12p1
10992 INCLUDE 'module_isrpia_inc.F'
10993 EXTERNAL CALCM1A2p1, CALCM2A2p1
10994 !C
10995 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
10996 !C
10997 IF (RH.LT.DRMM1) THEN
10998 SCASE = 'M1 ; SUBCASE 1'
10999 CALL CALCM1A2p1 ! SOLID PHASE ONLY POSSIBLE
11000 SCASE = 'M1 ; SUBCASE 1'
11001 ELSE
11002 SCASE = 'M1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
11003 CALL CALCMDRH22p1 (RH, DRMM1, DRNH4NO3, CALCM1A2p1, CALCM2A2p1)
11004 SCASE = 'M1 ; SUBCASE 2'
11005 ENDIF
11006 !C
11007 RETURN
11008 !C
11009 !C *** END OF SUBROUTINE CALCM1 ******************************************
11010 !C
11011 END
11012 !C
11013 !C=======================================================================
11014 !C
11015 !C *** ISORROPIA CODE II
11016 !C *** SUBROUTINE CALCM1A
11017 !C *** CASE M1A
11018 !C
11019 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11020 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr < 2)
11021 !C 2. SOLID AEROSOL ONLY
11022 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, NA2SO4, MGSO4, NH4CL, NACL, NANO3, NH4NO3
11023 !C
11024 !C *** COPYRIGHT 1996-2000, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11025 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
11026 !C
11027 !C=======================================================================
11029 SUBROUTINE CALCM1A2p1
11030 INCLUDE 'module_isrpia_inc.F'
11031 DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, &
11032 NO3FR
11033 !C
11034 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
11035 !C
11036 CCASO4 = MIN (W(6), W(2)) ! CCASO4
11037 SO4FR = MAX(W(2) - CCASO4, ZERO)
11038 CAFR = MAX(W(6) - CCASO4, ZERO)
11039 CK2SO4 = MIN (0.5D0*W(7), SO4FR) ! CK2S04
11040 FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO)
11041 SO4FR = MAX(SO4FR - CK2SO4, ZERO)
11042 CMGSO4 = MIN (W(8), SO4FR) ! CMGSO4
11043 FRMG = MAX(W(8) - CMGSO4, ZERO)
11044 SO4FR = MAX(SO4FR - CMGSO4, ZERO)
11045 CNA2SO4 = MAX (SO4FR,ZERO) ! CNA2SO4
11046 NAFR = MAX (W(1)-2.D0*CNA2SO4, ZERO)
11047 CNANO3 = MIN (NAFR, W(4)) ! CNANO3
11048 NO3FR = MAX (W(4)-CNANO3, ZERO)
11049 CNACL = MIN (MAX(NAFR-CNANO3, ZERO), W(5)) ! CNACL
11050 CLFR = MAX (W(5)-CNACL, ZERO)
11051 !C
11052 !C *** CALCULATE VOLATILE SPECIES **************************************
11053 !C
11054 ALF = W(3) ! FREE NH3
11055 BET = CLFR ! FREE CL
11056 GAM = NO3FR ! FREE NO3
11057 !C
11058 RTSQ = R*TEMP*R*TEMP
11059 A1 = XK6/RTSQ
11060 A2 = XK10/RTSQ
11061 !C
11062 THETA1 = GAM - BET*(A2/A1)
11063 THETA2 = A2/A1
11064 !C
11065 !C QUADRATIC EQUATION SOLUTION
11066 !C
11067 BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
11068 CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
11069 DD = BB*BB - 4.0D0*CC
11070 IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately
11071 !C
11072 !C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
11073 !C
11074 SQDD = SQRT(DD)
11075 KAPA1 = 0.5D0*(-BB+SQDD)
11076 KAPA2 = 0.5D0*(-BB-SQDD)
11077 LAMDA1 = THETA1 + THETA2*KAPA1
11078 LAMDA2 = THETA1 + THETA2*KAPA2
11079 !C
11080 IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
11081 IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. &
11082 BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
11083 KAPA = KAPA1
11084 LAMDA= LAMDA1
11085 GOTO 200
11086 ENDIF
11087 ENDIF
11088 !C
11089 IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
11090 IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
11091 BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
11092 KAPA = KAPA2
11093 LAMDA= LAMDA2
11094 GOTO 200
11095 ENDIF
11096 ENDIF
11097 !C
11098 !C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
11099 !C
11100 100 KAPA = ZERO
11101 LAMDA = ZERO
11102 DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
11103 DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
11104 !C
11105 !C NH4CL EQUILIBRIUM
11106 !C
11107 IF (DD1.GE.ZERO) THEN
11108 SQDD1 = SQRT(DD1)
11109 KAPA1 = 0.5D0*(ALF+BET + SQDD1)
11110 KAPA2 = 0.5D0*(ALF+BET - SQDD1)
11111 !C
11112 IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
11113 KAPA = KAPA1
11114 ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
11115 KAPA = KAPA2
11116 ELSE
11117 KAPA = ZERO
11118 ENDIF
11119 ENDIF
11120 !C
11121 !C NH4NO3 EQUILIBRIUM
11122 !C
11123 IF (DD2.GE.ZERO) THEN
11124 SQDD2 = SQRT(DD2)
11125 LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
11126 LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
11127 !C
11128 IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
11129 LAMDA = LAMDA1
11130 ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
11131 LAMDA = LAMDA2
11132 ELSE
11133 LAMDA = ZERO
11134 ENDIF
11135 ENDIF
11136 !C
11137 !C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
11138 !C
11139 IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
11140 IF (BET .LT. LAMDA/THETA1) THEN
11141 KAPA = ZERO
11142 ELSE
11143 LAMDA= ZERO
11144 ENDIF
11145 ENDIF
11146 !C
11147 !C *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
11148 !C
11149 200 CONTINUE
11150 CNH4NO3 = LAMDA
11151 CNH4CL = KAPA
11152 !C
11153 GNH3 = ALF - KAPA - LAMDA
11154 GHNO3 = GAM - LAMDA
11155 GHCL = BET - KAPA
11156 !C
11157 RETURN
11158 !C
11159 !C *** END OF SUBROUTINE CALCM1A *****************************************
11160 !C
11161 END
11162 !C
11163 !C=======================================================================
11164 !C
11165 !C *** ISORROPIA CODE II
11166 !C *** SUBROUTINE CALCP13
11167 !C *** CASE P13
11168 !C
11169 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11170 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11171 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11172 !C 3. SOLIDS POSSIBLE : CaSO4
11173 !C 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4,
11174 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11175 !C
11176 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11177 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11178 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11179 !C
11180 !C=======================================================================
11181 !C
11182 SUBROUTINE CALCP132p1
11183 INCLUDE 'module_isrpia_inc.F'
11184 !C
11185 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11186 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11187 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11188 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11189 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11190 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11191 !C
11192 !C *** SETUP PARAMETERS ************************************************
11193 !C
11194 CALAOU = .TRUE.
11195 CHI11 = MIN (W(2), W(6)) ! CCASO4
11196 FRCA = MAX (W(6) - CHI11, ZERO)
11197 FRSO4 = MAX (W(2) - CHI11, ZERO)
11198 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
11199 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
11200 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
11201 CHI10 = FRSO4 ! CMGSO4
11202 FRMG = MAX (W(8) - CHI10, ZERO)
11203 CHI7 = MIN (W(1), W(5)) ! CNACL
11204 FRNA = MAX (W(1) - CHI7, ZERO)
11205 FRCL = MAX (W(5) - CHI7, ZERO)
11206 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
11207 FRCA = MAX (FRCA - CHI12, ZERO)
11208 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
11209 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
11210 FRCA = MAX (FRCA - CHI17, ZERO)
11211 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
11212 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
11213 FRMG = MAX (FRMG - CHI15, ZERO)
11214 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
11215 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
11216 FRMG = MAX (FRMG - CHI16, ZERO)
11217 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
11218 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
11219 FRNA = MAX (FRNA - CHI8, ZERO)
11220 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
11221 CHI14 = MIN (FRK, FRCL) ! CKCL
11222 FRK = MAX (FRK - CHI14, ZERO)
11223 FRCL = MAX (FRCL - CHI14, ZERO)
11224 CHI13 = MIN (FRK, FRNO3) ! CKNO3
11225 FRK = MAX (FRK - CHI13, ZERO)
11226 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
11227 !C
11228 CHI5 = FRNO3 ! HNO3(g)
11229 CHI6 = FRCL ! HCL(g)
11230 CHI4 = W(3) ! NH3(g)
11231 !C
11232 CHI3 = ZERO ! CNH4CL
11233 CHI1 = ZERO
11234 CHI2 = ZERO
11235 !C
11236 PSI6LO = TINY
11237 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
11238 !C
11239 !C *** INITIAL VALUES FOR BISECTION ************************************
11240 !C
11241 X1 = PSI6LO
11242 Y1 = FUNCP132p1 (X1)
11243 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
11244 !C
11245 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11246 !C
11247 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11248 DO 10 I=1,NDIV
11249 X2 = X1+DX
11250 Y2 = FUNCP132p1 (X2)
11251 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
11252 X1 = X2
11253 Y1 = Y2
11254 10 CONTINUE
11255 !C
11256 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11257 !C
11258 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP132p1 (PSI6LO)
11259 GOTO 50
11260 !C
11261 !C *** PERFORM BISECTION ***********************************************
11262 !C
11263 20 DO 30 I=1,MAXIT
11264 X3 = 0.5*(X1+X2)
11265 Y3 = FUNCP132p1 (X3)
11266 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
11267 Y2 = Y3
11268 X2 = X3
11269 ELSE
11270 Y1 = Y3
11271 X1 = X3
11272 ENDIF
11273 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11274 30 CONTINUE
11275 CALL PUSHERR2p1 (0002, 'CALCP13') ! WARNING ERROR: NO CONVERGENCE
11276 !C
11277 !C *** CONVERGED ; RETURN **********************************************
11278 !C
11279 40 X3 = 0.5*(X1+X2)
11280 Y3 = FUNCP132p1 (X3)
11281 !C
11282 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
11283 !C
11284 50 CONTINUE
11285 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11286 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11287 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
11288 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
11289 MOLAL(6) = DELTA ! HSO4 EFFECT
11290 ENDIF
11291 !C
11292 RETURN
11293 !C
11294 !C *** END OF SUBROUTINE CALCP13 ******************************************
11295 !C
11296 END
11298 !C
11299 !C=======================================================================
11300 !C
11301 !C *** ISORROPIA CODE II
11302 !C *** SUBROUTINE FUNCP13
11303 !C *** CASE P13
11304 !C
11305 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11306 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11307 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11308 !C 3. SOLIDS POSSIBLE : CaSO4
11309 !C 4. Completely dissolved: CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4,
11310 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11311 !C
11312 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11313 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11314 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11315 !C
11316 !C=======================================================================
11317 !C
11318 DOUBLE PRECISION FUNCTION FUNCP132p1 (X)
11319 INCLUDE 'module_isrpia_inc.F'
11320 !C
11321 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11322 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11323 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11324 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11325 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11326 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11327 !C
11328 !C *** SETUP PARAMETERS ************************************************
11329 !C
11330 PSI6 = X
11331 PSI1 = ZERO
11332 PSI2 = ZERO
11333 PSI3 = ZERO
11334 PSI4 = ZERO
11335 PSI7 = CHI7
11336 PSI8 = CHI8
11337 PSI9 = CHI9
11338 PSI10 = CHI10
11339 PSI11 = ZERO
11340 PSI12 = CHI12
11341 PSI13 = CHI13
11342 PSI14 = CHI14
11343 PSI15 = CHI15
11344 PSI16 = CHI16
11345 PSI17 = CHI17
11346 FRST = .TRUE.
11347 CALAIN = .TRUE.
11348 !C
11349 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11350 !C
11351 DO 10 I=1,NSWEEP
11352 !C
11353 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11354 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11355 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11356 !C
11357 !C CALCULATE DISSOCIATION QUANTITIES
11358 !C
11359 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
11360 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6)
11361 PSI5 = PSI5/(A6/A5*(CHI6-PSI6) + PSI6 + PSI7 + PSI14 + &
11362 2.D0*PSI16 + 2.D0*PSI17)
11363 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
11364 !C
11365 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
11366 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
11367 CC = CHI4*(PSI5+PSI6)
11368 DD = MAX(BB*BB-4.d0*CC,ZERO)
11369 PSI4 =0.5d0*(-BB - SQRT(DD))
11370 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
11371 ELSE
11372 PSI4 = TINY
11373 ENDIF
11374 !C
11375 !C *** CALCULATE SPECIATION *********************************************
11376 !C
11377 MOLAL (2) = PSI8 + PSI7 ! NAI
11378 MOLAL (3) = PSI4 ! NH4I
11379 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
11380 MOLAL (5) = PSI9 + PSI10 ! SO4I
11381 MOLAL (6) = ZERO ! HSO4I
11382 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
11383 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
11384 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
11385 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
11386 !C
11387 !C *** CALCULATE H+ *****************************************************
11388 !C
11389 !C REST = 2.D0*W(2) + W(4) + W(5)
11390 !CC
11391 !C DELT1 = 0.0d0
11392 !C DELT2 = 0.0d0
11393 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
11394 !CC
11395 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
11396 !CC
11397 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
11398 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
11399 !CC
11400 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
11401 !CC
11402 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
11403 !C DELT1 = 0.5*(-ALFA1 + DIAK)
11404 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
11405 !C DELT2 = ALFA2
11406 !C DELT2 = MIN ( DELT2, DELT1)
11407 !C MOLAL(1) = DELT1 + DELT2 ! H+
11408 !C ELSE
11409 !C
11410 !C *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
11411 !C
11412 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
11413 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
11414 CALL CALCPH2p1 (SMIN, HI, OHI)
11415 MOLAL (1) = HI
11416 !C ENDIF
11417 !C
11418 GNH3 = MAX(CHI4 - PSI4, TINY)
11419 GHNO3 = MAX(CHI5 - PSI5, TINY)
11420 GHCL = MAX(CHI6 - PSI6, TINY)
11421 !C
11422 CNH4NO3 = ZERO
11423 CNH4CL = ZERO
11424 CNACL = ZERO
11425 CNANO3 = ZERO
11426 CK2SO4 = ZERO
11427 CMGSO4 = ZERO
11428 CCASO4 = CHI11
11429 CCANO32 = ZERO
11430 CKNO3 = ZERO
11431 CKCL = ZERO
11432 CMGNO32 = ZERO
11433 CMGCL2 = ZERO
11434 CCACL2 = ZERO
11435 !C
11436 CALL CALCMR2p1 ! Water content
11437 !C
11438 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
11439 !C
11440 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
11441 CALL CALCACT2p1
11442 ELSE
11443 GOTO 20
11444 ENDIF
11445 10 CONTINUE
11446 !C
11447 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
11448 !C
11449 !C20 FUNCP13 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
11450 20 FUNCP132p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
11451 !C
11452 RETURN
11453 !C
11454 !C *** END OF FUNCTION FUNCP13 *******************************************
11455 !C
11456 END
11457 !C=======================================================================
11458 !C
11459 !C *** ISORROPIA CODE II
11460 !C *** SUBROUTINE CALCP12
11461 !C *** CASE P12
11462 !C
11463 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11464 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11465 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11466 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4
11467 !C 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4,
11468 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11469 !C
11470 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11471 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11472 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11473 !C
11474 !C=======================================================================
11475 !C
11476 SUBROUTINE CALCP122p1
11477 INCLUDE 'module_isrpia_inc.F'
11478 !C
11479 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11480 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11481 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11482 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11483 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11484 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11485 !C
11486 !C *** SETUP PARAMETERS ************************************************
11487 !C
11488 CALAOU = .TRUE.
11489 CHI11 = MIN (W(2), W(6)) ! CCASO4
11490 FRCA = MAX (W(6) - CHI11, ZERO)
11491 FRSO4 = MAX (W(2) - CHI11, ZERO)
11492 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
11493 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
11494 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
11495 CHI10 = FRSO4 ! CMGSO4
11496 FRMG = MAX (W(8) - CHI10, ZERO)
11497 CHI7 = MIN (W(1), W(5)) ! CNACL
11498 FRNA = MAX (W(1) - CHI7, ZERO)
11499 FRCL = MAX (W(5) - CHI7, ZERO)
11500 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
11501 FRCA = MAX (FRCA - CHI12, ZERO)
11502 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
11503 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
11504 FRCA = MAX (FRCA - CHI17, ZERO)
11505 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
11506 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
11507 FRMG = MAX (FRMG - CHI15, ZERO)
11508 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
11509 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
11510 FRMG = MAX (FRMG - CHI16, ZERO)
11511 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
11512 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
11513 FRNA = MAX (FRNA - CHI8, ZERO)
11514 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
11515 CHI14 = MIN (FRK, FRCL) ! CKCL
11516 FRK = MAX (FRK - CHI14, ZERO)
11517 FRCL = MAX (FRCL - CHI14, ZERO)
11518 CHI13 = MIN (FRK, FRNO3) ! CKNO3
11519 FRK = MAX (FRK - CHI13, ZERO)
11520 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
11521 !C
11522 CHI5 = FRNO3 ! HNO3(g)
11523 CHI6 = FRCL ! HCL(g)
11524 CHI4 = W(3) ! NH3(g)
11525 !C
11526 CHI3 = ZERO ! CNH4CL
11527 CHI1 = ZERO
11528 CHI2 = ZERO
11529 !C
11530 PSI6LO = TINY
11531 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
11532 !C
11533 !C *** INITIAL VALUES FOR BISECTION ************************************
11534 !C
11535 X1 = PSI6LO
11536 Y1 = FUNCP122p1 (X1)
11537 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
11538 !C
11539 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11540 !C
11541 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11542 DO 10 I=1,NDIV
11543 X2 = X1+DX
11544 Y2 = FUNCP122p1 (X2)
11545 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
11546 X1 = X2
11547 Y1 = Y2
11548 10 CONTINUE
11549 !C
11550 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11551 !C
11552 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP122p1 (PSI6LO)
11553 GOTO 50
11554 !C
11555 !C *** PERFORM BISECTION ***********************************************
11556 !C
11557 20 DO 30 I=1,MAXIT
11558 X3 = 0.5*(X1+X2)
11559 Y3 = FUNCP122p1 (X3)
11560 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
11561 Y2 = Y3
11562 X2 = X3
11563 ELSE
11564 Y1 = Y3
11565 X1 = X3
11566 ENDIF
11567 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11568 30 CONTINUE
11569 CALL PUSHERR2p1 (0002, 'CALCP12') ! WARNING ERROR: NO CONVERGENCE
11570 !C
11571 !C *** CONVERGED ; RETURN **********************************************
11572 !C
11573 40 X3 = 0.5*(X1+X2)
11574 Y3 = FUNCP122p1 (X3)
11575 !C
11576 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
11577 !C
11578 50 CONTINUE
11579 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11580 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11581 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
11582 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
11583 MOLAL(6) = DELTA ! HSO4 EFFECT
11584 ENDIF
11585 !C
11586 RETURN
11587 !C
11588 !C *** END OF SUBROUTINE CALCP12 ******************************************
11589 !C
11590 END
11592 !C
11593 !C=======================================================================
11594 !C
11595 !C *** ISORROPIA CODE II
11596 !C *** SUBROUTINE FUNCP12
11597 !C *** CASE P12
11598 !C
11599 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11600 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11601 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11602 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4
11603 !C 4. Completely dissolved: CA(NO3)2, CACL2, KNO3, KCL, MGSO4,
11604 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11605 !C
11606 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11607 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11608 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11609 !C
11610 !C=======================================================================
11611 !C
11612 DOUBLE PRECISION FUNCTION FUNCP122p1 (X)
11613 INCLUDE 'module_isrpia_inc.F'
11614 !C
11615 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11616 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11617 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11618 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11619 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11620 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11621 !C
11622 !C *** SETUP PARAMETERS ************************************************
11623 !C
11624 PSI6 = X
11625 PSI1 = ZERO
11626 PSI2 = ZERO
11627 PSI3 = ZERO
11628 PSI4 = ZERO
11629 PSI7 = CHI7
11630 PSI8 = CHI8
11631 PSI9 = ZERO
11632 PSI10 = CHI10
11633 PSI11 = ZERO
11634 PSI12 = CHI12
11635 PSI13 = CHI13
11636 PSI14 = CHI14
11637 PSI15 = CHI15
11638 PSI16 = CHI16
11639 PSI17 = CHI17
11640 FRST = .TRUE.
11641 CALAIN = .TRUE.
11642 !C
11643 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11644 !C
11645 DO 10 I=1,NSWEEP
11646 !C
11647 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11648 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11649 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11650 A9 = XK17 *(WATER/GAMA(17))**3.0
11651 !C
11652 !C CALCULATE DISSOCIATION QUANTITIES
11653 !C
11654 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
11655 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
11656 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
11657 2.D0*PSI16 + 2.D0*PSI17)
11658 PSI5 = MIN(MAX(PSI5, TINY),CHI5)
11659 !C
11660 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
11661 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
11662 CC = CHI4*(PSI5+PSI6)
11663 DD = MAX(BB*BB-4.d0*CC,ZERO)
11664 PSI4 =0.5d0*(-BB - SQRT(DD))
11665 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
11666 ELSE
11667 PSI4 = TINY
11668 ENDIF
11669 !C
11670 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
11671 BBP = PSI10+PSI13+PSI14
11672 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
11673 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
11674 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
11675 IF (ISLV.EQ.0) THEN
11676 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
11677 ELSE
11678 PSI9 = ZERO
11679 ENDIF
11680 ENDIF
11681 !C
11682 !C
11683 !C *** CALCULATE SPECIATION ********************************************
11684 !C
11685 MOLAL (2) = PSI8 + PSI7 ! NAI
11686 MOLAL (3) = PSI4 ! NH4I
11687 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
11688 MOLAL (5) = PSI9 + PSI10 ! SO4I
11689 MOLAL (6) = ZERO ! HSO4I
11690 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
11691 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
11692 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
11693 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
11694 !C
11695 !C *** CALCULATE H+ *****************************************************
11696 !C
11697 !C REST = 2.D0*W(2) + W(4) + W(5)
11698 !CC
11699 !C DELT1 = 0.0d0
11700 !C DELT2 = 0.0d0
11701 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
11702 !CC
11703 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
11704 !CC
11705 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
11706 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
11707 !CC
11708 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
11709 !CC
11710 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
11711 !C DELT1 = 0.5*(-ALFA1 + DIAK)
11712 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
11713 !C DELT2 = ALFA2
11714 !C DELT2 = MIN ( DELT2, DELT1)
11715 !C MOLAL(1) = DELT1 + DELT2 ! H+
11716 !C ELSE
11717 !CC
11718 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
11719 !CC
11720 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
11721 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
11722 CALL CALCPH2p1 (SMIN, HI, OHI)
11723 MOLAL (1) = HI
11724 !C ENDIF
11725 !C
11726 GNH3 = MAX(CHI4 - PSI4, TINY)
11727 GHNO3 = MAX(CHI5 - PSI5, TINY)
11728 GHCL = MAX(CHI6 - PSI6, TINY)
11729 !C
11730 CNH4NO3 = ZERO
11731 CNH4CL = ZERO
11732 CNACL = ZERO
11733 CNANO3 = ZERO
11734 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
11735 CMGSO4 = ZERO
11736 CCASO4 = CHI11
11737 CCANO32 = ZERO
11738 CKNO3 = ZERO
11739 CKCL = ZERO
11740 CMGNO32 = ZERO
11741 CMGCL2 = ZERO
11742 CCACL2 = ZERO
11743 !C
11744 CALL CALCMR2p1 ! Water content
11745 !C
11746 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
11747 !C
11748 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
11749 CALL CALCACT2p1
11750 ELSE
11751 GOTO 20
11752 ENDIF
11753 10 CONTINUE
11754 !C
11755 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
11756 !C
11757 !!C20 FUNCP12 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
11758 20 FUNCP122p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
11759 !!C
11760 RETURN
11761 !!C
11762 !!C *** END OF FUNCTION FUNCP12 *******************************************
11763 !!C
11764 END
11766 !C=======================================================================
11767 !C
11768 !C *** ISORROPIA CODE II
11769 !C *** SUBROUTINE CALCP11
11770 !C *** CASE P11
11771 !C
11772 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11773 !!C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11774 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11775 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3
11776 !C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4,
11777 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11778 !C
11779 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11780 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11781 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11782 !C
11783 !C=======================================================================
11784 !C
11785 SUBROUTINE CALCP112p1
11786 INCLUDE 'module_isrpia_inc.F'
11787 !C
11788 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11789 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11790 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11791 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11792 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11793 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11794 !C
11795 !C *** SETUP PARAMETERS ************************************************
11796 !C
11797 CALAOU = .TRUE.
11798 CHI11 = MIN (W(2), W(6)) ! CCASO4
11799 FRCA = MAX (W(6) - CHI11, ZERO)
11800 FRSO4 = MAX (W(2) - CHI11, ZERO)
11801 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
11802 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
11803 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
11804 CHI10 = FRSO4 ! CMGSO4
11805 FRMG = MAX (W(8) - CHI10, ZERO)
11806 CHI7 = MIN (W(1), W(5)) ! CNACL
11807 FRNA = MAX (W(1) - CHI7, ZERO)
11808 FRCL = MAX (W(5) - CHI7, ZERO)
11809 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
11810 FRCA = MAX (FRCA - CHI12, ZERO)
11811 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
11812 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
11813 FRCA = MAX (FRCA - CHI17, ZERO)
11814 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
11815 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
11816 FRMG = MAX (FRMG - CHI15, ZERO)
11817 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
11818 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
11819 FRMG = MAX (FRMG - CHI16, ZERO)
11820 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
11821 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
11822 FRNA = MAX (FRNA - CHI8, ZERO)
11823 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
11824 CHI14 = MIN (FRK, FRCL) ! CKCL
11825 FRK = MAX (FRK - CHI14, ZERO)
11826 FRCL = MAX (FRCL - CHI14, ZERO)
11827 CHI13 = MIN (FRK, FRNO3) ! CKNO3
11828 FRK = MAX (FRK - CHI13, ZERO)
11829 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
11830 !C
11831 CHI5 = FRNO3 ! HNO3(g)
11832 CHI6 = FRCL ! HCL(g)
11833 CHI4 = W(3) ! NH3(g)
11834 !C
11835 CHI3 = ZERO ! CNH4CL
11836 CHI1 = ZERO
11837 CHI2 = ZERO
11838 !C
11839 PSI6LO = TINY
11840 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
11841 !C
11842 !C *** INITIAL VALUES FOR BISECTION ************************************
11843 !C
11844 X1 = PSI6LO
11845 Y1 = FUNCP112p1 (X1)
11846 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
11847 !C
11848 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
11849 !C
11850 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
11851 DO 10 I=1,NDIV
11852 X2 = X1+DX
11853 Y2 = FUNCP112p1 (X2)
11854 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
11855 X1 = X2
11856 Y1 = Y2
11857 10 CONTINUE
11858 !C
11859 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
11860 !C
11861 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP112p1 (PSI6LO)
11862 GOTO 50
11863 !C
11864 !C *** PERFORM BISECTION ***********************************************
11865 !C
11866 20 DO 30 I=1,MAXIT
11867 X3 = 0.5*(X1+X2)
11868 Y3 = FUNCP112p1 (X3)
11869 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
11870 Y2 = Y3
11871 X2 = X3
11872 ELSE
11873 Y1 = Y3
11874 X1 = X3
11875 ENDIF
11876 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
11877 30 CONTINUE
11878 CALL PUSHERR2p1 (0002, 'CALCP11') ! WARNING ERROR: NO CONVERGENCE
11879 !C
11880 !C *** CONVERGED ; RETURN **********************************************
11881 !C
11882 40 X3 = 0.5*(X1+X2)
11883 Y3 = FUNCP112p1 (X3)
11884 !C
11885 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
11886 !C
11887 50 CONTINUE
11888 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
11889 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
11890 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
11891 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
11892 MOLAL(6) = DELTA ! HSO4 EFFECT
11893 ENDIF
11894 !C
11895 RETURN
11896 !C
11897 !C *** END OF SUBROUTINE CALCP11 ******************************************
11898 !C
11899 END
11901 !C
11902 !C=======================================================================
11903 !C
11904 !C *** ISORROPIA CODE II
11905 !C *** SUBROUTINE FUNCP11
11906 !C *** CASE P11
11907 !C
11908 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
11909 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
11910 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
11911 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3
11912 !C 4. Completely dissolved: CA(NO3)2, CACL2, KCL, MGSO4,
11913 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
11914 !C
11915 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
11916 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
11917 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
11918 !C
11919 !C=======================================================================
11920 !C
11921 DOUBLE PRECISION FUNCTION FUNCP112p1 (X)
11922 INCLUDE 'module_isrpia_inc.F'
11923 !C
11924 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
11925 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
11926 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
11927 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
11928 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
11929 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
11930 !C
11931 !C *** SETUP PARAMETERS ************************************************
11932 !C
11933 PSI6 = X
11934 PSI1 = ZERO
11935 PSI2 = ZERO
11936 PSI3 = ZERO
11937 PSI7 = CHI7
11938 PSI8 = CHI8
11939 PSI9 = ZERO
11940 PSI10 = CHI10
11941 PSI11 = ZERO
11942 PSI12 = CHI12
11943 PSI13 = ZERO
11944 PSI14 = CHI14
11945 PSI15 = CHI15
11946 PSI16 = CHI16
11947 PSI17 = CHI17
11948 FRST = .TRUE.
11949 CALAIN = .TRUE.
11950 !C
11951 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
11952 !C
11953 DO 10 I=1,NSWEEP
11954 !C
11955 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
11956 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
11957 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
11958 A9 = XK17 *(WATER/GAMA(17))**3.0
11959 A13 = XK19 *(WATER/GAMA(19))**2.0
11960 !C
11961 !C CALCULATE DISSOCIATION QUANTITIES
11962 !C
11963 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
11964 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
11965 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
11966 2.D0*PSI16 + 2.D0*PSI17)
11967 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
11968 !C
11969 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
11970 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
11971 CC = CHI4*(PSI5+PSI6)
11972 DD = MAX(BB*BB-4.d0*CC,ZERO)
11973 PSI4 =0.5d0*(-BB - SQRT(DD))
11974 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
11975 ELSE
11976 PSI4 = TINY
11977 ENDIF
11978 !C
11979 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
11980 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
11981 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
11982 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
11983 PSI13 =0.5d0*(-VHTA + SQRT(DELTA))
11984 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
11985 ENDIF
11986 !C
11987 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
11988 BBP = PSI10+PSI13+PSI14
11989 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
11990 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
11991 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
11992 IF (ISLV.EQ.0) THEN
11993 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
11994 ELSE
11995 PSI9 = ZERO
11996 ENDIF
11997 ENDIF
11998 !C
11999 !C
12000 !C *** CALCULATE SPECIATION ********************************************
12001 !C
12002 MOLAL (2) = PSI8 + PSI7 ! NAI
12003 MOLAL (3) = PSI4 ! NH4I
12004 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
12005 MOLAL (5) = PSI9 + PSI10 ! SO4I
12006 MOLAL (6) = ZERO ! HSO4I
12007 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
12008 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
12009 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
12010 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
12011 !C
12012 !C *** CALCULATE H+ *****************************************************
12013 !C
12014 !C REST = 2.D0*W(2) + W(4) + W(5)
12015 !CC
12016 !C DELT1 = 0.0d0
12017 !C DELT2 = 0.0d0
12018 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
12019 !CC
12020 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
12021 !CC
12022 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
12023 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
12024 !CC
12025 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
12026 !CC
12027 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
12028 !C DELT1 = 0.5*(-ALFA1 + DIAK)
12029 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
12030 !C DELT2 = ALFA2
12031 !C DELT2 = MIN ( DELT2, DELT1)
12032 !C MOLAL(1) = DELT1 + DELT2 ! H+
12033 !C ELSE
12034 !CC
12035 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
12036 !CC
12037 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
12038 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
12039 CALL CALCPH2p1 (SMIN, HI, OHI)
12040 MOLAL (1) = HI
12041 !C ENDIF
12042 !C
12043 GNH3 = MAX(CHI4 - PSI4, TINY)
12044 GHNO3 = MAX(CHI5 - PSI5, TINY)
12045 GHCL = MAX(CHI6 - PSI6, TINY)
12046 !C
12047 CNH4NO3 = ZERO
12048 CNH4CL = ZERO
12049 CNACL = ZERO
12050 CNANO3 = ZERO
12051 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
12052 CMGSO4 = ZERO
12053 CCASO4 = CHI11
12054 CCANO32 = ZERO
12055 CKNO3 = MAX (CHI13 - PSI13, ZERO)
12056 CKCL = ZERO
12057 CMGNO32 = ZERO
12058 CMGCL2 = ZERO
12059 CCACL2 = ZERO
12060 !C
12061 CALL CALCMR2p1 ! Water content
12062 !C
12063 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12064 !C
12065 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12066 CALL CALCACT2p1
12067 ELSE
12068 GOTO 20
12069 ENDIF
12070 10 CONTINUE
12071 !C
12072 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12073 !C
12074 !C20 FUNCP11 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12075 20 FUNCP112p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
12076 !C
12077 RETURN
12078 !C
12079 !C *** END OF FUNCTION FUNCP11 *******************************************
12080 !C
12081 END
12083 !C=======================================================================
12084 !C
12085 !C *** ISORROPIA CODE II
12086 !C *** SUBROUTINE CALCP10
12087 !C *** CASE P10
12088 !C
12089 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12090 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12091 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12092 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4
12093 !C 4. Completely dissolved: CA(NO3)2, CACL2, KCL,
12094 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
12095 !C
12096 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12097 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12098 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12099 !C
12100 !C=======================================================================
12101 !C
12102 SUBROUTINE CALCP102p1
12103 INCLUDE 'module_isrpia_inc.F'
12104 !C
12105 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12106 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12107 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12108 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12109 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12110 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12111 !C
12112 !C *** SETUP PARAMETERS ************************************************
12113 !C
12114 CALAOU = .TRUE.
12115 CHI11 = MIN (W(2), W(6)) ! CCASO4
12116 FRCA = MAX (W(6) - CHI11, ZERO)
12117 FRSO4 = MAX (W(2) - CHI11, ZERO)
12118 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
12119 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
12120 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
12121 CHI10 = FRSO4 ! CMGSO4
12122 FRMG = MAX (W(8) - CHI10, ZERO)
12123 CHI7 = MIN (W(1), W(5)) ! CNACL
12124 FRNA = MAX (W(1) - CHI7, ZERO)
12125 FRCL = MAX (W(5) - CHI7, ZERO)
12126 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
12127 FRCA = MAX (FRCA - CHI12, ZERO)
12128 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
12129 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
12130 FRCA = MAX (FRCA - CHI17, ZERO)
12131 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
12132 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
12133 FRMG = MAX (FRMG - CHI15, ZERO)
12134 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
12135 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
12136 FRMG = MAX (FRMG - CHI16, ZERO)
12137 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
12138 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
12139 FRNA = MAX (FRNA - CHI8, ZERO)
12140 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
12141 CHI14 = MIN (FRK, FRCL) ! CKCL
12142 FRK = MAX (FRK - CHI14, ZERO)
12143 FRCL = MAX (FRCL - CHI14, ZERO)
12144 CHI13 = MIN (FRK, FRNO3) ! CKNO3
12145 FRK = MAX (FRK - CHI13, ZERO)
12146 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
12147 !C
12148 CHI5 = FRNO3 ! HNO3(g)
12149 CHI6 = FRCL ! HCL(g)
12150 CHI4 = W(3) ! NH3(g)
12151 !C
12152 CHI3 = ZERO ! CNH4CL
12153 CHI1 = ZERO
12154 CHI2 = ZERO
12155 !C
12156 PSI6LO = TINY
12157 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
12158 !C
12159 !C *** INITIAL VALUES FOR BISECTION ************************************
12160 !C
12161 X1 = PSI6LO
12162 Y1 = FUNCP102p1 (X1)
12163 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12164 !C
12165 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12166 !C
12167 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12168 DO 10 I=1,NDIV
12169 X2 = X1+DX
12170 Y2 = FUNCP102p1 (X2)
12171 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
12172 X1 = X2
12173 Y1 = Y2
12174 10 CONTINUE
12175 !C
12176 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12177 !C
12178 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP102p1 (PSI6LO)
12179 GOTO 50
12180 !C
12181 !C *** PERFORM BISECTION ***********************************************
12182 !C
12183 20 DO 30 I=1,MAXIT
12184 X3 = 0.5*(X1+X2)
12185 Y3 = FUNCP102p1 (X3)
12186 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
12187 Y2 = Y3
12188 X2 = X3
12189 ELSE
12190 Y1 = Y3
12191 X1 = X3
12192 ENDIF
12193 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12194 30 CONTINUE
12195 CALL PUSHERR2p1 (0002, 'CALCP10') ! WARNING ERROR: NO CONVERGENCE
12196 !C
12197 !C *** CONVERGED ; RETURN **********************************************
12198 !C
12199 40 X3 = 0.5*(X1+X2)
12200 Y3 = FUNCP102p1 (X3)
12201 !C
12202 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12203 !C
12204 50 CONTINUE
12205 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12206 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12207 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
12208 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
12209 MOLAL(6) = DELTA ! HSO4 EFFECT
12210 ENDIF
12211 !C
12212 RETURN
12213 !C
12214 !C *** END OF SUBROUTINE CALCP10 ******************************************
12215 !C
12216 END
12218 !C
12219 !C=======================================================================
12220 !C
12221 !C *** ISORROPIA CODE II
12222 !C *** SUBROUTINE FUNCP10
12223 !C *** CASE P10
12224 !C
12225 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12226 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12227 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12228 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4
12229 !C 4. Completely dissolved: CA(NO3)2, CACL2, KCL,
12230 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
12231 !C
12232 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12233 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12234 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12235 !C
12236 !C=======================================================================
12237 !C
12238 DOUBLE PRECISION FUNCTION FUNCP102p1 (X)
12239 INCLUDE 'module_isrpia_inc.F'
12240 !C
12241 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12242 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12243 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12244 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12245 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12246 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12247 !C
12248 !C *** SETUP PARAMETERS ************************************************
12249 !C
12250 PSI6 = X
12251 PSI1 = ZERO
12252 PSI2 = ZERO
12253 PSI3 = ZERO
12254 PSI7 = CHI7
12255 PSI8 = CHI8
12256 PSI9 = ZERO
12257 PSI10 = CHI10
12258 PSI11 = ZERO
12259 PSI12 = CHI12
12260 PSI13 = ZERO
12261 PSI14 = CHI14
12262 PSI15 = CHI15
12263 PSI16 = CHI16
12264 PSI17 = CHI17
12265 FRST = .TRUE.
12266 CALAIN = .TRUE.
12267 !C
12268 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12269 !C
12270 DO 10 I=1,NSWEEP
12271 !C
12272 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12273 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12274 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12275 A9 = XK17 *(WATER/GAMA(17))**3.0
12276 A13 = XK19 *(WATER/GAMA(19))**2.0
12277 !C
12278 !C CALCULATE DISSOCIATION QUANTITIES
12279 !C
12280 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
12281 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
12282 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
12283 2.D0*PSI16 + 2.D0*PSI17)
12284 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
12285 !C
12286 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
12287 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12288 CC = CHI4*(PSI5+PSI6)
12289 DD = MAX(BB*BB-4.d0*CC,ZERO)
12290 PSI4 =0.5d0*(-BB - SQRT(DD))
12291 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
12292 ELSE
12293 PSI4 = TINY
12294 ENDIF
12295 !C
12296 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
12297 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
12298 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
12299 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
12300 PSI13 =0.5d0*(-VHTA + SQRT(DELTA))
12301 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
12302 ENDIF
12303 !C
12304 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
12305 BBP = PSI10+PSI13+PSI14
12306 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
12307 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
12308 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
12309 IF (ISLV.EQ.0) THEN
12310 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
12311 ELSE
12312 PSI9 = ZERO
12313 ENDIF
12314 ENDIF
12315 !C
12316 !C
12317 !C *** CALCULATE SPECIATION ********************************************
12318 !C
12319 MOLAL (2) = PSI8 + PSI7 ! NAI
12320 MOLAL (3) = PSI4 ! NH4I
12321 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
12322 MOLAL (5) = PSI9 + PSI10 ! SO4I
12323 MOLAL (6) = ZERO ! HSO4I
12324 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
12325 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
12326 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
12327 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
12328 !C
12329 !C *** CALCULATE H+ *****************************************************
12330 !C
12331 !C REST = 2.D0*W(2) + W(4) + W(5)
12332 !CC
12333 !C DELT1 = 0.0d0
12334 !C DELT2 = 0.0d0
12335 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
12336 !CC
12337 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
12338 !CC
12339 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
12340 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
12341 !CC
12342 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
12343 !CC
12344 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
12345 !C DELT1 = 0.5*(-ALFA1 + DIAK)
12346 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
12347 !C DELT2 = ALFA2
12348 !C DELT2 = MIN ( DELT2, DELT1)
12349 !C MOLAL(1) = DELT1 + DELT2 ! H+
12350 !C ELSE
12351 !CC
12352 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
12353 !CC
12354 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
12355 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
12356 CALL CALCPH2p1 (SMIN, HI, OHI)
12357 MOLAL (1) = HI
12358 !C ENDIF
12359 !C
12360 GNH3 = MAX(CHI4 - PSI4, TINY)
12361 GHNO3 = MAX(CHI5 - PSI5, TINY)
12362 GHCL = MAX(CHI6 - PSI6, TINY)
12363 !C
12364 CNH4NO3 = ZERO
12365 CNH4CL = ZERO
12366 CNACL = ZERO
12367 CNANO3 = ZERO
12368 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
12369 CMGSO4 = ZERO
12370 CCASO4 = CHI11
12371 CCANO32 = ZERO
12372 CKNO3 = MAX (CHI13 - PSI13, ZERO)
12373 CKCL = ZERO
12374 CMGNO32 = ZERO
12375 CMGCL2 = ZERO
12376 CCACL2 = ZERO
12377 !C
12378 CALL CALCMR2p1 ! Water content
12379 !C
12380 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12381 !C
12382 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12383 CALL CALCACT2p1
12384 ELSE
12385 GOTO 20
12386 ENDIF
12387 10 CONTINUE
12388 !C
12389 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12390 !C
12391 !C20 FUNCP10 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12392 20 FUNCP102p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
12393 !C
12394 RETURN
12395 !C
12396 !C *** END OF FUNCTION FUNCP10 *******************************************
12397 !C
12398 END
12400 !C=======================================================================
12401 !C
12402 !C *** ISORROPIA CODE II
12403 !C *** SUBROUTINE CALCP9
12404 !C *** CASE P9
12405 !C
12406 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12407 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12408 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12409 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL
12410 !C 4. Completely dissolved: CA(NO3)2, CACL2,
12411 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
12412 !C
12413 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12414 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12415 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12416 !C
12417 !C=======================================================================
12418 !C
12419 SUBROUTINE CALCP92p1
12420 INCLUDE 'module_isrpia_inc.F'
12421 !C
12422 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12423 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12424 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12425 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12426 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12427 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12428 !C
12429 !C *** SETUP PARAMETERS ************************************************
12430 !C
12431 CALAOU = .TRUE.
12432 CHI11 = MIN (W(2), W(6)) ! CCASO4
12433 FRCA = MAX (W(6) - CHI11, ZERO)
12434 FRSO4 = MAX (W(2) - CHI11, ZERO)
12435 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
12436 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
12437 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
12438 CHI10 = FRSO4 ! CMGSO4
12439 FRMG = MAX (W(8) - CHI10, ZERO)
12440 CHI7 = MIN (W(1), W(5)) ! CNACL
12441 FRNA = MAX (W(1) - CHI7, ZERO)
12442 FRCL = MAX (W(5) - CHI7, ZERO)
12443 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
12444 FRCA = MAX (FRCA - CHI12, ZERO)
12445 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
12446 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
12447 FRCA = MAX (FRCA - CHI17, ZERO)
12448 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
12449 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
12450 FRMG = MAX (FRMG - CHI15, ZERO)
12451 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
12452 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
12453 FRMG = MAX (FRMG - CHI16, ZERO)
12454 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
12455 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
12456 FRNA = MAX (FRNA - CHI8, ZERO)
12457 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
12458 CHI14 = MIN (FRK, FRCL) ! CKCL
12459 FRK = MAX (FRK - CHI14, ZERO)
12460 FRCL = MAX (FRCL - CHI14, ZERO)
12461 CHI13 = MIN (FRK, FRNO3) ! CKNO3
12462 FRK = MAX (FRK - CHI13, ZERO)
12463 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
12464 !C
12465 CHI5 = FRNO3 ! HNO3(g)
12466 CHI6 = FRCL ! HCL(g)
12467 CHI4 = W(3) ! NH3(g)
12468 !C
12469 CHI3 = ZERO ! CNH4CL
12470 CHI1 = ZERO
12471 CHI2 = ZERO
12472 !C
12473 PSI6LO = TINY
12474 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
12475 !C
12476 !C *** INITIAL VALUES FOR BISECTION ************************************
12477 !C
12478 X1 = PSI6LO
12479 Y1 = FUNCP92p1 (X1)
12480 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12481 !C
12482 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12483 !C
12484 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12485 DO 10 I=1,NDIV
12486 X2 = X1+DX
12487 Y2 = FUNCP92p1 (X2)
12488 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
12489 X1 = X2
12490 Y1 = Y2
12491 10 CONTINUE
12492 !C
12493 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12494 !C
12495 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP92p1 (PSI6LO)
12496 GOTO 50
12497 !C
12498 !C *** PERFORM BISECTION ***********************************************
12499 !C
12500 20 DO 30 I=1,MAXIT
12501 X3 = 0.5*(X1+X2)
12502 Y3 = FUNCP92p1 (X3)
12503 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
12504 Y2 = Y3
12505 X2 = X3
12506 ELSE
12507 Y1 = Y3
12508 X1 = X3
12509 ENDIF
12510 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12511 30 CONTINUE
12512 CALL PUSHERR2p1 (0002, 'CALCP9') ! WARNING ERROR: NO CONVERGENCE
12513 !C
12514 !C *** CONVERGED ; RETURN **********************************************
12515 !C
12516 40 X3 = 0.5*(X1+X2)
12517 Y3 = FUNCP92p1 (X3)
12518 !C
12519 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12520 !C
12521 50 CONTINUE
12522 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12523 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12524 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
12525 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
12526 MOLAL(6) = DELTA ! HSO4 EFFECT
12527 ENDIF
12528 !C
12529 RETURN
12530 !C
12531 !C *** END OF SUBROUTINE CALCP9 ******************************************
12532 !C
12533 END
12535 !C
12536 !C=======================================================================
12537 !C
12538 !C *** ISORROPIA CODE II
12539 !C *** SUBROUTINE FUNCP9
12540 !C *** CASE P9
12541 !C
12542 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12543 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12544 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12545 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL
12546 !C 4. Completely dissolved: CA(NO3)2, CACL2,
12547 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
12548 !C
12549 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12550 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12551 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12552 !C
12553 !C=======================================================================
12554 !C
12555 DOUBLE PRECISION FUNCTION FUNCP92p1 (X)
12556 INCLUDE 'module_isrpia_inc.F'
12557 !C
12558 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12559 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12560 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12561 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12562 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12563 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12564 !C
12565 !C *** SETUP PARAMETERS ************************************************
12566 !C
12567 PSI6 = X
12568 PSI1 = ZERO
12569 PSI2 = ZERO
12570 PSI3 = ZERO
12571 PSI7 = CHI7
12572 PSI8 = CHI8
12573 PSI9 = ZERO
12574 PSI10 = CHI10
12575 PSI11 = ZERO
12576 PSI12 = CHI12
12577 PSI13 = ZERO
12578 PSI14 = ZERO
12579 PSI15 = CHI15
12580 PSI16 = CHI16
12581 PSI17 = CHI17
12582 FRST = .TRUE.
12583 CALAIN = .TRUE.
12584 !C
12585 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12586 !C
12587 DO 10 I=1,NSWEEP
12588 !C
12589 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12590 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12591 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12592 A9 = XK17 *(WATER/GAMA(17))**3.0
12593 A13 = XK19 *(WATER/GAMA(19))**2.0
12594 A14 = XK20 *(WATER/GAMA(20))**2.0
12595 !C
12596 !C CALCULATE DISSOCIATION QUANTITIES
12597 !C
12598 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
12599 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
12600 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
12601 2.D0*PSI16 + 2.D0*PSI17)
12602 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
12603 !C
12604 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
12605 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12606 CC = CHI4*(PSI5+PSI6)
12607 DD = MAX(BB*BB-4.d0*CC,ZERO)
12608 PSI4 =0.5d0*(-BB - SQRT(DD))
12609 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
12610 ELSE
12611 PSI4 = TINY
12612 ENDIF
12613 !C
12614 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
12615 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
12616 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
12617 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
12618 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
12619 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
12620 ENDIF
12621 !C
12622 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
12623 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
12624 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
12625 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
12626 ENDIF
12627 !C
12628 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
12629 BBP = PSI10+PSI13+PSI14
12630 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
12631 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
12632 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
12633 IF (ISLV.EQ.0) THEN
12634 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
12635 ELSE
12636 PSI9 = ZERO
12637 ENDIF
12638 ENDIF
12639 !C
12640 !C
12641 !C *** CALCULATE SPECIATION ********************************************
12642 !C
12643 MOLAL (2) = PSI8 + PSI7 ! NAI
12644 MOLAL (3) = PSI4 ! NH4I
12645 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
12646 MOLAL (5) = PSI9 + PSI10 ! SO4I
12647 MOLAL (6) = ZERO ! HSO4I
12648 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
12649 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
12650 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
12651 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
12652 !C
12653 !C *** CALCULATE H+ *****************************************************
12654 !C
12655 !C REST = 2.D0*W(2) + W(4) + W(5)
12656 !CC
12657 !C DELT1 = 0.0d0
12658 !C DELT2 = 0.0d0
12659 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
12660 !CC
12661 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
12662 !CC
12663 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
12664 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
12665 !CC
12666 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
12667 !CC
12668 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
12669 !C DELT1 = 0.5*(-ALFA1 + DIAK)
12670 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
12671 !C DELT2 = ALFA2
12672 !C DELT2 = MIN ( DELT2, DELT1)
12673 !C MOLAL(1) = DELT1 + DELT2 ! H+
12674 !C ELSE
12675 !CC
12676 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
12677 !CC
12678 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
12679 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
12680 CALL CALCPH2p1 (SMIN, HI, OHI)
12681 MOLAL (1) = HI
12682 !C ENDIF
12683 !C
12684 GNH3 = MAX(CHI4 - PSI4, TINY)
12685 GHNO3 = MAX(CHI5 - PSI5, TINY)
12686 GHCL = MAX(CHI6 - PSI6, TINY)
12687 !C
12688 CNH4NO3 = ZERO
12689 CNH4CL = ZERO
12690 CNACL = ZERO
12691 CNANO3 = ZERO
12692 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
12693 CMGSO4 = ZERO
12694 CCASO4 = CHI11
12695 CCANO32 = ZERO
12696 CKNO3 = MAX (CHI13 - PSI13, ZERO)
12697 CKCL = MAX (CHI14 - PSI14, ZERO)
12698 CMGNO32 = ZERO
12699 CMGCL2 = ZERO
12700 CCACL2 = ZERO
12701 !C
12702 CALL CALCMR2p1 ! Water content
12703 !C
12704 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
12705 !C
12706 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
12707 CALL CALCACT2p1
12708 ELSE
12709 GOTO 20
12710 ENDIF
12711 10 CONTINUE
12712 !C
12713 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
12714 !C
12715 !C20 FUNCP9 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
12716 20 FUNCP92p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
12717 !C
12718 RETURN
12719 !C
12720 !C *** END OF FUNCTION FUNCP9 *******************************************
12721 !C
12722 END
12723 !C=======================================================================
12724 !C
12725 !C *** ISORROPIA CODE II
12726 !C *** SUBROUTINE CALCP8
12727 !C *** CASE P8
12728 !C
12729 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12730 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12731 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12732 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL
12733 !C 4. Completely dissolved: CA(NO3)2, CACL2,
12734 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3
12735 !C
12736 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12737 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12738 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12739 !C
12740 !C=======================================================================
12741 !C
12742 SUBROUTINE CALCP82p1
12743 INCLUDE 'module_isrpia_inc.F'
12744 !C
12745 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12746 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12747 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12748 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12749 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12750 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12751 !C
12752 !C *** SETUP PARAMETERS ************************************************
12753 !C
12754 CALAOU = .TRUE.
12755 CHI11 = MIN (W(2), W(6)) ! CCASO4
12756 FRCA = MAX (W(6) - CHI11, ZERO)
12757 FRSO4 = MAX (W(2) - CHI11, ZERO)
12758 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
12759 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
12760 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
12761 CHI10 = FRSO4 ! CMGSO4
12762 FRMG = MAX (W(8) - CHI10, ZERO)
12763 CHI7 = MIN (W(1), W(5)) ! CNACL
12764 FRNA = MAX (W(1) - CHI7, ZERO)
12765 FRCL = MAX (W(5) - CHI7, ZERO)
12766 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
12767 FRCA = MAX (FRCA - CHI12, ZERO)
12768 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
12769 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
12770 FRCA = MAX (FRCA - CHI17, ZERO)
12771 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
12772 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
12773 FRMG = MAX (FRMG - CHI15, ZERO)
12774 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
12775 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
12776 FRMG = MAX (FRMG - CHI16, ZERO)
12777 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
12778 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
12779 FRNA = MAX (FRNA - CHI8, ZERO)
12780 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
12781 CHI14 = MIN (FRK, FRCL) ! CKCL
12782 FRK = MAX (FRK - CHI14, ZERO)
12783 FRCL = MAX (FRCL - CHI14, ZERO)
12784 CHI13 = MIN (FRK, FRNO3) ! CKNO3
12785 FRK = MAX (FRK - CHI13, ZERO)
12786 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
12787 !C
12788 CHI5 = FRNO3 ! HNO3(g)
12789 CHI6 = FRCL ! HCL(g)
12790 CHI4 = W(3) ! NH3(g)
12791 !C
12792 CHI3 = ZERO ! CNH4CL
12793 CHI1 = ZERO
12794 CHI2 = ZERO
12795 !C
12796 PSI6LO = TINY
12797 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
12798 !C
12799 !C *** INITIAL VALUES FOR BISECTION ************************************
12800 !C
12801 X1 = PSI6LO
12802 Y1 = FUNCP82p1 (X1)
12803 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
12804 !C
12805 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
12806 !C
12807 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
12808 DO 10 I=1,NDIV
12809 X2 = X1+DX
12810 Y2 = FUNCP82p1 (X2)
12811 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
12812 X1 = X2
12813 Y1 = Y2
12814 10 CONTINUE
12815 !C
12816 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
12817 !C
12818 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP82p1 (PSI6LO)
12819 GOTO 50
12820 !C
12821 !C *** PERFORM BISECTION ***********************************************
12822 !C
12823 20 DO 30 I=1,MAXIT
12824 X3 = 0.5*(X1+X2)
12825 Y3 = FUNCP82p1 (X3)
12826 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
12827 Y2 = Y3
12828 X2 = X3
12829 ELSE
12830 Y1 = Y3
12831 X1 = X3
12832 ENDIF
12833 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
12834 30 CONTINUE
12835 CALL PUSHERR2p1 (0002, 'CALCP8') ! WARNING ERROR: NO CONVERGENCE
12836 !C
12837 !C *** CONVERGED ; RETURN **********************************************
12838 !C
12839 40 X3 = 0.5*(X1+X2)
12840 Y3 = FUNCP82p1 (X3)
12841 !C
12842 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
12843 !C
12844 50 CONTINUE
12845 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
12846 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
12847 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
12848 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
12849 MOLAL(6) = DELTA ! HSO4 EFFECT
12850 ENDIF
12851 !C
12852 RETURN
12853 !C
12854 !C *** END OF SUBROUTINE CALCP8 ******************************************
12855 !C
12856 END
12858 !C
12859 !C=======================================================================
12860 !C
12861 !C *** ISORROPIA CODE II
12862 !C *** SUBROUTINE FUNCP8
12863 !C *** CASE P8
12864 !C
12865 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
12866 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
12867 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
12868 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL
12869 !C 4. Completely dissolved: CA(NO3)2, CACL2,
12870 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3
12871 !C
12872 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
12873 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
12874 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
12875 !C
12876 !C=======================================================================
12877 !C
12878 DOUBLE PRECISION FUNCTION FUNCP82p1 (X)
12879 INCLUDE 'module_isrpia_inc.F'
12880 !C
12881 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
12882 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
12883 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
12884 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
12885 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
12886 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
12887 !C
12888 !C *** SETUP PARAMETERS ************************************************
12889 !C
12890 PSI6 = X
12891 PSI1 = ZERO
12892 PSI2 = ZERO
12893 PSI3 = ZERO
12894 PSI7 = CHI7
12895 PSI8 = CHI8
12896 PSI9 = ZERO
12897 PSI10 = CHI10
12898 PSI11 = ZERO
12899 PSI12 = CHI12
12900 PSI13 = ZERO
12901 PSI14 = ZERO
12902 PSI15 = CHI15
12903 PSI16 = CHI16
12904 PSI17 = CHI17
12905 FRST = .TRUE.
12906 CALAIN = .TRUE.
12907 !C
12908 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
12909 !C
12910 DO 10 I=1,NSWEEP
12911 !C
12912 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
12913 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
12914 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
12915 A9 = XK17 *(WATER/GAMA(17))**3.0
12916 A13 = XK19 *(WATER/GAMA(19))**2.0
12917 A14 = XK20 *(WATER/GAMA(20))**2.0
12918 !C
12919 !C CALCULATE DISSOCIATION QUANTITIES
12920 !C
12921 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
12922 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
12923 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
12924 2.D0*PSI16 + 2.D0*PSI17)
12925 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
12926 !C
12927 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
12928 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
12929 CC = CHI4*(PSI5+PSI6)
12930 DD = MAX(BB*BB-4.d0*CC,ZERO)
12931 PSI4 =0.5d0*(-BB - SQRT(DD))
12932 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
12933 ELSE
12934 PSI4 = TINY
12935 ENDIF
12936 !C
12937 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
12938 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
12939 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
12940 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
12941 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
12942 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
12943 ENDIF
12944 !C
12945 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
12946 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
12947 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
12948 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
12949 ENDIF
12950 !C
12951 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
12952 BBP = PSI10+PSI13+PSI14
12953 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
12954 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
12955 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
12956 IF (ISLV.EQ.0) THEN
12957 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
12958 ELSE
12959 PSI9 = ZERO
12960 ENDIF
12961 ENDIF
12962 !C
12963 !C
12964 !C *** CALCULATE SPECIATION ********************************************
12965 !C
12966 MOLAL (2) = PSI8 + PSI7 ! NAI
12967 MOLAL (3) = PSI4 ! NH4I
12968 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
12969 MOLAL (5) = PSI9 + PSI10 ! SO4I
12970 MOLAL (6) = ZERO ! HSO4I
12971 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
12972 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
12973 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
12974 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
12975 !C
12976 !C *** CALCULATE H+ *****************************************************
12977 !C
12978 !C REST = 2.D0*W(2) + W(4) + W(5)
12979 !CC
12980 !C DELT1 = 0.0d0
12981 !C DELT2 = 0.0d0
12982 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
12983 !CC
12984 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
12985 !CC
12986 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
12987 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
12988 !C
12989 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
12990 !CC
12991 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
12992 !C DELT1 = 0.5*(-ALFA1 + DIAK)
12993 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
12994 !C DELT2 = ALFA2
12995 !C DELT2 = MIN ( DELT2, DELT1)
12996 !C MOLAL(1) = DELT1 + DELT2 ! H+
12997 !C ELSE
12998 !CC
12999 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
13000 !CC
13001 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
13002 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
13003 CALL CALCPH2p1 (SMIN, HI, OHI)
13004 MOLAL (1) = HI
13005 !C ENDIF
13006 !C
13007 GNH3 = MAX(CHI4 - PSI4, TINY)
13008 GHNO3 = MAX(CHI5 - PSI5, TINY)
13009 GHCL = MAX(CHI6 - PSI6, TINY)
13010 !C
13011 CNH4NO3 = ZERO
13012 !C CNH4CL = ZERO
13013 CNACL = ZERO
13014 CNANO3 = ZERO
13015 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
13016 CMGSO4 = ZERO
13017 CCASO4 = CHI11
13018 CCANO32 = ZERO
13019 CKNO3 = MAX (CHI13 - PSI13, ZERO)
13020 CKCL = MAX (CHI14 - PSI14, ZERO)
13021 CMGNO32 = ZERO
13022 CMGCL2 = ZERO
13023 CCACL2 = ZERO
13024 !C
13025 !C *** NH4Cl(s) calculations
13026 !C
13027 A3 = XK6 /(R*TEMP*R*TEMP)
13028 IF (GNH3*GHCL.GT.A3) THEN
13029 DELT = MIN(GNH3, GHCL)
13030 BB = -(GNH3+GHCL)
13031 CC = GNH3*GHCL-A3
13032 DD = BB*BB - 4.D0*CC
13033 PSI31 = 0.5D0*(-BB + SQRT(DD))
13034 PSI32 = 0.5D0*(-BB - SQRT(DD))
13035 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
13036 PSI3 = PSI31
13037 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
13038 PSI3 = PSI32
13039 ELSE
13040 PSI3 = ZERO
13041 ENDIF
13042 ELSE
13043 PSI3 = ZERO
13044 ENDIF
13045 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
13046 !C
13047 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
13048 !C
13049 GNH3 = MAX(GNH3 - PSI3, TINY)
13050 GHCL = MAX(GHCL - PSI3, TINY)
13051 CNH4CL = PSI3
13052 !C
13053 CALL CALCMR2p1 ! Water content
13054 !C
13055 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13056 !C
13057 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13058 CALL CALCACT2p1
13059 ELSE
13060 GOTO 20
13061 ENDIF
13062 10 CONTINUE
13063 !C
13064 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
13065 !C
13066 !C20 FUNCP8 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
13067 20 FUNCP82p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
13068 !C
13069 RETURN
13070 !C
13071 !C *** END OF FUNCTION FUNCP8 *******************************************
13072 !C
13073 END
13074 !C=======================================================================
13075 !C
13076 !C *** ISORROPIA CODE II
13077 !C *** SUBROUTINE CALCP7
13078 !C *** CASE P7
13079 !C
13080 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13081 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13082 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
13083 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL
13084 !C 4. Completely dissolved: CA(NO3)2, CACL2,
13085 !C MG(NO3)2, MGCL2, NANO3, NH4NO3
13086 !C
13087 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
13088 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13089 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
13090 !C
13091 !C=======================================================================
13092 !C
13093 SUBROUTINE CALCP72p1
13094 INCLUDE 'module_isrpia_inc.F'
13095 !C
13096 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
13097 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
13098 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
13099 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
13100 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
13101 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
13102 !C
13103 !C *** SETUP PARAMETERS ************************************************
13104 !C
13105 CALAOU = .TRUE.
13106 CHI11 = MIN (W(2), W(6)) ! CCASO4
13107 FRCA = MAX (W(6) - CHI11, ZERO)
13108 FRSO4 = MAX (W(2) - CHI11, ZERO)
13109 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
13110 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
13111 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
13112 CHI10 = FRSO4 ! CMGSO4
13113 FRMG = MAX (W(8) - CHI10, ZERO)
13114 CHI7 = MIN (W(1), W(5)) ! CNACL
13115 FRNA = MAX (W(1) - CHI7, ZERO)
13116 FRCL = MAX (W(5) - CHI7, ZERO)
13117 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
13118 FRCA = MAX (FRCA - CHI12, ZERO)
13119 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
13120 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
13121 FRCA = MAX (FRCA - CHI17, ZERO)
13122 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
13123 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
13124 FRMG = MAX (FRMG - CHI15, ZERO)
13125 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
13126 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
13127 FRMG = MAX (FRMG - CHI16, ZERO)
13128 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
13129 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
13130 FRNA = MAX (FRNA - CHI8, ZERO)
13131 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
13132 CHI14 = MIN (FRK, FRCL) ! CKCL
13133 FRK = MAX (FRK - CHI14, ZERO)
13134 FRCL = MAX (FRCL - CHI14, ZERO)
13135 CHI13 = MIN (FRK, FRNO3) ! CKNO3
13136 FRK = MAX (FRK - CHI13, ZERO)
13137 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
13138 !C
13139 CHI5 = FRNO3 ! HNO3(g)
13140 CHI6 = FRCL ! HCL(g)
13141 CHI4 = W(3) ! NH3(g)
13142 !C
13143 CHI3 = ZERO ! CNH4CL
13144 CHI1 = ZERO
13145 CHI2 = ZERO
13146 !C
13147 PSI6LO = TINY
13148 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
13149 !C
13150 !C *** INITIAL VALUES FOR BISECTION ************************************
13151 !C
13152 X1 = PSI6LO
13153 Y1 = FUNCP72p1 (X1)
13154 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
13155 !C
13156 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13157 !C
13158 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
13159 DO 10 I=1,NDIV
13160 X2 = X1+DX
13161 Y2 = FUNCP72p1 (X2)
13162 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
13163 X1 = X2
13164 Y1 = Y2
13165 10 CONTINUE
13166 !C
13167 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
13168 !C
13169 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP72p1 (PSI6LO)
13170 GOTO 50
13171 !C
13172 !C *** PERFORM BISECTION ***********************************************
13173 !C
13174 20 DO 30 I=1,MAXIT
13175 X3 = 0.5*(X1+X2)
13176 Y3 = FUNCP72p1 (X3)
13177 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
13178 Y2 = Y3
13179 X2 = X3
13180 ELSE
13181 Y1 = Y3
13182 X1 = X3
13183 ENDIF
13184 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13185 30 CONTINUE
13186 CALL PUSHERR2p1 (0002, 'CALCP7') ! WARNING ERROR: NO CONVERGENCE
13187 !C
13188 !C *** CONVERGED ; RETURN **********************************************
13189 !C
13190 40 X3 = 0.5*(X1+X2)
13191 Y3 = FUNCP72p1 (X3)
13192 !C
13193 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
13194 !C
13195 50 CONTINUE
13196 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
13197 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
13198 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
13199 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
13200 MOLAL(6) = DELTA ! HSO4 EFFECT
13201 ENDIF
13202 !C
13203 RETURN
13204 !C
13205 !C *** END OF SUBROUTINE CALCP7 ******************************************
13206 !C
13207 END
13209 !C
13210 !C=======================================================================
13211 !C
13212 !C *** ISORROPIA CODE II
13213 !C *** SUBROUTINE FUNCP7
13214 !C *** CASE P7
13215 !C
13216 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13217 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13218 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
13219 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL
13220 !C 4. Completely dissolved: CA(NO3)2, CACL2,
13221 !C MG(NO3)2, MGCL2, NANO3, NH4NO3
13222 !C
13223 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
13224 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13225 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
13226 !C
13227 !C=======================================================================
13228 !C
13229 DOUBLE PRECISION FUNCTION FUNCP72p1 (X)
13230 INCLUDE 'module_isrpia_inc.F'
13231 !C
13232 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
13233 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
13234 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
13235 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
13236 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
13237 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
13238 !C
13239 !C *** SETUP PARAMETERS ************************************************
13240 !C
13241 PSI6 = X
13242 PSI1 = ZERO
13243 PSI2 = ZERO
13244 PSI3 = ZERO
13245 PSI7 = ZERO
13246 PSI8 = CHI8
13247 PSI9 = ZERO
13248 PSI10 = CHI10
13249 PSI11 = ZERO
13250 PSI12 = CHI12
13251 PSI13 = ZERO
13252 PSI14 = ZERO
13253 PSI15 = CHI15
13254 PSI16 = CHI16
13255 PSI17 = CHI17
13256 FRST = .TRUE.
13257 CALAIN = .TRUE.
13258 !C
13259 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
13260 !C
13261 DO 10 I=1,NSWEEP
13262 !C
13263 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
13264 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
13265 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
13266 A9 = XK17 *(WATER/GAMA(17))**3.0
13267 A13 = XK19 *(WATER/GAMA(19))**2.0
13268 A14 = XK20 *(WATER/GAMA(20))**2.0
13269 A7 = XK8 *(WATER/GAMA(1))**2.0
13270 !C
13271 !C CALCULATE DISSOCIATION QUANTITIES
13272 !C
13273 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
13274 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
13275 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
13276 2.D0*PSI16 + 2.D0*PSI17)
13277 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
13278 !C
13279 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
13280 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
13281 CC = CHI4*(PSI5+PSI6)
13282 DD = MAX(BB*BB-4.d0*CC,ZERO)
13283 PSI4 =0.5d0*(-BB - SQRT(DD))
13284 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
13285 ELSE
13286 PSI4 = TINY
13287 ENDIF
13288 !C
13289 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
13290 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
13291 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
13292 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
13293 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
13294 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
13295 ENDIF
13296 !C
13297 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
13298 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
13299 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
13300 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
13301 ENDIF
13302 !C
13303 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
13304 BBP = PSI10+PSI13+PSI14
13305 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
13306 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
13307 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
13308 IF (ISLV.EQ.0) THEN
13309 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
13310 ELSE
13311 PSI9 = ZERO
13312 ENDIF
13313 ENDIF
13314 !C
13315 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
13316 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
13317 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
13318 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
13319 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
13320 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
13321 ENDIF
13322 !C
13323 !C
13324 !C *** CALCULATE SPECIATION ********************************************
13325 !C
13326 MOLAL (2) = PSI8 + PSI7 ! NAI
13327 MOLAL (3) = PSI4 ! NH4I
13328 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
13329 MOLAL (5) = PSI9 + PSI10 ! SO4I
13330 MOLAL (6) = ZERO ! HSO4I
13331 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
13332 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
13333 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
13334 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
13335 !C
13336 !C *** CALCULATE H+ *****************************************************
13337 !C
13338 !C REST = 2.D0*W(2) + W(4) + W(5)
13339 !CC
13340 !C DELT1 = 0.0d0
13341 !C DELT2 = 0.0d0
13342 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
13343 !CC
13344 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
13345 !CC
13346 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
13347 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
13348 !CC
13349 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
13350 !CC
13351 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
13352 !C DELT1 = 0.5*(-ALFA1 + DIAK)
13353 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
13354 !C DELT2 = ALFA2
13355 !C DELT2 = MIN ( DELT2, DELT1)
13356 !C MOLAL(1) = DELT1 + DELT2 ! H+
13357 !C ELSE
13358 !CC
13359 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
13360 !CC
13361 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
13362 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
13363 CALL CALCPH2p1 (SMIN, HI, OHI)
13364 MOLAL (1) = HI
13365 !C ENDIF
13366 !C
13367 GNH3 = MAX(CHI4 - PSI4, TINY)
13368 GHNO3 = MAX(CHI5 - PSI5, TINY)
13369 GHCL = MAX(CHI6 - PSI6, TINY)
13370 !C
13371 CNH4NO3 = ZERO
13372 !C CNH4CL = ZERO
13373 CNACL = MAX (CHI7 - PSI7, ZERO)
13374 CNANO3 = ZERO
13375 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
13376 CMGSO4 = ZERO
13377 CCASO4 = CHI11
13378 CCANO32 = ZERO
13379 CKNO3 = MAX (CHI13 - PSI13, ZERO)
13380 CKCL = MAX (CHI14 - PSI14, ZERO)
13381 CMGNO32 = ZERO
13382 CMGCL2 = ZERO
13383 CCACL2 = ZERO
13384 !C
13385 !C *** NH4Cl(s) calculations
13386 !C
13387 A3 = XK6 /(R*TEMP*R*TEMP)
13388 IF (GNH3*GHCL.GT.A3) THEN
13389 DELT = MIN(GNH3, GHCL)
13390 BB = -(GNH3+GHCL)
13391 CC = GNH3*GHCL-A3
13392 DD = BB*BB - 4.D0*CC
13393 PSI31 = 0.5D0*(-BB + SQRT(DD))
13394 PSI32 = 0.5D0*(-BB - SQRT(DD))
13395 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
13396 PSI3 = PSI31
13397 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
13398 PSI3 = PSI32
13399 ELSE
13400 PSI3 = ZERO
13401 ENDIF
13402 ELSE
13403 PSI3 = ZERO
13404 ENDIF
13405 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
13406 !C
13407 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
13408 !C
13409 GNH3 = MAX(GNH3 - PSI3, TINY)
13410 GHCL = MAX(GHCL - PSI3, TINY)
13411 CNH4CL = PSI3
13412 !C
13413 CALL CALCMR2p1 ! Water content
13414 !C
13415 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13416 !C
13417 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13418 CALL CALCACT2p1
13419 ELSE
13420 GOTO 20
13421 ENDIF
13422 10 CONTINUE
13423 !C
13424 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
13425 !C
13426 !C20 FUNCP7 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
13427 20 FUNCP72p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
13428 !C
13429 RETURN
13430 !C
13431 !C *** END OF FUNCTION FUNCP7 *******************************************
13432 !C
13433 END
13434 !C=======================================================================
13435 !C
13436 !C *** ISORROPIA CODE II
13437 !C *** SUBROUTINE CALCP6
13438 !C *** CASE P6
13439 !C
13440 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13441 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13442 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
13443 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3
13444 !C 4. Completely dissolved: CA(NO3)2, CACL2,
13445 !C MG(NO3)2, MGCL2, NH4NO3
13446 !C
13447 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
13448 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13449 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
13450 !C
13451 !C=======================================================================
13452 !C
13453 SUBROUTINE CALCP62p1
13454 INCLUDE 'module_isrpia_inc.F'
13455 !C
13456 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
13457 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
13458 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
13459 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
13460 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
13461 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
13462 !C
13463 !C *** SETUP PARAMETERS ************************************************
13464 !C
13465 CALAOU = .TRUE.
13466 CHI11 = MIN (W(2), W(6)) ! CCASO4
13467 FRCA = MAX (W(6) - CHI11, ZERO)
13468 FRSO4 = MAX (W(2) - CHI11, ZERO)
13469 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
13470 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
13471 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
13472 CHI10 = FRSO4 ! CMGSO4
13473 FRMG = MAX (W(8) - CHI10, ZERO)
13474 CHI7 = MIN (W(1), W(5)) ! CNACL
13475 FRNA = MAX (W(1) - CHI7, ZERO)
13476 FRCL = MAX (W(5) - CHI7, ZERO)
13477 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
13478 FRCA = MAX (FRCA - CHI12, ZERO)
13479 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
13480 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
13481 FRCA = MAX (FRCA - CHI17, ZERO)
13482 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
13483 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
13484 FRMG = MAX (FRMG - CHI15, ZERO)
13485 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
13486 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
13487 FRMG = MAX (FRMG - CHI16, ZERO)
13488 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
13489 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
13490 FRNA = MAX (FRNA - CHI8, ZERO)
13491 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
13492 CHI14 = MIN (FRK, FRCL) ! CKCL
13493 FRK = MAX (FRK - CHI14, ZERO)
13494 FRCL = MAX (FRCL - CHI14, ZERO)
13495 CHI13 = MIN (FRK, FRNO3) ! CKNO3
13496 FRK = MAX (FRK - CHI13, ZERO)
13497 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
13498 !C
13499 CHI5 = FRNO3 ! HNO3(g)
13500 CHI6 = FRCL ! HCL(g)
13501 CHI4 = W(3) ! NH3(g)
13502 !C
13503 CHI3 = ZERO ! CNH4CL
13504 CHI1 = ZERO
13505 CHI2 = ZERO
13506 !C
13507 PSI6LO = TINY
13508 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
13509 !C
13510 !C *** INITIAL VALUES FOR BISECTION ************************************
13511 !C
13512 X1 = PSI6LO
13513 Y1 = FUNCP62p1 (X1)
13514 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
13515 !C
13516 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13517 !C
13518 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
13519 DO 10 I=1,NDIV
13520 X2 = X1+DX
13521 Y2 = FUNCP62p1 (X2)
13522 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
13523 X1 = X2
13524 Y1 = Y2
13525 10 CONTINUE
13526 !C
13527 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
13528 !C
13529 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP62p1 (PSI6LO)
13530 GOTO 50
13531 !C
13532 !C *** PERFORM BISECTION ***********************************************
13533 !C
13534 20 DO 30 I=1,MAXIT
13535 X3 = 0.5*(X1+X2)
13536 Y3 = FUNCP62p1 (X3)
13537 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
13538 Y2 = Y3
13539 X2 = X3
13540 ELSE
13541 Y1 = Y3
13542 X1 = X3
13543 ENDIF
13544 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13545 30 CONTINUE
13546 CALL PUSHERR2p1 (0002, 'CALCP6') ! WARNING ERROR: NO CONVERGENCE
13547 !C
13548 !C *** CONVERGED ; RETURN **********************************************
13549 !C
13550 40 X3 = 0.5*(X1+X2)
13551 Y3 = FUNCP62p1 (X3)
13552 !C
13553 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
13554 !C
13555 50 CONTINUE
13556 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
13557 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
13558 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
13559 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
13560 MOLAL(6) = DELTA ! HSO4 EFFECT
13561 ENDIF
13562 !C
13563 RETURN
13564 !C
13565 !C *** END OF SUBROUTINE CALCP6 ******************************************
13566 !C
13567 END
13569 !C
13570 !C=======================================================================
13571 !C
13572 !C *** ISORROPIA CODE II
13573 !C *** SUBROUTINE FUNCP6
13574 !C *** CASE P6
13575 !C
13576 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13577 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13578 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
13579 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3
13580 !C 4. Completely dissolved: CA(NO3)2, CACL2,
13581 !C MG(NO3)2, MGCL2, NH4NO3
13582 !C
13583 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
13584 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13585 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
13586 !C
13587 !C=======================================================================
13588 !C
13589 DOUBLE PRECISION FUNCTION FUNCP62p1 (X)
13590 INCLUDE 'module_isrpia_inc.F'
13591 !C
13592 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
13593 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
13594 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
13595 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
13596 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
13597 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
13598 !C
13599 !C *** SETUP PARAMETERS ************************************************
13600 !C
13601 PSI6 = X
13602 PSI1 = ZERO
13603 PSI2 = ZERO
13604 PSI3 = ZERO
13605 PSI7 = ZERO
13606 PSI8 = ZERO
13607 PSI9 = ZERO
13608 PSI10 = CHI10
13609 PSI11 = ZERO
13610 PSI12 = CHI12
13611 PSI13 = ZERO
13612 PSI14 = ZERO
13613 PSI15 = CHI15
13614 PSI16 = CHI16
13615 PSI17 = CHI17
13616 FRST = .TRUE.
13617 CALAIN = .TRUE.
13618 !C
13619 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
13620 !C
13621 DO 10 I=1,NSWEEP
13622 !C
13623 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
13624 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
13625 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
13626 A9 = XK17 *(WATER/GAMA(17))**3.0
13627 A13 = XK19 *(WATER/GAMA(19))**2.0
13628 A14 = XK20 *(WATER/GAMA(20))**2.0
13629 A7 = XK8 *(WATER/GAMA(1))**2.0
13630 A8 = XK9 *(WATER/GAMA(3))**2.0
13631 !C
13632 !C CALCULATE DISSOCIATION QUANTITIES
13633 !C
13634 PSI5 = CHI5*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) - &
13635 A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
13636 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
13637 2.D0*PSI16 + 2.D0*PSI17)
13638 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
13639 !C
13640 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
13641 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
13642 CC = CHI4*(PSI5+PSI6)
13643 DD = MAX(BB*BB-4.d0*CC,ZERO)
13644 PSI4 =0.5d0*(-BB - SQRT(DD))
13645 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
13646 ELSE
13647 PSI4 = TINY
13648 ENDIF
13649 !C
13650 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
13651 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
13652 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
13653 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
13654 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
13655 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
13656 ENDIF
13657 !C
13658 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
13659 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
13660 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
13661 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
13662 ENDIF
13663 !C
13664 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
13665 BBP = PSI10+PSI13+PSI14
13666 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
13667 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
13668 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
13669 IF (ISLV.EQ.0) THEN
13670 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
13671 ELSE
13672 PSI9 = ZERO
13673 ENDIF
13674 ENDIF
13675 !C
13676 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
13677 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
13678 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
13679 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
13680 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
13681 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
13682 ENDIF
13683 !C
13684 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
13685 !C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15
13686 !C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8
13687 !C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO)
13688 !C PSI8 = 0.5D0*( -VIT + SQRT(DIA) )
13689 PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- &
13690 PSI5-2.D0*PSI12-PSI13-2.D0*PSI15
13691 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
13692 ENDIF
13693 !C
13694 !C
13695 !C *** CALCULATE SPECIATION ********************************************
13696 !C
13697 MOLAL (2) = PSI8 + PSI7 ! NAI
13698 MOLAL (3) = PSI4 ! NH4I
13699 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
13700 MOLAL (5) = PSI9 + PSI10 ! SO4I
13701 MOLAL (6) = ZERO ! HSO4I
13702 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
13703 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
13704 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
13705 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
13706 !C
13707 !C *** CALCULATE H+ *****************************************************
13708 !C
13709 !C REST = 2.D0*W(2) + W(4) + W(5)
13710 !CC
13711 !C DELT1 = 0.0d0
13712 !C DELT2 = 0.0d0
13713 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
13714 !C
13715 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
13716 !CC
13717 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
13718 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
13719 !CC
13720 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
13721 !CC
13722 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
13723 !C DELT1 = 0.5*(-ALFA1 + DIAK)
13724 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
13725 !C DELT2 = ALFA2
13726 !C DELT2 = MIN ( DELT2, DELT1)
13727 !C MOLAL(1) = DELT1 + DELT2 ! H+
13728 !C ELSE
13729 !CC
13730 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
13731 !CC
13732 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
13733 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
13734 CALL CALCPH2p1 (SMIN, HI, OHI)
13735 MOLAL (1) = HI
13736 !C ENDIF
13737 !C
13738 GNH3 = MAX(CHI4 - PSI4, TINY)
13739 GHNO3 = MAX(CHI5 - PSI5, TINY)
13740 GHCL = MAX(CHI6 - PSI6, TINY)
13741 !C
13742 CNH4NO3 = ZERO
13743 !C CNH4CL = ZERO
13744 CNACL = MAX (CHI7 - PSI7, ZERO)
13745 CNANO3 = MAX (CHI8 - PSI8, ZERO)
13746 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
13747 CMGSO4 = ZERO
13748 CCASO4 = CHI11
13749 CCANO32 = ZERO
13750 CKNO3 = MAX (CHI13 - PSI13, ZERO)
13751 CKCL = MAX (CHI14 - PSI14, ZERO)
13752 CMGNO32 = ZERO
13753 CMGCL2 = ZERO
13754 CCACL2 = ZERO
13755 !C
13756 !C *** NH4Cl(s) calculations
13757 !C
13758 A3 = XK6 /(R*TEMP*R*TEMP)
13759 IF (GNH3*GHCL.GT.A3) THEN
13760 DELT = MIN(GNH3, GHCL)
13761 BB = -(GNH3+GHCL)
13762 CC = GNH3*GHCL-A3
13763 DD = BB*BB - 4.D0*CC
13764 PSI31 = 0.5D0*(-BB + SQRT(DD))
13765 PSI32 = 0.5D0*(-BB - SQRT(DD))
13766 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
13767 PSI3 = PSI31
13768 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
13769 PSI3 = PSI32
13770 ELSE
13771 PSI3 = ZERO
13772 ENDIF
13773 ELSE
13774 PSI3 = ZERO
13775 ENDIF
13776 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
13777 !C
13778 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
13779 !C
13780 GNH3 = MAX(GNH3 - PSI3, TINY)
13781 GHCL = MAX(GHCL - PSI3, TINY)
13782 CNH4CL = PSI3
13783 !C
13784 CALL CALCMR2p1 ! Water content
13785 !C
13786 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
13787 !C
13788 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
13789 CALL CALCACT2p1
13790 ELSE
13791 GOTO 20
13792 ENDIF
13793 10 CONTINUE
13794 !C
13795 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
13796 !C
13797 !C20 FUNCP6 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
13798 20 FUNCP62p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
13799 !C
13800 RETURN
13801 !C
13802 !C *** END OF FUNCTION FUNCP6 *******************************************
13803 !C
13804 END
13805 !C
13806 !C=======================================================================
13807 !C
13808 !C *** ISORROPIA CODE II
13809 !C *** SUBROUTINE CALCP5
13810 !C *** CASE P5
13811 !C
13812 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13813 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13814 !C 2. SOLID AEROSOL ONLY
13815 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4,
13816 !C NANO3, NACL, NH4NO3, NH4CL
13817 !C
13818 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
13819 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13820 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
13821 !C
13822 !C=======================================================================
13823 !C
13824 SUBROUTINE CALCP52p1
13825 INCLUDE 'module_isrpia_inc.F'
13826 EXTERNAL CALCP1A2p1, CALCP62p1
13827 !C
13828 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
13829 !C
13830 IF (W(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE
13831 SCASE = 'P5 ; SUBCASE 1'
13832 CALL CALCP5A2p1
13833 SCASE = 'P5 ; SUBCASE 1'
13834 ELSE ! NO3, CL NON EXISTANT
13835 SCASE = 'P1 ; SUBCASE 1'
13836 CALL CALCP1A2p1
13837 SCASE = 'P1 ; SUBCASE 1'
13838 ENDIF
13839 !C
13840 IF (WATER.LE.TINY) THEN
13841 IF (RH.LT.DRMP5) THEN ! ONLY SOLIDS
13842 WATER = TINY
13843 DO 10 I=1,NIONS
13844 MOLAL(I) = ZERO
13845 10 CONTINUE
13846 CALL CALCP1A2p1
13847 SCASE = 'P5 ; SUBCASE 2'
13848 RETURN
13849 ELSE
13850 SCASE = 'P5 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4,
13851 !C NANO3, NACL, NH4NO3, NH4CL)
13852 CALL CALCMDRH22p1 (RH, DRMP5, DRNH4NO3, CALCP1A2p1, CALCP62p1)
13853 SCASE = 'P5 ; SUBCASE 3'
13854 ENDIF
13855 ENDIF
13856 !C
13857 RETURN
13858 !C
13859 !C *** END OF SUBROUTINE CALCP5 ******************************************
13860 !C
13861 END
13862 !C
13863 !C=======================================================================
13864 !C
13865 !C *** ISORROPIA CODE II
13866 !C *** SUBROUTINE CALCP5A
13867 !C *** CASE P5A
13868 !C
13869 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
13870 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
13871 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
13872 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3
13873 !C 4. Completely dissolved: CA(NO3)2, CACL2,
13874 !C MG(NO3)2, MGCL2
13875 !C
13876 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
13877 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
13878 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
13879 !C
13880 !C=======================================================================
13881 !C
13882 SUBROUTINE CALCP5A2p1
13883 INCLUDE 'module_isrpia_inc.F'
13884 !C
13885 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
13886 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
13887 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
13888 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
13889 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
13890 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
13891 !C
13892 !C *** SETUP PARAMETERS ************************************************
13893 !C
13894 CALAOU = .TRUE.
13895 CHI11 = MIN (W(2), W(6)) ! CCASO4
13896 FRCA = MAX (W(6) - CHI11, ZERO)
13897 FRSO4 = MAX (W(2) - CHI11, ZERO)
13898 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
13899 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
13900 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
13901 CHI10 = FRSO4 ! CMGSO4
13902 FRMG = MAX (W(8) - CHI10, ZERO)
13903 CHI7 = MIN (W(1), W(5)) ! CNACL
13904 FRNA = MAX (W(1) - CHI7, ZERO)
13905 FRCL = MAX (W(5) - CHI7, ZERO)
13906 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
13907 FRCA = MAX (FRCA - CHI12, ZERO)
13908 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
13909 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
13910 FRCA = MAX (FRCA - CHI17, ZERO)
13911 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
13912 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
13913 FRMG = MAX (FRMG - CHI15, ZERO)
13914 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
13915 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
13916 FRMG = MAX (FRMG - CHI16, ZERO)
13917 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
13918 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
13919 FRNA = MAX (FRNA - CHI8, ZERO)
13920 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
13921 CHI14 = MIN (FRK, FRCL) ! CKCL
13922 FRK = MAX (FRK - CHI14, ZERO)
13923 FRCL = MAX (FRCL - CHI14, ZERO)
13924 CHI13 = MIN (FRK, FRNO3) ! CKNO3
13925 FRK = MAX (FRK - CHI13, ZERO)
13926 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
13927 !C
13928 CHI5 = FRNO3 ! HNO3(g)
13929 CHI6 = FRCL ! HCL(g)
13930 CHI4 = W(3) ! NH3(g)
13931 !C
13932 CHI3 = ZERO ! CNH4CL
13933 CHI1 = ZERO
13934 CHI2 = ZERO
13935 !C
13936 PSI6LO = TINY
13937 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
13938 !C
13939 !C *** INITIAL VALUES FOR BISECTION ************************************
13940 !C
13941 X1 = PSI6LO
13942 Y1 = FUNCP52p1 (X1)
13943 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
13944 !C
13945 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
13946 !C
13947 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
13948 DO 10 I=1,NDIV
13949 X2 = X1+DX
13950 Y2 = FUNCP52p1 (X2)
13951 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
13952 X1 = X2
13953 Y1 = Y2
13954 10 CONTINUE
13955 !C
13956 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
13957 !C
13958 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP52p1 (PSI6LO)
13959 GOTO 50
13960 !C
13961 !C *** PERFORM BISECTION ***********************************************
13962 !C
13963 20 DO 30 I=1,MAXIT
13964 X3 = 0.5*(X1+X2)
13965 Y3 = FUNCP52p1 (X3)
13966 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
13967 Y2 = Y3
13968 X2 = X3
13969 ELSE
13970 Y1 = Y3
13971 X1 = X3
13972 ENDIF
13973 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
13974 30 CONTINUE
13975 CALL PUSHERR2p1 (0002, 'CALCP5') ! WARNING ERROR: NO CONVERGENCE
13976 !C
13977 !C *** CONVERGED ; RETURN **********************************************
13978 !C
13979 40 X3 = 0.5*(X1+X2)
13980 Y3 = FUNCP52p1 (X3)
13981 !C
13982 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
13983 !C
13984 50 CONTINUE
13985 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
13986 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
13987 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
13988 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
13989 MOLAL(6) = DELTA ! HSO4 EFFECT
13990 ENDIF
13991 !C
13992 RETURN
13993 !C
13994 !C *** END OF SUBROUTINE CALCP5A ******************************************
13995 !C
13996 END
13998 !C
13999 !C=======================================================================
14000 !C
14001 !C *** ISORROPIA CODE II
14002 !C *** SUBROUTINE FUNCP5
14003 !C *** CASE P5
14004 !C
14005 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14006 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14007 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
14008 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3
14009 !C 4. Completely dissolved: CA(NO3)2, CACL2,
14010 !C MG(NO3)2, MGCL2
14011 !C
14012 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
14013 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14014 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
14015 !C
14016 !C=======================================================================
14017 !C
14018 DOUBLE PRECISION FUNCTION FUNCP52p1 (X)
14019 INCLUDE 'module_isrpia_inc.F'
14020 !C
14021 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
14022 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
14023 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
14024 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
14025 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
14026 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
14027 !C
14028 !C *** SETUP PARAMETERS ************************************************
14029 !C
14030 PSI6 = X
14031 PSI1 = ZERO
14032 PSI2 = ZERO
14033 PSI3 = ZERO
14034 PSI7 = ZERO
14035 PSI8 = ZERO
14036 PSI9 = ZERO
14037 PSI10 = CHI10
14038 PSI11 = ZERO
14039 PSI12 = CHI12
14040 PSI13 = ZERO
14041 PSI14 = ZERO
14042 PSI15 = CHI15
14043 PSI16 = CHI16
14044 PSI17 = CHI17
14045 FRST = .TRUE.
14046 CALAIN = .TRUE.
14047 !C
14048 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14049 !C
14050 DO 10 I=1,NSWEEP
14051 !C
14052 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
14053 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
14054 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
14055 A9 = XK17 *(WATER/GAMA(17))**3.0
14056 A13 = XK19 *(WATER/GAMA(19))**2.0
14057 A14 = XK20 *(WATER/GAMA(20))**2.0
14058 A7 = XK8 *(WATER/GAMA(1))**2.0
14059 A8 = XK9 *(WATER/GAMA(3))**2.0
14060 !C
14061 !C CALCULATE DISSOCIATION QUANTITIES
14062 !C
14063 PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) &
14064 - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
14065 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
14066 2.D0*PSI16 + 2.D0*PSI17)
14067 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
14068 !C
14069 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
14070 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
14071 CC = CHI4*(PSI5+PSI6)
14072 DD = MAX(BB*BB-4.d0*CC,ZERO)
14073 PSI4 =0.5d0*(-BB - SQRT(DD))
14074 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
14075 ELSE
14076 PSI4 = TINY
14077 ENDIF
14078 !C
14079 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
14080 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
14081 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
14082 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
14083 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
14084 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
14085 ENDIF
14086 !C
14087 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
14088 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
14089 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
14090 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
14091 ENDIF
14092 !C
14093 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
14094 BBP = PSI10+PSI13+PSI14
14095 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
14096 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
14097 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
14098 IF (ISLV.EQ.0) THEN
14099 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
14100 ELSE
14101 PSI9 = ZERO
14102 ENDIF
14103 ENDIF
14104 !C
14105 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
14106 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
14107 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
14108 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
14109 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
14110 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
14111 ENDIF
14112 !C
14113 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
14114 !C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15
14115 !C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8
14116 !C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO)
14117 !C PSI8 = 0.5D0*( -VIT + SQRT(DIA) )
14118 PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- &
14119 PSI5-2.D0*PSI12-PSI13-2.D0*PSI15
14120 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
14121 ENDIF
14122 !C
14123 !C
14124 !C *** CALCULATE SPECIATION ********************************************
14125 !C
14126 MOLAL (2) = PSI8 + PSI7 ! NAI
14127 MOLAL (3) = PSI4 ! NH4I
14128 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
14129 MOLAL (5) = PSI9 + PSI10 ! SO4I
14130 MOLAL (6) = ZERO ! HSO4I
14131 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
14132 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
14133 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
14134 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
14135 !CC
14136 !CC *** CALCULATE H+ *****************************************************
14137 !CC
14138 !C REST = 2.D0*W(2) + W(4) + W(5)
14139 !CC
14140 !C DELT1 = 0.0d0
14141 !C DELT2 = 0.0d0
14142 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
14143 !CC
14144 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
14145 !CC
14146 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
14147 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
14148 !CC
14149 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
14150 !CC
14151 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
14152 !C DELT1 = 0.5*(-ALFA1 + DIAK)
14153 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
14154 !C DELT2 = ALFA2
14155 !C DELT2 = MIN ( DELT2, DELT1)
14156 !C MOLAL(1) = DELT1 + DELT2 ! H+
14157 !C ELSE
14158 !CC
14159 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
14160 !CC
14161 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
14162 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
14163 CALL CALCPH2p1 (SMIN, HI, OHI)
14164 MOLAL (1) = HI
14165 !C ENDIF
14166 !C
14167 GNH3 = MAX(CHI4 - PSI4, TINY)
14168 GHNO3 = MAX(CHI5 - PSI5, TINY)
14169 GHCL = MAX(CHI6 - PSI6, TINY)
14170 !C
14171 !C CNH4NO3 = ZERO
14172 !C CNH4CL = ZERO
14173 CNACL = MAX (CHI7 - PSI7, ZERO)
14174 CNANO3 = MAX (CHI8 - PSI8, ZERO)
14175 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
14176 CMGSO4 = ZERO
14177 CCASO4 = CHI11
14178 CCANO32 = ZERO
14179 CKNO3 = MAX (CHI13 - PSI13, ZERO)
14180 CKCL = MAX (CHI14 - PSI14, ZERO)
14181 CMGNO32 = ZERO
14182 CMGCL2 = ZERO
14183 CCACL2 = ZERO
14184 !C
14185 !C *** NH4Cl(s) calculations
14186 !C
14187 A3 = XK6 /(R*TEMP*R*TEMP)
14188 IF (GNH3*GHCL.GT.A3) THEN
14189 DELT = MIN(GNH3, GHCL)
14190 BB = -(GNH3+GHCL)
14191 CC = GNH3*GHCL-A3
14192 DD = BB*BB - 4.D0*CC
14193 PSI31 = 0.5D0*(-BB + SQRT(DD))
14194 PSI32 = 0.5D0*(-BB - SQRT(DD))
14195 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
14196 PSI3 = PSI31
14197 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
14198 PSI3 = PSI32
14199 ELSE
14200 PSI3 = ZERO
14201 ENDIF
14202 ELSE
14203 PSI3 = ZERO
14204 ENDIF
14205 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
14206 !C
14207 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
14208 !C
14209 GNH3 = MAX(GNH3 - PSI3, TINY)
14210 GHCL = MAX(GHCL - PSI3, TINY)
14211 CNH4CL = PSI3
14212 !C
14213 !C *** NH4NO3(s) calculations
14214 !C
14215 A2 = XK10 /(R*TEMP*R*TEMP)
14216 IF (GNH3*GHNO3.GT.A2) THEN
14217 DELT = MIN(GNH3, GHNO3)
14218 BB = -(GNH3+GHNO3)
14219 CC = GNH3*GHNO3-A2
14220 DD = BB*BB - 4.D0*CC
14221 PSI21 = 0.5D0*(-BB + SQRT(DD))
14222 PSI22 = 0.5D0*(-BB - SQRT(DD))
14223 IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN
14224 PSI2 = PSI21
14225 ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN
14226 PSI2 = PSI22
14227 ELSE
14228 PSI2 = ZERO
14229 ENDIF
14230 ELSE
14231 PSI2 = ZERO
14232 ENDIF
14233 PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO)
14234 !C
14235 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
14236 !C
14237 GNH3 = MAX(GNH3 - PSI2, TINY)
14238 GHCL = MAX(GHNO3 - PSI2, TINY)
14239 CNH4NO3 = PSI2
14240 !C
14241 CALL CALCMR2p1 ! Water content
14242 !C
14243 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14244 !C
14245 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14246 CALL CALCACT2p1
14247 ELSE
14248 GOTO 20
14249 ENDIF
14250 10 CONTINUE
14251 !C
14252 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
14253 !C
14254 !C20 FUNCP5 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
14255 20 FUNCP52p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
14256 !C
14257 RETURN
14258 !C
14259 !C *** END OF FUNCTION FUNCP5 *******************************************
14260 !C
14261 END
14262 !C
14263 !C=======================================================================
14264 !C
14265 !C *** ISORROPIA CODE II
14266 !C *** SUBROUTINE CALCP4
14267 !C *** CASE P4
14268 !C
14269 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14270 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14271 !C 2. SOLID AEROSOL ONLY
14272 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, KCL, MGSO4,
14273 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL
14274 !C
14275 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14276 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14277 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
14278 !C
14279 !C=======================================================================
14280 !C
14281 SUBROUTINE CALCP42p1
14282 INCLUDE 'module_isrpia_inc.F'
14283 EXTERNAL CALCP1A2p1, CALCP5A2p1
14284 !C
14285 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
14286 !C
14287 IF (W(4).GT.TINY) THEN ! NO3 EXIST, WATER POSSIBLE
14288 SCASE = 'P4 ; SUBCASE 1'
14289 CALL CALCP4A2p1
14290 SCASE = 'P4 ; SUBCASE 1'
14291 ELSE ! NO3, CL NON EXISTANT
14292 SCASE = 'P1 ; SUBCASE 1'
14293 CALL CALCP1A2p1
14294 SCASE = 'P1 ; SUBCASE 1'
14295 ENDIF
14296 !C
14297 IF (WATER.LE.TINY) THEN
14298 IF (RH.LT.DRMP4) THEN ! ONLY SOLIDS
14299 WATER = TINY
14300 DO 10 I=1,NIONS
14301 MOLAL(I) = ZERO
14302 10 CONTINUE
14303 CALL CALCP1A2p1
14304 SCASE = 'P4 ; SUBCASE 2'
14305 RETURN
14306 ELSE
14307 SCASE = 'P4 ; SUBCASE 3' ! MDRH REGION (CaSO4, K2SO4, KNO3, KCL, MGSO4,
14308 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL)
14309 CALL CALCMDRH22p1 (RH, DRMP4, DRMGNO32, CALCP1A2p1, CALCP5A2p1)
14310 SCASE = 'P4 ; SUBCASE 3'
14311 ENDIF
14312 ENDIF
14313 !C
14314 RETURN
14315 !C
14316 !C *** END OF SUBROUTINE CALCP4 ******************************************
14317 !C
14318 END
14319 !C
14320 !C=======================================================================
14321 !C
14322 !C *** ISORROPIA CODE II
14323 !C *** SUBROUTINE CALCP4A
14324 !C *** CASE P4A
14325 !C
14326 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14327 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14328 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
14329 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2
14330 !C 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2
14331 !C
14332 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
14333 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14334 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
14335 !C
14336 !C=======================================================================
14337 !C
14338 SUBROUTINE CALCP4A2p1
14339 INCLUDE 'module_isrpia_inc.F'
14340 !C
14341 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
14342 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
14343 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
14344 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
14345 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
14346 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
14347 !C
14348 !C *** SETUP PARAMETERS ************************************************
14349 !C
14350 CALAOU = .TRUE.
14351 CHI11 = MIN (W(2), W(6)) ! CCASO4
14352 FRCA = MAX (W(6) - CHI11, ZERO)
14353 FRSO4 = MAX (W(2) - CHI11, ZERO)
14354 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
14355 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
14356 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
14357 CHI10 = FRSO4 ! CMGSO4
14358 FRMG = MAX (W(8) - CHI10, ZERO)
14359 CHI7 = MIN (W(1), W(5)) ! CNACL
14360 FRNA = MAX (W(1) - CHI7, ZERO)
14361 FRCL = MAX (W(5) - CHI7, ZERO)
14362 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
14363 FRCA = MAX (FRCA - CHI12, ZERO)
14364 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
14365 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
14366 FRCA = MAX (FRCA - CHI17, ZERO)
14367 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
14368 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
14369 FRMG = MAX (FRMG - CHI15, ZERO)
14370 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
14371 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
14372 FRMG = MAX (FRMG - CHI16, ZERO)
14373 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
14374 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
14375 FRNA = MAX (FRNA - CHI8, ZERO)
14376 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
14377 CHI14 = MIN (FRK, FRCL) ! CKCL
14378 FRK = MAX (FRK - CHI14, ZERO)
14379 FRCL = MAX (FRCL - CHI14, ZERO)
14380 CHI13 = MIN (FRK, FRNO3) ! CKNO3
14381 FRK = MAX (FRK - CHI13, ZERO)
14382 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
14383 !C
14384 CHI5 = FRNO3 ! HNO3(g)
14385 CHI6 = FRCL ! HCL(g)
14386 CHI4 = W(3) ! NH3(g)
14387 !C
14388 CHI3 = ZERO ! CNH4CL
14389 CHI1 = ZERO
14390 CHI2 = ZERO
14391 !C
14392 PSI6LO = TINY
14393 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
14394 !C
14395 !C *** INITIAL VALUES FOR BISECTION ************************************
14396 !C
14397 X1 = PSI6LO
14398 Y1 = FUNCP42p1 (X1)
14399 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
14400 !C
14401 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14402 !C
14403 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
14404 DO 10 I=1,NDIV
14405 X2 = X1+DX
14406 Y2 = FUNCP42p1 (X2)
14407 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
14408 X1 = X2
14409 Y1 = Y2
14410 10 CONTINUE
14411 !C
14412 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
14413 !C
14414 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP42p1 (PSI6LO)
14415 GOTO 50
14416 !C
14417 !C *** PERFORM BISECTION ***********************************************
14418 !C
14419 20 DO 30 I=1,MAXIT
14420 X3 = 0.5*(X1+X2)
14421 Y3 = FUNCP42p1 (X3)
14422 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
14423 Y2 = Y3
14424 X2 = X3
14425 ELSE
14426 Y1 = Y3
14427 X1 = X3
14428 ENDIF
14429 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14430 30 CONTINUE
14431 CALL PUSHERR2p1 (0002, 'CALCP4') ! WARNING ERROR: NO CONVERGENCE
14432 !C
14433 !C *** CONVERGED ; RETURN **********************************************
14434 !C
14435 40 X3 = 0.5*(X1+X2)
14436 Y3 = FUNCP42p1 (X3)
14437 !C
14438 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
14439 !C
14440 50 CONTINUE
14441 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
14442 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
14443 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
14444 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
14445 MOLAL(6) = DELTA ! HSO4 EFFECT
14446 ENDIF
14447 !C
14448 RETURN
14449 !C
14450 !C *** END OF SUBROUTINE CALCP4A ******************************************
14451 !C
14452 END
14454 !C
14455 !C=======================================================================
14456 !C
14457 !C *** ISORROPIA CODE II
14458 !C *** SUBROUTINE FUNCP4
14459 !C *** CASE P4
14460 !C
14461 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14462 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14463 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
14464 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL, NANO3, NH4NO3, MG(NO3)2
14465 !C 4. Completely dissolved: CA(NO3)2, CACL2, MGCL2
14466 !C
14467 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
14468 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14469 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
14470 !C
14471 !C=======================================================================
14472 !C
14473 DOUBLE PRECISION FUNCTION FUNCP42p1 (X)
14474 INCLUDE 'module_isrpia_inc.F'
14475 !C
14476 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
14477 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
14478 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
14479 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
14480 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
14481 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
14482 !C
14483 !C *** SETUP PARAMETERS ************************************************
14484 !C
14485 PSI6 = X
14486 PSI1 = ZERO
14487 PSI2 = ZERO
14488 PSI3 = ZERO
14489 PSI7 = ZERO
14490 PSI8 = ZERO
14491 PSI9 = ZERO
14492 PSI10 = CHI10
14493 PSI11 = ZERO
14494 PSI12 = CHI12
14495 PSI13 = ZERO
14496 PSI14 = ZERO
14497 PSI15 = CHI15
14498 PSI16 = CHI16
14499 PSI17 = CHI17
14500 FRST = .TRUE.
14501 CALAIN = .TRUE.
14502 !C
14503 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14504 !C
14505 DO 10 I=1,NSWEEP
14506 !C
14507 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
14508 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
14509 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
14510 A9 = XK17 *(WATER/GAMA(17))**3.0
14511 A13 = XK19 *(WATER/GAMA(19))**2.0
14512 A14 = XK20 *(WATER/GAMA(20))**2.0
14513 A7 = XK8 *(WATER/GAMA(1))**2.0
14514 A8 = XK9 *(WATER/GAMA(3))**2.0
14515 !C
14516 !C CALCULATE DISSOCIATION QUANTITIES
14517 !C
14518 PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) &
14519 - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
14520 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
14521 2.D0*PSI16 + 2.D0*PSI17)
14522 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
14523 !C
14524 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
14525 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
14526 CC = CHI4*(PSI5+PSI6)
14527 DD = MAX(BB*BB-4.d0*CC,ZERO)
14528 PSI4 =0.5d0*(-BB - SQRT(DD))
14529 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
14530 ELSE
14531 PSI4 = TINY
14532 ENDIF
14533 !C
14534 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
14535 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
14536 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
14537 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
14538 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
14539 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
14540 ENDIF
14541 !C
14542 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
14543 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
14544 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
14545 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
14546 ENDIF
14547 !C
14548 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
14549 BBP = PSI10+PSI13+PSI14
14550 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
14551 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
14552 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
14553 IF (ISLV.EQ.0) THEN
14554 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
14555 ELSE
14556 PSI9 = ZERO
14557 ENDIF
14558 ENDIF
14559 !C
14560 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
14561 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
14562 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
14563 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
14564 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
14565 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
14566 ENDIF
14567 !C
14568 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
14569 !C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15
14570 !C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8
14571 !C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO)
14572 !C PSI8 = 0.5D0*( -VIT + SQRT(DIA) )
14573 PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- &
14574 PSI5-2.D0*PSI12-PSI13-2.D0*PSI15
14575 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
14576 ENDIF
14577 !C
14578 !C
14579 !C *** CALCULATE SPECIATION ********************************************
14580 !C
14581 MOLAL (2) = PSI8 + PSI7 ! NAI
14582 MOLAL (3) = PSI4 ! NH4I
14583 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
14584 MOLAL (5) = PSI9 + PSI10 ! SO4I
14585 MOLAL (6) = ZERO ! HSO4I
14586 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
14587 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
14588 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
14589 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
14590 !C
14591 !C *** CALCULATE H+ *****************************************************
14592 !C
14593 !C REST = 2.D0*W(2) + W(4) + W(5)
14594 !CC
14595 !C DELT1 = 0.0d0
14596 !C DELT2 = 0.0d0
14597 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
14598 !CC
14599 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
14600 !CC
14601 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
14602 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
14603 !CC
14604 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
14605 !CC
14606 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
14607 !C DELT1 = 0.5*(-ALFA1 + DIAK)
14608 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
14609 !C DELT2 = ALFA2
14610 !C DELT2 = MIN ( DELT2, DELT1)
14611 !C MOLAL(1) = DELT1 + DELT2 ! H+
14612 !C ELSE
14613 !CC
14614 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
14615 !CC
14616 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
14617 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
14618 CALL CALCPH2p1 (SMIN, HI, OHI)
14619 MOLAL (1) = HI
14620 !C ENDIF
14621 !C
14622 GNH3 = MAX(CHI4 - PSI4, TINY)
14623 GHNO3 = MAX(CHI5 - PSI5, TINY)
14624 GHCL = MAX(CHI6 - PSI6, TINY)
14625 !C
14626 !C CNH4CL = ZERO
14627 !C CNH4NO3 = ZERO
14628 CNACL = MAX (CHI7 - PSI7, ZERO)
14629 CNANO3 = MAX (CHI8 - PSI8, ZERO)
14630 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
14631 CMGSO4 = ZERO
14632 CCASO4 = CHI11
14633 CCANO32 = ZERO
14634 CKNO3 = MAX (CHI13 - PSI13, ZERO)
14635 CKCL = MAX (CHI14 - PSI14, ZERO)
14636 CMGNO32 = ZERO
14637 CMGCL2 = ZERO
14638 CCACL2 = ZERO
14639 !C
14640 !C *** NH4Cl(s) calculations
14641 !C
14642 A3 = XK6 /(R*TEMP*R*TEMP)
14643 IF (GNH3*GHCL.GT.A3) THEN
14644 DELT = MIN(GNH3, GHCL)
14645 BB = -(GNH3+GHCL)
14646 CC = GNH3*GHCL-A3
14647 DD = BB*BB - 4.D0*CC
14648 PSI31 = 0.5D0*(-BB + SQRT(DD))
14649 PSI32 = 0.5D0*(-BB - SQRT(DD))
14650 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
14651 PSI3 = PSI31
14652 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
14653 PSI3 = PSI32
14654 ELSE
14655 PSI3 = ZERO
14656 ENDIF
14657 ELSE
14658 PSI3 = ZERO
14659 ENDIF
14660 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
14661 !C
14662 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
14663 !C
14664 GNH3 = MAX(GNH3 - PSI3, TINY)
14665 GHCL = MAX(GHCL - PSI3, TINY)
14666 CNH4CL = PSI3
14667 !C
14668 !C *** NH4NO3(s) calculations
14669 !C
14670 A2 = XK10 /(R*TEMP*R*TEMP)
14671 IF (GNH3*GHNO3.GT.A2) THEN
14672 DELT = MIN(GNH3, GHNO3)
14673 BB = -(GNH3+GHNO3)
14674 CC = GNH3*GHNO3-A2
14675 DD = BB*BB - 4.D0*CC
14676 PSI21 = 0.5D0*(-BB + SQRT(DD))
14677 PSI22 = 0.5D0*(-BB - SQRT(DD))
14678 IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN
14679 PSI2 = PSI21
14680 ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN
14681 PSI2 = PSI22
14682 ELSE
14683 PSI2 = ZERO
14684 ENDIF
14685 ELSE
14686 PSI2 = ZERO
14687 ENDIF
14688 PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5), ZERO)
14689 !C
14690 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
14691 !C
14692 GNH3 = MAX(GNH3 - PSI2, TINY)
14693 GHCL = MAX(GHNO3 - PSI2, TINY)
14694 CNH4NO3 = PSI2
14695 !C
14696 CALL CALCMR2p1 ! Water content
14697 !C
14698 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
14699 !C
14700 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
14701 CALL CALCACT2p1
14702 ELSE
14703 GOTO 20
14704 ENDIF
14705 10 CONTINUE
14706 !C
14707 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
14708 !C
14709 !C20 FUNCP4 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
14710 20 FUNCP42p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
14711 !C
14712 RETURN
14713 !C
14714 !C *** END OF FUNCTION FUNCP4 *******************************************
14715 !C
14716 END
14718 !C=======================================================================
14719 !C
14720 !C *** ISORROPIA CODE II
14721 !C *** SUBROUTINE CALCP3
14722 !C *** CASE P3
14723 !C
14724 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14725 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14726 !C 2. SOLID AEROSOL ONLY
14727 !C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4,
14728 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL
14729 !C
14730 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
14731 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14732 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
14733 !C
14734 !C=======================================================================
14735 !C
14736 SUBROUTINE CALCP32p1
14737 INCLUDE 'module_isrpia_inc.F'
14738 EXTERNAL CALCP1A2p1, CALCP4A2p1
14739 !C
14740 !C *** REGIME DEPENDS ON THE EXISTANCE OF WATER AND OF THE RH ************
14741 !C
14742 IF (W(4).GT.TINY .AND. W(5).GT.TINY) THEN ! NO3,CL EXIST, WATER POSSIBLE
14743 SCASE = 'P3 ; SUBCASE 1'
14744 CALL CALCP3A2p1
14745 SCASE = 'P3 ; SUBCASE 1'
14746 ELSE ! NO3, CL NON EXISTANT
14747 SCASE = 'P1 ; SUBCASE 1'
14748 CALL CALCP1A2p1
14749 SCASE = 'P1 ; SUBCASE 1'
14750 ENDIF
14751 !C
14752 IF (WATER.LE.TINY) THEN
14753 IF (RH.LT.DRMP3) THEN ! ONLY SOLIDS
14754 WATER = TINY
14755 DO 10 I=1,NIONS
14756 MOLAL(I) = ZERO
14757 10 CONTINUE
14758 CALL CALCP1A2p1
14759 SCASE = 'P3 ; SUBCASE 2'
14760 RETURN
14761 ELSE
14762 SCASE = 'P3 ; SUBCASE 3' ! MDRH REGION (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4,
14763 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL)
14764 CALL CALCMDRH22p1 (RH, DRMP3, DRCANO32, CALCP1A2p1, CALCP4A2p1)
14765 SCASE = 'P3 ; SUBCASE 3'
14766 ENDIF
14767 ENDIF
14768 !C
14769 RETURN
14770 !C
14771 !C *** END OF SUBROUTINE CALCP3 ******************************************
14772 !C
14773 END
14774 !C
14775 !C=======================================================================
14776 !C
14777 !C *** ISORROPIA CODE II
14778 !C *** SUBROUTINE CALCP3A
14779 !C *** CASE P3A
14780 !C
14781 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14782 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14783 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
14784 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL,
14785 !C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2
14786 !C 4. Completely dissolved: CACL2, MGCL2
14787 !C
14788 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
14789 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14790 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
14791 !C
14792 !C=======================================================================
14793 !C
14794 SUBROUTINE CALCP3A2p1
14795 INCLUDE 'module_isrpia_inc.F'
14796 !C
14797 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
14798 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
14799 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
14800 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
14801 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
14802 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
14803 !C
14804 !C *** SETUP PARAMETERS ************************************************
14805 !C
14806 CALAOU = .TRUE.
14807 CHI11 = MIN (W(2), W(6)) ! CCASO4
14808 FRCA = MAX (W(6) - CHI11, ZERO)
14809 FRSO4 = MAX (W(2) - CHI11, ZERO)
14810 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
14811 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
14812 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
14813 CHI10 = FRSO4 ! CMGSO4
14814 FRMG = MAX (W(8) - CHI10, ZERO)
14815 CHI7 = MIN (W(1), W(5)) ! CNACL
14816 FRNA = MAX (W(1) - CHI7, ZERO)
14817 FRCL = MAX (W(5) - CHI7, ZERO)
14818 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
14819 FRCA = MAX (FRCA - CHI12, ZERO)
14820 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
14821 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
14822 FRCA = MAX (FRCA - CHI17, ZERO)
14823 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
14824 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
14825 FRMG = MAX (FRMG - CHI15, ZERO)
14826 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
14827 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
14828 FRMG = MAX (FRMG - CHI16, ZERO)
14829 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
14830 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
14831 FRNA = MAX (FRNA - CHI8, ZERO)
14832 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
14833 CHI14 = MIN (FRK, FRCL) ! CKCL
14834 FRK = MAX (FRK - CHI14, ZERO)
14835 FRCL = MAX (FRCL - CHI14, ZERO)
14836 CHI13 = MIN (FRK, FRNO3) ! CKNO3
14837 FRK = MAX (FRK - CHI13, ZERO)
14838 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
14839 !C
14840 CHI5 = FRNO3 ! HNO3(g)
14841 CHI6 = FRCL ! HCL(g)
14842 CHI4 = W(3) ! NH3(g)
14843 !C
14844 CHI3 = ZERO ! CNH4CL
14845 CHI1 = ZERO
14846 CHI2 = ZERO
14847 !C
14848 PSI6LO = TINY
14849 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
14850 !C
14851 !C *** INITIAL VALUES FOR BISECTION ************************************
14852 !C
14853 X1 = PSI6LO
14854 Y1 = FUNCP32p1 (X1)
14855 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
14856 !C
14857 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
14858 !C
14859 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
14860 DO 10 I=1,NDIV
14861 X2 = X1+DX
14862 Y2 = FUNCP32p1 (X2)
14863 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
14864 X1 = X2
14865 Y1 = Y2
14866 10 CONTINUE
14867 !C
14868 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
14869 !C
14870 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP32p1 (PSI6LO)
14871 GOTO 50
14872 !C
14873 !C *** PERFORM BISECTION ***********************************************
14874 !C
14875 20 DO 30 I=1,MAXIT
14876 X3 = 0.5*(X1+X2)
14877 Y3 = FUNCP32p1 (X3)
14878 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
14879 Y2 = Y3
14880 X2 = X3
14881 ELSE
14882 Y1 = Y3
14883 X1 = X3
14884 ENDIF
14885 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
14886 30 CONTINUE
14887 CALL PUSHERR2p1 (0002, 'CALCP3') ! WARNING ERROR: NO CONVERGENCE
14888 !C
14889 !C *** CONVERGED ; RETURN **********************************************
14890 !C
14891 40 X3 = 0.5*(X1+X2)
14892 Y3 = FUNCP32p1 (X3)
14893 !C
14894 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
14895 !C
14896 50 CONTINUE
14897 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
14898 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
14899 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
14900 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
14901 MOLAL(6) = DELTA ! HSO4 EFFECT
14902 ENDIF
14903 !C
14904 RETURN
14905 !C
14906 !C *** END OF SUBROUTINE CALCP3A ******************************************
14907 !C
14908 END
14910 !C
14911 !C=======================================================================
14912 !C
14913 !C *** ISORROPIA CODE II
14914 !C *** SUBROUTINE FUNCP3
14915 !C *** CASE P3
14916 !C
14917 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
14918 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
14919 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
14920 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL,
14921 !C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2
14922 !C 4. Completely dissolved: CACL2, MGCL2
14923 !C
14924 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
14925 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
14926 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
14927 !C
14928 !C=======================================================================
14929 !C
14930 DOUBLE PRECISION FUNCTION FUNCP32p1 (X)
14931 INCLUDE 'module_isrpia_inc.F'
14932 !C
14933 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
14934 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
14935 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
14936 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
14937 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
14938 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
14939 !C
14940 !C *** SETUP PARAMETERS ************************************************
14941 !C
14942 PSI6 = X
14943 PSI1 = ZERO
14944 PSI2 = ZERO
14945 PSI3 = ZERO
14946 PSI7 = ZERO
14947 PSI8 = ZERO
14948 PSI9 = ZERO
14949 PSI10 = CHI10
14950 PSI11 = ZERO
14951 PSI12 = CHI12
14952 PSI13 = ZERO
14953 PSI14 = ZERO
14954 PSI15 = CHI15
14955 PSI16 = CHI16
14956 PSI17 = CHI17
14957 FRST = .TRUE.
14958 CALAIN = .TRUE.
14959 !C
14960 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
14961 !C
14962 DO 10 I=1,NSWEEP
14963 !C
14964 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
14965 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
14966 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
14967 A9 = XK17 *(WATER/GAMA(17))**3.0
14968 A13 = XK19 *(WATER/GAMA(19))**2.0
14969 A14 = XK20 *(WATER/GAMA(20))**2.0
14970 A7 = XK8 *(WATER/GAMA(1))**2.0
14971 A8 = XK9 *(WATER/GAMA(3))**2.0
14972 !C
14973 !C CALCULATE DISSOCIATION QUANTITIES
14974 !C
14975 PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) &
14976 - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
14977 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
14978 2.D0*PSI16 + 2.D0*PSI17)
14979 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
14980 !C
14981 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
14982 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
14983 CC = CHI4*(PSI5+PSI6)
14984 DD = MAX(BB*BB-4.d0*CC,ZERO)
14985 PSI4 =0.5d0*(-BB - SQRT(DD))
14986 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
14987 ELSE
14988 PSI4 = TINY
14989 ENDIF
14990 !C
14991 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
14992 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
14993 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
14994 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
14995 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
14996 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
14997 ENDIF
14998 !C
14999 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
15000 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
15001 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
15002 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
15003 ENDIF
15004 !C
15005 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
15006 BBP = PSI10+PSI13+PSI14
15007 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
15008 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
15009 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
15010 IF (ISLV.EQ.0) THEN
15011 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
15012 ELSE
15013 PSI9 = ZERO
15014 ENDIF
15015 ENDIF
15016 !C
15017 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
15018 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
15019 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
15020 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
15021 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
15022 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
15023 ENDIF
15024 !C
15025 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
15026 !C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15
15027 !C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8
15028 !C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO)
15029 !C PSI8 = 0.5D0*( -VIT + SQRT(DIA) )
15030 PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- &
15031 PSI5-2.D0*PSI12-PSI13-2.D0*PSI15
15032 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
15033 ENDIF
15034 !C
15035 !C
15036 !C *** CALCULATE SPECIATION ********************************************
15037 !C
15038 MOLAL (2) = PSI8 + PSI7 ! NAI
15039 MOLAL (3) = PSI4 ! NH4I
15040 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
15041 MOLAL (5) = PSI9 + PSI10 ! SO4I
15042 MOLAL (6) = ZERO ! HSO4I
15043 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
15044 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
15045 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
15046 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
15047 !C
15048 !C *** CALCULATE H+ *****************************************************
15049 !C
15050 !C REST = 2.D0*W(2) + W(4) + W(5)
15051 !CC
15052 !C DELT1 = 0.0d0
15053 !C DELT2 = 0.0d0
15054 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
15055 !CC
15056 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
15057 !CC
15058 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
15059 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
15060 !CC
15061 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
15062 !CC
15063 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
15064 !C DELT1 = 0.5*(-ALFA1 + DIAK)
15065 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
15066 !C DELT2 = ALFA2
15067 !C DELT2 = MIN ( DELT2, DELT1)
15068 !C MOLAL(1) = DELT1 + DELT2 ! H+
15069 !C ELSE
15070 !CC
15071 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
15072 !CC
15073 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
15074 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
15075 CALL CALCPH2p1 (SMIN, HI, OHI)
15076 MOLAL (1) = HI
15077 !C ENDIF
15078 !C
15079 GNH3 = MAX(CHI4 - PSI4, TINY)
15080 GHNO3 = MAX(CHI5 - PSI5, TINY)
15081 GHCL = MAX(CHI6 - PSI6, TINY)
15082 !C
15083 !C CNH4CL = ZERO
15084 !C CNH4NO3 = ZERO
15085 CNACL = MAX (CHI7 - PSI7, ZERO)
15086 CNANO3 = MAX (CHI8 - PSI8, ZERO)
15087 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
15088 CMGSO4 = ZERO
15089 CCASO4 = CHI11
15090 CCANO32 = ZERO
15091 CKNO3 = MAX (CHI13 - PSI13, ZERO)
15092 CKCL = MAX (CHI14 - PSI14, ZERO)
15093 CMGNO32 = ZERO
15094 CMGCL2 = ZERO
15095 CCACL2 = ZERO
15096 !C
15097 !C *** NH4Cl(s) calculations
15098 !C
15099 A3 = XK6 /(R*TEMP*R*TEMP)
15100 IF (GNH3*GHCL.GT.A3) THEN
15101 DELT = MIN(GNH3, GHCL)
15102 BB = -(GNH3+GHCL)
15103 CC = GNH3*GHCL-A3
15104 DD = BB*BB - 4.D0*CC
15105 PSI31 = 0.5D0*(-BB + SQRT(DD))
15106 PSI32 = 0.5D0*(-BB - SQRT(DD))
15107 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
15108 PSI3 = PSI31
15109 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
15110 PSI3 = PSI32
15111 ELSE
15112 PSI3 = ZERO
15113 ENDIF
15114 ELSE
15115 PSI3 = ZERO
15116 ENDIF
15117 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6), ZERO)
15118 !C
15119 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
15120 !C
15121 GNH3 = MAX(GNH3 - PSI3, TINY)
15122 GHCL = MAX(GHCL - PSI3, TINY)
15123 CNH4CL = PSI3
15124 !C
15125 !C *** NH4NO3(s) calculations
15126 !C
15127 A2 = XK10 /(R*TEMP*R*TEMP)
15128 IF (GNH3*GHNO3.GT.A2) THEN
15129 DELT = MIN(GNH3, GHNO3)
15130 BB = -(GNH3+GHNO3)
15131 CC = GNH3*GHNO3-A2
15132 DD = BB*BB - 4.D0*CC
15133 PSI21 = 0.5D0*(-BB + SQRT(DD))
15134 PSI22 = 0.5D0*(-BB - SQRT(DD))
15135 IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN
15136 PSI2 = PSI21
15137 ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN
15138 PSI2 = PSI22
15139 ELSE
15140 PSI2 = ZERO
15141 ENDIF
15142 ELSE
15143 PSI2 = ZERO
15144 ENDIF
15145 PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO)
15146 !C
15147 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
15148 !C
15149 GNH3 = MAX(GNH3 - PSI2, TINY)
15150 GHCL = MAX(GHNO3 - PSI2, TINY)
15151 CNH4NO3 = PSI2
15152 !C
15153 CALL CALCMR2p1 ! Water content
15154 !C
15155 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
15156 !C
15157 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
15158 CALL CALCACT2p1
15159 ELSE
15160 GOTO 20
15161 ENDIF
15162 10 CONTINUE
15163 !C
15164 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
15165 !C
15166 !C20 FUNCP3 = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
15167 20 FUNCP32p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
15168 !C
15169 RETURN
15170 !C
15171 !C *** END OF FUNCTION FUNCP3 *******************************************
15172 !C
15173 END
15175 !C=======================================================================
15176 !C
15177 !C *** ISORROPIA CODE II
15178 !C *** SUBROUTINE CALCP2
15179 !C *** CASE P2
15180 !C
15181 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15182 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
15183 !C 2. SOLID AEROSOL ONLY
15184 !C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4,
15185 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
15186 !C
15187 !C THERE ARE THREE REGIMES IN THIS CASE:
15188 !C 1. CACL2(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A)
15189 !C 2. CACL2(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
15190 !C 3. CACL2(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
15191 !C
15192 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES P1A, P2B
15193 !C RESPECTIVELY
15194 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
15195 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15196 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
15197 !C
15198 !C=======================================================================
15199 !C
15200 !C
15201 SUBROUTINE CALCP22p1
15202 INCLUDE 'module_isrpia_inc.F'
15203 EXTERNAL CALCP1A2p1, CALCP3A2p1, CALCP4A2p1, CALCP5A2p1, CALCP62p1
15204 !C
15205 !C *** FIND DRY COMPOSITION **********************************************
15206 !C
15207 CALL CALCP1A2p1
15208 !C
15209 !C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
15210 !C
15211 IF (CCACL2.GT.TINY) THEN
15212 SCASE = 'P2 ; SUBCASE 1'
15213 CALL CALCP2A2p1
15214 SCASE = 'P2 ; SUBCASE 1'
15215 ENDIF
15216 !C
15217 IF (WATER.LE.TINY) THEN
15218 IF (RH.LT.DRMP2) THEN ! ONLY SOLIDS
15219 WATER = TINY
15220 DO 10 I=1,NIONS
15221 MOLAL(I) = ZERO
15222 10 CONTINUE
15223 CALL CALCP1A2p1
15224 SCASE = 'P2 ; SUBCASE 2'
15225 ELSE
15226 IF (CMGCL2.GT. TINY) THEN
15227 SCASE = 'P2 ; SUBCASE 3' ! MDRH (CaSO4, CA(NO3)2, K2SO4, KNO3, KCL, MGSO4, MGCL2,
15228 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL)
15229 CALL CALCMDRH22p1 (RH, DRMP2, DRMGCL2, CALCP1A2p1, CALCP3A2p1)
15230 SCASE = 'P2 ; SUBCASE 3'
15231 ENDIF
15232 IF (WATER.LE.TINY .AND. RH.GE.DRMP3 .AND. RH.LT.DRMP4) THEN
15233 SCASE = 'P2 ; SUBCASE 4' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4, CANO32,
15234 !C MG(NO3)2, NANO3, NACL, NH4NO3, NH4CL)
15235 CALL CALCMDRH22p1 (RH, DRMP3, DRCANO32, CALCP1A2p1, CALCP4A2p1)
15236 SCASE = 'P2 ; SUBCASE 4'
15237 ENDIF
15238 IF (WATER.LE.TINY .AND. RH.GE.DRMP4 .AND. RH.LT.DRMP5) THEN
15239 SCASE = 'P2 ; SUBCASE 5' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4,
15240 !C MGNO32, NANO3, NACL, NH4NO3, NH4CL)
15241 CALL CALCMDRH22p1 (RH, DRMP4, DRMGNO32, CALCP1A2p1, CALCP5A2p1)
15242 SCASE = 'P2 ; SUBCASE 5'
15243 ENDIF
15244 IF (WATER.LE.TINY .AND. RH.GE.DRMP5) THEN
15245 SCASE = 'P2 ; SUBCASE 6' ! MDRH (CaSO4, K2SO4, KNO3, KCL, MGSO4,
15246 !C NANO3, NACL, NH4NO3, NH4CL)
15247 CALL CALCMDRH22p1 (RH, DRMP5, DRNH4NO3, CALCP1A2p1, CALCP62p1)
15248 SCASE = 'P2 ; SUBCASE 6'
15249 ELSE
15250 WATER = TINY
15251 DO 20 I=1,NIONS
15252 MOLAL(I) = ZERO
15253 20 CONTINUE
15254 CALL CALCP1A2p1
15255 SCASE = 'P2 ; SUBCASE 2'
15256 ENDIF
15257 ENDIF
15258 ENDIF
15259 !C
15260 RETURN
15261 !C
15262 !C *** END OF SUBROUTINE CALCP2 ******************************************
15263 !C
15264 END
15265 !C
15266 !C=======================================================================
15267 !C
15268 !C *** ISORROPIA CODE II
15269 !C *** SUBROUTINE CALCP2A
15270 !C *** CASE P2A
15271 !C
15272 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15273 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
15274 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
15275 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL,
15276 !C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2
15277 !C 4. Completely dissolved: CACL2
15278 !C
15279 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
15280 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15281 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
15282 !C
15283 !C=======================================================================
15284 !C
15285 SUBROUTINE CALCP2A2p1
15286 INCLUDE 'module_isrpia_inc.F'
15287 !C
15288 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
15289 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
15290 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
15291 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
15292 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
15293 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
15294 !C
15295 !C *** SETUP PARAMETERS ************************************************
15296 !C
15297 CALAOU = .TRUE.
15298 CHI11 = MIN (W(2), W(6)) ! CCASO4
15299 FRCA = MAX (W(6) - CHI11, ZERO)
15300 FRSO4 = MAX (W(2) - CHI11, ZERO)
15301 CHI9 = MIN (FRSO4, 0.5D0*W(7)) ! CK2SO4
15302 FRK = MAX (W(7) - 2.D0*CHI9, ZERO)
15303 FRSO4 = MAX (FRSO4 - CHI9, ZERO)
15304 CHI10 = FRSO4 ! CMGSO4
15305 FRMG = MAX (W(8) - CHI10, ZERO)
15306 CHI7 = MIN (W(1), W(5)) ! CNACL
15307 FRNA = MAX (W(1) - CHI7, ZERO)
15308 FRCL = MAX (W(5) - CHI7, ZERO)
15309 CHI12 = MIN (FRCA, 0.5D0*W(4)) ! CCANO32
15310 FRCA = MAX (FRCA - CHI12, ZERO)
15311 FRNO3 = MAX (W(4) - 2.D0*CHI12, ZERO)
15312 CHI17 = MIN (FRCA, 0.5D0*FRCL) ! CCACL2
15313 FRCA = MAX (FRCA - CHI17, ZERO)
15314 FRCL = MAX (FRCL - 2.D0*CHI17, ZERO)
15315 CHI15 = MIN (FRMG, 0.5D0*FRNO3) ! CMGNO32
15316 FRMG = MAX (FRMG - CHI15, ZERO)
15317 FRNO3 = MAX (FRNO3 - 2.D0*CHI15, ZERO)
15318 CHI16 = MIN (FRMG, 0.5D0*FRCL) ! CMGCL2
15319 FRMG = MAX (FRMG - CHI16, ZERO)
15320 FRCL = MAX (FRCL - 2.D0*CHI16, ZERO)
15321 CHI8 = MIN (FRNA, FRNO3) ! CNANO3
15322 FRNA = MAX (FRNA - CHI8, ZERO)
15323 FRNO3 = MAX (FRNO3 - CHI8, ZERO)
15324 CHI14 = MIN (FRK, FRCL) ! CKCL
15325 FRK = MAX (FRK - CHI14, ZERO)
15326 FRCL = MAX (FRCL - CHI14, ZERO)
15327 CHI13 = MIN (FRK, FRNO3) ! CKNO3
15328 FRK = MAX (FRK - CHI13, ZERO)
15329 FRNO3 = MAX (FRNO3 - CHI13, ZERO)
15330 !C
15331 CHI5 = FRNO3 ! HNO3(g)
15332 CHI6 = FRCL ! HCL(g)
15333 CHI4 = W(3) ! NH3(g)
15334 !C
15335 CHI3 = ZERO ! CNH4CL
15336 CHI1 = ZERO
15337 CHI2 = ZERO
15338 !C
15339 PSI6LO = TINY
15340 PSI6HI = CHI6-TINY ! MIN(CHI6-TINY, CHI4)
15341 !C
15342 !C *** INITIAL VALUES FOR BISECTION ************************************
15343 !C
15344 X1 = PSI6LO
15345 Y1 = FUNCP2A2p1 (X1)
15346 IF (ABS(Y1).LE.EPS .OR. CHI6.LE.TINY) GOTO 50
15347 !C
15348 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
15349 !C
15350 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
15351 DO 10 I=1,NDIV
15352 X2 = X1+DX
15353 Y2 = FUNCP2A2p1 (X2)
15354 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
15355 X1 = X2
15356 Y1 = Y2
15357 10 CONTINUE
15358 !C
15359 !C *** NO SUBDIVISION WITH SOLUTION; IF ABS(Y2)<EPS SOLUTION IS ASSUMED
15360 !C
15361 IF (ABS(Y2) .GT. EPS) Y2 = FUNCP2A2p1(PSI6LO)
15362 GOTO 50
15363 !C
15364 !C *** PERFORM BISECTION ***********************************************
15365 !C
15366 20 DO 30 I=1,MAXIT
15367 X3 = 0.5*(X1+X2)
15368 Y3 = FUNCP2A2p1 (X3)
15369 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
15370 Y2 = Y3
15371 X2 = X3
15372 ELSE
15373 Y1 = Y3
15374 X1 = X3
15375 ENDIF
15376 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
15377 30 CONTINUE
15378 CALL PUSHERR2p1 (0002, 'CALCP2A') ! WARNING ERROR: NO CONVERGENCE
15379 !C
15380 !C *** CONVERGED ; RETURN **********************************************
15381 !C
15382 40 X3 = 0.5*(X1+X2)
15383 Y3 = FUNCP2A2p1 (X3)
15384 !C
15385 !C *** CALCULATE HSO4 SPECIATION AND RETURN *******************************
15386 !C
15387 50 CONTINUE
15388 IF (MOLAL(1).GT.TINY .AND. MOLAL(5).GT.TINY) THEN
15389 CALL CALCHS42p1 (MOLAL(1), MOLAL(5), ZERO, DELTA)
15390 MOLAL(1) = MOLAL(1) - DELTA ! H+ EFFECT
15391 MOLAL(5) = MOLAL(5) - DELTA ! SO4 EFFECT
15392 MOLAL(6) = DELTA ! HSO4 EFFECT
15393 ENDIF
15394 !C
15395 RETURN
15396 !C
15397 !C *** END OF SUBROUTINE CALCP2A ******************************************
15398 !C
15399 END
15401 !C
15402 !C=======================================================================
15403 !C
15404 !C *** ISORROPIA CODE II
15405 !C *** SUBROUTINE FUNCP2A
15406 !C *** CASE P2A
15407 !C
15408 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15409 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
15410 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
15411 !C 3. SOLIDS POSSIBLE : CaSO4, K2SO4, KNO3, MGSO4, KCL, NH4CL, NACL,
15412 !C NANO3, NH4NO3, MG(NO3)2, CA(NO3)2, MGCL2
15413 !C 4. Completely dissolved: CACL2
15414 !C
15415 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
15416 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15417 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
15418 !C
15419 !C=======================================================================
15420 !C
15421 DOUBLE PRECISION FUNCTION FUNCP2A2p1 (X)
15422 INCLUDE 'module_isrpia_inc.F'
15423 !C
15424 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
15425 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
15426 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
15427 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
15428 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
15429 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
15430 !C
15431 !C *** SETUP PARAMETERS ************************************************
15432 !C
15433 PSI6 = X
15434 PSI1 = ZERO
15435 PSI2 = ZERO
15436 PSI3 = ZERO
15437 PSI7 = ZERO
15438 PSI8 = ZERO
15439 PSI9 = ZERO
15440 PSI10 = CHI10
15441 PSI11 = ZERO
15442 PSI12 = CHI12
15443 PSI13 = ZERO
15444 PSI14 = ZERO
15445 PSI15 = CHI15
15446 PSI16 = CHI16
15447 PSI17 = CHI17
15448 FRST = .TRUE.
15449 CALAIN = .TRUE.
15450 !C
15451 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
15452 !C
15453 DO 10 I=1,NSWEEP
15454 !C
15455 A4 = (XK2/XKW)*R*TEMP*(GAMA(10)/GAMA(5))**2.0
15456 A5 = XK4 *R*TEMP*(WATER/GAMA(10))**2.0
15457 A6 = XK3 *R*TEMP*(WATER/GAMA(11))**2.0
15458 A9 = XK17 *(WATER/GAMA(17))**3.0
15459 A13 = XK19 *(WATER/GAMA(19))**2.0
15460 A14 = XK20 *(WATER/GAMA(20))**2.0
15461 A7 = XK8 *(WATER/GAMA(1))**2.0
15462 A8 = XK9 *(WATER/GAMA(3))**2.0
15463 !C
15464 !C CALCULATE DISSOCIATION QUANTITIES
15465 !C
15466 PSI5 = (CHI5-PSI2)*(PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17) &
15467 - A6/A5*(PSI8+2.D0*PSI12+PSI13+2.D0*PSI15)*(CHI6-PSI6-PSI3)
15468 PSI5 = PSI5/(A6/A5*(CHI6-PSI6-PSI3) + PSI6 + PSI7 + PSI14 + &
15469 2.D0*PSI16 + 2.D0*PSI17)
15470 PSI5 = MIN (MAX (PSI5, TINY) , CHI5)
15471 !C
15472 IF (W(3).GT.TINY .AND. WATER.GT.TINY) THEN ! First try 3rd order soln
15473 BB =-(CHI4 + PSI6 + PSI5 + 1.d0/A4)
15474 CC = CHI4*(PSI5+PSI6)
15475 DD = MAX(BB*BB-4.d0*CC,ZERO)
15476 PSI4 =0.5d0*(-BB - SQRT(DD))
15477 PSI4 = MIN(MAX(PSI4,ZERO),CHI4)
15478 ELSE
15479 PSI4 = TINY
15480 ENDIF
15481 !C
15482 IF (CHI13.GT.TINY .AND. WATER.GT.TINY) THEN !KNO3
15483 VHTA = PSI5+PSI8+2.D0*PSI12+2.D0*PSI15+PSI14+2.D0*PSI9
15484 GKAMA = (PSI5+PSI8+2.D0*PSI12+2.D0*PSI15)*(2.D0*PSI9+PSI14)-A13
15485 DELTA = MAX(VHTA*VHTA-4.d0*GKAMA,ZERO)
15486 PSI13 = 0.5d0*(-VHTA + SQRT(DELTA))
15487 PSI13 = MIN(MAX(PSI13,ZERO),CHI13)
15488 ENDIF
15489 !C
15490 IF (CHI14.GT.TINY .AND. WATER.GT.TINY) THEN !KCL
15491 PSI14 = A14/A13*(PSI5+PSI8+2.D0*PSI12+PSI13+2.D0*PSI15) - &
15492 PSI6-PSI7-2.D0*PSI16-2.D0*PSI17
15493 PSI14 = MIN (MAX (PSI14, ZERO), CHI14)
15494 ENDIF
15495 !C
15496 IF (CHI9.GT.TINY .AND. WATER.GT.TINY) THEN !K2SO4
15497 BBP = PSI10+PSI13+PSI14
15498 CCP = (PSI13+PSI14)*(0.25D0*(PSI13+PSI14)+PSI10)
15499 DDP = 0.25D0*(PSI13+PSI14)**2.0*PSI10-A9/4.D0
15500 CALL POLY32p1 (BBP, CCP, DDP, PSI9, ISLV)
15501 IF (ISLV.EQ.0) THEN
15502 PSI9 = MIN (MAX(PSI9,ZERO) , CHI9)
15503 ELSE
15504 PSI9 = ZERO
15505 ENDIF
15506 ENDIF
15507 !C
15508 IF (CHI7.GT.TINY .AND. WATER.GT.TINY) THEN ! NACL DISSOLUTION
15509 VITA = PSI6+PSI14+PSI8+2.D0*PSI16+2.D0*PSI17
15510 GKAMA= PSI8*(2.D0*PSI16+PSI6+PSI14+2.D0*PSI17)-A7
15511 DIAK = MAX(VITA*VITA - 4.0D0*GKAMA,ZERO)
15512 PSI7 = 0.5D0*( -VITA + SQRT(DIAK) )
15513 PSI7 = MAX(MIN(PSI7, CHI7), ZERO)
15514 ENDIF
15515 !C
15516 IF (CHI8.GT.TINY .AND. WATER.GT.TINY) THEN ! NANO3 DISSOLUTION
15517 !C VIT = PSI5+PSI13+PSI7+2.D0*PSI12+2.D0*PSI15
15518 !C GKAM = PSI7*(2.D0*PSI12+PSI5+PSI13+2.D0*PSI15)-A8
15519 !C DIA = MAX(VIT*VIT - 4.0D0*GKAM,ZERO)
15520 !C PSI8 = 0.5D0*( -VIT + SQRT(DIA) )
15521 PSI8 = A8/A7*(PSI6+PSI7+PSI14+2.D0*PSI16+2.D0*PSI17)- &
15522 PSI5-2.D0*PSI12-PSI13-2.D0*PSI15
15523 PSI8 = MAX(MIN(PSI8, CHI8), ZERO)
15524 ENDIF
15525 !C
15526 !C
15527 !C *** CALCULATE SPECIATION ********************************************
15528 !C
15529 MOLAL (2) = PSI8 + PSI7 ! NAI
15530 MOLAL (3) = PSI4 ! NH4I
15531 MOLAL (4) = PSI6 + PSI7 + PSI14 + 2.D0*PSI16 + 2.D0*PSI17 ! CLI
15532 MOLAL (5) = PSI9 + PSI10 ! SO4I
15533 MOLAL (6) = ZERO ! HSO4I
15534 MOLAL (7) = PSI5 + PSI8 + 2.D0*PSI12 + PSI13 + 2.D0*PSI15 ! NO3I
15535 MOLAL (8) = PSI11 + PSI12 + PSI17 ! CAI
15536 MOLAL (9) = 2.D0*PSI9 + PSI13 + PSI14 ! KI
15537 MOLAL (10)= PSI10 + PSI15 + PSI16 ! MGI
15538 !C
15539 !C *** CALCULATE H+ *****************************************************
15540 !C
15541 !C REST = 2.D0*W(2) + W(4) + W(5)
15542 !CC
15543 !C DELT1 = 0.0d0
15544 !C DELT2 = 0.0d0
15545 !C IF (W(1)+W(6)+W(7)+W(8).GT.REST) THEN
15546 !CC
15547 !CC *** CALCULATE EQUILIBRIUM CONSTANTS **********************************
15548 !CC
15549 !C ALFA1 = XK26*RH*(WATER/1.0) ! CO2(aq) + H2O
15550 !C ALFA2 = XK27*(WATER/1.0) ! HCO3-
15551 !CC
15552 !C X = W(1)+W(6)+W(7)+W(8) - REST ! EXCESS OF CRUSTALS EQUALS CO2(aq)
15553 !CC
15554 !C DIAK = SQRT( (ALFA1)**2.0 + 4.0D0*ALFA1*X)
15555 !C DELT1 = 0.5*(-ALFA1 + DIAK)
15556 !C DELT1 = MIN ( MAX (DELT1, ZERO), X)
15557 !C DELT2 = ALFA2
15558 !C DELT2 = MIN ( DELT2, DELT1)
15559 !C MOLAL(1) = DELT1 + DELT2 ! H+
15560 !C ELSE
15561 !CC
15562 !CC *** NO EXCESS OF CRUSTALS CALCULATE H+ *******************************
15563 !CC
15564 SMIN = 2.d0*MOLAL(5)+MOLAL(7)+MOLAL(4)-MOLAL(2)-MOLAL(3) &
15565 - MOLAL(9) - 2.D0*MOLAL(10) - 2.D0*MOLAL(8)
15566 CALL CALCPH2p1 (SMIN, HI, OHI)
15567 MOLAL (1) = HI
15568 !C ENDIF
15569 !C
15570 GNH3 = MAX(CHI4 - PSI4, TINY)
15571 GHNO3 = MAX(CHI5 - PSI5, TINY)
15572 GHCL = MAX(CHI6 - PSI6, TINY)
15573 !C
15574 !C CNH4CL = ZERO
15575 !C CNH4NO3 = ZERO
15576 CNACL = MAX (CHI7 - PSI7, ZERO)
15577 CNANO3 = MAX (CHI8 - PSI8, ZERO)
15578 CK2SO4 = MAX (CHI9 - PSI9, ZERO)
15579 CMGSO4 = ZERO
15580 CCASO4 = CHI11
15581 CCANO32 = ZERO
15582 CKNO3 = MAX (CHI13 - PSI13, ZERO)
15583 CKCL = MAX (CHI14 - PSI14, ZERO)
15584 CMGNO32 = ZERO
15585 CMGCL2 = ZERO
15586 CCACL2 = ZERO
15587 !C
15588 !C *** NH4Cl(s) calculations
15589 !C
15590 A3 = XK6 /(R*TEMP*R*TEMP)
15591 IF (GNH3*GHCL.GT.A3) THEN
15592 DELT = MIN(GNH3, GHCL)
15593 BB = -(GNH3+GHCL)
15594 CC = GNH3*GHCL-A3
15595 DD = BB*BB - 4.D0*CC
15596 PSI31 = 0.5D0*(-BB + SQRT(DD))
15597 PSI32 = 0.5D0*(-BB - SQRT(DD))
15598 IF (DELT-PSI31.GT.ZERO .AND. PSI31.GT.ZERO) THEN
15599 PSI3 = PSI31
15600 ELSEIF (DELT-PSI32.GT.ZERO .AND. PSI32.GT.ZERO) THEN
15601 PSI3 = PSI32
15602 ELSE
15603 PSI3 = ZERO
15604 ENDIF
15605 ELSE
15606 PSI3 = ZERO
15607 ENDIF
15608 PSI3 = MAX(MIN(MIN(PSI3,CHI4-PSI4),CHI6-PSI6),ZERO)
15609 !C
15610 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
15611 !C
15612 GNH3 = MAX(GNH3 - PSI3, TINY)
15613 GHCL = MAX(GHCL - PSI3, TINY)
15614 CNH4CL = PSI3
15615 !C
15616 !C *** NH4NO3(s) calculations
15617 !C
15618 A2 = XK10 /(R*TEMP*R*TEMP)
15619 IF (GNH3*GHNO3.GT.A2) THEN
15620 DELT = MIN(GNH3, GHNO3)
15621 BB = -(GNH3+GHNO3)
15622 CC = GNH3*GHNO3-A2
15623 DD = BB*BB - 4.D0*CC
15624 PSI21 = 0.5D0*(-BB + SQRT(DD))
15625 PSI22 = 0.5D0*(-BB - SQRT(DD))
15626 IF (DELT-PSI21.GT.ZERO .AND. PSI21.GT.ZERO) THEN
15627 PSI2 = PSI21
15628 ELSEIF (DELT-PSI22.GT.ZERO .AND. PSI22.GT.ZERO) THEN
15629 PSI2 = PSI22
15630 ELSE
15631 PSI2 = ZERO
15632 ENDIF
15633 ELSE
15634 PSI2 = ZERO
15635 ENDIF
15636 PSI2 = MAX(MIN(MIN(PSI2,CHI4-PSI4-PSI3),CHI5-PSI5),ZERO)
15637 !C
15638 !C *** CALCULATE GAS / SOLID SPECIES (LIQUID IN MOLAL ALREADY) *********
15639 !C
15640 GNH3 = MAX (GNH3 - PSI2, TINY)
15641 GHCL = MAX (GHNO3 - PSI2, TINY)
15642 CNH4NO3 = PSI2
15643 !C
15644 CALL CALCMR2p1 ! Water content
15645 !C
15646 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
15647 !C
15648 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
15649 CALL CALCACT2p1
15650 ELSE
15651 GOTO 20
15652 ENDIF
15653 10 CONTINUE
15654 !C
15655 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
15656 !C
15657 !C20 FUNCP2A = MOLAL(3)*MOLAL(4)/GHCL/GNH3/A6/A4 - ONE
15658 20 FUNCP2A2p1 = MOLAL(1)*MOLAL(4)/GHCL/A6 - ONE
15659 !C
15660 RETURN
15661 !C
15662 !C *** END OF FUNCTION FUNCP2A *******************************************
15663 !C
15664 END
15667 !C=======================================================================
15668 !C
15669 !C *** ISORROPIA CODE II
15670 !C *** SUBROUTINE CALCP1
15671 !C *** CASE P1
15672 !C
15673 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15674 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
15675 !C 2. SOLID AEROSOL ONLY
15676 !C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4,
15677 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
15678 !C
15679 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
15680 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
15681 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCP1A)
15682 !C
15683 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
15684 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15685 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
15686 !C
15687 !C=======================================================================
15688 !C
15689 SUBROUTINE CALCP12p1
15690 INCLUDE 'module_isrpia_inc.F'
15691 EXTERNAL CALCP1A2p1, CALCP2A2p1
15692 !C
15693 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
15694 !C
15695 IF (RH.LT.DRMP1) THEN
15696 SCASE = 'P1 ; SUBCASE 1'
15697 CALL CALCP1A2p1 ! SOLID PHASE ONLY POSSIBLE
15698 SCASE = 'P1 ; SUBCASE 1'
15699 ELSE
15700 SCASE = 'P1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
15701 CALL CALCMDRH22p1 (RH, DRMP1, DRCACL2, CALCP1A2p1, CALCP2A2p1)
15702 SCASE = 'P1 ; SUBCASE 2'
15703 ENDIF
15704 !C
15705 !C
15706 RETURN
15707 !C
15708 !C *** END OF SUBROUTINE CALCP1 ******************************************
15709 !C
15710 END
15711 !C
15712 !C=======================================================================
15713 !C
15714 !C *** ISORROPIA CODE II
15715 !C *** SUBROUTINE CALCP1A
15716 !C *** CASE P1A
15717 !C
15718 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15719 !C 1. SULFATE POOR (SULRAT > 2.0) ; Rcr+Na >= 2.0 ; Rcr > 2)
15720 !C 2. SOLID AEROSOL ONLY
15721 !C 3. SOLIDS POSSIBLE : CaSO4, CA(NO3)2, CACL2, K2SO4, KNO3, KCL, MGSO4,
15722 !C MG(NO3)2, MGCL2, NANO3, NACL, NH4NO3, NH4CL
15723 !C
15724 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
15725 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15726 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
15727 !C
15728 !C=======================================================================
15730 SUBROUTINE CALCP1A2p1
15731 INCLUDE 'module_isrpia_inc.F'
15732 DOUBLE PRECISION LAMDA, LAMDA1, LAMDA2, KAPA, KAPA1, KAPA2, NAFR, &
15733 NO3FR
15734 !C
15735 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
15736 !C
15737 CCASO4 = MIN (W(2), W(6)) !SOLID CASO4
15738 CAFR = MAX (W(6) - CCASO4, ZERO)
15739 SO4FR = MAX (W(2) - CCASO4, ZERO)
15740 CK2SO4 = MIN (SO4FR, 0.5D0*W(7)) !SOLID K2SO4
15741 FRK = MAX (W(7) - 2.D0*CK2SO4, ZERO)
15742 SO4FR = MAX (SO4FR - CK2SO4, ZERO)
15743 CMGSO4 = SO4FR !SOLID MGSO4
15744 FRMG = MAX (W(8) - CMGSO4, ZERO)
15745 CNACL = MIN (W(1), W(5)) !SOLID NACL
15746 NAFR = MAX (W(1) - CNACL, ZERO)
15747 CLFR = MAX (W(5) - CNACL, ZERO)
15748 CCANO32 = MIN (CAFR, 0.5D0*W(4)) !SOLID CA(NO3)2
15749 CAFR = MAX (CAFR - CCANO32, ZERO)
15750 NO3FR = MAX (W(4) - 2.D0*CCANO32, ZERO)
15751 CCACL2 = MIN (CAFR, 0.5D0*CLFR) !SOLID CACL2
15752 CAFR = MAX (CAFR - CCACL2, ZERO)
15753 CLFR = MAX (CLFR - 2.D0*CCACL2, ZERO)
15754 CMGNO32 = MIN (FRMG, 0.5D0*NO3FR) !SOLID MG(NO3)2
15755 FRMG = MAX (FRMG - CMGNO32, ZERO)
15756 NO3FR = MAX (NO3FR - 2.D0*CMGNO32, ZERO)
15757 CMGCL2 = MIN (FRMG, 0.5D0*CLFR) !SOLID MGCL2
15758 FRMG = MAX (FRMG - CMGCL2, ZERO)
15759 CLFR = MAX (CLFR - 2.D0*CMGCL2, ZERO)
15760 CNANO3 = MIN (NAFR, NO3FR) !SOLID NANO3
15761 NAFR = MAX (NAFR - CNANO3, ZERO)
15762 NO3FR = MAX (NO3FR - CNANO3, ZERO)
15763 CKCL = MIN (FRK, CLFR) !SOLID KCL
15764 FRK = MAX (FRK - CKCL, ZERO)
15765 CLFR = MAX (CLFR - CKCL, ZERO)
15766 CKNO3 = MIN (FRK, NO3FR) !SOLID KNO3
15767 FRK = MAX (FRK - CKNO3, ZERO)
15768 NO3FR = MAX (NO3FR - CKNO3, ZERO)
15769 !C
15770 !C *** CALCULATE VOLATILE SPECIES **************************************
15771 !C
15772 ALF = W(3) ! FREE NH3
15773 BET = CLFR ! FREE CL
15774 GAM = NO3FR ! FREE NO3
15775 !C
15776 RTSQ = R*TEMP*R*TEMP
15777 A1 = XK6/RTSQ
15778 A2 = XK10/RTSQ
15779 !C
15780 THETA1 = GAM - BET*(A2/A1)
15781 THETA2 = A2/A1
15782 !C
15783 !C QUADRATIC EQUATION SOLUTION
15784 !C
15785 BB = (THETA1-ALF-BET*(ONE+THETA2))/(ONE+THETA2)
15786 CC = (ALF*BET-A1-BET*THETA1)/(ONE+THETA2)
15787 DD = BB*BB - 4.0D0*CC
15788 IF (DD.LT.ZERO) GOTO 100 ! Solve each reaction seperately
15789 !C
15790 !C TWO ROOTS FOR KAPA, CHECK AND SEE IF ANY VALID
15791 !C
15792 SQDD = SQRT(DD)
15793 KAPA1 = 0.5D0*(-BB+SQDD)
15794 KAPA2 = 0.5D0*(-BB-SQDD)
15795 LAMDA1 = THETA1 + THETA2*KAPA1
15796 LAMDA2 = THETA1 + THETA2*KAPA2
15797 !C
15798 IF (KAPA1.GE.ZERO .AND. LAMDA1.GE.ZERO) THEN
15799 IF (ALF-KAPA1-LAMDA1.GE.ZERO .AND. &
15800 BET-KAPA1.GE.ZERO .AND. GAM-LAMDA1.GE.ZERO) THEN
15801 KAPA = KAPA1
15802 LAMDA= LAMDA1
15803 GOTO 200
15804 ENDIF
15805 ENDIF
15806 !C
15807 IF (KAPA2.GE.ZERO .AND. LAMDA2.GE.ZERO) THEN
15808 IF (ALF-KAPA2-LAMDA2.GE.ZERO .AND. &
15809 BET-KAPA2.GE.ZERO .AND. GAM-LAMDA2.GE.ZERO) THEN
15810 KAPA = KAPA2
15811 LAMDA= LAMDA2
15812 GOTO 200
15813 ENDIF
15814 ENDIF
15815 !C
15816 !C SEPERATE SOLUTION OF NH4CL & NH4NO3 EQUILIBRIA
15817 !C
15818 100 KAPA = ZERO
15819 LAMDA = ZERO
15820 DD1 = (ALF+BET)*(ALF+BET) - 4.0D0*(ALF*BET-A1)
15821 DD2 = (ALF+GAM)*(ALF+GAM) - 4.0D0*(ALF*GAM-A2)
15822 !C
15823 !C NH4CL EQUILIBRIUM
15824 !C
15825 IF (DD1.GE.ZERO) THEN
15826 SQDD1 = SQRT(DD1)
15827 KAPA1 = 0.5D0*(ALF+BET + SQDD1)
15828 KAPA2 = 0.5D0*(ALF+BET - SQDD1)
15829 !C
15830 IF (KAPA1.GE.ZERO .AND. KAPA1.LE.MIN(ALF,BET)) THEN
15831 KAPA = KAPA1
15832 ELSE IF (KAPA2.GE.ZERO .AND. KAPA2.LE.MIN(ALF,BET)) THEN
15833 KAPA = KAPA2
15834 ELSE
15835 KAPA = ZERO
15836 ENDIF
15837 ENDIF
15838 !C
15839 !C NH4NO3 EQUILIBRIUM
15840 !C
15841 IF (DD2.GE.ZERO) THEN
15842 SQDD2 = SQRT(DD2)
15843 LAMDA1= 0.5D0*(ALF+GAM + SQDD2)
15844 LAMDA2= 0.5D0*(ALF+GAM - SQDD2)
15845 !C
15846 IF (LAMDA1.GE.ZERO .AND. LAMDA1.LE.MIN(ALF,GAM)) THEN
15847 LAMDA = LAMDA1
15848 ELSE IF (LAMDA2.GE.ZERO .AND. LAMDA2.LE.MIN(ALF,GAM)) THEN
15849 LAMDA = LAMDA2
15850 ELSE
15851 LAMDA = ZERO
15852 ENDIF
15853 ENDIF
15854 !C
15855 !C IF BOTH KAPA, LAMDA ARE > 0, THEN APPLY EXISTANCE CRITERION
15856 !C
15857 IF (KAPA.GT.ZERO .AND. LAMDA.GT.ZERO) THEN
15858 IF (BET .LT. LAMDA/THETA1) THEN
15859 KAPA = ZERO
15860 ELSE
15861 LAMDA= ZERO
15862 ENDIF
15863 ENDIF
15864 !C
15865 !C *** CALCULATE COMPOSITION OF VOLATILE SPECIES ***********************
15866 !C
15867 200 CONTINUE
15868 CNH4NO3 = LAMDA
15869 CNH4CL = KAPA
15870 !C
15871 GNH3 = ALF - KAPA - LAMDA
15872 GHNO3 = GAM - LAMDA
15873 GHCL = BET - KAPA
15874 !C
15875 RETURN
15876 !C
15877 !C *** END OF SUBROUTINE CALCP1A *****************************************
15878 !C
15879 END
15880 !C
15881 !C======================================================================
15882 !C
15883 !C *** ISORROPIA CODE
15884 !C *** SUBROUTINE CALCL9
15885 !C *** CASE L9
15886 !C
15887 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15888 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
15889 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
15890 !C 3. SOLIDS POSSIBLE : CASO4
15891 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4, K2SO4
15892 !C
15893 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
15894 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
15895 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
15896 !C
15897 !C=======================================================================
15898 !C
15899 SUBROUTINE CALCL92p1
15900 INCLUDE 'module_isrpia_inc.F'
15901 DOUBLE PRECISION LAMDA
15902 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
15903 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
15904 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
15905 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
15906 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
15907 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
15908 !C
15909 !C *** FIND DRY COMPOSITION **********************************************
15910 !C
15911 CALL CALCL1A2p1
15912 !C
15913 !C *** SETUP PARAMETERS ************************************************
15914 !C
15915 CHI1 = CNH4HS4 ! Save from CALCL1 run
15916 CHI2 = CLC
15917 CHI3 = CNAHSO4
15918 CHI4 = CNA2SO4
15919 CHI5 = CNH42S4
15920 CHI6 = CK2SO4
15921 CHI7 = CMGSO4
15922 CHI8 = CKHSO4
15923 !C
15924 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
15925 PSI2 = CLC
15926 PSI3 = CNAHSO4
15927 PSI4 = CNA2SO4
15928 PSI5 = CNH42S4
15929 PSI6 = CK2SO4
15930 PSI7 = CMGSO4
15931 PSI8 = CKHSO4
15932 !C
15933 CALAOU = .TRUE. ! Outer loop activity calculation flag
15934 FRST = .TRUE.
15935 CALAIN = .TRUE.
15936 !C
15937 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
15938 !C
15939 DO 10 I=1,NSWEEP
15940 !C
15941 A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.
15942 !C
15943 !C CALCULATE DISSOCIATION QUANTITIES
15944 !C
15945 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
15946 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
15947 DD = MAX(BB*BB - 4.D0*CC, ZERO)
15948 LAMDA= 0.5D0*(-BB + SQRT(DD))
15949 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
15950 !C
15951 !C *** CALCULATE SPECIATION ********************************************
15952 !C
15953 MOLAL(1) = LAMDA ! HI
15954 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
15955 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
15956 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
15957 MOLAL(6) = PSI2 + PSI3 + PSI1 + PSI8 - LAMDA ! HSO4I
15958 MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI
15959 MOLAL(10)= PSI7 ! MGI
15960 !C
15961 CLC = ZERO
15962 CNAHSO4 = ZERO
15963 CNA2SO4 = ZERO
15964 CNH42S4 = ZERO
15965 CNH4HS4 = ZERO
15966 CK2SO4 = ZERO
15967 CMGSO4 = ZERO
15968 CKHSO4 = ZERO
15969 !C
15970 CALL CALCMR2p1 ! Water content
15972 !C
15973 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
15974 !C
15975 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
15976 CALL CALCACT2p1
15977 ELSE
15978 GOTO 20
15979 ENDIF
15980 10 CONTINUE
15981 !C
15982 20 RETURN
15983 !C
15984 !C *** END OF SUBROUTINE CALCL9 *****************************************
15985 !C
15986 END
15987 !C=======================================================================
15988 !C
15989 !C *** ISORROPIA CODE
15990 !C *** SUBROUTINE CALCL8
15991 !C *** CASE L8
15992 !C
15993 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
15994 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
15995 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
15996 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4
15997 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4
15998 !C
15999 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16000 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16001 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16002 !C
16003 !C=======================================================================
16004 !C
16005 SUBROUTINE CALCL82p1
16006 INCLUDE 'module_isrpia_inc.F'
16007 DOUBLE PRECISION LAMDA
16008 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16009 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16010 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16011 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16012 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16013 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16014 !C
16015 !C *** FIND DRY COMPOSITION **********************************************
16016 !C
16017 CALL CALCL1A2p1
16018 !C
16019 !C *** SETUP PARAMETERS ************************************************
16020 !C
16021 CHI1 = CNH4HS4 ! Save from CALCL1 run
16022 CHI2 = CLC
16023 CHI3 = CNAHSO4
16024 CHI4 = CNA2SO4
16025 CHI5 = CNH42S4
16026 CHI6 = CK2SO4
16027 CHI7 = CMGSO4
16028 CHI8 = CKHSO4
16029 !C
16030 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
16031 PSI2 = CLC
16032 PSI3 = CNAHSO4
16033 PSI4 = CNA2SO4
16034 PSI5 = CNH42S4
16035 PSI6 = ZERO
16036 PSI7 = CMGSO4
16037 PSI8 = CKHSO4
16038 !C
16039 CALAOU = .TRUE. ! Outer loop activity calculation flag
16040 PSI6LO = ZERO ! Low limit
16041 PSI6HI = CHI6 ! High limit
16042 !C
16043 !C *** INITIAL VALUES FOR BISECTION ************************************
16044 !C
16045 IF (CHI6.LE.TINY) THEN
16046 Y1 = FUNCL82p1 (ZERO)
16047 GOTO 50
16048 ENDIF
16049 !C
16050 X1 = PSI6HI
16051 Y1 = FUNCL82p1 (X1)
16052 YHI= Y1 ! Save Y-value at HI position
16053 !C
16054 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 *********
16055 !C
16056 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
16057 !C
16058 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
16059 !C
16060 DX = (PSI6HI-PSI6LO)/FLOAT(NDIV)
16061 DO 10 I=1,NDIV
16062 X2 = X1-DX
16063 Y2 = FUNCL82p1 (X2)
16064 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
16065 X1 = X2
16066 Y1 = Y2
16067 10 CONTINUE
16068 !C
16069 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4
16070 !C
16071 YLO= Y1 ! Save Y-value at Hi position
16072 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
16073 Y3 = FUNCL82p1 (ZERO)
16074 GOTO 50
16075 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
16076 GOTO 50
16077 ELSE
16078 CALL PUSHERR2p1 (0001, 'CALCL8') ! WARNING ERROR: NO SOLUTION
16079 GOTO 50
16080 ENDIF
16081 !C *** PERFORM BISECTION ***********************************************
16082 !C
16083 20 DO 30 I=1,MAXIT
16084 X3 = 0.5*(X1+X2)
16085 Y3 = FUNCL82p1 (X3)
16086 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
16087 Y2 = Y3
16088 X2 = X3
16089 ELSE
16090 Y1 = Y3
16091 X1 = X3
16092 ENDIF
16093 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
16094 30 CONTINUE
16095 CALL PUSHERR2p1 (0002, 'CALCL8') ! WARNING ERROR: NO CONVERGENCE
16096 !C
16097 !C *** CONVERGED ; RETURN **********************************************
16098 !C
16099 40 X3 = 0.5*(X1+X2)
16100 Y3 = FUNCL82p1 (X3)
16101 !C
16102 50 RETURN
16103 !C
16104 !C *** END OF SUBROUTINE CALCL8 *****************************************
16105 !C
16106 END
16107 !C
16108 !C=======================================================================
16109 !C
16110 !C *** ISORROPIA CODE II
16111 !C *** FUNCTION FUNCL8
16112 !C *** CASE L8
16113 !C
16114 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16115 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
16116 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16117 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4
16118 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4, NA2SO4
16119 !C
16120 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
16121 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16122 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16123 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16124 !C
16125 !C=======================================================================
16126 !C
16127 DOUBLE PRECISION FUNCTION FUNCL82p1 (P6)
16128 INCLUDE 'module_isrpia_inc.F'
16129 DOUBLE PRECISION LAMDA
16130 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16131 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16132 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16133 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16134 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16135 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16136 !C
16137 !C *** SETUP PARAMETERS ************************************************
16138 !C
16139 PSI6 = P6
16140 !C
16141 !C *** SETUP PARAMETERS ************************************************
16142 !C
16143 FRST = .TRUE.
16144 CALAIN = .TRUE.
16145 !C
16146 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
16147 !C
16148 DO 10 I=1,NSWEEP
16149 !C
16150 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
16151 !C
16152 !C CALCULATE DISSOCIATION QUANTITIES
16153 !C
16154 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
16155 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
16156 DD = BB*BB - 4.D0*CC
16157 LAMDA= 0.5D0*(-BB + SQRT(DD))
16158 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
16159 !C
16160 !C *** CALCULATE SPECIATION ********************************************
16161 !C
16162 MOLAL(1) = LAMDA ! HI
16163 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
16164 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
16165 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
16166 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
16167 MOLAL(9) = PSI8 + 2.0*PSI6 ! KI
16168 MOLAL(10)= PSI7 ! MGI
16169 !C
16170 CLC = ZERO
16171 CNAHSO4 = ZERO
16172 CNA2SO4 = ZERO
16173 CNH42S4 = ZERO
16174 CNH4HS4 = ZERO
16175 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
16176 CMGSO4 = ZERO
16177 CKHSO4 = ZERO
16178 CALL CALCMR2p1 ! Water content
16179 !C
16180 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
16181 !C
16182 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
16183 CALL CALCACT2p1
16184 ELSE
16185 GOTO 20
16186 ENDIF
16187 10 CONTINUE
16188 !C
16189 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
16190 !C
16191 20 A6 = XK17*(WATER/GAMA(17))**3.0
16192 FUNCL82p1 = MOLAL(9)*MOLAL(9)*MOLAL(5)/A6 - ONE
16193 RETURN
16194 !C
16195 !C *** END OF FUNCTION FUNCL8 ****************************************
16196 !C
16197 END
16198 !C
16199 !C=======================================================================
16200 !C
16201 !C *** ISORROPIA CODE II
16202 !C *** SUBROUTINE CALCL7
16203 !C *** CASE L7
16204 !C
16205 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16206 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
16207 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16208 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4
16209 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4
16210 !C
16211 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16212 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16213 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16214 !C
16215 !C=======================================================================
16216 !C
16217 SUBROUTINE CALCL72p1
16218 INCLUDE 'module_isrpia_inc.F'
16219 DOUBLE PRECISION LAMDA
16220 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16221 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16222 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16223 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16224 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16225 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16226 !C
16227 !C *** FIND DRY COMPOSITION **********************************************
16228 !C
16229 CALL CALCL1A2p1
16230 !C
16231 !C *** SETUP PARAMETERS ************************************************
16232 !C
16233 CHI1 = CNH4HS4 ! Save from CALCL1 run
16234 CHI2 = CLC
16235 CHI3 = CNAHSO4
16236 CHI4 = CNA2SO4
16237 CHI5 = CNH42S4
16238 CHI6 = CK2SO4
16239 CHI7 = CMGSO4
16240 CHI8 = CKHSO4
16241 !C
16242 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
16243 PSI2 = CLC
16244 PSI3 = CNAHSO4
16245 PSI4 = ZERO
16246 PSI5 = CNH42S4
16247 PSI6 = ZERO
16248 PSI7 = CMGSO4
16249 PSI8 = CKHSO4
16250 !C
16251 CALAOU = .TRUE. ! Outer loop activity calculation flag
16252 PSI4LO = ZERO ! Low limit
16253 PSI4HI = CHI4 ! High limit
16254 !C
16255 !C *** INITIAL VALUES FOR BISECTION ************************************
16256 !C
16257 IF (CHI4.LE.TINY) THEN
16258 Y1 = FUNCL72p1 (ZERO)
16259 GOTO 50
16260 ENDIF
16261 !C
16262 X1 = PSI4HI
16263 Y1 = FUNCL72p1 (X1)
16264 YHI= Y1 ! Save Y-value at HI position
16265 !C
16266 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 *********
16267 !C
16268 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
16269 !C
16270 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
16271 !C
16272 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
16273 DO 10 I=1,NDIV
16274 X2 = X1-DX
16275 Y2 = FUNCL72p1 (X2)
16276 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
16277 X1 = X2
16278 Y1 = Y2
16279 10 CONTINUE
16280 !C
16281 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4
16282 !C
16283 YLO= Y1 ! Save Y-value at Hi position
16284 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
16285 Y3 = FUNCL72p1 (ZERO)
16286 GOTO 50
16287 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
16288 GOTO 50
16289 ELSE
16290 CALL PUSHERR2p1 (0001, 'CALCL7') ! WARNING ERROR: NO SOLUTION
16291 GOTO 50
16292 ENDIF
16293 !C *** PERFORM BISECTION ***********************************************
16294 !C
16295 20 DO 30 I=1,MAXIT
16296 X3 = 0.5*(X1+X2)
16297 Y3 = FUNCL72p1 (X3)
16298 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
16299 Y2 = Y3
16300 X2 = X3
16301 ELSE
16302 Y1 = Y3
16303 X1 = X3
16304 ENDIF
16305 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
16306 30 CONTINUE
16307 CALL PUSHERR2p1 (0002, 'CALCL7') ! WARNING ERROR: NO CONVERGENCE
16308 !C
16309 !C *** CONVERGED ; RETURN **********************************************
16310 !C
16311 40 X3 = 0.5*(X1+X2)
16312 Y3 = FUNCL72p1 (X3)
16313 !C
16314 50 RETURN
16315 !C
16316 !C *** END OF SUBROUTINE CALCL7 *****************************************
16317 !C
16318 END
16319 !C
16320 !C=======================================================================
16321 !C
16322 !C *** ISORROPIA CODE II
16323 !C *** FUNCTION FUNCL7
16324 !C *** CASE L7
16325 !C
16326 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16327 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
16328 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16329 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, NA2SO4
16330 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4, MGSO4
16331 !C
16332 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
16333 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16334 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16335 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16336 !C
16337 !C=======================================================================
16338 !C
16339 DOUBLE PRECISION FUNCTION FUNCL72p1 (P4)
16340 INCLUDE 'module_isrpia_inc.F'
16341 DOUBLE PRECISION LAMDA
16342 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16343 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16344 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16345 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16346 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16347 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16348 !C
16349 !C *** SETUP PARAMETERS ************************************************
16350 !C
16351 PSI4 = P4
16352 !C
16353 !C *** SETUP PARAMETERS ************************************************
16354 !C
16355 FRST = .TRUE.
16356 CALAIN = .TRUE.
16357 !C
16358 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
16359 !C
16360 DO 10 I=1,NSWEEP
16361 !C
16362 A4 = XK5 *(WATER/GAMA(2))**3.0
16363 A6 = XK17*(WATER/GAMA(17))**3.0
16364 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
16365 !C
16366 !C CALCULATE DISSOCIATION QUANTITIES
16367 !C
16368 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
16369 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
16370 !C
16371 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
16372 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
16373 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
16374 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
16375 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
16376 IF (ISLV.EQ.0) THEN
16377 PSI6 = MIN (PSI6, CHI6)
16378 ELSE
16379 PSI6 = ZERO
16380 ENDIF
16381 ENDIF
16382 !C
16383 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
16384 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
16385 DD = BB*BB - 4.D0*CC
16386 LAMDA= 0.5D0*(-BB + SQRT(DD))
16387 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
16388 !C
16389 !C
16390 !C *** CALCULATE SPECIATION ********************************************
16391 !C
16392 MOLAL(1) = LAMDA ! HI
16393 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
16394 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
16395 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
16396 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
16397 MOLAL(9) = PSI8 + 2.0*PSI6 ! KI
16398 MOLAL(10)= PSI7 ! MGI
16399 !C
16400 CLC = ZERO
16401 CNAHSO4 = ZERO
16402 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
16403 CNH42S4 = ZERO
16404 CNH4HS4 = ZERO
16405 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
16406 CMGSO4 = ZERO
16407 CKHSO4 = ZERO
16408 CALL CALCMR2p1 ! Water content
16409 !C
16410 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
16411 !C
16412 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
16413 CALL CALCACT2p1
16414 ELSE
16415 GOTO 20
16416 ENDIF
16417 10 CONTINUE
16418 !C
16419 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
16420 !C
16421 20 A4 = XK5 *(WATER/GAMA(2))**3.0
16422 FUNCL72p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
16423 RETURN
16424 !C
16425 !C *** END OF FUNCTION FUNCL7 ****************************************
16426 !C
16427 END
16428 !C
16429 !C
16430 !C=======================================================================
16431 !C
16432 !C *** ISORROPIA CODE II
16433 !C *** SUBROUTINE CALCL6
16434 !C *** CASE L6
16435 !C
16436 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16437 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
16438 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16439 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, NA2SO4
16440 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4, KHSO4
16441 !C
16442 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16443 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16444 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16445 !C
16446 !C=======================================================================
16447 !C
16448 SUBROUTINE CALCL62p1
16449 INCLUDE 'module_isrpia_inc.F'
16450 DOUBLE PRECISION LAMDA
16451 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16452 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16453 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16454 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16455 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16456 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16457 !C
16458 !C *** FIND DRY COMPOSITION **********************************************
16459 !C
16460 CALL CALCL1A2p1
16461 !C
16462 !C *** SETUP PARAMETERS ************************************************
16463 !C
16464 CHI1 = CNH4HS4 ! Save from CALCL1 run
16465 CHI2 = CLC
16466 CHI3 = CNAHSO4
16467 CHI4 = CNA2SO4
16468 CHI5 = CNH42S4
16469 CHI6 = CK2SO4
16470 CHI7 = CMGSO4
16471 CHI8 = CKHSO4
16472 !C
16473 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
16474 PSI2 = CLC
16475 PSI3 = CNAHSO4
16476 PSI4 = ZERO
16477 PSI5 = CNH42S4
16478 PSI6 = ZERO
16479 PSI7 = ZERO
16480 PSI8 = CKHSO4
16481 !C
16482 CALAOU = .TRUE. ! Outer loop activity calculation flag
16483 PSI4LO = ZERO ! Low limit
16484 PSI4HI = CHI4 ! High limit
16485 !C
16486 !C *** INITIAL VALUES FOR BISECTION ************************************
16487 !C
16488 IF (CHI4.LE.TINY) THEN
16489 Y1 = FUNCL62p1 (ZERO)
16490 GOTO 50
16491 ENDIF
16492 !C
16493 X1 = PSI4HI
16494 Y1 = FUNCL62p1 (X1)
16495 YHI= Y1 ! Save Y-value at HI position
16496 !C
16497 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH K2SO4 *********
16498 !C
16499 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
16500 !C
16501 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
16502 !C
16503 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
16504 DO 10 I=1,NDIV
16505 X2 = X1-DX
16506 Y2 = FUNCL62p1 (X2)
16507 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
16508 X1 = X2
16509 Y1 = Y2
16510 10 CONTINUE
16511 !C
16512 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH K2SO4
16513 !C
16514 YLO= Y1 ! Save Y-value at Hi position
16515 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
16516 Y3 = FUNCL62p1 (ZERO)
16517 GOTO 50
16518 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
16519 GOTO 50
16520 ELSE
16521 CALL PUSHERR2p1 (0001, 'CALCL6') ! WARNING ERROR: NO SOLUTION
16522 GOTO 50
16523 ENDIF
16524 !C
16525 !C *** PERFORM BISECTION ***********************************************
16526 !C
16527 20 DO 30 I=1,MAXIT
16528 X3 = 0.5*(X1+X2)
16529 Y3 = FUNCL62p1 (X3)
16530 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
16531 Y2 = Y3
16532 X2 = X3
16533 ELSE
16534 Y1 = Y3
16535 X1 = X3
16536 ENDIF
16537 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
16538 30 CONTINUE
16539 CALL PUSHERR2p1 (0002, 'CALCL6') ! WARNING ERROR: NO CONVERGENCE
16540 !C
16541 !C *** CONVERGED ; RETURN **********************************************
16542 !C
16543 40 X3 = 0.5*(X1+X2)
16544 Y3 = FUNCL62p1 (X3)
16545 !C
16546 50 RETURN
16547 !C
16548 !C *** END OF SUBROUTINE CALCL6 *****************************************
16549 !C
16550 END
16551 !C
16552 !C=======================================================================
16553 !C
16554 !C *** ISORROPIA CODE II
16555 !C *** FUNCTION FUNCL6
16556 !C *** CASE L6
16557 !C
16558 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16559 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
16560 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16561 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, NA2SO4
16562 !C
16563 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
16564 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16565 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16566 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16567 !C
16568 !C=======================================================================
16569 !C
16570 DOUBLE PRECISION FUNCTION FUNCL62p1 (P4)
16571 INCLUDE 'module_isrpia_inc.F'
16572 DOUBLE PRECISION LAMDA
16573 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16574 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16575 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16576 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16577 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16578 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16579 !C
16580 !C *** SETUP PARAMETERS ************************************************
16581 !C
16582 PSI4 = P4
16583 !C
16584 !C *** SETUP PARAMETERS ************************************************
16585 !C
16586 FRST = .TRUE.
16587 CALAIN = .TRUE.
16588 !C
16589 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
16590 !C
16591 DO 10 I=1,NSWEEP
16592 !C
16593 A4 = XK5*(WATER/GAMA(2))**3.0
16594 A6 = XK17*(WATER/GAMA(17))**3.0
16595 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
16596 !C
16597 !C CALCULATE DISSOCIATION QUANTITIES
16598 !C
16599 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
16600 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
16601 !C
16602 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
16603 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
16604 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
16605 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
16606 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
16607 IF (ISLV.EQ.0) THEN
16608 PSI6 = MIN (PSI6, CHI6)
16609 ELSE
16610 PSI6 = ZERO
16611 ENDIF
16612 ENDIF
16613 !C
16614 PSI7 = CHI7
16615 !C
16616 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
16617 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
16618 DD = BB*BB - 4.D0*CC
16619 LAMDA= 0.5D0*(-BB + SQRT(DD))
16620 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
16621 !C
16622 !C *** CALCULATE SPECIATION ********************************************
16623 !C
16624 MOLAL(1) = LAMDA ! HI
16625 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
16626 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
16627 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
16628 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
16629 MOLAL(9) = PSI8 + 2.0*PSI6 ! KI
16630 MOLAL(10)= PSI7 ! MGI
16631 !C
16632 CLC = ZERO
16633 CNAHSO4 = ZERO
16634 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
16635 CNH42S4 = ZERO
16636 CNH4HS4 = ZERO
16637 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
16638 CMGSO4 = ZERO
16639 CKHSO4 = ZERO
16640 CALL CALCMR2p1 ! Water content
16641 !C
16642 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
16643 !C
16644 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
16645 CALL CALCACT2p1
16646 ELSE
16647 GOTO 20
16648 ENDIF
16649 10 CONTINUE
16650 !C
16651 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
16652 !C
16653 20 A4 = XK5 *(WATER/GAMA(2))**3.0
16654 FUNCL62p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
16655 RETURN
16656 !C
16657 !C *** END OF FUNCTION FUNCL6 ****************************************
16658 !C
16659 END
16660 !C
16661 !C=======================================================================
16662 !C
16663 !C *** ISORROPIA CODE II
16664 !C *** SUBROUTINE CALCL5
16665 !C *** CASE L5
16666 !C
16667 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16668 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
16669 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16670 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4
16671 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4
16672 !C
16673 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16674 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16675 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16676 !C
16677 !C=======================================================================
16678 !C
16679 SUBROUTINE CALCL52p1
16680 INCLUDE 'module_isrpia_inc.F'
16681 DOUBLE PRECISION LAMDA
16682 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16683 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16684 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16685 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16686 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16687 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16688 !C
16689 !C *** FIND DRY COMPOSITION **********************************************
16690 !C
16691 CALL CALCL1A2p1
16692 !C
16693 !C *** SETUP PARAMETERS ************************************************
16694 !C
16695 CHI1 = CNH4HS4 ! Save from CALCL1 run
16696 CHI2 = CLC
16697 CHI3 = CNAHSO4
16698 CHI4 = CNA2SO4
16699 CHI5 = CNH42S4
16700 CHI6 = CK2SO4
16701 CHI7 = CMGSO4
16702 CHI8 = CKHSO4
16703 !C
16704 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
16705 PSI2 = CLC
16706 PSI3 = CNAHSO4
16707 PSI4 = ZERO
16708 PSI5 = CNH42S4
16709 PSI6 = ZERO
16710 PSI7 = ZERO
16711 PSI8 = ZERO
16712 !C
16713 CALAOU = .TRUE. ! Outer loop activity calculation flag
16714 PSI4LO = ZERO ! Low limit
16715 PSI4HI = CHI4 ! High limit
16717 !C
16718 !C *** INITIAL VALUES FOR BISECTION ************************************
16719 !C
16720 IF (CHI4.LE.TINY) THEN
16721 Y1 = FUNCL52p1 (ZERO)
16722 GOTO 50
16723 ENDIF
16724 !C
16725 X1 = PSI4HI
16726 Y1 = FUNCL52p1 (X1)
16727 YHI= Y1 ! Save Y-value at HI position
16728 !C
16729 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *********
16730 !C
16731 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
16732 !C
16733 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
16734 !C
16736 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
16737 DO 10 I=1,NDIV
16738 X2 = MAX(X1-DX, PSI4LO)
16739 Y2 = FUNCL52p1 (X2)
16740 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
16741 X1 = X2
16742 Y1 = Y2
16743 10 CONTINUE
16744 !C
16745 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4
16746 !C
16747 YLO= Y1 ! Save Y-value at Hi position
16748 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
16749 Y3 = FUNCL52p1 (ZERO)
16750 GOTO 50
16751 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
16752 GOTO 50
16753 ELSE
16754 CALL PUSHERR2p1 (0001, 'CALCL5') ! WARNING ERROR: NO SOLUTION
16755 GOTO 50
16756 ENDIF
16757 !C
16758 !C *** PERFORM BISECTION ***********************************************
16759 !C
16760 20 DO 30 I=1,MAXIT
16761 X3 = 0.5*(X1+X2)
16762 Y3 = FUNCL52p1 (X3)
16763 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
16764 Y2 = Y3
16765 X2 = X3
16766 ELSE
16767 Y1 = Y3
16768 X1 = X3
16769 ENDIF
16770 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
16771 30 CONTINUE
16772 CALL PUSHERR2p1 (0002, 'CALCL5') ! WARNING ERROR: NO CONVERGENCE
16773 !C
16774 !C *** CONVERGED ; RETURN **********************************************
16775 !C
16776 40 X3 = 0.5*(X1+X2)
16777 Y3 = FUNCL52p1 (X3)
16778 !C
16779 50 RETURN
16780 !C
16781 !C *** END OF SUBROUTINE CALCL5 *****************************************
16782 !C
16783 END
16784 !C
16785 !C=======================================================================
16786 !C
16787 !C *** ISORROPIA CODE II
16788 !C *** FUNCTION FUNCL5
16789 !C *** CASE L5
16790 !C
16791 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16792 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
16793 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16794 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NA2SO4
16795 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC, (NH4)2SO4
16796 !C
16797 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
16798 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16799 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16800 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16801 !C
16802 !C=======================================================================
16803 !C
16804 DOUBLE PRECISION FUNCTION FUNCL52p1 (P4)
16805 INCLUDE 'module_isrpia_inc.F'
16806 DOUBLE PRECISION LAMDA
16807 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16808 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16809 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16810 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16811 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16812 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16813 !C
16814 !C *** SETUP PARAMETERS ************************************************
16815 !C
16816 PSI4 = P4
16817 !C
16818 !C *** SETUP PARAMETERS ************************************************
16819 !C
16820 FRST = .TRUE.
16821 CALAIN = .TRUE.
16822 !C
16823 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
16824 !C
16825 DO 10 I=1,NSWEEP
16826 !C
16827 A4 = XK5*(WATER/GAMA(2))**3.0
16828 A6 = XK17*(WATER/GAMA(17))**3.0
16829 A8 = XK18*(WATER/GAMA(18))**2.0
16830 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
16831 !C
16832 !C CALCULATE DISSOCIATION QUANTITIES
16833 !C
16834 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
16835 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
16836 !C
16837 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
16838 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
16839 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
16840 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
16841 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
16842 IF (ISLV.EQ.0) THEN
16843 PSI6 = MIN (PSI6, CHI6)
16844 ELSE
16845 PSI6 = ZERO
16846 ENDIF
16847 ENDIF
16848 !C
16849 PSI7 = CHI7
16850 !C
16851 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
16852 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
16853 DD = MAX(BB*BB - 4.D0*CC, ZERO)
16854 LAMDA= 0.5D0*(-BB + SQRT(DD))
16855 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
16856 !C
16857 BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA
16858 CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8
16859 DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO)
16860 PSI8 = 0.5D0*(-BITA + SQRT(DELT))
16861 PSI8 = MIN(MAX (PSI8, ZERO), CHI8)
16862 !C
16863 !C *** CALCULATE SPECIATION ********************************************
16864 !C
16865 MOLAL(1) = LAMDA ! HI
16866 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
16867 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
16868 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
16869 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
16870 MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI
16871 MOLAL(10)= PSI7 ! MGI
16872 !C
16873 CLC = ZERO
16874 CNAHSO4 = ZERO
16875 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
16876 CNH42S4 = ZERO
16877 CNH4HS4 = ZERO
16878 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
16879 CMGSO4 = ZERO
16880 CKHSO4 = MAX(CHI8 - PSI8, ZERO)
16881 !C
16882 CALL CALCMR2p1 ! Water content
16883 !C
16884 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
16885 !C
16887 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
16888 CALL CALCACT2p1
16889 ELSE
16890 GOTO 20
16891 ENDIF
16892 10 CONTINUE
16893 !C
16894 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
16895 !C
16896 20 A4 = XK5 *(WATER/GAMA(2))**3.0
16897 FUNCL52p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
16898 !C
16899 RETURN
16900 !C
16901 !C *** END OF FUNCTION FUNCL5 ****************************************
16902 !C
16903 END
16904 !C
16905 !C=======================================================================
16906 !C
16907 !C *** ISORROPIA CODE II
16908 !C *** SUBROUTINE CALCL4
16909 !C *** CASE L4
16910 !C
16911 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
16912 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
16913 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
16914 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4
16915 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC
16916 !C
16917 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
16918 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
16919 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
16920 !C
16921 !C=======================================================================
16922 !C
16923 SUBROUTINE CALCL42p1
16924 INCLUDE 'module_isrpia_inc.F'
16925 DOUBLE PRECISION LAMDA
16926 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
16927 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
16928 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
16929 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
16930 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
16931 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
16932 !C
16933 !C *** FIND DRY COMPOSITION **********************************************
16934 !C
16935 CALL CALCL1A2p1
16936 !C
16937 !C *** SETUP PARAMETERS ************************************************
16938 !C
16939 CHI1 = CNH4HS4 ! Save from CALCL1 run
16940 CHI2 = CLC
16941 CHI3 = CNAHSO4
16942 CHI4 = CNA2SO4
16943 CHI5 = CNH42S4
16944 CHI6 = CK2SO4
16945 CHI7 = CMGSO4
16946 CHI8 = CKHSO4
16947 !C
16948 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
16949 PSI2 = CLC
16950 PSI3 = CNAHSO4
16951 PSI4 = ZERO
16952 PSI5 = ZERO
16953 PSI6 = ZERO
16954 PSI7 = ZERO
16955 PSI8 = ZERO
16956 !C
16957 CALAOU = .TRUE. ! Outer loop activity calculation flag
16958 PSI4LO = ZERO ! Low limit
16959 PSI4HI = CHI4 ! High limit
16960 !C
16961 IF (CHI4.LE.TINY) THEN
16962 Y1 = FUNCL42p1 (ZERO)
16963 GOTO 50
16964 ENDIF
16965 !C
16966 !C *** INITIAL VALUES FOR BISECTION ************************************
16967 !C
16968 X1 = PSI4HI
16969 Y1 = FUNCL42p1 (X1)
16970 YHI= Y1 ! Save Y-value at HI position
16971 !C
16972 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *********
16973 !C
16974 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
16975 !C
16976 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
16977 !C
16978 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
16979 DO 10 I=1,NDIV
16980 X2 = X1-DX
16981 Y2 = FUNCL42p1 (X2)
16982 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
16983 X1 = X2
16984 Y1 = Y2
16985 10 CONTINUE
16986 !C
16987 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4 **
16988 !C
16989 YLO= Y1 ! Save Y-value at Hi position
16990 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
16991 Y3 = FUNCL42p1 (ZERO)
16992 GOTO 50
16993 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
16994 GOTO 50
16995 ELSE
16996 CALL PUSHERR2p1 (0001, 'CALCL4') ! WARNING ERROR: NO SOLUTION
16997 GOTO 50
16998 ENDIF
16999 !C
17000 !C *** PERFORM BISECTION ***********************************************
17001 !C
17002 20 DO 30 I=1,MAXIT
17003 X3 = 0.5*(X1+X2)
17004 Y3 = FUNCL42p1 (X3)
17005 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
17006 Y2 = Y3
17007 X2 = X3
17008 ELSE
17009 Y1 = Y3
17010 X1 = X3
17011 ENDIF
17012 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
17013 30 CONTINUE
17014 CALL PUSHERR2p1 (0002, 'CALCL4') ! WARNING ERROR: NO CONVERGENCE
17015 !C
17016 !C *** CONVERGED ; RETURN **********************************************
17017 !C
17018 40 X3 = 0.5*(X1+X2)
17019 Y3 = FUNCL42p1 (X3)
17020 !C
17021 50 RETURN
17022 !C
17023 !C *** END OF SUBROUTINE CALCL4 *****************************************
17024 !C
17025 END
17026 !C
17027 !C=======================================================================
17028 !C
17029 !C *** ISORROPIA CODE II
17030 !C *** FUNCTION FUNCL4
17031 !C *** CASE L4
17032 !C
17033 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17034 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
17035 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17036 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4
17037 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4, LC
17038 !C
17039 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
17040 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17041 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17042 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17043 !C
17044 !C=======================================================================
17045 !C
17046 DOUBLE PRECISION FUNCTION FUNCL42p1 (P4)
17047 INCLUDE 'module_isrpia_inc.F'
17048 DOUBLE PRECISION LAMDA
17049 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17050 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17051 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17052 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17053 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17054 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17055 !C
17056 !C *** SETUP PARAMETERS ************************************************
17057 !C
17058 PSI4 = P4
17059 !C
17060 !C *** SETUP PARAMETERS ************************************************
17061 !C
17062 FRST = .TRUE.
17063 CALAIN = .TRUE.
17064 !C
17065 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
17066 !C
17067 DO 10 I=1,NSWEEP
17068 !C
17069 A4 = XK5*(WATER/GAMA(2))**3.0
17070 A5 = XK7*(WATER/GAMA(4))**3.0
17071 A6 = XK17*(WATER/GAMA(17))**3.0
17072 A8 = XK18*(WATER/GAMA(18))**2.0
17073 A9 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
17074 !C
17075 !C CALCULATE DISSOCIATION QUANTITIES
17076 !C
17077 PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) &! psi5
17078 /2.D0/SQRT(A4/A5)
17079 PSI5 = MAX (MIN (PSI5, CHI5), ZERO)
17080 !C
17081 PSI7 = CHI7
17082 !C
17083 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
17084 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
17085 DD = MAX(BB*BB - 4.D0*CC, ZERO)
17086 LAMDA= 0.5D0*(-BB + SQRT(DD))
17087 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
17088 !C
17089 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
17090 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
17091 !C
17092 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
17093 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
17094 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
17095 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
17096 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
17097 IF (ISLV.EQ.0) THEN
17098 PSI6 = MIN (PSI6, CHI6)
17099 ELSE
17100 PSI6 = ZERO
17101 ENDIF
17102 ENDIF
17103 !C
17104 BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA
17105 CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8
17106 DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO)
17107 PSI8 = 0.5D0*(-BITA + SQRT(DELT))
17108 PSI8 = MIN(MAX (PSI8, ZERO), CHI8)
17109 !C
17110 !C *** CALCULATE SPECIATION ********************************************
17111 !C
17112 MOLAL(1) = LAMDA ! HI
17113 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
17114 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
17115 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
17116 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
17117 MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI
17118 MOLAL(10)= PSI7 ! MGI
17119 !C
17120 CLC = ZERO
17121 CNAHSO4 = ZERO
17122 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
17123 CNH42S4 = MAX(CHI5 - PSI5, ZERO)
17124 CNH4HS4 = ZERO
17125 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
17126 CMGSO4 = ZERO
17127 CKHSO4 = MAX(CHI8 - PSI8, ZERO)
17128 CALL CALCMR2p1 ! Water content
17129 !C
17130 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
17131 !C
17132 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
17133 CALL CALCACT2p1
17134 ELSE
17135 GOTO 20
17136 ENDIF
17137 10 CONTINUE
17138 !C
17139 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
17140 !C
17141 20 A4 = XK5 *(WATER/GAMA(2))**3.0
17142 FUNCL42p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
17143 RETURN
17144 !C
17145 !C *** END OF FUNCTION FUNCL4 ****************************************
17146 !C
17147 END
17148 !C=======================================================================
17149 !C
17150 !C *** ISORROPIA CODE II
17151 !C *** SUBROUTINE CALCL3
17152 !C *** CASE L3
17153 !C
17154 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17155 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17156 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17157 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17158 !C
17159 !C THERE ARE THREE REGIMES IN THIS CASE:
17160 !C 1.(NA,NH4)HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCI3A)
17161 !C 2.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
17162 !C 3.(NA,NH4)HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
17163 !C
17164 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES I1A, I2B
17165 !C RESPECTIVELY
17166 !C
17167 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
17168 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17169 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
17170 !C
17171 !C=======================================================================
17172 !C
17173 SUBROUTINE CALCL32p1
17174 INCLUDE 'module_isrpia_inc.F'
17175 EXTERNAL CALCL1A2p1, CALCL42p1
17176 !C
17177 !C *** FIND DRY COMPOSITION *********************************************
17178 !C
17179 CALL CALCL1A2p1
17180 !C
17181 !C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH *********************
17182 !C
17183 IF (CNH4HS4.GT.TINY .OR. CNAHSO4.GT.TINY) THEN
17184 SCASE = 'L3 ; SUBCASE 1'
17185 CALL CALCL3A2p1 ! FULL SOLUTION
17186 SCASE = 'L3 ; SUBCASE 1'
17187 ENDIF
17188 !C
17189 IF (WATER.LE.TINY) THEN
17190 IF (RH.LT.DRML3) THEN ! SOLID SOLUTION
17191 WATER = TINY
17192 DO 10 I=1,NIONS
17193 MOLAL(I) = ZERO
17194 10 CONTINUE
17195 CALL CALCL1A2p1
17196 SCASE = 'L3 ; SUBCASE 2'
17197 !C
17198 ELSEIF (RH.GE.DRML3) THEN ! MDRH OF L3
17199 SCASE = 'L3 ; SUBCASE 3'
17200 CALL CALCMDRH22p1 (RH, DRML3, DRLC, CALCL1A2p1, CALCL42p1)
17201 SCASE = 'L3 ; SUBCASE 3'
17202 ENDIF
17203 ENDIF
17204 !C
17205 RETURN
17206 !C
17207 !C *** END OF SUBROUTINE CALCL3 *****************************************
17208 !C
17209 END
17210 !C
17211 !C=======================================================================
17212 !C
17213 !C *** ISORROPIA CODE II
17214 !C *** SUBROUTINE CALCL3A
17215 !C *** CASE L3 ; SUBCASE 1
17216 !C
17217 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17218 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17219 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17220 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC
17221 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4
17222 !C
17223 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17224 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17225 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17226 !C
17227 !C=======================================================================
17228 !C
17229 SUBROUTINE CALCL3A2p1
17230 INCLUDE 'module_isrpia_inc.F'
17231 DOUBLE PRECISION LAMDA
17232 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17233 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17234 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17235 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17236 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17237 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17238 !C
17239 !C *** FIND DRY COMPOSITION **********************************************
17240 !C
17241 CALL CALCL1A2p1
17242 !C
17243 !C *** SETUP PARAMETERS ************************************************
17244 !C
17245 CHI1 = CNH4HS4 ! Save from CALCL1 run
17246 CHI2 = CLC
17247 CHI3 = CNAHSO4
17248 CHI4 = CNA2SO4
17249 CHI5 = CNH42S4
17250 CHI6 = CK2SO4
17251 CHI7 = CMGSO4
17252 CHI8 = CKHSO4
17253 !C
17254 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
17255 PSI2 = ZERO
17256 PSI3 = CNAHSO4
17257 PSI4 = ZERO
17258 PSI5 = ZERO
17259 PSI6 = ZERO
17260 PSI7 = ZERO
17261 PSI8 = ZERO
17262 !C
17263 CALAOU = .TRUE. ! Outer loop activity calculation flag
17264 PSI2LO = ZERO ! Low limit
17265 PSI2HI = CHI2 ! High limit
17266 !C
17267 !C *** INITIAL VALUES FOR BISECTION ************************************
17268 !C
17269 X1 = PSI2HI
17270 Y1 = FUNCL3A2p1 (X1)
17271 YHI= Y1 ! Save Y-value at HI position
17272 !C
17273 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
17274 !C
17275 IF (YHI.LT.EPS) GOTO 50
17276 !C
17277 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
17278 !C
17279 DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
17280 DO 10 I=1,NDIV
17281 X2 = MAX(X1-DX, PSI2LO)
17282 Y2 = FUNCL3A2p1 (X2)
17283 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
17284 X1 = X2
17285 Y1 = Y2
17286 10 CONTINUE
17287 !C
17288 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
17289 !C
17290 IF (Y2.GT.EPS) Y2 = FUNCL3A2p1 (ZERO)
17291 GOTO 50
17292 !C
17293 !C *** PERFORM BISECTION ***********************************************
17294 !C
17295 20 DO 30 I=1,MAXIT
17296 X3 = 0.5*(X1+X2)
17297 Y3 = FUNCL3A2p1 (X3)
17298 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
17299 Y2 = Y3
17300 X2 = X3
17301 ELSE
17302 Y1 = Y3
17303 X1 = X3
17304 ENDIF
17305 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
17306 30 CONTINUE
17307 CALL PUSHERR2p1 (0002, 'CALCL3A') ! WARNING ERROR: NO CONVERGENCE
17308 !C
17309 !C *** CONVERGED ; RETURN **********************************************
17310 !C
17311 40 X3 = 0.5*(X1+X2)
17312 Y3 = FUNCL3A2p1 (X3)
17313 !C
17314 50 RETURN
17315 !C
17316 !C *** END OF SUBROUTINE CALCL3A *****************************************
17317 !C
17318 END
17319 !C
17320 !C=======================================================================
17321 !C
17322 !C *** ISORROPIA CODE II
17323 !C *** SUBROUTINE FUNCL3A
17324 !C *** CASE L3 ; SUBCASE 1
17325 !C
17326 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17327 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17328 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17329 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC
17330 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4
17331 !C
17332 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17333 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17334 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17335 !C
17336 !C=======================================================================
17337 !C
17338 DOUBLE PRECISION FUNCTION FUNCL3A2p1 (P2)
17339 INCLUDE 'module_isrpia_inc.F'
17340 DOUBLE PRECISION LAMDA
17341 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17342 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17343 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17344 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17345 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17346 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17347 !C
17348 !C *** SETUP PARAMETERS ************************************************
17349 !C
17351 PSI2 = P2 ! Save PSI2 in COMMON BLOCK
17352 PSI4LO = ZERO ! Low limit for PSI4
17353 PSI4HI = CHI4 ! High limit for PSI4
17354 !C
17355 !C *** IF NH3 =0, CALL FUNCL3B FOR Y4=0 ********************************
17356 !C
17357 IF (CHI4.LE.TINY) THEN
17358 FUNCL3A2p1 = FUNCL3B2p1 (ZERO)
17359 GOTO 50
17360 ENDIF
17361 !C
17362 !C *** INITIAL VALUES FOR BISECTION ************************************
17363 !C
17364 X1 = PSI4HI
17365 Y1 = FUNCL3B2p1 (X1)
17366 IF (ABS(Y1).LE.EPS) GOTO 50
17367 YHI= Y1 ! Save Y-value at HI position
17368 !C
17369 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *********
17370 !C
17371 IF (YHI.LT.ZERO) GOTO 50
17372 !C
17373 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
17374 !C
17375 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
17376 DO 10 I=1,NDIV
17377 X2 = MAX(X1-DX, PSI4LO)
17378 Y2 = FUNCL3B2p1 (X2)
17379 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
17380 X1 = X2
17381 Y1 = Y2
17382 10 CONTINUE
17383 !C
17384 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4
17385 !C
17386 IF (Y2.GT.EPS) Y2 = FUNCL3B2p1 (PSI4LO)
17387 GOTO 50
17388 !C
17389 !C *** PERFORM BISECTION ***********************************************
17390 !C
17391 20 DO 30 I=1,MAXIT
17392 X3 = 0.5*(X1+X2)
17393 Y3 = FUNCL3B2p1 (X3)
17394 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
17395 Y2 = Y3
17396 X2 = X3
17397 ELSE
17398 Y1 = Y3
17399 X1 = X3
17400 ENDIF
17401 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
17402 30 CONTINUE
17403 CALL PUSHERR2p1 (0004, 'FUNCL3A2p1') ! WARNING ERROR: NO CONVERGENCE
17404 !C
17405 !C *** INNER LOOP CONVERGED **********************************************
17406 !C
17407 40 X3 = 0.5*(X1+X2)
17408 Y3 = FUNCL3B2p1 (X3)
17409 !C
17410 !C *** CALCULATE FUNCTION VALUE FOR INTERNAL LOOP ***************************
17411 !C
17412 50 A2 = XK13*(WATER/GAMA(13))**5.0
17413 FUNCL3A2p1 = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE
17414 RETURN
17415 !C
17416 !C *** END OF FUNCTION FUNCL3A *******************************************
17417 !C
17418 END
17419 !C
17420 !C=======================================================================
17421 !C
17422 !C *** ISORROPIA CODE II
17423 !C *** FUNCTION FUNCL3B
17424 !C *** CASE L3 ; SUBCASE 2
17425 !C
17426 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17427 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SULRAT < 2.0)
17428 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17429 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, (NH4)2SO4, NA2SO4, LC
17430 !C 4. COMPLETELY DISSOLVED: NH4HSO4, NAHSO4
17431 !C
17432 !C SOLUTION IS SAVED IN COMMON BLOCK /CASE/
17433 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17434 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17435 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17436 !C
17437 !C=======================================================================
17438 !C
17439 DOUBLE PRECISION FUNCTION FUNCL3B2p1 (P4)
17440 INCLUDE 'module_isrpia_inc.F'
17441 DOUBLE PRECISION LAMDA
17442 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17443 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17444 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17445 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17446 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17447 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17448 !C
17449 !C *** SETUP PARAMETERS ************************************************
17450 !C
17451 PSI4 = P4
17452 !C
17453 FRST = .TRUE.
17454 CALAIN = .TRUE.
17455 !C
17456 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
17457 !C
17458 DO 10 I=1,NSWEEP
17459 !C
17460 A4 = XK5*(WATER/GAMA(2))**3.0
17461 A5 = XK7*(WATER/GAMA(4))**3.0
17462 A6 = XK17*(WATER/GAMA(17))**3.0
17463 A8 = XK18*(WATER/GAMA(18))**2.0
17464 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
17465 !C
17466 !C CALCULATE DISSOCIATION QUANTITIES
17467 !C
17468 PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) & ! psi5
17469 /2.D0/SQRT(A4/A5)
17470 PSI5 = MAX (MIN (PSI5, CHI5), ZERO)
17471 !C
17472 PSI7 = CHI7
17473 !C
17474 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
17475 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
17476 DD = MAX(BB*BB - 4.D0*CC, ZERO)
17477 LAMDA= 0.5D0*(-BB + SQRT(DD))
17478 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
17479 !C
17480 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
17481 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
17482 !C
17483 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
17484 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
17485 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
17486 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
17487 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
17488 IF (ISLV.EQ.0) THEN
17489 PSI6 = MIN (PSI6, CHI6)
17490 ELSE
17491 PSI6 = ZERO
17492 ENDIF
17493 ENDIF
17494 !C
17495 BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA
17496 CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8
17497 DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO)
17498 PSI8 = 0.5D0*(-BITA + SQRT(DELT))
17499 PSI8 = MIN(MAX (PSI8, ZERO), CHI8)
17500 !C
17501 !C *** CALCULATE SPECIATION ********************************************
17502 !C
17503 MOLAL(1) = LAMDA ! HI
17504 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
17505 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
17506 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
17507 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
17508 MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI
17509 MOLAL(10)= PSI7 ! MGI
17510 !C
17511 CLC = MAX(CHI2 - PSI2, ZERO)
17512 CNAHSO4 = ZERO
17513 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
17514 CNH42S4 = MAX(CHI5 - PSI5, ZERO)
17515 CNH4HS4 = ZERO
17516 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
17517 CMGSO4 = MAX(CHI7 - PSI7, ZERO)
17518 CKHSO4 = MAX(CHI8 - PSI8, ZERO)
17519 CALL CALCMR2p1 ! Water content
17520 !C
17521 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
17522 !C
17523 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
17524 CALL CALCACT2p1
17525 ELSE
17526 GOTO 20
17527 ENDIF
17528 10 CONTINUE
17529 !C
17530 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
17531 !C
17532 20 A4 = XK5 *(WATER/GAMA(2))**3.0
17533 FUNCL3B2p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
17534 RETURN
17535 !C
17536 !C *** END OF FUNCTION FUNCL3B ****************************************
17537 !C
17538 END
17540 !C=======================================================================
17541 !C
17542 !C *** ISORROPIA CODE II
17543 !C *** SUBROUTINE CALCL2
17544 !C *** CASE L2
17545 !C
17546 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17547 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17548 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17549 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17550 !C
17551 !C THERE ARE THREE REGIMES IN THIS CASE:
17552 !C 1. NH4HSO4(s) POSSIBLE. LIQUID & SOLID AEROSOL (SUBROUTINE CALCL2A)
17553 !C 2. NH4HSO4(s) NOT POSSIBLE, AND RH < MDRH. SOLID AEROSOL ONLY
17554 !C 3. NH4HSO4(s) NOT POSSIBLE, AND RH >= MDRH. SOLID & LIQUID AEROSOL
17555 !C
17556 !C REGIMES 2. AND 3. ARE CONSIDERED TO BE THE SAME AS CASES L1A, L2B
17557 !C RESPECTIVELY
17558 !C
17559 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
17560 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17561 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
17562 !C
17563 !C=======================================================================
17564 !C
17565 SUBROUTINE CALCL22p1
17566 INCLUDE 'module_isrpia_inc.F'
17567 EXTERNAL CALCL1A2p1, CALCL3A2p1
17568 !C
17569 !C *** FIND DRY COMPOSITION **********************************************
17570 !C
17571 CALL CALCL1A2p1
17572 !C
17573 !C *** REGIME DEPENDS UPON THE POSSIBLE SOLIDS & RH **********************
17574 !C
17575 IF (CNH4HS4.GT.TINY) THEN
17576 SCASE = 'L2 ; SUBCASE 1'
17577 CALL CALCL2A2p1
17578 SCASE = 'L2 ; SUBCASE 1'
17579 ENDIF
17580 !C
17581 IF (WATER.LE.TINY) THEN
17582 IF (RH.LT.DRML2) THEN ! SOLID SOLUTION ONLY
17583 WATER = TINY
17584 DO 10 I=1,NIONS
17585 MOLAL(I) = ZERO
17586 10 CONTINUE
17587 CALL CALCL1A2p1
17588 SCASE = 'L2 ; SUBCASE 2'
17589 !C
17590 ELSEIF (RH.GE.DRML2) THEN ! MDRH OF L2
17591 SCASE = 'L2 ; SUBCASE 3'
17592 CALL CALCMDRH22p1 (RH, DRML2, DRNAHSO4, CALCL1A2p1, CALCL3A2p1)
17593 SCASE = 'L2 ; SUBCASE 3'
17594 ENDIF
17595 ENDIF
17596 !C
17597 RETURN
17598 !C
17599 !C *** END OF SUBROUTINE CALCL2 ******************************************
17600 !C
17601 END
17602 !C
17603 !C=======================================================================
17604 !C
17605 !C *** ISORROPIA CODE II
17606 !C *** SUBROUTINE CALCL2A
17607 !C *** CASE L2 ; SUBCASE 1
17608 !C
17609 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17610 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17611 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17612 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17613 !C 4. COMPLETELY DISSOLVED: NH4HSO4
17614 !C
17615 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17616 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17617 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17618 !C
17619 !C=======================================================================
17620 !C
17621 SUBROUTINE CALCL2A2p1
17622 INCLUDE 'module_isrpia_inc.F'
17623 DOUBLE PRECISION LAMDA
17624 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17625 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17626 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17627 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17628 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17629 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17630 !C
17631 !C *** SETUP PARAMETERS ************************************************
17632 !C
17633 CHI1 = CNH4HS4 ! Save from CALCL1 run
17634 CHI2 = CLC
17635 CHI3 = CNAHSO4
17636 CHI4 = CNA2SO4
17637 CHI5 = CNH42S4
17638 CHI6 = CK2SO4
17639 CHI7 = CMGSO4
17640 CHI8 = CKHSO4
17641 !C
17643 PSI1 = CNH4HS4 ! ASSIGN INITIAL PSI's
17644 PSI2 = ZERO
17645 PSI3 = ZERO
17646 PSI4 = ZERO
17647 PSI5 = ZERO
17648 PSI6 = ZERO
17649 PSI7 = ZERO
17650 PSI8 = ZERO
17651 !C
17652 CALAOU = .TRUE. ! Outer loop activity calculation flag
17653 PSI2LO = ZERO ! Low limit
17654 PSI2HI = CHI2 ! High limit
17655 !C
17656 !C *** INITIAL VALUES FOR BISECTION ************************************
17657 !C
17658 X1 = PSI2HI
17659 Y1 = FUNCL2A2p1 (X1)
17660 YHI= Y1 ! Save Y-value at HI position
17661 !C
17662 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH NA2SO4 *********
17663 !C
17664 IF (YHI.LT.EPS) GOTO 50
17665 !C
17666 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
17667 !C
17668 DX = (PSI2HI-PSI2LO)/FLOAT(NDIV)
17669 DO 10 I=1,NDIV
17670 X2 = MAX(X1-DX, PSI2LO)
17671 Y2 = FUNCL2A2p1 (X2)
17672 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
17673 X1 = X2
17674 Y1 = Y2
17675 10 CONTINUE
17676 !C
17677 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH NA2SO4
17678 !C
17679 IF (Y2.GT.EPS) Y2 = FUNCL2A2p1 (ZERO)
17680 GOTO 50
17681 !C
17682 !C *** PERFORM BISECTION ***********************************************
17683 !C
17684 20 DO 30 I=1,MAXIT
17685 X3 = 0.5*(X1+X2)
17686 Y3 = FUNCL2A2p1 (X3)
17687 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
17688 Y2 = Y3
17689 X2 = X3
17690 ELSE
17691 Y1 = Y3
17692 X1 = X3
17693 ENDIF
17694 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
17695 30 CONTINUE
17696 CALL PUSHERR2p1 (0002, 'CALCL2A') ! WARNING ERROR: NO CONVERGENCE
17697 !C
17698 !C *** CONVERGED ; RETURN **********************************************
17699 !C
17700 40 X3 = 0.5*(X1+X2)
17701 Y3 = FUNCL2A2p1 (X3)
17702 !C
17703 50 RETURN
17704 !C
17705 !C *** END OF SUBROUTINE CALCL2A *****************************************
17706 !C
17707 END
17708 !C
17709 !C=======================================================================
17710 !C
17711 !C *** ISORROPIA CODE II
17712 !C *** SUBROUTINE FUNCL2A
17713 !C *** CASE L2 ; SUBCASE 1
17714 !C
17715 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17716 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17717 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17718 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17719 !C 4. COMPLETELY DISSOLVED: NH4HSO4
17720 !C
17721 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17722 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17723 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17724 !C
17725 !C=======================================================================
17726 !C
17727 DOUBLE PRECISION FUNCTION FUNCL2A2p1 (P2)
17728 INCLUDE 'module_isrpia_inc.F'
17729 DOUBLE PRECISION LAMDA
17730 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17731 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17732 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17733 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17734 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17735 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17736 !C
17737 !C *** SETUP PARAMETERS ************************************************
17738 !C
17740 PSI2 = P2 ! Save PSI3 in COMMON BLOCK
17741 PSI4LO = ZERO ! Low limit for PSI4
17742 PSI4HI = CHI4 ! High limit for PSI4
17743 !C
17744 !C *** IF NH3 =0, CALL FUNCL3B FOR Y4=0 ********************************
17745 !C
17747 IF (CHI4.LE.TINY) THEN
17748 FUNCL2A2p1 = FUNCL2B2p1 (ZERO)
17749 GOTO 50
17750 ENDIF
17751 !C
17752 !C *** INITIAL VALUES FOR BISECTION ************************************
17753 !C
17755 X1 = PSI4HI
17756 Y1 = FUNCL2B2p1 (X1)
17758 IF (ABS(Y1).LE.EPS) GOTO 50
17759 YHI= Y1 ! Save Y-value at HI position
17760 !C
17761 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH LC *********
17762 !C
17763 IF (YHI.LT.ZERO) GOTO 50
17764 !C
17765 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
17766 !C
17767 DX = (PSI4HI-PSI4LO)/FLOAT(NDIV)
17768 DO 10 I=1,NDIV
17769 X2 = MAX(X1-DX, PSI4LO)
17770 Y2 = FUNCL2B2p1 (X2)
17771 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
17772 X1 = X2
17773 Y1 = Y2
17774 10 CONTINUE
17775 !C
17776 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH LC
17777 !C
17778 IF (Y2.GT.EPS) Y2 = FUNCL2B2p1 (PSI4LO)
17779 GOTO 50
17780 !C
17781 !C *** PERFORM BISECTION ***********************************************
17782 !C
17783 20 DO 30 I=1,MAXIT
17784 X3 = 0.5*(X1+X2)
17785 Y3 = FUNCL2B2p1 (X3)
17786 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
17787 Y2 = Y3
17788 X2 = X3
17789 ELSE
17790 Y1 = Y3
17791 X1 = X3
17792 ENDIF
17793 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
17794 30 CONTINUE
17795 CALL PUSHERR2p1 (0004, 'FUNCL2A2p1') ! WARNING ERROR: NO CONVERGENCE
17796 !C
17797 !C *** INNER LOOP CONVERGED **********************************************
17798 !C
17799 40 X3 = 0.5*(X1+X2)
17800 Y3 = FUNCL2B2p1 (X3)
17801 !C
17802 !C *** CALCULATE FUNCTION VALUE FOR OUTER LOOP ***************************
17803 !C
17804 50 A2 = XK13*(WATER/GAMA(13))**5.0
17805 FUNCL2A2p1 = MOLAL(5)*MOLAL(6)*MOLAL(3)**3.0/A2 - ONE
17806 RETURN
17807 !C
17808 !C *** END OF FUNCTION FUNCL2A *******************************************
17809 !C
17810 END
17811 !C
17812 !C=======================================================================
17813 !C
17814 !C *** ISORROPIA CODE II
17815 !C *** SUBROUTINE FUNCL2B
17816 !C *** CASE L2 ; SUBCASE 2
17817 !C
17818 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17819 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17820 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17821 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17822 !C 4. COMPLETELY DISSOLVED: NH4HSO4
17823 !C
17824 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
17825 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17826 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
17827 !C
17828 !C=======================================================================
17829 !C
17830 DOUBLE PRECISION FUNCTION FUNCL2B2p1 (P4)
17831 INCLUDE 'module_isrpia_inc.F'
17832 DOUBLE PRECISION LAMDA
17833 COMMON /SOLUT2p1/ CHI1, CHI2, CHI3, CHI4, CHI5, CHI6, CHI7, CHI8, &
17834 CHI9, CHI10, CHI11, CHI12, CHI13, CHI14, CHI15, &
17835 CHI16, CHI17, PSI1, PSI2, PSI3, PSI4, PSI5, PSI6, &
17836 PSI7, PSI8, PSI9, PSI10, PSI11, PSI12, PSI13, &
17837 PSI14, PSI15, PSI16, PSI17, A1, A2, A3, A4, A5, A6, &
17838 A7, A8, A9, A10, A11, A12, A13, A14, A15, A16, A17
17839 !C
17840 !C *** SETUP PARAMETERS ************************************************
17841 !C
17842 PSI4 = P4 ! Save PSI4 in COMMON BLOCK
17843 !C
17844 !C *** SETUP PARAMETERS ************************************************
17845 !C
17846 FRST = .TRUE.
17847 CALAIN = .TRUE.
17848 PSI3 = CHI3
17849 PSI5 = CHI5
17850 LAMDA = ZERO
17851 PSI6 = CHI6
17852 PSI8 = CHI8
17853 !C
17854 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
17855 !C
17856 DO 10 I=1,NSWEEP
17857 !C
17858 A3 = XK11*(WATER/GAMA(12))**2.0
17859 A4 = XK5*(WATER/GAMA(2))**3.0
17860 A5 = XK7*(WATER/GAMA(4))**3.0
17861 A6 = XK17*(WATER/GAMA(17))**3.0
17862 A8 = XK18*(WATER/GAMA(18))**2.0
17863 A9 = XK1*(WATER)*(GAMA(8)**2.0)/(GAMA(7)**3.0)
17864 !C
17865 !C CALCULATE DISSOCIATION QUANTITIES
17866 !C
17867 PSI5 = (PSI3 + 2.D0*PSI4 - SQRT(A4/A5)*(3.D0*PSI2 + PSI1)) &! psi5
17868 /2.D0/SQRT(A4/A5)
17869 PSI5 = MAX (MIN (PSI5, CHI5), ZERO)
17870 !C
17871 IF (CHI3.GT.TINY .AND. WATER.GT.TINY) THEN
17872 AA = 2.D0*PSI4 + PSI2 + PSI1 + PSI8 - LAMDA
17873 BB = 2.D0*PSI4*(PSI2 + PSI1 + PSI8 - LAMDA) - A3
17874 CC = ZERO
17875 CALL POLY32p1 (AA, BB, CC, PSI3, ISLV)
17876 IF (ISLV.EQ.0) THEN
17877 PSI3 = MIN (PSI3, CHI3)
17878 ELSE
17879 PSI3 = ZERO
17880 ENDIF
17881 ENDIF
17882 !C
17883 PSI7 = CHI7
17884 !C
17885 BB = PSI7 + PSI6 + PSI5 + PSI4 + PSI2 + A9 ! LAMDA
17886 CC = -A9*(PSI8 + PSI1 + PSI2 + PSI3)
17887 DD = MAX(BB*BB - 4.D0*CC, ZERO)
17888 LAMDA= 0.5D0*(-BB + SQRT(DD))
17889 LAMDA= MIN(MAX (LAMDA, TINY), PSI8+PSI3+PSI2+PSI1)
17890 !C
17891 !C PSI6 = 0.5*(SQRT(A6/A4)*(2.D0*PSI4+PSI3)-PSI8) ! PSI6
17892 !C PSI6 = MIN (MAX (PSI6, ZERO), CHI6)
17893 !C
17894 IF (CHI6.GT.TINY .AND. WATER.GT.TINY) THEN
17895 AA = PSI5+PSI4+PSI2+PSI7+PSI8+LAMDA
17896 BB = PSI8*(PSI5+PSI4+PSI2+PSI7+0.25D0*PSI8+LAMDA)
17897 CC = 0.25D0*(PSI8*PSI8*(PSI5+PSI4+PSI2+PSI7+LAMDA)-A6)
17898 CALL POLY32p1 (AA, BB, CC, PSI6, ISLV)
17899 IF (ISLV.EQ.0) THEN
17900 PSI6 = MIN (PSI6, CHI6)
17901 ELSE
17902 PSI6 = ZERO
17903 ENDIF
17904 ENDIF
17905 !C
17906 BITA = PSI3 + PSI2 + PSI1 + 2.D0*PSI6 - LAMDA ! PSI8
17907 CAMA = 2.D0*PSI6*(PSI3 + PSI2 + PSI1 - LAMDA) - A8
17908 DELT = MAX(BITA*BITA - 4.D0*CAMA, ZERO)
17909 PSI8 = 0.5D0*(-BITA + SQRT(DELT))
17910 PSI8 = MIN(MAX (PSI8, ZERO), CHI8)
17911 !C
17912 !C *** CALCULATE SPECIATION ********************************************
17913 !C
17914 MOLAL(1) = LAMDA ! HI
17915 MOLAL(2) = 2.D0*PSI4 + PSI3 ! NAI
17916 MOLAL(3) = 3.D0*PSI2 + 2.D0*PSI5 + PSI1 ! NH4I
17917 MOLAL(5) = PSI2 + PSI4 + PSI5 + PSI6 + PSI7 + LAMDA ! SO4I
17918 MOLAL(6) = MAX(PSI2 + PSI3 + PSI1 + PSI8 - LAMDA, TINY) ! HSO4I
17919 MOLAL(9) = PSI8 + 2.0D0*PSI6 ! KI
17920 MOLAL(10)= PSI7 ! MGI
17921 !C
17922 CLC = MAX(CHI2 - PSI2, ZERO)
17923 CNAHSO4 = MAX(CHI3 - PSI3, ZERO)
17924 CNA2SO4 = MAX(CHI4 - PSI4, ZERO)
17925 CNH42S4 = MAX(CHI5 - PSI5, ZERO)
17926 CNH4HS4 = ZERO
17927 CK2SO4 = MAX(CHI6 - PSI6, ZERO)
17928 CMGSO4 = MAX(CHI7 - PSI7, ZERO)
17929 CKHSO4 = MAX(CHI8 - PSI8, ZERO)
17930 CALL CALCMR2p1 ! Water content
17931 !C
17932 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
17933 !C
17934 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
17935 CALL CALCACT2p1
17936 ELSE
17937 GOTO 20
17938 ENDIF
17939 10 CONTINUE
17940 !C
17941 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
17942 !C
17943 20 A4 = XK5 *(WATER/GAMA(2))**3.0
17944 FUNCL2B2p1 = MOLAL(5)*MOLAL(2)*MOLAL(2)/A4 - ONE
17945 RETURN
17946 !C
17947 !C *** END OF FUNCTION FUNCL2B ****************************************
17948 !C
17949 END
17951 !C=======================================================================
17952 !C
17953 !C *** ISORROPIA CODE II
17954 !C *** SUBROUTINE CALCL1
17955 !C *** CASE L1
17956 !C
17957 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
17958 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
17959 !C 2. SOLID & LIQUID AEROSOL POSSIBLE
17960 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
17961 !C
17962 !C THERE ARE TWO POSSIBLE REGIMES HERE, DEPENDING ON RELATIVE HUMIDITY:
17963 !C 1. WHEN RH >= MDRH ; LIQUID PHASE POSSIBLE (MDRH REGION)
17964 !C 2. WHEN RH < MDRH ; ONLY SOLID PHASE POSSIBLE (SUBROUTINE CALCI1A)
17965 !C
17966 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY,
17967 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
17968 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS & ATHANASIOS NENES
17969 !C
17970 !C=======================================================================
17971 !C
17972 SUBROUTINE CALCL12p1
17973 INCLUDE 'module_isrpia_inc.F'
17974 EXTERNAL CALCL1A2p1, CALCL2A2p1
17975 !C
17976 !C *** REGIME DEPENDS UPON THE AMBIENT RELATIVE HUMIDITY *****************
17977 !C
17978 IF (RH.LT.DRML1) THEN
17979 SCASE = 'L1 ; SUBCASE 1'
17980 CALL CALCL1A2p1 ! SOLID PHASE ONLY POSSIBLE
17981 SCASE = 'L1 ; SUBCASE 1'
17982 ELSE
17983 SCASE = 'L1 ; SUBCASE 2' ! LIQUID & SOLID PHASE POSSIBLE
17984 CALL CALCMDRH22p1 (RH, DRML1, DRNH4HS4, CALCL1A2p1, CALCL2A2p1)
17985 SCASE = 'L1 ; SUBCASE 2'
17986 ENDIF
17987 !C
17988 !C *** AMMONIA IN GAS PHASE **********************************************
17989 !C
17990 !C CALL CALCNH3
17991 !C
17992 RETURN
17993 !C
17994 !C *** END OF SUBROUTINE CALCL1 ******************************************
17995 !C
17996 END
17997 !C
17998 !C=======================================================================
17999 !C
18000 !C *** ISORROPIA CODE II
18001 !C *** SUBROUTINE CALCL1A
18002 !C *** CASE L1A
18003 !C
18004 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18005 !C 1. SULFATE RICH, NO FREE ACID (1.0 <= SO4RAT < 2.0)
18006 !C 2. SOLID AEROSOL ONLY
18007 !C 3. SOLIDS POSSIBLE : K2SO4, CASO4, MGSO4, KHSO4, NH4HSO4, NAHSO4, (NH4)2SO4, NA2SO4, LC
18008 !C
18009 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18010 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18011 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18012 !C
18013 !C=======================================================================
18014 !C
18015 SUBROUTINE CALCL1A2p1
18016 INCLUDE 'module_isrpia_inc.F'
18017 !C
18018 !C *** CALCULATE NON VOLATILE SOLIDS ***********************************
18019 !C
18020 CCASO4 = MIN (W(6), W(2)) ! CCASO4
18021 FRSO4 = MAX(W(2) - CCASO4, ZERO)
18022 CAFR = MAX(W(6) - CCASO4, ZERO)
18023 CK2SO4 = MIN (0.5D0*W(7), FRSO4) ! CK2SO4
18024 FRK = MAX(W(7) - 2.D0*CK2SO4, ZERO)
18025 FRSO4 = MAX(FRSO4 - CK2SO4, ZERO)
18026 CNA2SO4 = MIN (0.5D0*W(1), FRSO4) ! CNA2SO4
18027 FRNA = MAX(W(1) - 2.D0*CNA2SO4, ZERO)
18028 FRSO4 = MAX(FRSO4 - CNA2SO4, ZERO)
18029 CMGSO4 = MIN (W(8), FRSO4) ! CMGSO4
18030 FRMG = MAX(W(8) - CMGSO4, ZERO)
18031 FRSO4 = MAX(FRSO4 - CMGSO4, ZERO)
18032 !C
18033 CNH4HS4 = ZERO
18034 CNAHSO4 = ZERO
18035 CNH42S4 = ZERO
18036 CKHSO4 = ZERO
18037 !C
18038 CLC = MIN(W(3)/3.D0, FRSO4/2.D0)
18039 FRSO4 = MAX(FRSO4-2.D0*CLC, ZERO)
18040 FRNH4 = MAX(W(3)-3.D0*CLC, ZERO)
18041 !C
18042 IF (FRSO4.LE.TINY) THEN
18043 CLC = MAX(CLC - FRNH4, ZERO)
18044 CNH42S4 = 2.D0*FRNH4
18046 ELSEIF (FRNH4.LE.TINY) THEN
18047 CNH4HS4 = 3.D0*MIN(FRSO4, CLC)
18048 CLC = MAX(CLC-FRSO4, ZERO)
18049 !C IF (CK2SO4.GT.TINY) THEN
18050 !C FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO)
18051 !C CKHSO4 = 2.D0*FRSO4
18052 !C CK2SO4 = MAX(CK2SO4-FRSO4, ZERO)
18053 !C ENDIF
18054 !C IF (CNA2SO4.GT.TINY) THEN
18055 !C FRSO4 = MAX(FRSO4-CKHSO4/2.D0, ZERO)
18056 !C CNAHSO4 = 2.D0*FRSO4
18057 !C CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO)
18058 !C ENDIF
18059 !C
18060 IF (CNA2SO4.GT.TINY) THEN
18061 FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO)
18062 CNAHSO4 = 2.D0*FRSO4
18063 CNA2SO4 = MAX(CNA2SO4-FRSO4, ZERO)
18064 ENDIF
18065 IF (CK2SO4.GT.TINY) THEN
18066 FRSO4 = MAX(FRSO4-CNH4HS4/3.D0, ZERO)
18067 CKHSO4 = 2.D0*FRSO4
18068 CK2SO4 = MAX(CK2SO4-FRSO4, ZERO)
18069 ENDIF
18070 ENDIF
18071 !C
18072 !C *** CALCULATE GAS SPECIES ********************************************
18073 !C
18074 GHNO3 = W(4)
18075 GHCL = W(5)
18076 GNH3 = ZERO
18077 !C
18078 RETURN
18079 !C
18080 !C *** END OF SUBROUTINE CALCL1A *****************************************
18081 !C
18082 END
18083 !C
18084 !C
18085 !C=======================================================================
18086 !C
18087 !C *** ISORROPIA CODE II
18088 !C *** SUBROUTINE CALCK4
18089 !C *** CASE K4
18090 !C
18091 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18092 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18093 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18094 !C 3. SOLIDS POSSIBLE : CASO4
18095 !C
18096 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18097 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18098 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18099 !C
18100 !C=======================================================================
18101 !C
18102 SUBROUTINE CALCK42p1
18103 INCLUDE 'module_isrpia_inc.F'
18104 !C
18105 DOUBLE PRECISION LAMDA, KAPA
18106 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18107 A1, A2, A3, A4
18108 !C
18109 !C *** SETUP PARAMETERS ************************************************
18110 !C
18111 CALAOU =.TRUE. ! Outer loop activity calculation flag
18112 FRST = .TRUE.
18113 CALAIN = .TRUE.
18114 !C
18115 CHI1 = W(3) ! Total NH4 initially as NH4HSO4
18116 CHI2 = W(1) ! Total NA initially as NaHSO4
18117 CHI3 = W(7) ! Total K initially as KHSO4
18118 CHI4 = W(8) ! Total Mg initially as MgSO4
18119 !C
18120 LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4
18121 PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED
18122 PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED
18123 PSI3 = CHI3 ! ALL KHSO4 DELIQUESCED
18124 PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED
18125 !C
18126 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
18127 !C
18128 DO 10 I=1,NSWEEP
18129 !C
18130 A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
18131 !C
18132 BB = A4+LAMDA+PSI4 ! KAPA
18133 CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4
18134 DD = MAX(BB*BB-4.D0*CC, ZERO)
18135 KAPA = 0.5D0*(-BB+SQRT(DD))
18136 !C
18137 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
18138 !C
18139 MOLAL (1) = MAX(LAMDA + KAPA, TINY) ! HI
18140 MOLAL (2) = PSI2 ! NAI
18141 MOLAL (3) = PSI1 ! NH4I
18142 MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I
18143 MOLAL (6) = MAX(LAMDA + PSI1 + PSI2 + PSI3 - KAPA, ZERO) ! HSO4I
18144 MOLAL (9) = PSI3 ! KI
18145 MOLAL (10)= PSI4 ! MGI
18146 !C
18147 CNH4HS4 = ZERO
18148 CNAHSO4 = ZERO
18149 CKHSO4 = ZERO
18150 CCASO4 = W(6)
18151 CMGSO4 = ZERO
18152 !C
18153 CALL CALCMR2p1 ! Water content
18154 !C
18155 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
18156 !C
18157 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
18158 CALL CALCACT2p1
18159 ELSE
18160 GOTO 20
18161 ENDIF
18162 10 CONTINUE
18163 !C
18164 20 RETURN
18165 !C
18166 !C *** END OF SUBROUTINE CALCK4
18167 !C
18168 END
18169 !C
18170 !C=======================================================================
18171 !C
18172 !C *** ISORROPIA CODE II
18173 !C *** SUBROUTINE CALCK3
18174 !C *** CASE K3
18175 !C
18176 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18177 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18178 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18179 !C 3. SOLIDS POSSIBLE : KHSO4, CASO4
18180 !C
18181 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18182 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18183 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18184 !C
18185 !C=======================================================================
18186 !C
18187 SUBROUTINE CALCK32p1
18188 INCLUDE 'module_isrpia_inc.F'
18189 !C
18190 DOUBLE PRECISION LAMDA, KAPA
18191 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18192 A1, A2, A3, A4
18193 !C
18194 !C *** SETUP PARAMETERS ************************************************
18195 !C
18196 CALAOU =.TRUE. ! Outer loop activity calculation flag
18197 CHI1 = W(3) ! Total NH4 initially as NH4HSO4
18198 CHI2 = W(1) ! Total NA initially as NaHSO4
18199 CHI3 = W(7) ! Total K initially as KHSO4
18200 CHI4 = W(8) ! Total Mg initially as MgSO4
18201 !C
18202 PSI3LO = TINY ! Low limit
18203 PSI3HI = CHI3 ! High limit
18204 !C
18205 !C *** INITIAL VALUES FOR BISECTION ************************************
18206 !C
18207 X1 = PSI3HI
18208 Y1 = FUNCK32p1 (X1)
18209 YHI= Y1 ! Save Y-value at HI position
18210 !C
18211 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 ****
18212 !C
18213 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
18214 !C
18215 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
18216 !C
18217 DX = (PSI3HI-PSI3LO)/FLOAT(NDIV)
18218 DO 10 I=1,NDIV
18219 X2 = X1-DX
18220 Y2 = FUNCK32p1 (X2)
18221 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
18222 X1 = X2
18223 Y1 = Y2
18224 10 CONTINUE
18225 !C
18226 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4
18227 !C
18228 YLO= Y1 ! Save Y-value at Hi position
18229 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
18230 Y3 = FUNCK32p1 (ZERO)
18231 GOTO 50
18232 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
18233 GOTO 50
18234 ELSE
18235 CALL PUSHERR2p1 (0001, 'CALCK3') ! WARNING ERROR: NO SOLUTION
18236 GOTO 50
18237 ENDIF
18238 !C
18239 !C *** PERFORM BISECTION ***********************************************
18240 !C
18241 20 DO 30 I=1,MAXIT
18242 X3 = 0.5*(X1+X2)
18243 Y3 = FUNCK32p1 (X3)
18244 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
18245 Y2 = Y3
18246 X2 = X3
18247 ELSE
18248 Y1 = Y3
18249 X1 = X3
18250 ENDIF
18251 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
18252 30 CONTINUE
18253 CALL PUSHERR2p1 (0002, 'CALCK3') ! WARNING ERROR: NO CONVERGENCE
18254 !C
18255 !C *** CONVERGED ; RETURN **********************************************
18256 !C
18257 40 X3 = 0.5*(X1+X2)
18258 Y3 = FUNCK32p1 (X3)
18259 !C
18260 50 RETURN
18261 !C
18262 !C *** END OF SUBROUTINE CALCK3 ******************************************
18263 !C
18264 END
18265 !C
18266 !C=======================================================================
18267 !C
18268 !C *** ISORROPIA CODE
18269 !C *** SUBROUTINE FUNCK3
18270 !C *** CASE K3
18271 !C
18272 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18273 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18274 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18275 !C 3. SOLIDS POSSIBLE : KHSO4, CaSO4
18276 !C
18277 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18278 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18279 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18280 !C
18281 !C=======================================================================
18282 !C
18283 DOUBLE PRECISION FUNCTION FUNCK32p1 (P1)
18284 INCLUDE 'module_isrpia_inc.F'
18285 DOUBLE PRECISION LAMDA, KAPA
18286 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18287 A1, A2, A3, A4
18288 !C
18289 !C *** SETUP PARAMETERS ************************************************
18290 !C
18291 FRST = .TRUE.
18292 CALAIN = .TRUE.
18293 !C
18294 LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4
18295 PSI3 = P1
18296 PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED
18297 PSI2 = CHI2 ! ALL NaHSO4 DELIQUESCED
18298 PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED
18300 !C
18301 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
18302 !C
18303 DO 10 I=1,NSWEEP
18304 !C
18305 A3 = XK18 *(WATER/GAMA(18))**2.0
18306 A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
18307 !C
18308 !C
18309 BB = A4+LAMDA+PSI4 ! KAPA
18310 CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4
18311 DD = MAX(BB*BB-4.D0*CC, ZERO)
18312 KAPA = 0.5D0*(-BB+SQRT(DD))
18313 !C
18314 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
18315 !C
18316 MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI
18317 MOLAL (2) = PSI2 ! NAI
18318 MOLAL (3) = PSI1 ! NH4I
18319 MOLAL (4) = ZERO
18320 MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I
18321 MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I
18322 MOLAL (7) = ZERO
18323 MOLAL (8) = ZERO
18324 MOLAL (9) = PSI3 ! KI
18325 MOLAL (10)= PSI4
18326 !C
18327 CNH4HS4 = ZERO
18328 CNAHSO4 = ZERO
18329 CKHSO4 = CHI3-PSI3
18330 CCASO4 = W(6)
18331 CMGSO4 = ZERO
18332 !C
18333 CALL CALCMR2p1 ! Water content
18334 !C
18335 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
18336 !C
18337 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
18338 CALL CALCACT2p1
18339 ELSE
18340 GOTO 20
18341 ENDIF
18342 10 CONTINUE
18343 !C
18344 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
18345 !C
18346 20 FUNCK32p1 = MOLAL(9)*MOLAL(6)/A3 - ONE
18347 !C
18348 !C *** END OF FUNCTION FUNCK3 *******************************************
18349 !C
18350 END
18351 !C
18352 !C=======================================================================
18353 !C
18354 !C *** ISORROPIA CODE II
18355 !C *** SUBROUTINE CALCK2
18356 !C *** CASE K2
18357 !C
18358 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18359 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18360 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18361 !C 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4
18362 !C
18363 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18364 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18365 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18366 !C
18367 !C=======================================================================
18368 !C
18369 SUBROUTINE CALCK22p1
18370 INCLUDE 'module_isrpia_inc.F'
18371 !C
18372 DOUBLE PRECISION LAMDA, KAPA
18373 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18374 A1, A2, A3, A4
18375 !C
18376 !C *** SETUP PARAMETERS ************************************************
18377 !C
18378 CALAOU =.TRUE. ! Outer loop activity calculation flag
18379 CHI1 = W(3) ! Total NH4 initially as NH4HSO4
18380 CHI2 = W(1) ! Total NA initially as NaHSO4
18381 CHI3 = W(7) ! Total K initially as KHSO4
18382 CHI4 = W(8) ! Total Mg initially as MgSO4
18383 !C
18384 PSI3LO = TINY ! Low limit
18385 PSI3HI = CHI3 ! High limit
18386 !C
18387 !C *** INITIAL VALUES FOR BISECTION ************************************
18388 !C
18389 X1 = PSI3HI
18390 Y1 = FUNCK22p1 (X1)
18391 YHI= Y1 ! Save Y-value at HI position
18392 !C
18393 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 ****
18394 !C
18395 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
18396 !C
18397 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
18398 !C
18399 DX = (PSI3HI-PSI3LO)/FLOAT(NDIV)
18400 DO 10 I=1,NDIV
18401 X2 = X1-DX
18402 Y2 = FUNCK22p1 (X2)
18403 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
18404 X1 = X2
18405 Y1 = Y2
18406 10 CONTINUE
18407 !C
18408 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4
18409 !C
18410 YLO= Y1 ! Save Y-value at Hi position
18411 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
18412 Y3 = FUNCK22p1 (ZERO)
18413 GOTO 50
18414 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
18415 GOTO 50
18416 ELSE
18417 CALL PUSHERR2p1 (0001, 'CALCK2') ! WARNING ERROR: NO SOLUTION
18418 GOTO 50
18419 ENDIF
18420 !C
18421 !C *** PERFORM BISECTION ***********************************************
18422 !C
18423 20 DO 30 I=1,MAXIT
18424 X3 = 0.5*(X1+X2)
18425 Y3 = FUNCK22p1 (X3)
18426 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
18427 Y2 = Y3
18428 X2 = X3
18429 ELSE
18430 Y1 = Y3
18431 X1 = X3
18432 ENDIF
18433 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
18434 30 CONTINUE
18435 CALL PUSHERR2p1 (0002, 'CALCK2') ! WARNING ERROR: NO CONVERGENCE
18436 !C
18437 !C *** CONVERGED ; RETURN **********************************************
18438 !C
18439 40 X3 = 0.5*(X1+X2)
18440 Y3 = FUNCK22p1 (X3)
18441 !C
18442 50 RETURN
18443 !C
18444 !C *** END OF SUBROUTINE CALCK2 ******************************************
18445 !C
18446 END
18447 !C
18448 !C=======================================================================
18449 !C
18450 !C *** ISORROPIA CODE II
18451 !C *** SUBROUTINE FUNCK2
18452 !C *** CASE K2
18453 !C
18454 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18455 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18456 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18457 !C 3. SOLIDS POSSIBLE : NAHSO4, KHSO4, CaSO4
18458 !C
18459 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18460 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18461 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18462 !C
18463 !C=======================================================================
18464 !C
18465 DOUBLE PRECISION FUNCTION FUNCK22p1 (P1)
18466 INCLUDE 'module_isrpia_inc.F'
18467 DOUBLE PRECISION LAMDA, KAPA
18468 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18469 A1, A2, A3, A4
18470 !C
18471 !C *** SETUP PARAMETERS ************************************************
18472 !C
18473 FRST = .TRUE.
18474 CALAIN = .TRUE.
18475 !C
18476 LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4
18477 PSI3 = P1
18478 PSI1 = CHI1 ! ALL NH4HSO4 DELIQUESCED
18479 PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED
18480 !C
18481 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
18482 !C
18483 DO 10 I=1,NSWEEP
18484 !C
18485 A2 = XK11 *(WATER/GAMA(12))**2.0
18486 A3 = XK18 *(WATER/GAMA(18))**2.0
18487 A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
18488 !C
18489 PSI2 = A2/A3*PSI3 ! PSI2
18490 PSI2 = MIN(MAX(PSI2, ZERO),CHI2)
18491 !C
18492 BB = A4+LAMDA+PSI4 ! KAPA
18493 CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4
18494 DD = MAX(BB*BB-4.D0*CC, ZERO)
18495 KAPA = 0.5D0*(-BB+SQRT(DD))
18496 !C
18497 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
18498 !C
18499 MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI
18500 MOLAL (2) = PSI2 ! NAI
18501 MOLAL (3) = PSI1 ! NH4I
18502 MOLAL (4) = ZERO
18503 MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I
18504 MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I
18505 MOLAL (7) = ZERO
18506 MOLAL (8) = ZERO
18507 MOLAL (9) = PSI3 ! KI
18508 MOLAL (10)= PSI4
18509 !C
18510 CNH4HS4 = ZERO
18511 CNAHSO4 = CHI2-PSI2
18512 CKHSO4 = CHI3-PSI3
18513 CCASO4 = W(6)
18514 CMGSO4 = ZERO
18515 !C
18516 CALL CALCMR2p1 ! Water content
18517 !C
18518 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
18519 !C
18520 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
18521 CALL CALCACT2p1
18522 ELSE
18523 GOTO 20
18524 ENDIF
18525 10 CONTINUE
18526 !C
18527 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
18528 !C
18529 20 FUNCK22p1 = MOLAL(9)*MOLAL(6)/A3 - ONE
18530 !C
18531 !C *** END OF FUNCTION FUNCK2 *******************************************
18532 !C
18533 END
18534 !C
18535 !C=======================================================================
18536 !C
18537 !C *** ISORROPIA CODE II
18538 !C *** SUBROUTINE CALCK1
18539 !C *** CASE K1
18540 !C
18541 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18542 !C 1. SULFATE SUPER RICH, FREE ACID (SO4RAT < 1.0)
18543 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18544 !C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4
18545 !C
18546 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18547 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18548 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18549 !C
18550 !C=======================================================================
18551 !C
18552 SUBROUTINE CALCK12p1
18553 INCLUDE 'module_isrpia_inc.F'
18554 !C
18555 DOUBLE PRECISION LAMDA, KAPA
18556 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18557 A1, A2, A3, A4
18558 !C
18559 !C *** SETUP PARAMETERS ************************************************
18560 !C
18562 CALAOU =.TRUE. ! Outer loop activity calculation flag
18563 CHI1 = W(3) ! Total NH4 initially as NH4HSO4
18564 CHI2 = W(1) ! Total NA initially as NaHSO4
18565 CHI3 = W(7) ! Total K initially as KHSO4
18566 CHI4 = W(8) ! Total Mg initially as MGSO4
18567 !C
18568 PSI3LO = TINY ! Low limit
18569 PSI3HI = CHI3 ! High limit
18570 !C
18571 !C *** INITIAL VALUES FOR BISECTION ************************************
18572 !C
18573 X1 = PSI3HI
18574 Y1 = FUNCK12p1 (X1)
18575 YHI= Y1 ! Save Y-value at HI position
18576 !C
18577 !C *** YHI < 0.0 THE SOLUTION IS ALWAYS UNDERSATURATED WITH KHSO4 ****
18578 !C
18579 IF (ABS(Y1).LE.EPS .OR. YHI.LT.ZERO) GOTO 50
18580 !C
18581 !C *** ROOT TRACKING ; FOR THE RANGE OF HI AND LO **********************
18582 !C
18583 DX = (PSI3HI-PSI3LO)/FLOAT(NDIV)
18584 DO 10 I=1,NDIV
18585 X2 = X1-DX
18586 Y2 = FUNCK12p1 (X2)
18587 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y2).LT.ZERO) GOTO 20 ! (Y1*Y2.LT.ZERO)
18588 X1 = X2
18589 Y1 = Y2
18590 10 CONTINUE
18591 !C
18592 !C *** { YLO, YHI } > 0.0 THE SOLUTION IS ALWAYS SUPERSATURATED WITH KHSO4
18593 !C
18594 YLO= Y1 ! Save Y-value at Hi position
18595 IF (YLO.GT.ZERO .AND. YHI.GT.ZERO) THEN
18596 Y3 = FUNCK12p1 (ZERO)
18597 GOTO 50
18598 ELSE IF (ABS(Y2) .LT. EPS) THEN ! X2 IS A SOLUTION
18599 GOTO 50
18600 ELSE
18601 CALL PUSHERR2p1 (0001, 'CALCK1') ! WARNING ERROR: NO SOLUTION
18602 GOTO 50
18603 ENDIF
18604 !C
18605 !C *** PERFORM BISECTION ***********************************************
18606 !C
18607 20 DO 30 I=1,MAXIT
18608 X3 = 0.5*(X1+X2)
18609 Y3 = FUNCK12p1 (X3)
18610 IF (SIGN(1.d0,Y1)*SIGN(1.d0,Y3) .LE. ZERO) THEN ! (Y1*Y3 .LE. ZERO)
18611 Y2 = Y3
18612 X2 = X3
18613 ELSE
18614 Y1 = Y3
18615 X1 = X3
18616 ENDIF
18617 IF (ABS(X2-X1) .LE. EPS*X1) GOTO 40
18618 30 CONTINUE
18619 CALL PUSHERR2p1 (0002, 'CALCK1') ! WARNING ERROR: NO CONVERGENCE
18620 !C
18621 !C *** CONVERGED ; RETURN **********************************************
18622 !C
18623 40 X3 = 0.5*(X1+X2)
18624 Y3 = FUNCK12p1 (X3)
18625 !C
18626 50 RETURN
18627 !C
18628 !C *** END OF SUBROUTINE CALCK1 ******************************************
18629 !C
18630 END
18631 !C
18632 !C=======================================================================
18633 !C
18634 !C *** ISORROPIA CODE II
18635 !C *** SUBROUTINE FUNCK1
18636 !C *** CASE K1
18637 !C
18638 !C THE MAIN CHARACTERISTICS OF THIS REGIME ARE:
18639 !C 1. SULFATE super RICH, FREE ACID (SO4RAT < 1.0)
18640 !C 2. THERE IS BOTH A LIQUID & SOLID PHASE
18641 !C 3. SOLIDS POSSIBLE : NH4HSO4, NAHSO4, KHSO4, CASO4
18642 !C
18643 !C *** COPYRIGHT 1996-2006, UNIVERSITY OF MIAMI, CARNEGIE MELLON UNIVERSITY
18644 !C *** GEORGIA INSTITUTE OF TECHNOLOGY
18645 !C *** WRITTEN BY CHRISTOS FOUNTOUKIS AND ATHANASIOS NENES
18646 !C
18647 !C=======================================================================
18648 !C
18649 DOUBLE PRECISION FUNCTION FUNCK12p1 (P1)
18650 INCLUDE 'module_isrpia_inc.F'
18651 DOUBLE PRECISION LAMDA, KAPA
18652 COMMON /CASEK2p1/ CHI1,CHI2,CHI3,CHI4,LAMDA,KAPA,PSI1,PSI2,PSI3, &
18653 A1, A2, A3, A4
18654 !C
18655 !C *** SETUP PARAMETERS ************************************************
18656 !C
18657 FRST = .TRUE.
18658 CALAIN = .TRUE.
18659 !C
18660 LAMDA = MAX(W(2) - W(3) - W(1) - W(6) - W(7) - W(8), TINY) ! FREE H2SO4
18661 PSI3 = P1
18662 PSI4 = CHI4 ! ALL MgSO4 DELIQUESCED
18663 !C
18664 !C *** SOLVE EQUATIONS ; WITH ITERATIONS FOR ACTIVITY COEF. ************
18665 !C
18666 DO 10 I=1,NSWEEP
18667 !C
18668 A1 = XK12 *(WATER/GAMA(09))**2.0
18669 A2 = XK11 *(WATER/GAMA(12))**2.0
18670 A3 = XK18 *(WATER/GAMA(18))**2.0
18671 A4 = XK1 *WATER/GAMA(7)*(GAMA(8)/GAMA(7))**2.0
18672 !C
18673 PSI1 = A1/A3*PSI3 ! PSI1
18674 PSI1 = MIN(MAX(PSI1, ZERO),CHI1)
18675 !C
18676 PSI2 = A2/A3*PSI3 ! PSI2
18677 PSI2 = MIN(MAX(PSI2, ZERO),CHI2)
18678 !C
18679 BB = A4+LAMDA+PSI4 ! KAPA
18680 CC =-A4*(LAMDA + PSI3 + PSI2 + PSI1) + LAMDA*PSI4
18681 DD = MAX(BB*BB-4.D0*CC, ZERO)
18682 KAPA = 0.5D0*(-BB+SQRT(DD))
18683 !C
18684 !C *** SAVE CONCENTRATIONS IN MOLAL ARRAY ******************************
18685 !C
18686 MOLAL (1) = MAX(LAMDA + KAPA, ZERO) ! HI
18687 MOLAL (2) = PSI2 ! NAI
18688 MOLAL (3) = PSI1 ! NH4I
18689 MOLAL (4) = ZERO ! CLI
18690 MOLAL (5) = MAX(KAPA + PSI4, ZERO) ! SO4I
18691 MOLAL (6) = MAX(LAMDA+PSI1+PSI2+PSI3-KAPA,ZERO) ! HSO4I
18692 MOLAL (7) = ZERO ! NO3I
18693 MOLAL (8) = ZERO ! CAI
18694 MOLAL (9) = PSI3 ! KI
18695 MOLAL (10)= PSI4 ! MGI
18696 !C
18697 CNH4HS4 = CHI1-PSI1
18698 CNAHSO4 = CHI2-PSI2
18699 CKHSO4 = CHI3-PSI3
18700 CCASO4 = W(6)
18701 CMGSO4 = ZERO
18702 !C
18703 CALL CALCMR2p1 ! Water content
18704 !C
18705 !C *** CALCULATE ACTIVITIES OR TERMINATE INTERNAL LOOP *****************
18706 !C
18707 IF (FRST.AND.CALAOU .OR. .NOT.FRST.AND.CALAIN) THEN
18708 CALL CALCACT2p1
18710 ELSE
18711 GOTO 20
18712 ENDIF
18713 10 CONTINUE
18714 !C
18715 !C *** CALCULATE OBJECTIVE FUNCTION ************************************
18716 !C
18717 20 FUNCK12p1 = MOLAL(9)*MOLAL(6)/A3 - ONE
18718 !C
18719 !C *** END OF FUNCTION FUNCK1 ****************************************
18720 !C
18721 END