File: /nfs/home/0/users/jenkins/mfix.git/model/parse_mod.f
1 MODULE parse
2
3 Use param
4 Use param1
5 USE funits
6 USE compar
7
8 IMPLICIT NONE
9
10
11 CHARACTER(LEN=2), PARAMETER :: START_STR = '@('
12 CHARACTER(LEN=1), PARAMETER :: END_STR = ')'
13
14
15 CHARACTER(LEN=4), PARAMETER :: RXN_BLK = 'RXNS'
16 CHARACTER(LEN=8), PARAMETER :: DES_RXN_BLK = 'DES_RXNS'
17 CHARACTER(LEN=3), PARAMETER :: END_BLK = 'END'
18
19 LOGICAL READING_RXN
20 LOGICAL READING_RATE
21
22 LOGICAL DES_RXN
23 LOGICAL TFM_RXN
24
25
26
27 LOGICAL IN_CONSTRUCT
28
29
30 LOGICAL MORE_ChemEq
31
32
33 CHARACTER(len=32), DIMENSION(:), ALLOCATABLE :: RXN_NAME
34
35 CHARACTER(len=512), DIMENSION(:), ALLOCATABLE :: RXN_CHEM_EQ
36
37 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: usrDH
38
39 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: usrfDH
40
41
42
43
44 LOGICAL IN_DES_CONSTRUCT
45
46
47 CHARACTER(len=32), DIMENSION(:), ALLOCATABLE :: DES_RXN_NAME
48
49 CHARACTER(len=512), DIMENSION(:), ALLOCATABLE :: DES_RXN_CHEM_EQ
50
51 DOUBLE PRECISION, DIMENSION(:), ALLOCATABLE :: DES_usrDH
52
53 DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: DES_usrfDH
54
55 CONTAINS
56
57
58
59
60
61
62
63
64
65
66
67
68
69 SUBROUTINE setReaction(RxN, lNg, lSAg, lM, lNs, lSAs, lDH, lfDH)
70
71 use rxn_com
72 use toleranc
73
74 IMPLICIT NONE
75
76
77
78
79 TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: RxN
80
81 INTEGER, INTENT(IN) :: lNg
82
83 CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
84
85 INTEGER, INTENT(IN) :: lM
86
87 INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
88
89 CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
90
91 DOUBLE PRECISION, INTENT(IN) :: lDH
92
93 DOUBLE PRECISION, DIMENSION(0:DIM_M), INTENT(IN) :: lfDH
94
95
96
97
98 CHARACTER(LEN=32), DIMENSION(50) :: rAlias , pAlias
99 DOUBLE PRECISION, DIMENSION(50) :: rCoeff , pCoeff
100
101
102 INTEGER rNo, pNo
103
104 INTEGER rEnd, pStart
105
106 INTEGER L, LL, M, lN
107
108
109
110 DOUBLE PRECISION sumFDH
111
112 CHARACTER(LEN=512) lChemEq
113
114 CHARACTER(LEN=32) lName
115
116 LOGICAL Skip
117
118 LOGICAL pMap(0:lM)
119
120 INTEGER nSpecies, nPhases
121
122 LOGICAL blankAlias(0:(DIM_N_g + lM*DIM_N_s))
123
124
125 = trim(adjustl(RxN%Name))
126 lChemEq = trim(adjustl(RxN%ChemEq))
127
128 RxN%Classification = "Undefined"
129 RxN%Calc_DH = .TRUE.
130 RxN%nSpecies = 0
131 RxN%nPhases = 0
132
133
134
135 CALL checkSplit(lName, lChemEq, rEnd, pStart, Skip)
136 IF(Skip) THEN
137 RxN%nSpecies = 0
138 RETURN
139 ENDIF
140
141 %Calc_DH = .TRUE.
142 IF(lDH /= UNDEFINED) RxN%Calc_DH = .FALSE.
143
144
145 CALL splitEntries(lName, lChemEq, 1, rEnd, rNo, rAlias, rCoeff)
146
147 CALL splitEntries(lName, lChemEq, pStart, len_trim(lChemEq), &
148 pNo, pAlias, pCoeff)
149
150 nSpecies = rNo + pNo
151 RxN%nSpecies = nSpecies
152 Allocate( RxN%Species( nSpecies ))
153
154 CALL checkBlankAliases(lNg, lSAg, lM, lNs, lSAs, blankAlias)
155
156
157
158 CALL mapAliases(lName, lChemEq, lNg, lSAg, lM, lNs, lSAs, rNo, &
159 rAlias, rCoeff, -ONE, 0, blankAlias, RxN)
160
161
162
163 CALL mapAliases(lName, lChemEq, lNg, lSAg, lM, lNs, lSAs, pNo, &
164 pAlias, pCoeff, ONE, rNo, blankAlias, RxN)
165
166
167
168 = max(1,lM)
169 LL = (L * (L-1)/2)
170 Allocate( RxN%rPhase( LL+L ))
171
172
173
174 (:) = .FALSE.
175 nPhases = 0
176 DO lN = 1, nSpecies
177 M = RxN%Species(lN)%pMap
178
179 RxN%Species(lN)%mXfr = M
180 RxN%Species(lN)%xXfr = ZERO
181
182 IF(.NOT.pMap(M)) THEN
183 pMap(M) = .TRUE.
184 nPhases = nPhases + 1
185 ENDIF
186 ENDDO
187 RxN%nPhases = nPhases
188
189
190 = ZERO
191
192 IF(.NOT.RxN%Calc_DH) THEN
193
194 Allocate( RxN%HoR( 0:lM ))
195 RxN%HoR(:) = ZERO
196 DO M=0,lM
197
198
199 IF(pMap(M) .AND. lFDH(M) .NE. UNDEFINED) THEN
200
201 %HoR(M) = lFDH(M) * lDH
202 sumFDH = sumFDH + lFDH(M)
203
204
205 ELSEIF(.NOT.pMap(M) .AND. lFDH(M) .NE. UNDEFINED) THEN
206 IF(myPE == PE_IO) THEN
207 write(*,1000) trim(lName)
208 write(*,1001)
209 write(*,1010)
210
211 write(UNIT_LOG,1000) trim(lName)
212 write(UNIT_LOG,1001)
213 write(UNIT_LOG,1010)
214 ENDIF
215
216 CALL MFIX_EXIT(myPE)
217 ENDIF
218 ENDDO
219
220 DO M=lM+1,DIM_M
221 IF(.NOT.RxN%Calc_DH .AND. lFDH(M) .NE. UNDEFINED) THEN
222 IF(myPE == PE_IO) THEN
223 write(*,1000) trim(lName)
224 write(*,1001)
225 write(*,1010)
226
227 write(UNIT_LOG,1000) trim(lName)
228 write(UNIT_LOG,1001)
229 write(UNIT_LOG,1010)
230
231 ENDIF
232 CALL MFIX_EXIT(myPE)
233 ENDIF
234 ENDDO
235 ENDIF
236
237
238 IF(.NOT.RxN%Calc_DH .AND. .NOT. COMPARE(sumFDH, ONE)) THEN
239 IF(myPE == PE_IO) THEN
240 write(*,1002) trim(lName)
241 write(*,1010)
242
243 write(UNIT_LOG,1002) trim(lName)
244 write(UNIT_LOG,1010)
245
246 CALL MFIX_EXIT(myPE)
247 ENDIF
248 ENDIF
249
250 RETURN
251
252 1000 FORMAT(/1X,70('*')/' From: From: setReaction:',/ &
253 ' Message: Heat of reaction is proportioned to a phase not', &
254 ' referenced',/' by the chemical equation for reaction ',A,'.')
255
256 1001 FORMAT(/' If this is a catalytic reaction, reference one of the',&
257 ' species of the',/' catalyst phase within the chemical', &
258 ' equation with a stoichiometric',/' coefficient of zero.'/)
259
260 1002 FORMAT(/1X,70('*')/' From: From: setReaction:',/ &
261 ' Message: The heat of reaction partitions (fracDH) to all', &
262 ' phases do',/' not sum to one for reaction ',A,'.')
263
264 1010 FORMAT(' Please refer to the Readme file for chemical equation', &
265 ' input formats',/' and correct the data file.',/1X,70('*')/)
266
267
268 END SUBROUTINE setReaction
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285 SUBROUTINE checkSplit(lName, lChemEq, lrEnd, lpStart, lSkip)
286
287 IMPLICIT NONE
288
289
290
291
292 CHARACTER(len=*), INTENT(IN) :: lName
293
294 CHARACTER(len=*), INTENT(IN) :: lChemEq
295
296 INTEGER, INTENT(OUT) :: lrEnd
297
298 INTEGER, INTENT(OUT) :: lpStart
299
300
301 LOGICAL, INTENT(OUT) :: lSkip
302
303
304
305
306 INTEGER hArr, tArr
307
308 INTEGER hEqs, tEqs
309
310 INTEGER hRArr, tRArr
311
312 CHARACTER(LEN=512) FLAG
313 FLAG = ''
314
315
316
317 = .FALSE.
318 IF(INDEX(lChemEq,'NONE') > 0) THEN
319 lSkip = .TRUE.
320 lrEnd = UNDEFINED_I
321 lpStart = UNDEFINED_I
322 RETURN
323 ENDIF
324
325
326 = INDEX(lChemEq,'-', BACK=.FALSE.)
327 hArr = INDEX(lChemEq,">", BACK=.TRUE.)
328
329 = INDEX(lChemEq,"=", BACK=.FALSE.)
330 hEqs = INDEX(lChemEq,"=", BACK=.TRUE.)
331
332 = INDEX(lChemEq,"<", BACK=.FALSE.)
333 tRArr = INDEX(lChemEq,"-", BACK=.TRUE.)
334
335
336 IF(hRArr > 0) THEN
337 IF(myPE == PE_IO) THEN
338
339 IF(hArr > 0) THEN
340 FLAG = setFlag(20, hRArr, hArr)
341 ELSEIF(tRArr > 0) THEN
342 FLAG = setFlag(20, hRArr, tRArr)
343 ELSE
344 FLAG = setFlag(20, hRArr)
345 ENDIF
346
347 write(*,1000) trim(lName)
348 write(*,1002)'Illegal'
349 write(*,1010) trim(lChemEq), trim(Flag)
350 write(*,1001)
351
352 write(UNIT_LOG,1000) trim(lName)
353 write(UNIT_LOG,1002)'Illegal'
354 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
355 write(UNIT_LOG,1001)
356
357 CALL MFIX_EXIT(myPE)
358 ENDIF
359 ENDIF
360
361 IF(hArr /= 0 .AND. hEqs /= 0) THEN
362 IF(myPE == PE_IO) THEN
363
364 = setFlag(20, hArr, hEqs)
365
366 write(*,1000) trim(lName)
367 write(*,1002)'Too many'
368 write(*,1010) trim(lChemEq), trim(Flag)
369 write(*,1001)
370
371 write(UNIT_LOG,1000) trim(lName)
372 write(UNIT_LOG,1002)'Too many'
373 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
374 write(UNIT_LOG,1001)
375
376 CALL MFIX_EXIT(myPE)
377 ENDIF
378
379 ELSEIF(hArr == 0 .AND. hEqs == 0) THEN
380 IF(myPE == PE_IO) THEN
381 write(*,1000) trim(lName)
382 write(*,1002) 'No'
383 write(*,1011) trim(lChemEq)
384 write(*,1001)
385
386 write(UNIT_LOG,1000) trim(lName)
387 write(UNIT_LOG,1002) 'No'
388 write(UNIT_LOG,1011) trim(lChemEq)
389 write(UNIT_LOG,1001)
390
391 CALL MFIX_EXIT(myPE)
392 ENDIF
393
394 ELSEIF(hArr /= 0) THEN
395
396 IF(tArr == 0) THEN
397
398 = setFlag(20, hArr)
399 IF(myPE == PE_IO) THEN
400 write(*,1000) trim(lName)
401 write(*,1003) 'Missing the tail; -->'
402 write(*,1010) trim(lChemEq), trim(Flag)
403 write(*,1001)
404
405 write(UNIT_LOG,1000) trim(lName)
406 write(UNIT_LOG,1003) 'Missing the tail; -->'
407 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
408 write(UNIT_LOG,1001)
409
410 CALL MFIX_EXIT(myPE)
411 ENDIF
412 ELSEIF(tArr > hArr) THEN
413 IF(myPE == PE_IO) THEN
414 FLAG = setFlag(20, hArr, INDEX(lChemEq,'-',BACK=.TRUE.))
415 write(*,1000) trim(lName)
416 write(*,1003) 'Arror head preceeds the tail; -->'
417 write(*,1010) trim(lChemEq), trim(Flag)
418 write(*,1001)
419
420 write(UNIT_LOG,1000) trim(lName)
421 write(UNIT_LOG,1003) 'Arror head preceeds the tail; -->'
422 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
423 write(UNIT_LOG,1001)
424
425 CALL MFIX_EXIT(myPE)
426 ENDIF
427 ELSE
428
429
430 = tArr - 1
431 lpStart = hArr + 1
432 ENDIF
433
434
435 ELSEIF(hEqs /= 0) THEN
436 lrEnd = tEqs - 1
437 lpStart = hEqs + 1
438
439
440 ELSE
441 IF(myPE == PE_IO) THEN
442 write(*,1000) trim(lName)
443 write(*,1004)
444 write(*,1011) trim(lChemEq)
445 write(*,1001)
446
447 write(UNIT_LOG,1000) trim(lName)
448 write(UNIT_LOG,1004)
449 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
450 write(UNIT_LOG,1001)
451
452 CALL MFIX_EXIT(myPE)
453 ENDIF
454 ENDIF
455
456 RETURN
457
458 1000 FORMAT(/1X,70('*')/' From: From: setReaction --> checkSplit',/ &
459 ' Message: Error in determining the reactants and products', &
460 ' in the',/' chemical equation for reaction ',A,'.')
461
462 1001 FORMAT(' Please refer to the Readme file for chemical equation', &
463 ' input formats',/' and correct the data file.',/1X,70('*')/)
464
465 1002 FORMAT(/1X,A,' operators were found!')
466
467 1003 FORMAT(' Incorrect operator format! ',A)
468
469 1004 FORMAT(' FATAL ERROR: All logical checks failed.')
470
471 1010 FORMAT(/' Chemical Equation: ',A,/1X, A/)
472
473 1011 FORMAT(/' Chemical Equation: ',A,/)
474
475
476 END SUBROUTINE checkSplit
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491 SUBROUTINE splitEntries(lName, lChemEq, lStart, lEnd, lNo, &
492 lAlias, lCoeff)
493
494 IMPLICIT NONE
495
496
497
498
499 CHARACTER(len=*), INTENT(IN) :: lName
500
501 CHARACTER(len=*), INTENT(IN) :: lChemEq
502
503 INTEGER, INTENT(IN) :: lStart
504
505 INTEGER, INTENT(IN) :: lEnd
506
507 INTEGER, INTENT(OUT) :: lNo
508
509 CHARACTER(LEN=32), DIMENSION(50), INTENT(OUT) :: lAlias
510
511 DOUBLE PRECISION, DIMENSION(50), INTENT(OUT) :: lCoeff
512
513
514
515
516 LOGICAL MORE
517
518 INTEGER lPOS
519
520 INTEGER rPOS
521
522
523 = 0
524 lAlias(:) = ''
525 lCoeff(:) = UNDEFINED
526
527
528 = lStart
529 MORE = .TRUE.
530
531 DO WHILE(MORE)
532
533 = lNo + 1
534
535 = (lPOS-1) + INDEX(lChemEq(lPOS:lEnd),"+", BACK=.FALSE.)
536
537 IF(rPOS .GT. lPOS) THEN
538
539
540 CALL splitAliasAndCoeff(lName, lChemEq, lPOS, rPOS-1, &
541 lAlias(lNo), lCoeff(lNo))
542
543 = .TRUE.
544
545 ELSE
546
547
548 CALL splitAliasAndCoeff(lName, lChemEq, lPOS, lEnd, &
549 lAlias(lNo), lCoeff(lNo))
550
551 = .FALSE.
552 ENDIF
553
554 = rPOS + 1
555 ENDDO
556
557 RETURN
558 END SUBROUTINE splitEntries
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575 SUBROUTINE splitAliasAndCoeff(lName, lChemEq, lStart, lEnd, &
576 lAlias, lCoeff)
577
578 IMPLICIT NONE
579
580
581
582
583 CHARACTER(len=*), INTENT(IN) :: lName
584
585 CHARACTER(len=*), INTENT(IN) :: lChemEq
586
587 INTEGER, INTENT(IN) :: lStart
588
589 INTEGER, INTENT(IN) :: lEnd
590
591 CHARACTER(LEN=32), INTENT(OUT) :: lAlias
592
593 DOUBLE PRECISION, INTENT(OUT) :: lCoeff
594
595
596
597
598 LOGICAL MATCH
599 INTEGER nPOS
600
601 INTEGER L, N, IOS, aPOS, a2POS
602
603 CHARACTER(LEN=12), PARAMETER :: Numbers = '.0123456789'
604
605
606 CHARACTER(LEN=512) FLAG
607 FLAG = ''
608
609
610 = INDEX(lChemEq(lStart:lEnd),"*", BACK=.FALSE.)
611
612 IF(aPOS .GT. ZERO) THEN
613
614 = INDEX(lChemEq(lStart:lEnd),"*", BACK=.TRUE.)
615 IF(aPOS /= a2POS) THEN
616 IF(myPE == PE_IO) THEN
617
618 = setFlag(20, lStart+aPOS, lStart+a2POS)
619
620 write(*,1000) trim(lName)
621 write(*,1002)'Too many'
622 write(*,1010) trim(lChemEq), trim(Flag)
623 write(*,1001)
624
625 write(UNIT_LOG,1000) trim(lName)
626 write(UNIT_LOG,1002)'Too many'
627 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
628 write(UNIT_LOG,1001)
629
630 CALL MFIX_EXIT(myPE)
631 ENDIF
632 ELSE
633
634
635
636 READ(lChemEq(lStart:(lStart+aPOS-2)),*,IOSTAT=IOS) lCoeff
637 IF(IOS .NE. 0 .AND. myPE == PE_IO) THEN
638
639 = setFlag(20, lStart + int(aPOS/2))
640
641 write(*,1000) trim(lName)
642 write(*,1010) trim(lChemEq), trim(Flag)
643 write(*,1001)
644
645 write(UNIT_LOG,1000) trim(lName)
646 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
647 write(UNIT_LOG,1001)
648
649 CALL MFIX_EXIT(myPE)
650 ENDIF
651
652 WRITE(lAlias,"(A)") &
653 trim(adjustl(lChemEq((lStart+aPOS):lEnd)))
654 ENDIF
655
656 ELSE
657
658 = 0
659
660
661 DO L=lStart,lEnd
662 MATCH = .FALSE.
663 DO N=1,12
664 IF(lChemEq(L:L) /= Numbers(N:N)) CYCLE
665
666 = L
667
668 = .TRUE.
669 ENDDO
670
671 IF(.NOT.MATCH) EXIT
672 ENDDO
673
674
675 IF(trim(lChemEq(lStart:nPOS)) =='') THEN
676 lCoeff = 1.0d0
677 ELSE
678
679 READ(lChemEq(lStart:nPOS),*,IOSTAT=IOS) lCoeff
680
681 IF(IOS .NE. 0 .AND. myPE == PE_IO) THEN
682
683 = setFlag(20, &
684 lStart+int(len_trim(lChemEq(lStart:nPOS))/2))
685
686 write(*,1000) trim(lName)
687 write(*,1010) trim(lChemEq), trim(Flag)
688 write(*,1001)
689
690 write(UNIT_LOG,1000) trim(lName)
691 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
692 write(UNIT_LOG,1001)
693
694 CALL MFIX_EXIT(myPE)
695 ENDIF
696 ENDIF
697
698 READ(lChemEq(nPOS+1:lEnd),*,IOSTAT=IOS) lAlias
699 ENDIF
700
701 IF(LEN_TRIM(lAlias) == 0 .AND. myPE == PE_IO) THEN
702
703 = setFlag(20, lStart + int(lEnd/2))
704
705 write(*,1003) trim(lName)
706 write(*,1010) trim(lChemEq), trim(Flag)
707 write(*,1001)
708
709 write(UNIT_LOG,1003) trim(lName)
710 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
711 write(UNIT_LOG,1001)
712
713 CALL MFIX_EXIT(myPE)
714 ENDIF
715
716 RETURN
717
718 1000 FORMAT(/1X,70('*')/' From: From: setReaction -->', &
719 ' splitAliasAndCoeff',/' Message: Error determining the', &
720 ' stoichiometric coefficient in the',/' chemical equation', &
721 ' for reaction ',A,'.')
722
723
724 1001 FORMAT(' Please refer to the Readme file for chemical equation', &
725 ' input formats',/' and correct the data file.',/1X,70('*')/)
726
727 1002 FORMAT(/1X,A,' operators were found!')
728
729 1003 FORMAT(/1X,70('*')/' From: From: setReaction -->', &
730 ' splitAliasAndCoeff',/' Message: Error determining the', &
731 ' speices in the chemical equation for',/' reaction ',A,'.'/)
732
733 1010 FORMAT(/' Chemical Equation: ',A,/1X, A/)
734
735 1011 FORMAT(/' Chemical Equation: ',A,/)
736
737 END SUBROUTINE splitAliasAndCoeff
738
739
740
741
742
743
744
745
746
747
748 SUBROUTINE checkBlankAliases(lNg, lSAg, lM, lNs, lSAs, lBA)
749
750 IMPLICIT NONE
751
752
753 INTEGER, INTENT(IN) :: lNg
754
755 CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
756
757 INTEGER, INTENT(IN) :: lM
758
759 INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
760
761 CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
762
763 LOGICAL, INTENT(OUT) :: lBA(0:(DIM_N_g + lM*DIM_N_s))
764
765 INTEGER M, N
766
767
768 INTEGER Nsp
769
770
771 = 0
772
773 lBA(0) = .FALSE.
774 DO N = 1, lNg
775 Nsp = Nsp + 1
776 lBA(Nsp) = .FALSE.
777 IF(len_trim(lSAg(N)) == 0) THEN
778 lBA(Nsp) = .TRUE.
779 lBA(0) = .TRUE.
780 ENDIF
781 ENDDO
782
783
784 DO M = 1, lM
785 DO N = 1, lNs(M)
786 Nsp = Nsp + 1
787 lBA(Nsp) = .FALSE.
788 IF(len_trim(lSAs(M,N)) == 0) THEN
789 lBA(Nsp) = .TRUE.
790 lBA(0) = .TRUE.
791 ENDIF
792 ENDDO
793 ENDDO
794
795 RETURN
796 END SUBROUTINE checkBlankAliases
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813 SUBROUTINE mapAliases(lName, lChemEq, lNg, lSAg, lM, lNs, lSAs, &
814 lNo, lAlias, lCoeff, lSgn, lStart, lBA, lRxN)
815
816 use rxn_com
817
818 IMPLICIT NONE
819
820
821
822
823 CHARACTER(len=*), INTENT(IN) :: lName
824
825 CHARACTER(len=*), INTENT(IN) :: lChemEq
826
827 INTEGER, INTENT(IN) :: lNg
828
829 CHARACTER(len=32), DIMENSION(DIM_N_g), INTENT(IN) :: lSAg
830
831 INTEGER, INTENT(IN) :: lM
832
833 INTEGER, DIMENSION(DIM_M), INTENT(IN) :: lNs
834
835 CHARACTER(len=32), DIMENSION(DIM_M, DIM_N_s), INTENT(IN) :: lSAs
836
837 INTEGER, INTENT(IN) :: lNo
838
839 CHARACTER(LEN=32), DIMENSION(50), INTENT(IN) :: lAlias
840
841 DOUBLE PRECISION, DIMENSION(50), INTENT(IN) :: lCoeff
842
843 DOUBLE PRECISION, INTENT(IN) :: lSgn
844
845 INTEGER, INTENT(IN) :: lStart
846
847 LOGICAL, INTENT(IN) :: lBA(0:(DIM_N_g + lM*DIM_N_s))
848
849
850 TYPE(REACTION_BLOCK), POINTER, INTENT(INOUT) :: lRxN
851
852
853
854
855
856 INTEGER L, M, N
857
858 CHARACTER(LEN=512) FLAG
859
860 INTEGER lPOS, rPOS
861
862
863 = ''
864
865
866 ALOOP : DO L=1, lNo
867
868 DO N = 1, lNg
869 IF( checkMatch(lSAg(N), lAlias(L))) THEN
870 lRxN%Species(lStart + L)%pMap = 0
871 lRxN%Species(lStart + L)%sMap = N
872 lRxN%Species(lStart + L)%Coeff = lSgn * lCoeff(L)
873 CYCLE ALOOP
874 ENDIF
875 ENDDO
876
877 DO M = 1, lM
878 DO N = 1, lNs(M)
879 IF(checkMatch(lSAs(M,N),lAlias(L))) THEN
880 lRxN%Species(lStart + L)%pMap = M
881 lRxN%Species(lStart + L)%sMap = N
882 lRxN%Species(lStart + L)%Coeff = lSgn * lCoeff(L)
883 CYCLE ALOOP
884 ENDIF
885 ENDDO
886 ENDDO
887
888 IF(myPE == PE_IO) THEN
889
890 = INDEX(lChemEq,trim(lAlias(L)), BACK=.FALSE.)
891 rPOS = INDEX(lChemEq,trim(lAlias(L)), BACK=.TRUE.)
892 FLAG = setFlag(20, 1 + int((lPOS + rPOS)/2))
893
894 write(*,1000) trim(lAlias(L)), trim(lName)
895 write(*,1010) trim(lChemEq), trim(Flag)
896 IF(lBA(0)) CALL writeBA()
897 write(*,1001)
898
899 write(UNIT_LOG,1000) trim(lAlias(L)), trim(lName)
900 write(UNIT_LOG,1010) trim(lChemEq), trim(Flag)
901 IF(lBA(0)) CALL writeBA(UNIT_LOG)
902 write(UNIT_LOG,1001)
903 ENDIF
904
905 CALL MFIX_EXIT(myPE)
906
907 ENDDO ALOOP
908
909 RETURN
910
911 1000 FORMAT(/1X,70('*')/' From: From: setReaction --> mapAliases',/ &
912 ' Message: Unable to match species ',A,' in the chemical', &
913 ' equation for ',/' reaction ',A,'.')
914
915 1001 FORMAT(/' Please refer to the Readme file for chemical equation',&
916 ' input formats',/' and correct the data file.',/1X,70('*')/)
917
918 1010 FORMAT(/' Chemical Equation: ',A,/1X, A/)
919
920 1011 FORMAT(/' Chemical Equation: ',A,/)
921
922
923 contains
924
925
926
927
928
929
930
931
932
933
934 LOGICAL FUNCTION checkMatch(lSA, ceSA)
935
936 IMPLICIT NONE
937
938
939
940 CHARACTER(LEN=32), INTENT(IN) :: lSA, ceSA
941
942
943
944 CHARACTER(LEN=32) tlSA
945
946
947 = lSA
948
949 CALL MAKE_UPPER_CASE (tlSA,32)
950
951 = .FALSE.
952 IF(trim(tlSA) == trim(ceSA)) checkMatch = .TRUE.
953 RETURN
954 END FUNCTION checkMatch
955
956
957
958
959
960
961
962
963
964
965
966
967
968 SUBROUTINE updateMap(lnP, lpMap, llNoP)
969
970 IMPLICIT NONE
971
972
973
974 INTEGER, INTENT(INOUT) :: lnP
975
976 LOGICAL, INTENT(INOUT) :: lpMap
977 INTEGER, INTENT(INOUT) :: llNoP
978
979
980
981
982
983
984
985 = llNoP + 1
986
987 IF(lpMap) RETURN
988
989
990 = lnP + 1
991 lpMap = .TRUE.
992
993 RETURN
994 END SUBROUTINE updateMap
995
996
997
998
999
1000
1001
1002
1003
1004
1005 SUBROUTINE writeBA(FUNIT)
1006
1007 IMPLICIT NONE
1008
1009
1010 INTEGER, OPTIONAL, INTENT(IN) :: FUNIT
1011
1012 INTEGER M, N
1013
1014
1015 INTEGER Nsp
1016
1017 IF(.NOT.PRESENT(FUNIT)) THEN
1018 write(*,1000)
1019 ELSE
1020 write(FUNIT,1000)
1021 ENDIF
1022
1023
1024 = 0
1025
1026 DO N = 1, lNg
1027 Nsp = Nsp + 1
1028 IF(lBA(Nsp)) THEN
1029 IF(.NOT.PRESENT(FUNIT)) THEN
1030 write(*,1001)N
1031 ELSE
1032 write(FUNIT,1001) N
1033 ENDIF
1034 ENDIF
1035 ENDDO
1036
1037
1038 DO M = 1, lM
1039 DO N = 1, lNs(M)
1040 Nsp = Nsp + 1
1041
1042 IF(lBA(Nsp)) THEN
1043 IF(.NOT.PRESENT(FUNIT)) THEN
1044 write(*,1002)M, N
1045 ELSE
1046 write(FUNIT,1002)M, N
1047 ENDIF
1048 ENDIF
1049 ENDDO
1050 ENDDO
1051
1052 RETURN
1053
1054 1000 FORMAT(' Species aliases were not provided for the following:')
1055 1001 FORMAT(3X, ' Gas phase species ',I2)
1056 1002 FORMAT(3X, ' Solid phase ',I2,' specie ',I2)
1057
1058 END SUBROUTINE writeBA
1059
1060 END SUBROUTINE mapAliases
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071 CHARACTER(len=512) FUNCTION setFlag(fill, flg1, flg2) RESULT(OUT)
1072
1073 IMPLICIT NONE
1074
1075
1076
1077
1078
1079 INTEGER, INTENT(IN) :: fill
1080
1081 INTEGER, INTENT(IN) :: flg1
1082
1083 INTEGER, INTENT(IN), OPTIONAL :: flg2
1084
1085
1086
1087 INTEGER L, FILL1, FILL2
1088
1089
1090 = ''
1091 DO L = 1, FILL-1
1092 WRITE(OUT,"(A,A)") trim(OUT), '-'
1093 ENDDO
1094
1095
1096 IF(PRESENT(flg2)) THEN
1097 IF(flg1 < flg2) THEN
1098 FILL1 = flg1 - 1
1099 FILL2 = (flg2-flg1) - 1
1100 ELSE
1101 FILL1 = flg2 - 1
1102 FILL2 = (flg1-flg2) - 1
1103 ENDIF
1104 ELSE
1105 FILL1 = flg1 - 1
1106 FILL2 = 0
1107 ENDIF
1108
1109
1110 DO L = 1, FILL1
1111 WRITE(OUT,"(A,A)") trim(OUT), '-'
1112 ENDDO
1113 WRITE(OUT,"(A,A)") trim(OUT), '^'
1114
1115 IF(FILL2 > 0) THEN
1116 DO L = 1, FILL2
1117 WRITE(OUT,"(A,A)") trim(OUT), '-'
1118 ENDDO
1119 WRITE(OUT,"(A,A)") trim(OUT), '^'
1120 ENDIF
1121
1122 END FUNCTION setFlag
1123
1124 END MODULE parse
1125