File: pick-dir/pick.f90
1 PROGRAM PICK
2 USE KINETIC
3 IMPLICIT NONE
4 !
5 ! PARAMETER definitions
6 !
7 INTEGER , PARAMETER :: NMAXR = 10000 , NMAXS = 500
8 !
9 ! Local variables
10 !
11 TYPE (BIMOLECULAR_RECORD) , DIMENSION(NMAXR) :: bimolecular
12 TYPE (BULKBIMOLECULAR_RECORD) , DIMENSION(NMAXR) &
13 & :: bulkbimolecular
14 TYPE (BULKTRANSFER_RECORD) , DIMENSION(NMAXR) :: bulktransfer
15 TYPE (COSMICRAY_RECORD) , DIMENSION(NMAXR) :: cosmicray
16 CHARACTER(200) :: fn , fnbi_in , fnbi_out , fnbulkbi_in , &
17 & fnbulkbi_out , fnbulktrans_in , &
18 & fnbulktrans_out , fncr_in , fncr_out , &
19 & fnhet_in , fnhet_out , fnj_in , fnj_out , &
20 & fnspecies , fntri_in , fntri_out , fnuhet_in , &
21 & fnuhet_out
22 TYPE (HETEROGENEOUS_RECORD) , DIMENSION(NMAXR) :: heterogeneous
23 INTEGER :: i , ispint , isppce , iwant , j , jchan , jlog , &
24 & jreject , jselect , nkb , nkbulkbi , nkbulktrans , &
25 & nkcr , nkh , nkj , nkt , nkuh , nlinesperpage , nspec
26 LOGICAL , DIMENSION(14) :: lp
27 LOGICAL :: lp_all , lp_any , lr_all , lverb , lwant_r , &
28 & l_p_unknown , l_r_unknown , l_unknown
29 LOGICAL , DIMENSION(2) :: lr
30 LOGICAL :: LSPEC , LWANT_THIS_REACTION
31 TYPE (PHOTOLYSIS_RECORD) , DIMENSION(NMAXR) :: photolysis
32 TYPE (SPECIES_RECORD) , DIMENSION(NMAXS) :: species
33 CHARACTER(20) :: st_blank , st_unknown
34 TYPE (TRIMOLECULAR_RECORD) , DIMENSION(NMAXR) :: trimolecular
35 TYPE (UMOLECULARHETEROGENEOUS_RECORD) , DIMENSION(NMAXR) &
36 & :: uniheterogeneous
37 !
38 !-----------------------------------------------------------------------
39 !
40 ! Written by: David Lary
41 !
42 ! Started: 7/1/1993
43 !
44 ! Last updated: 29/1/2004
45 !
46 !-----------------------------------------------------------------------
47 !
48 ! itype:
49 ! 1 = bimolecular.
50 ! 2 = trimolecular.
51 ! 3 = photolysis.
52 ! 4 = heterogeneous.
53 ! 5 = unimolecular heterogeneous.
54 ! 6 = bulk phase bimolecular.
55 ! 7 = bulk phase transfer (into the drop).
56 ! 8 = bulk phase transfer (out of drop).
57 ! 9 = cosmic rays.
58 !
59 !----------------------------------------------------------------------
60 !
61 PRINT * , "Pick.'
62 jlog = 1
63 jchan = 10
64 lverb = .TRUE.
65 lverb = .FALSE.
66 !
67 !----------------------------------------------------------------------
68 !
69 fn = "pick.log'
70 PRINT * , TRIM(fn)
71 OPEN (jlog,FILE=TRIM(fn),STATUS="unknown')
72 !
73 !----------------------------------------------------------------------
74 !
75 jselect = 4
76 jreject = 1
77 !
78 !----------------------------------------------------------------------
79 !
80 CALL BLANK(st_blank)
81 CALL BLANK(st_unknown)
82 st_unknown(1:1) = "?'
83 !
84 !----------------------------------------------------------------------
85 !
86 fnspecies = "specie.d'
87 !
88 !----------------------------------------------------------------------
89 !
90 ! Open control file
91 fn = "pick.ctl'
92 PRINT * , TRIM(fn)
93 OPEN (jchan,FILE=TRIM(fn),STATUS="old')
94 READ (jchan,*) jselect
95 DO i = 1 , 5
96 READ (jchan,*)
97 ENDDO
98 READ (jchan,*) jreject
99 !
100 READ (jchan,*) fnbi_in
101 READ (jchan,*) fnbi_out
102 !
103 READ (jchan,*) fntri_in
104 READ (jchan,*) fntri_out
105 !
106 READ (jchan,*) fnj_in
107 READ (jchan,*) fnj_out
108 !
109 READ (jchan,*) fnhet_in
110 READ (jchan,*) fnhet_out
111 !
112 READ (jchan,*) fnuhet_in
113 READ (jchan,*) fnuhet_out
114 !
115 READ (jchan,*) fnbulktrans_in
116 READ (jchan,*) fnbulktrans_out
117 !
118 READ (jchan,*) fnbulkbi_in
119 READ (jchan,*) fnbulkbi_out
120 !
121 READ (jchan,*) fncr_in
122 READ (jchan,*) fncr_out
123 !
124 CLOSE (jchan)
125 !
126 !----------------------------------------------------------------------
127 !
128 ! Read in an AutoChem required species list.
129 CALL RD_SPECIES(jchan,fnspecies,species,lverb,NMAXS,nspec,isppce, &
130 & ispint)
131 IF ( nspec>NMAXS ) THEN
132 PRINT * , "Increase NMAXS to > ' , nspec
133 STOP
134 ENDIF
135 PRINT * , "the total number of species is :' , nspec
136 PRINT * , "the number of integrated species is:' , ispint
137 PRINT * , "The number of species in pce is :' , isppce
138 !
139 !----------------------------------------------------------------------
140 !
141 ! Read in an AutoChem bimolecular kinetic data file.
142 CALL RD_ALL_BI(jchan,fnbi_in,bimolecular,lverb,NMAXR,nkb)
143 IF ( nkb>NMAXR ) THEN
144 PRINT * , "Increase NMAXR to > ' , nkb
145 STOP
146 ENDIF
147 !
148 ! Read in an AutoChem trimolecular kinetic data file.
149 CALL RD_ALL_TRI(jchan,fntri_in,trimolecular,lverb,NMAXR,nkt)
150 IF ( nkt>NMAXR ) THEN
151 PRINT * , "Increase NMAXR to > ' , nkt
152 STOP
153 ENDIF
154 !
155 ! Read in an AutoChem photolysis kinetic data file.
156 CALL RD_ALL_J(jchan,fnj_in,photolysis,lverb,NMAXR,nkj)
157 IF ( nkj>NMAXR ) THEN
158 PRINT * , "Increase NMAXR to > ' , nkj
159 STOP
160 ENDIF
161 !
162 ! Read in an AutoChem heterogeneous kinetic data file.
163 CALL RD_ALL_HET(jchan,fnhet_in,heterogeneous,lverb,NMAXR,nkh)
164 IF ( nkh>NMAXR ) THEN
165 PRINT * , "Increase NMAXR to > ' , nkh
166 STOP
167 ENDIF
168 !
169 ! Read in an AutoChem heterogeneous kinetic data file.
170 CALL RD_ALL_UNIHET(jchan,fnuhet_in,uniheterogeneous,lverb,NMAXR, &
171 & nkuh)
172 IF ( nkuh>NMAXR ) THEN
173 PRINT * , "Increase NMAXR to > ' , nkuh
174 STOP
175 ENDIF
176 !
177 ! Read in an AutoChem bulk phase bimolecular kinetic data file.
178 CALL RD_ALL_BULKBI(jchan,fnbulkbi_in,bulkbimolecular,lverb,NMAXR, &
179 & nkbulkbi)
180 IF ( nkbulkbi>NMAXR ) THEN
181 PRINT * , "Increase NMAXR to > ' , nkbulkbi
182 STOP
183 ENDIF
184 !
185 ! Read in an AutoChem bulk phase transfer data file.
186 CALL RD_ALL_BULKTRANS(jchan,fnbulktrans_in,bulktransfer,lverb, &
187 & NMAXR,nkbulktrans)
188 IF ( nkbulktrans>NMAXR ) THEN
189 PRINT * , "Increase NMAXR to > ' , nkbulktrans
190 STOP
191 ENDIF
192 !
193 ! Read in an AutoChem Cosmic Ray kinetic data file.
194 CALL RD_ALL_CR(jchan,fncr_in,cosmicray,lverb,NMAXR,nkcr)
195 IF ( nkcr>NMAXR ) THEN
196 PRINT * , "Increase NMAXR to > ' , nkcr
197 STOP
198 ENDIF
199 !
200 !----------------------------------------------------------------------
201 !
202 IF ( lverb ) THEN
203 DO i = 1 , nkb
204 PRINT "(i4,1x,a)' , i , TRIM(bimolecular(i)%comment)
205 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
206 & (bimolecular(i)%RE(j),j=1,bimolecular(i)%iwantr)
207 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
208 & (bimolecular(i)%P(j),j=1,bimolecular(i)%iwantp)
209 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
210 & (bimolecular(i)%Z(j),j=1,bimolecular(i)%iwantp)
211 PRINT "(1p,a1,1x,1(5(e13.4,8x),2x))' , bimolecular(i)%flag ,&
212 & bimolecular(i)%a1 , bimolecular(i)%a2 , bimolecular(i)&
213 & %a3 , bimolecular(i)%a4 , bimolecular(i)%a5
214 IF ( bimolecular(i)%flag=="V' ) THEN
215 PRINT "(1p,1(2x,5(e13.4,8x)),/)' , bimolecular(i)%b1 , &
216 & bimolecular(i)%b2 , bimolecular(i)%b3 , &
217 & bimolecular(i)%b4 , bimolecular(i)%b5
218 ELSE
219 PRINT *
220 ENDIF
221 ENDDO
222 ENDIF
223 IF ( lverb ) THEN
224 DO i = 1 , nkt
225 PRINT "(i4,1x,a)' , i , TRIM(trimolecular(i)%comment)
226 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
227 & (trimolecular(i)%RE(j),j=1,trimolecular(i)%iwantr)
228 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
229 & (trimolecular(i)%P(j),j=1,trimolecular(i)%iwantp)
230 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
231 & (trimolecular(i)%Z(j),j=1,trimolecular(i)%iwantp)
232 IF ( trimolecular(i)%flag=="E' ) THEN
233 PRINT "(1p,1(2x,2(e13.4,8x)),/)' , trimolecular(i)%a1 , &
234 & trimolecular(i)%a2
235 ELSE
236 PRINT "(1p,a1,1x,1(5(e13.4,8x),2x))' , trimolecular(i) &
237 & %flag , trimolecular(i)%a1 , trimolecular(i)%a2 , &
238 & trimolecular(i)%a3 , trimolecular(i)%a4 , &
239 & trimolecular(i)%a5
240 PRINT "(1p,2x,1(5(e13.4,8x),2x))' , trimolecular(i)%b1 , &
241 & trimolecular(i)%b2 , trimolecular(i)%b3 , &
242 & trimolecular(i)%b4 , trimolecular(i)%b5
243 PRINT "(1p,2x,1(5(e13.4,8x),2x),/)' , trimolecular(i) &
244 & %c1 , trimolecular(i)%c2 , trimolecular(i)%c3 , &
245 & trimolecular(i)%c4 , trimolecular(i)%c5
246 ENDIF
247 ENDDO
248 ENDIF
249 IF ( lverb ) THEN
250 DO i = 1 , nkj
251 PRINT "(i4,1x,a)' , i , TRIM(photolysis(i)%comment)
252 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
253 & (photolysis(i)%RE(j),j=1,photolysis(i)%iwantr)
254 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
255 & (photolysis(i)%P(j),j=1,photolysis(i)%iwantp)
256 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
257 & (photolysis(i)%Z(j),j=1,photolysis(i)%iwantp)
258 PRINT "(5x,a)' , TRIM(photolysis(i)%st_cross_data)
259 PRINT "(5x,a,/)' , TRIM(photolysis(i)%st_cross_fun)
260 ENDDO
261 ENDIF
262 IF ( lverb ) THEN
263 DO i = 1 , nkh
264 PRINT "(i4,1x,a)' , i , TRIM(heterogeneous(i)%comment)
265 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
266 & (heterogeneous(i)%RE(j),j=1,heterogeneous(i)%iwantr)
267 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
268 & (heterogeneous(i)%P(j),j=1,heterogeneous(i)%iwantp)
269 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
270 & (heterogeneous(i)%Z(j),j=1,heterogeneous(i)%iwantp)
271 PRINT "(1p,3x,i3,17x,e13.4,11x,a25)' , heterogeneous(i) &
272 & %isptype , heterogeneous(i)%gamma , &
273 & TRIM(heterogeneous(i)%fun)
274 PRINT "(1p,2x,4(e13.4,8x),/)' , heterogeneous(i)%sig , &
275 & heterogeneous(i)%eps , heterogeneous(i)%rm , &
276 & heterogeneous(i)%alpha
277 ENDDO
278 ENDIF
279 IF ( lverb ) THEN
280 DO i = 1 , nkuh
281 PRINT "(i4,1x,a)' , i , TRIM(uniheterogeneous(i)%comment)
282 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
283 & (uniheterogeneous(i)%RE(j),j=1,uniheterogeneous(i) &
284 & %iwantr)
285 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
286 & (uniheterogeneous(i)%P(j),j=1,uniheterogeneous(i) &
287 & %iwantp)
288 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
289 & (uniheterogeneous(i)%Z(j),j=1,uniheterogeneous(i) &
290 & %iwantp)
291 PRINT "(1p,3x,i3,17x,e13.4,11x,a25)' , uniheterogeneous(i) &
292 & %isptype , uniheterogeneous(i)%gamma , &
293 & TRIM(uniheterogeneous(i)%fun)
294 PRINT "(1p,2x,e13.4,/)' , uniheterogeneous(i)%rm
295 ENDDO
296 ENDIF
297 IF ( lverb ) THEN
298 DO i = 1 , nkbulkbi
299 PRINT "(i4,1x,a)' , i , TRIM(bulkbimolecular(i)%comment)
300 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
301 & (bulkbimolecular(i)%RE(j),j=1,bulkbimolecular(i) &
302 & %iwantr)
303 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
304 & (bulkbimolecular(i)%P(j),j=1,bulkbimolecular(i) &
305 & %iwantp)
306 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
307 & (bulkbimolecular(i)%Z(j),j=1,bulkbimolecular(i) &
308 & %iwantp)
309 PRINT "(1p,2x,i4,17x,2(e13.4,8x),/)' , bulkbimolecular(i) &
310 & %isptype , bulkbimolecular(i)%a1 , bulkbimolecular(i) &
311 & %a2
312 ENDDO
313 ENDIF
314 IF ( lverb ) THEN
315 DO i = 1 , nkbulktrans
316 PRINT "(i4,1x,a)' , i , TRIM(bulktransfer(i)%comment)
317 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
318 & (bulktransfer(i)%RE(j),j=1,bulktransfer(i)%iwantr)
319 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
320 & (bulktransfer(i)%P(j),j=1,bulktransfer(i)%iwantp)
321 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
322 & (bulktransfer(i)%Z(j),j=1,bulktransfer(i)%iwantp)
323 PRINT "(1p,2x,5(e13.4,8x),/,2x,2(e13.4,8x),/,2x,i4,20x,a,/)'&
324 & , bulktransfer(i)%a2 , bulktransfer(i)%alpha , &
325 & bulktransfer(i)%rm , bulktransfer(i)%a1 , &
326 & bulktransfer(i)%a5 , bulktransfer(i)%sig , &
327 & bulktransfer(i)%eps , bulktransfer(i)%isptype , &
328 & bulktransfer(i)%fun
329 ENDDO
330 ENDIF
331 IF ( lverb ) THEN
332 DO i = 1 , nkcr
333 PRINT "(i4,1x,a)' , i , TRIM(cosmicray(i)%comment)
334 PRINT "(a2,3x,2(a20,1x))' , "R:' , &
335 & (cosmicray(i)%RE(j),j=1,cosmicray(i)%iwantr)
336 PRINT "(1p,a2,3x,14(a20,1x))' , "P:' , &
337 & (cosmicray(i)%P(j),j=1,cosmicray(i)%iwantp)
338 PRINT "(1p,a2,14(e13.4,8x))' , "#:' , &
339 & (cosmicray(i)%Z(j),j=1,cosmicray(i)%iwantp)
340 PRINT "(1p,2x,e13.4,/)' , cosmicray(i)%formrateperion
341 ENDDO
342 ENDIF
343 !
344 !----------------------------------------------------------------------
345 !
346 ! Now check to see which reactions are needed.
347 !
348 !----------------------------------------------------------------------
349 !
350 PRINT * , TRIM(fnbi_out)
351 OPEN (jchan,FILE=TRIM(fnbi_out),STATUS="unknown')
352 !
353 !----------------------------------------------------------------------
354 !
355 ! Skip header
356 DO i = 1 , 3
357 WRITE (jchan,*)
358 ENDDO
359 !
360 WRITE (jlog,FMT=*) "bimolecular'
361 iwant = 0
362 DO i = 1 , nkb
363 !
364 ! reactants.
365 l_r_unknown = .FALSE.
366 DO j = 1 , bimolecular(i)%iwantr
367 lr(j) = LSPEC(bimolecular(i)%RE(j),species%speci,nspec, &
368 & NMAXS)
369 IF ( bimolecular(i)%RE(j)==st_unknown ) l_r_unknown = .TRUE.
370 ENDDO
371 !
372 ! If all reactants are required species.
373 lr_all = ALL(lr(1:bimolecular(i)%iwantr))
374 !
375 ! products.
376 l_p_unknown = .FALSE.
377 DO j = 1 , bimolecular(i)%iwantp
378 lp(j) = LSPEC(bimolecular(i)%P(j),species%speci,nspec,NMAXS)
379 IF ( bimolecular(i)%P(j)==st_unknown ) l_p_unknown = .TRUE.
380 ENDDO
381 !
382 ! If all products are required species.
383 lp_all = ALL(lp(1:bimolecular(i)%iwantp))
384 !
385 ! If any products are required species.
386 lp_any = ANY(lp(1:bimolecular(i)%iwantp))
387 !
388 ! If any unknown reactants or products
389 l_unknown = l_r_unknown .OR. l_p_unknown
390 !
391 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
392 & jreject,l_unknown,jlog)
393 IF ( lwant_r ) THEN
394 iwant = iwant + 1
395 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
396 & TRIM(bimolecular(i)%comment)
397 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
398 & (bimolecular(i)%RE(j),j=1,bimolecular(i)%iwantr)
399 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
400 & (bimolecular(i)%P(j),j=1,bimolecular(i)%iwantp)
401 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
402 & (bimolecular(i)%Z(j),j=1,bimolecular(i)%iwantp)
403 WRITE (jchan,FMT="(1p,a1,1x,1(5(e13.4,8x),2x))') &
404 & bimolecular(i)%flag , bimolecular(i)%a1 , &
405 & bimolecular(i)%a2 , bimolecular(i)%a3 , &
406 & bimolecular(i)%a4 , bimolecular(i)%a5
407 IF ( bimolecular(i)%flag=="V' ) THEN
408 WRITE (jchan,FMT="(1p,1(2x,5(e13.4,8x)),/)') &
409 & bimolecular(i)%b1 , bimolecular(i)%b2 , &
410 & bimolecular(i)%b3 , bimolecular(i)%b4 , &
411 & bimolecular(i)%b5
412 ELSE
413 WRITE (jchan,*)
414 ENDIF
415 ELSE
416 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
417 & (bimolecular(i)%RE(j),j=1,bimolecular(i)%iwantr)
418 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
419 & (bimolecular(i)%P(j),j=1,bimolecular(i)%iwantp)
420 ENDIF
421 !
422 ENDDO
423 CLOSE (jchan)
424 PRINT * , "Selected :' , iwant , " bimolecular reactions.'
425 nkb = iwant
426 !
427 !----------------------------------------------------------------------
428 !
429 PRINT * , TRIM(fntri_out)
430 OPEN (jchan,FILE=TRIM(fntri_out),STATUS="unknown')
431 !
432 !----------------------------------------------------------------------
433 !
434 ! Skip header
435 DO i = 1 , 3
436 WRITE (jchan,*)
437 ENDDO
438 !
439 WRITE (jlog,FMT=*) "trimolecular'
440 iwant = 0
441 DO i = 1 , nkt
442 !
443 ! reactants.
444 l_r_unknown = .FALSE.
445 DO j = 1 , trimolecular(i)%iwantr
446 lr(j) = LSPEC(trimolecular(i)%RE(j),species%speci,nspec, &
447 & NMAXS)
448 IF ( trimolecular(i)%RE(j)==st_unknown ) &
449 & l_r_unknown = .TRUE.
450 ENDDO
451 !
452 ! If all reactants are required species.
453 lr_all = ALL(lr(1:trimolecular(i)%iwantr))
454 !
455 ! products.
456 l_p_unknown = .FALSE.
457 DO j = 1 , trimolecular(i)%iwantp
458 lp(j) = LSPEC(trimolecular(i)%P(j),species%speci,nspec, &
459 & NMAXS)
460 IF ( trimolecular(i)%P(j)==st_unknown ) l_p_unknown = .TRUE.
461 ENDDO
462 !
463 ! If all products are required species.
464 lp_all = ALL(lp(1:trimolecular(i)%iwantp))
465 !
466 ! If any products are required species.
467 lp_any = ANY(lp(1:trimolecular(i)%iwantp))
468 !
469 ! If any unknown reactants or products
470 l_unknown = l_r_unknown .OR. l_p_unknown
471 !
472 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
473 & jreject,l_unknown,jlog)
474 IF ( lwant_r ) THEN
475 iwant = iwant + 1
476 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
477 & TRIM(trimolecular(i)%comment)
478 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
479 & (trimolecular(i)%RE(j),j=1,trimolecular(i)%iwantr)
480 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
481 & (trimolecular(i)%P(j),j=1,trimolecular(i)%iwantp)
482 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
483 & (trimolecular(i)%Z(j),j=1,trimolecular(i)%iwantp)
484 !
485 IF ( trimolecular(i)%flag=="E' ) THEN
486 WRITE (jchan,FMT="(1p,1(2x,2(e13.4,8x)),/)') &
487 & trimolecular(i)%a1 , trimolecular(i)%a2
488 ELSE
489 WRITE (jchan,FMT="(1p,a1,1x,1(5(e13.4,8x),2x))') &
490 & trimolecular(i)%flag , trimolecular(i)%a1 , &
491 & trimolecular(i)%a2 , trimolecular(i)%a3 , &
492 & trimolecular(i)%a4 , trimolecular(i)%a5
493 WRITE (jchan,FMT="(1p,2x,1(5(e13.4,8x),2x))') &
494 & trimolecular(i)%b1 , trimolecular(i)%b2 , &
495 & trimolecular(i)%b3 , trimolecular(i)%b4 , &
496 & trimolecular(i)%b5
497 WRITE (jchan,FMT="(1p,2x,1(5(e13.4,8x),2x),/)') &
498 & trimolecular(i)%c1 , trimolecular(i)%c2 , &
499 & trimolecular(i)%c3 , trimolecular(i)%c4 , &
500 & trimolecular(i)%c5
501 ENDIF
502 ELSE
503 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
504 & (trimolecular(i)%RE(j),j=1,trimolecular(i)%iwantr)
505 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
506 & (trimolecular(i)%P(j),j=1,trimolecular(i)%iwantp)
507 ENDIF
508 !
509 ENDDO
510 CLOSE (jchan)
511 PRINT * , "Selected :' , iwant , " trimolecular reactions.'
512 nkt = iwant
513 !
514 !----------------------------------------------------------------------
515 !
516 PRINT * , TRIM(fnj_out)
517 OPEN (jchan,FILE=TRIM(fnj_out),STATUS="unknown')
518 !
519 !----------------------------------------------------------------------
520 !
521 ! Skip header
522 DO i = 1 , 3
523 WRITE (jchan,*)
524 ENDDO
525 !
526 WRITE (jlog,FMT=*) "photolysis'
527 iwant = 0
528 DO i = 1 , nkj
529 !
530 ! reactants.
531 l_r_unknown = .FALSE.
532 DO j = 1 , 1
533 lr(j) = LSPEC(photolysis(i)%RE(j),species%speci,nspec,NMAXS)
534 IF ( photolysis(i)%RE(j)==st_unknown ) l_r_unknown = .TRUE.
535 ENDDO
536 !
537 ! If all reactants are required species.
538 lr_all = ALL(lr(1:1))
539 !
540 ! products.
541 l_p_unknown = .FALSE.
542 DO j = 1 , photolysis(i)%iwantp
543 lp(j) = LSPEC(photolysis(i)%P(j),species%speci,nspec,NMAXS)
544 IF ( photolysis(i)%P(j)==st_unknown ) l_p_unknown = .TRUE.
545 ENDDO
546 !
547 ! If all products are required species.
548 lp_all = ALL(lp(1:photolysis(i)%iwantp))
549 !
550 ! If any products are required species.
551 lp_any = ANY(lp(1:photolysis(i)%iwantp))
552 !
553 ! If any unknown reactants or products
554 l_unknown = l_r_unknown .OR. l_p_unknown
555 !
556 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
557 & jreject,l_unknown,jlog)
558 IF ( lwant_r ) THEN
559 iwant = iwant + 1
560 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
561 & TRIM(photolysis(i)%comment)
562 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
563 & (photolysis(i)%RE(j),j=1,photolysis(i)%iwantr)
564 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
565 & (photolysis(i)%P(j),j=1,photolysis(i)%iwantp)
566 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
567 & (photolysis(i)%Z(j),j=1,photolysis(i)%iwantp)
568 WRITE (jchan,FMT="(5x,a)') TRIM(photolysis(i)%st_cross_data)
569 WRITE (jchan,FMT="(5x,a,/)') &
570 & TRIM(photolysis(i)%st_cross_fun)
571 !
572 ELSE
573 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
574 & (photolysis(i)%RE(j),j=1,photolysis(i)%iwantr)
575 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
576 & (photolysis(i)%P(j),j=1,photolysis(i)%iwantp)
577 ENDIF
578 !
579 ENDDO
580 CLOSE (jchan)
581 PRINT * , "Selected :' , iwant , " photolysis reactions.'
582 nkj = iwant
583 !
584 !----------------------------------------------------------------------
585 !
586 PRINT * , TRIM(fnhet_out)
587 OPEN (jchan,FILE=TRIM(fnhet_out),STATUS="unknown')
588 !
589 !----------------------------------------------------------------------
590 !
591 ! Skip header
592 DO i = 1 , 3
593 WRITE (jchan,*)
594 ENDDO
595 !
596 WRITE (jlog,FMT=*) "heterogeneous'
597 iwant = 0
598 DO i = 1 , nkh
599 !
600 ! reactants.
601 l_r_unknown = .FALSE.
602 DO j = 1 , heterogeneous(i)%iwantr
603 lr(j) = LSPEC(heterogeneous(i)%RE(j),species%speci,nspec, &
604 & NMAXS)
605 IF ( heterogeneous(i)%RE(j)==st_unknown ) &
606 & l_r_unknown = .TRUE.
607 ENDDO
608 !
609 ! If all reactants are required species.
610 lr_all = ALL(lr(1:heterogeneous(i)%iwantr))
611 !
612 ! products.
613 l_p_unknown = .FALSE.
614 DO j = 1 , heterogeneous(i)%iwantp
615 lp(j) = LSPEC(heterogeneous(i)%P(j),species%speci,nspec, &
616 & NMAXS)
617 IF ( heterogeneous(i)%P(j)==st_unknown ) &
618 & l_p_unknown = .TRUE.
619 ENDDO
620 !
621 ! If all products are required species.
622 lp_all = ALL(lp(1:heterogeneous(i)%iwantp))
623 !
624 ! If any products are required species.
625 lp_any = ANY(lp(1:heterogeneous(i)%iwantp))
626 !
627 ! If any unknown reactants or products
628 l_unknown = l_r_unknown .OR. l_p_unknown
629 !
630 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
631 & jreject,l_unknown,jlog)
632 ! IF ( lwant_r .AND. (heterogeneous(i)%gamma>0) ) THEN
633 IF ( lwant_r ) THEN
634 iwant = iwant + 1
635 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
636 & TRIM(heterogeneous(i)%comment)
637 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
638 & (heterogeneous(i)%RE(j),j=1,heterogeneous(i)%iwantr)
639 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
640 & (heterogeneous(i)%P(j),j=1,heterogeneous(i)%iwantp)
641 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
642 & (heterogeneous(i)%Z(j),j=1,heterogeneous(i)%iwantp)
643 !
644 WRITE (jchan,FMT="(1p,3x,i3,17x,e13.4,11x,a25)') &
645 & heterogeneous(i)%isptype , heterogeneous(i)%gamma , &
646 & heterogeneous(i)%fun
647 WRITE (jchan,FMT="(1p,2x,4(e13.4,8x),/)') heterogeneous(i) &
648 & %sig , heterogeneous(i)%eps , heterogeneous(i)%rm , &
649 & heterogeneous(i)%alpha
650 !
651 ELSE
652 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
653 & (heterogeneous(i)%RE(j),j=1,heterogeneous(i)%iwantr)
654 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
655 & (heterogeneous(i)%P(j),j=1,heterogeneous(i)%iwantp)
656 ENDIF
657 !
658 ENDDO
659 CLOSE (jchan)
660 PRINT * , "Selected :' , iwant , " heterogeneous reactions.'
661 nkh = iwant
662 !
663 !----------------------------------------------------------------------
664 !
665 PRINT * , TRIM(fnuhet_out)
666 OPEN (jchan,FILE=TRIM(fnuhet_out),STATUS="unknown')
667 !
668 !----------------------------------------------------------------------
669 !
670 ! Skip header
671 DO i = 1 , 3
672 WRITE (jchan,*)
673 ENDDO
674 !
675 WRITE (jlog,FMT=*) "uniheterogeneous'
676 iwant = 0
677 DO i = 1 , nkuh
678 !
679 ! reactants.
680 l_r_unknown = .FALSE.
681 DO j = 1 , 1
682 lr(j) = LSPEC(uniheterogeneous(i)%RE(j),species%speci,nspec,&
683 & NMAXS)
684 IF ( uniheterogeneous(i)%RE(j)==st_unknown ) &
685 & l_r_unknown = .TRUE.
686 ENDDO
687 !
688 ! If all reactants are required species.
689 lr_all = ALL(lr(1:1))
690 !
691 ! products.
692 l_p_unknown = .FALSE.
693 DO j = 1 , uniheterogeneous(i)%iwantp
694 lp(j) = LSPEC(uniheterogeneous(i)%P(j),species%speci,nspec, &
695 & NMAXS)
696 IF ( uniheterogeneous(i)%P(j)==st_unknown ) &
697 & l_p_unknown = .TRUE.
698 ENDDO
699 !
700 ! If all products are required species.
701 lp_all = ALL(lp(1:uniheterogeneous(i)%iwantp))
702 !
703 ! If any products are required species.
704 lp_any = ANY(lp(1:uniheterogeneous(i)%iwantp))
705 !
706 ! If any unknown reactants or products
707 l_unknown = l_r_unknown .OR. l_p_unknown
708 !
709 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
710 & jreject,l_unknown,jlog)
711 ! IF ( lwant_r .AND. (uniheterogeneous(i)%gamma>0) ) THEN
712 IF ( lwant_r ) THEN
713 iwant = iwant + 1
714 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
715 & TRIM(uniheterogeneous(i)%comment)
716 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
717 & (uniheterogeneous(i)%RE(j),j=1,uniheterogeneous(i) &
718 & %iwantr)
719 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
720 & (uniheterogeneous(i)%P(j),j=1,uniheterogeneous(i) &
721 & %iwantp)
722 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
723 & (uniheterogeneous(i)%Z(j),j=1,uniheterogeneous(i) &
724 & %iwantp)
725 !
726 WRITE (jchan,FMT="(1p,3x,i3,17x,e13.4,11x,a25)') &
727 & uniheterogeneous(i)%isptype , uniheterogeneous(i) &
728 & %gamma , uniheterogeneous(i)%fun
729 WRITE (jchan,FMT="(1p,2x,e13.4,/)') uniheterogeneous(i)%rm
730 ELSE
731 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
732 & (uniheterogeneous(i)%RE(j),j=1,uniheterogeneous(i) &
733 & %iwantr)
734 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
735 & (uniheterogeneous(i)%P(j),j=1,uniheterogeneous(i) &
736 & %iwantp)
737 ENDIF
738 !
739 ENDDO
740 CLOSE (jchan)
741 PRINT * , "Selected :' , iwant , " uniheterogeneous reactions.'
742 nkuh = iwant
743 !
744 !----------------------------------------------------------------------
745 !
746 PRINT * , TRIM(fnbulkbi_out)
747 OPEN (jchan,FILE=TRIM(fnbulkbi_out),STATUS="unknown')
748 !
749 !----------------------------------------------------------------------
750 !
751 ! Skip header
752 DO i = 1 , 3
753 WRITE (jchan,*)
754 ENDDO
755 !
756 WRITE (jlog,FMT=*) "bulkbimolecular'
757 iwant = 0
758 DO i = 1 , nkbulkbi
759 !
760 ! reactants.
761 l_r_unknown = .FALSE.
762 DO j = 1 , bulkbimolecular(i)%iwantr
763 lr(j) = LSPEC(bulkbimolecular(i)%RE(j),species%speci,nspec, &
764 & NMAXS)
765 IF ( bulkbimolecular(i)%RE(j)==st_unknown ) &
766 & l_r_unknown = .TRUE.
767 ENDDO
768 !
769 ! If all reactants are required species.
770 lr_all = ALL(lr(1:bulkbimolecular(i)%iwantr))
771 !
772 ! products.
773 l_p_unknown = .FALSE.
774 DO j = 1 , bulkbimolecular(i)%iwantp
775 lp(j) = LSPEC(bulkbimolecular(i)%P(j),species%speci,nspec, &
776 & NMAXS)
777 IF ( bulkbimolecular(i)%P(j)==st_unknown ) &
778 & l_p_unknown = .TRUE.
779 ENDDO
780 !
781 ! If all products are required species.
782 lp_all = ALL(lp(1:bulkbimolecular(i)%iwantp))
783 !
784 ! If any products are required species.
785 lp_any = ANY(lp(1:bulkbimolecular(i)%iwantp))
786 !
787 ! If any unknown reactants or products
788 l_unknown = l_r_unknown .OR. l_p_unknown
789 !
790 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
791 & jreject,l_unknown,jlog)
792 IF ( lwant_r ) THEN
793 iwant = iwant + 1
794 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
795 & TRIM(bulkbimolecular(i)%comment)
796 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
797 & (bulkbimolecular(i)%RE(j),j=1,bulkbimolecular(i) &
798 & %iwantr)
799 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
800 & (bulkbimolecular(i)%P(j),j=1,bulkbimolecular(i) &
801 & %iwantp)
802 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
803 & (bulkbimolecular(i)%Z(j),j=1,bulkbimolecular(i) &
804 & %iwantp)
805 !
806 WRITE (jchan,FMT="(1p,2x,i4,17x,2(e13.4,8x),/)') &
807 & bulkbimolecular(i)%isptype , bulkbimolecular(i)%a1 , &
808 & bulkbimolecular(i)%a2
809 ELSE
810 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
811 & (bulkbimolecular(i)%RE(j),j=1,bulkbimolecular(i) &
812 & %iwantr)
813 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
814 & (bulkbimolecular(i)%P(j),j=1,bulkbimolecular(i) &
815 & %iwantp)
816 ENDIF
817 !
818 ENDDO
819 CLOSE (jchan)
820 PRINT * , "Selected :' , iwant , " bulk bimolecular reactions.'
821 nkbulkbi = iwant
822 !
823 !----------------------------------------------------------------------
824 !
825 PRINT * , TRIM(fnbulktrans_out)
826 OPEN (jchan,FILE=TRIM(fnbulktrans_out),STATUS="unknown')
827 !
828 !----------------------------------------------------------------------
829 !
830 ! Skip header
831 DO i = 1 , 3
832 WRITE (jchan,*)
833 ENDDO
834 !
835 WRITE (jlog,FMT=*) "bulktransfer'
836 iwant = 0
837 DO i = 1 , nkbulktrans
838 !
839 ! reactants.
840 l_r_unknown = .FALSE.
841 DO j = 1 , 1
842 lr(j) = LSPEC(bulktransfer(i)%RE(j),species%speci,nspec, &
843 & NMAXS)
844 IF ( bulktransfer(i)%RE(j)==st_unknown ) &
845 & l_r_unknown = .TRUE.
846 ENDDO
847 !
848 ! If all reactants are required species.
849 lr_all = ALL(lr(1:bulktransfer(i)%iwantr))
850 !
851 ! products.
852 l_p_unknown = .FALSE.
853 DO j = 1 , bulktransfer(i)%iwantp
854 lp(j) = LSPEC(bulktransfer(i)%P(j),species%speci,nspec, &
855 & NMAXS)
856 IF ( bulktransfer(i)%P(j)==st_unknown ) l_p_unknown = .TRUE.
857 ENDDO
858 !
859 ! If all products are required species.
860 lp_all = ALL(lp(1:bulktransfer(i)%iwantp))
861 !
862 ! If any products are required species.
863 lp_any = ANY(lp(1:bulktransfer(i)%iwantp))
864 !
865 ! If any unknown reactants or products
866 l_unknown = l_r_unknown .OR. l_p_unknown
867 !
868 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
869 & jreject,l_unknown,jlog)
870 IF ( lwant_r ) THEN
871 iwant = iwant + 1
872 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
873 & TRIM(bulktransfer(i)%comment)
874 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
875 & (bulktransfer(i)%RE(j),j=1,bulktransfer(i)%iwantr)
876 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
877 & (bulktransfer(i)%P(j),j=1,bulktransfer(i)%iwantp)
878 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
879 & (bulktransfer(i)%Z(j),j=1,bulktransfer(i)%iwantp)
880 !
881 WRITE (jchan, &
882 &"(1p,2x,5(e13.4,8x),/,2x,2(e13.4,8x),/,2x,i4,20x,a,/)'&
883 & ) bulktransfer(i)%a2 , bulktransfer(i)%alpha , &
884 & bulktransfer(i)%rm , bulktransfer(i)%a1 , &
885 & bulktransfer(i)%a5 , bulktransfer(i)%sig , &
886 & bulktransfer(i)%eps , bulktransfer(i)%isptype , &
887 & bulktransfer(i)%fun
888 ELSE
889 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
890 & (bulktransfer(i)%RE(j),j=1,bulktransfer(i)%iwantr)
891 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
892 & (bulktransfer(i)%P(j),j=1,bulktransfer(i)%iwantp)
893 ENDIF
894 !
895 ENDDO
896 CLOSE (jchan)
897 PRINT * , "Selected :' , iwant , " bulk transfer reactions.'
898 nkbulktrans = iwant
899 !
900 !----------------------------------------------------------------------
901 !
902 PRINT * , TRIM(fncr_out)
903 OPEN (jchan,FILE=TRIM(fncr_out),STATUS="unknown')
904 !
905 !----------------------------------------------------------------------
906 !
907 ! Skip header
908 DO i = 1 , 3
909 WRITE (jchan,*)
910 ENDDO
911 !
912 WRITE (jlog,FMT=*) "cosmicray'
913 iwant = 0
914 DO i = 1 , nkcr
915 !
916 ! reactants.
917 l_r_unknown = .FALSE.
918 DO j = 1 , cosmicray(i)%iwantr
919 lr(j) = LSPEC(cosmicray(i)%RE(j),species%speci,nspec,NMAXS)
920 IF ( cosmicray(i)%RE(j)==st_unknown ) l_r_unknown = .TRUE.
921 ENDDO
922 !
923 ! If all reactants are required species.
924 lr_all = ALL(lr(1:cosmicray(i)%iwantr))
925 !
926 ! products.
927 l_p_unknown = .FALSE.
928 DO j = 1 , cosmicray(i)%iwantp
929 lp(j) = LSPEC(cosmicray(i)%P(j),species%speci,nspec,NMAXS)
930 IF ( cosmicray(i)%P(j)==st_unknown ) l_p_unknown = .TRUE.
931 ENDDO
932 !
933 ! If all products are required species.
934 lp_all = ALL(lp(1:cosmicray(i)%iwantp))
935 !
936 ! If any products are required species.
937 lp_any = ANY(lp(1:cosmicray(i)%iwantp))
938 !
939 ! If any unknown reactants or products
940 l_unknown = l_r_unknown .OR. l_p_unknown
941 !
942 lwant_r = LWANT_THIS_REACTION(lr_all,lp_any,lp_all,jselect, &
943 & jreject,l_unknown,jlog)
944 IF ( lwant_r ) THEN
945 iwant = iwant + 1
946 WRITE (jchan,FMT="(i4,1x,a)') iwant , &
947 & TRIM(cosmicray(i)%comment)
948 WRITE (jchan,FMT="(a2,3x,2(a20,1x))') "R:' , &
949 & (cosmicray(i)%RE(j),j=1,cosmicray(i)%iwantr)
950 WRITE (jchan,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
951 & (cosmicray(i)%P(j),j=1,cosmicray(i)%iwantp)
952 WRITE (jchan,FMT="(1p,a2,14(e13.4,8x))') "#:' , &
953 & (cosmicray(i)%Z(j),j=1,cosmicray(i)%iwantp)
954 !
955 WRITE (jchan,FMT="(1p,2x,e13.4,/)') cosmicray(i) &
956 & %formrateperion
957 ELSE
958 WRITE (jlog,FMT="(a2,3x,2(a20,1x))') "R:' , &
959 & (cosmicray(i)%RE(j),j=1,cosmicray(i)%iwantr)
960 WRITE (jlog,FMT="(1p,a2,3x,14(a20,1x))') "P:' , &
961 & (cosmicray(i)%P(j),j=1,cosmicray(i)%iwantp)
962 ENDIF
963 !
964 ENDDO
965 CLOSE (jchan)
966 PRINT * , "Selected :' , iwant , " cosmic ray reactions.'
967 nkcr = iwant
968 !
969 !----------------------------------------------------------------------
970 !
971 ! Now write out the kinetic sizes module
972 fn = "kinetic_param.f90'
973 PRINT * , TRIM(fn)
974 OPEN (jchan,FILE=TRIM(fn),STATUS="unknown')
975 !
976 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
977 WRITE (jchan,FMT="(a)') "!'
978 WRITE (jchan,FMT="(a)') &
979 &"! Fortran 90 Code automatically generated by the AutoChem Program&
980 &me "Pick"."
981 WRITE (jchan,FMT="(a)') "!'
982 WRITE (jchan,FMT="(a)') "! by David Lary 1993-2004.'
983 WRITE (jchan,FMT="(a)') "!'
984 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
985 WRITE (jchan,FMT="(a)') "!'
986 WRITE (jchan,FMT="(a)') "MODULE Kinetic_Param'
987 WRITE (jchan,FMT="(a)') "!'
988 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
989 WRITE (jchan,FMT="(a)') "!'
990 WRITE (jchan,FMT="(a)') "USE Kinetic'
991 WRITE (jchan,FMT="(a)') "!'
992 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
993 WRITE (jchan,FMT="(a)') "!'
994 WRITE (jchan,FMT="(a)') "! Specie parameters'
995 WRITE (jchan,FMT="(a)') "!'
996 WRITE (jchan,FMT="(a)') "! The total number of species'
997 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nspec =' , &
998 & nspec
999 WRITE (jchan,FMT="(a)') "!'
1000 WRITE (jchan,FMT="(a)') "! The total number of integrated species'
1001 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nspint =' , &
1002 & ispint
1003 WRITE (jchan,FMT="(a)') "!'
1004 WRITE (jchan,FMT="(a)') "! The total number of species in pce'
1005 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nsppce =' , &
1006 & isppce
1007 WRITE (jchan,FMT="(a)') "!'
1008 WRITE (jchan,FMT="(a)') "! The total number of species in pce'
1009 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nsppcer =' , &
1010 & MAX(1,isppce)
1011 WRITE (jchan,FMT="(a)') "!'
1012 WRITE (jchan,FMT="(a)') &
1013 &"! The total number of species in pce+integrated'
1014 WRITE (jchan,FMT="(2x,a,i6)') &
1015 &"INTEGER, PARAMETER :: nspall = nspint+nsppce'
1016 WRITE (jchan,FMT="(a)') "!'
1017 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1018 WRITE (jchan,FMT="(a)') "!'
1019 WRITE (jchan,FMT="(a)') &
1020 &"! Number of kinetic processes of each type'
1021 WRITE (jchan,FMT="(a)') "!'
1022 WRITE (jchan,FMT="(a)') "! Number of bimolecular reactions.'
1023 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrb =' , &
1024 & MAX(1,nkb) + 1
1025 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkb =' , nkb
1026 WRITE (jchan,FMT="(a)') "!'
1027 WRITE (jchan,FMT="(a)') "! Number of trimolecular reactions.'
1028 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrt =' , &
1029 & MAX(1,nkt) + 1
1030 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkt =' , nkt
1031 WRITE (jchan,FMT="(a)') "!'
1032 WRITE (jchan,FMT="(a)') "! Number of photolysis reactions.'
1033 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrj =' , &
1034 & MAX(1,nkj) + 1
1035 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkj =' , nkj
1036 WRITE (jchan,FMT="(a)') "!'
1037 WRITE (jchan,FMT="(a)') "! Number of heterogeneous reactions.'
1038 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrh =' , &
1039 & MAX(1,nkh) + 1
1040 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkh =' , nkh
1041 WRITE (jchan,FMT="(a)') "!'
1042 WRITE (jchan,FMT="(a)') "! Number of uniheterogeneous reactions.'
1043 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkruh =' , &
1044 & MAX(1,nkuh) + 1
1045 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkuh =' , &
1046 & nkuh
1047 WRITE (jchan,FMT="(a)') "!'
1048 WRITE (jchan,FMT="(a)') "! Number of bulk bimolecular reactions.'
1049 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrbulkbi =' &
1050 & , MAX(1,nkbulkbi) + 1
1051 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkbulkbi =' ,&
1052 & nkbulkbi
1053 WRITE (jchan,FMT="(a)') "!'
1054 WRITE (jchan,FMT="(a)') "! Number of bulk transfer reactions.'
1055 WRITE (jchan,FMT="(2x,a,i6)') &
1056 &"INTEGER, PARAMETER :: nkrbulktrans ='&
1057 & , MAX(1,nkbulktrans) + 1
1058 WRITE (jchan,FMT="(2x,a,i6)') &
1059 &"INTEGER, PARAMETER :: nkbulktrans ='&
1060 & , nkbulktrans
1061 WRITE (jchan,FMT="(a)') "!'
1062 WRITE (jchan,FMT="(a)') "! Number of cosmic ray reactions.'
1063 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkrcr =' , &
1064 & MAX(1,nkcr) + 1
1065 WRITE (jchan,FMT="(2x,a,i6)') "INTEGER, PARAMETER :: nkcr =' , &
1066 & nkcr
1067 WRITE (jchan,FMT="(a)') "!'
1068 WRITE (jchan,FMT="(a)') "! Total number of reactions.'
1069 WRITE (jchan,FMT="(2x,a,i6)') &
1070 &"INTEGER, PARAMETER :: NK=NKB+NKT+NKJ+NKH+NKUH+NKBULKBI+2*NKBULKTR&
1071 &ANS+NKCR"
1072 WRITE (jchan,FMT="(a)') "!'
1073 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1074 WRITE (jchan,FMT="(a)') "!'
1075 WRITE (jchan,FMT="(a)') "! Constituent concentrations'
1076 WRITE (jchan,FMT="(a)') &
1077 &"TYPE (SPECIES_RECORD) , DIMENSION(NSPEC) :: species'
1078 WRITE (jchan,FMT="(a)') "!'
1079 WRITE (jchan,FMT="(a)') "! Reaction types'
1080 WRITE (jchan,FMT="(a)') &
1081 &"TYPE (BIMOLECULAR_RECORD) , DIMENSION(NKRB) :: bimolecular'
1082 WRITE (jchan,FMT="(a)') &
1083 &"TYPE (TRIMOLECULAR_RECORD) , DIMENSION(NKRT) :: trimolecular'
1084 WRITE (jchan,FMT="(a)') &
1085 &"TYPE (PHOTOLYSIS_RECORD) , DIMENSION(NKRJ) :: photolysis'
1086 WRITE (jchan,FMT="(a)') &
1087 &"TYPE (HETEROGENEOUS_RECORD) , DIMENSION(NKRH) :: heterogeneous'
1088 WRITE (jchan,FMT="(a)') &
1089 &"TYPE (UMolecularHeterogeneous_Record) , DIMENSION(NKRUH) :: unihe&
1090 &terogeneous"
1091 WRITE (jchan,FMT="(a)') &
1092 &"TYPE (BULKBIMOLECULAR_RECORD) , DIMENSION(NKRBULKBI) :: bulkbimol&
1093 &ecular"
1094 WRITE (jchan,FMT="(a)') &
1095 &"TYPE (BULKTRANSFER_RECORD) , DIMENSION(NKRBULKTRANS) :: bulktrans&
1096 &fer"
1097 WRITE (jchan,FMT="(a)') &
1098 &"TYPE (COSMICRAY_RECORD) , DIMENSION(NKRCR) :: cosmicray'
1099 WRITE (jchan,FMT="(a)') "!'
1100 WRITE (jchan,FMT="(a)') "! All reactions as one vector.'
1101 WRITE (jchan,FMT="(a)') "!'
1102 WRITE (jchan,FMT="(a)') &
1103 &"TYPE (Reaction_Record) , DIMENSION(NK) :: Reaction'
1104 WRITE (jchan,FMT="(a)') "!'
1105 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1106 WRITE (jchan,FMT="(a)') "!'
1107 WRITE (jchan,FMT="(a)') &
1108 &"! Wavelength data for each photolysis process.'
1109 WRITE (jchan,FMT="(a)') "!'
1110 WRITE (jchan,FMT="(a)') &
1111 &"TYPE (PhotolysisWave_Record) , DIMENSION(nkrj) :: PhotolysisWave'
1112 WRITE (jchan,FMT="(a)') "!'
1113 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1114 WRITE (jchan,FMT="(a)') "!'
1115 WRITE (jchan,FMT="(a)') "! Solar Irradiance record.'
1116 WRITE (jchan,FMT="(a)') "!'
1117 WRITE (jchan,FMT="(a)') &
1118 &"TYPE (SolarIrradiance_Record) :: SolarIrradiance'
1119 WRITE (jchan,FMT="(a)') "!'
1120 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1121 WRITE (jchan,FMT="(a)') "!'
1122 WRITE (jchan,FMT="(a)') "END MODULE Kinetic_Param'
1123 WRITE (jchan,FMT="(a)') "!'
1124 WRITE (jchan,FMT="(73a)') "!' , ("-',i=1,72)
1125 CLOSE (jchan)
1126 !
1127 !----------------------------------------------------------------------
1128 !
1129 ! Read back in chosen subset of files
1130 !
1131 !----------------------------------------------------------------------
1132 !
1133 ! Read in an AutoChem bimolecular kinetic data file.
1134 CALL RD_ALL_BI(jchan,fnbi_out,bimolecular,lverb,NMAXR,nkb)
1135 !
1136 ! Read in an AutoChem trimolecular kinetic data file.
1137 CALL RD_ALL_TRI(jchan,fntri_out,trimolecular,lverb,NMAXR,nkt)
1138 !
1139 ! Read in an AutoChem photolysis kinetic data file.
1140 CALL RD_ALL_J(jchan,fnj_out,photolysis,lverb,NMAXR,nkj)
1141 !
1142 ! Read in an AutoChem heterogeneous kinetic data file.
1143 CALL RD_ALL_HET(jchan,fnhet_out,heterogeneous,lverb,NMAXR,nkh)
1144 !
1145 ! Read in an AutoChem heterogeneous kinetic data file.
1146 CALL RD_ALL_UNIHET(jchan,fnuhet_out,uniheterogeneous,lverb,NMAXR, &
1147 & nkuh)
1148 !
1149 ! Read in an AutoChem bulk phase bimolecular kinetic data file.
1150 CALL RD_ALL_BULKBI(jchan,fnbulkbi_out,bulkbimolecular,lverb,NMAXR,&
1151 & nkbulkbi)
1152 !
1153 ! Read in an AutoChem bulk phase transfer data file.
1154 CALL RD_ALL_BULKTRANS(jchan,fnbulktrans_out,bulktransfer,lverb, &
1155 & NMAXR,nkbulktrans)
1156 !
1157 ! Read in an AutoChem Cosmic Ray kinetic data file.
1158 CALL RD_ALL_CR(jchan,fncr_out,cosmicray,lverb,NMAXR,nkcr)
1159 !
1160 !----------------------------------------------------------------------
1161 !
1162 ! Write LaTeX files.
1163 !
1164 !----------------------------------------------------------------------
1165 !
1166 nlinesperpage = 38
1167 !
1168 ! Bimolecular.
1169 fn = "bimolecular.tex'
1170 CALL WR_BIMOLECULAR_LATEX(fn,jchan,species,bimolecular,NMAXR, &
1171 & NMAXS,nspec,nkb,nlinesperpage)
1172 !
1173 ! Trimolecular.
1174 fn = "trimolecular.tex'
1175 CALL WR_TRIMOLECULAR_LATEX(fn,jchan,species,trimolecular,NMAXR, &
1176 & NMAXS,nspec,nkt,nlinesperpage)
1177 !
1178 ! Photolysis.
1179 fn = "photolysis.tex'
1180 CALL WR_PHOTOLYSIS_LATEX(fn,jchan,species,photolysis,NMAXR,NMAXS, &
1181 & nspec,nkj,nlinesperpage)
1182 !
1183 ! Heterogeneous.
1184 fn = "heterogeneous.tex'
1185 CALL WR_HETEROGENEOUS_LATEX(fn,jchan,species,heterogeneous,NMAXR, &
1186 & NMAXS,nspec,nkh,nlinesperpage)
1187 !
1188 ! Unimolecular Heterogeneous.
1189 fn = "uniheterogeneous.tex'
1190 CALL WR_UNIHETEROGENEOUS_LATEX(fn,jchan,species,uniheterogeneous, &
1191 & NMAXR,NMAXS,nspec,nkuh, &
1192 & nlinesperpage)
1193 !
1194 ! Bulk Phase Bimolecular.
1195 fn = "bulkbimolecular.tex'
1196 CALL WR_BULKBIMOLECULAR_LATEX(fn,jchan,species,bulkbimolecular, &
1197 & NMAXR,NMAXS,nspec,nkbulkbi, &
1198 & nlinesperpage)
1199 !
1200 ! Bulk Phase Bimolecular.
1201 fn = "bulktransfer.tex'
1202 CALL WR_BULKTRANSFER_LATEX(fn,jchan,species,bulktransfer,NMAXR, &
1203 & NMAXS,nspec,nkbulktrans,nlinesperpage)
1204 !
1205 ! Cosmic Ray.
1206 fn = "cosmicray.tex'
1207 CALL WR_CR_LATEX(fn,jchan,species,cosmicray,NMAXR,NMAXS,nspec, &
1208 & nkcr,nlinesperpage)
1209 !
1210 !----------------------------------------------------------------------
1211 !
1212 END PROGRAM PICK