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