1
2      SUBROUTINE INPPHI
3!***********************************************************************
4!                 INPPHI Module of the AMS/EPA Regulatory Model - AERMOD
5!
6!        PURPOSE: Processes Mass Fraction (PHI) Input Values
7!
8!        PROGRAMMER:  Jeff Wang, Roger Brode
9!        MODIFIED BY: D. Strimaitis, SRC
10!
11!        DATE:    February 15, 1993
12!
13!        INPUTS:  Input Runstream Image Parameters
14!
15!        OUTPUTS: Mass Fraction Input Values
16!
17!        CALLED FROM:   PARTDEP
18!***********************************************************************
19
20!     Variable Declarations
21      USE MAIN1
22      IMPLICIT NONE
23      CHARACTER MODNAM*12
24
25      SAVE
26      INTEGER :: I , J , K , IH , IL , ISDX , IING
27      CHARACTER LID*8 , HID*8 , LID1*8 , LID2*8 , HID1*8 , HID2*8
28      CHARACTER(LEN=ILEN_FLD) :: SOID
29      LOGICAL FIND , INGRP , RMARK
30
31!     Variable Initializations
32      FIND = .FALSE.                                                    !      0
33      INGRP = .FALSE.
34      MODNAM = 'INPPHI'
35
36!     Get The Source ID(s)
37      SOID = FIELD(3)
38      CALL FSPLIT(PATH,KEYWRD,SOID,ILEN_FLD,'-',RMARK,LID,HID)
39
40      IF ( LID.EQ.HID ) THEN
41!        Search For The Index
42         CALL SINDEX(SRCID,NSRC,SOID,ISDX,FIND)                         !      0
43         IF ( FIND ) THEN
44            ISET = IWRK2(ISDX,6)                                        !      0
45            DO K = 4 , IFC
46!              Change It To Numbers
47               CALL STONUM(FIELD(K),ILEN_FLD,FNUM,IMIT)                 !      0
48!              Check The Numerical Field
49               IF ( IMIT.EQ.-1 ) THEN
50                  CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD)             !      0
51                  GOTO 20
52               ENDIF
53!                 WRITE Error Message: Mass Fraction Out-of-Range
54               IF ( FNUM.LT.0.0 .OR. FNUM.GT.1.0 )                      &
55     &              CALL ERRHDL(PATH,MODNAM,'E','332',SRCID(ISDX))
56               DO J = 1 , IMIT
57                  ISET = ISET + 1                                       !      0
58                  IF ( ISET.LE.NPDMAX ) THEN
59!                    Assign The Field
60                     APHI(ISET,ISDX) = FNUM                             !      0
61                  ELSE
62!                    WRITE Error Message: Too Many PartDiam Categories
63                     WRITE (DUMMY,'(I8)') NPDMAX                        !      0
64                     CALL ERRHDL(PATH,MODNAM,'E','245',DUMMY)
65                  ENDIF
66               ENDDO
67 20         ENDDO
68            IWRK2(ISDX,6) = ISET                                        !      0
69         ELSE
70!           WRITE Error Message     ! Source Location Has Not Been Identified
71            CALL ERRHDL(PATH,MODNAM,'E','300',KEYWRD)                   !      0
72         ENDIF
73      ELSE
74!        First Check Range for Upper Value < Lower Value
75         CALL SETIDG(LID,LID1,IL,LID2)                                  !      0
76         CALL SETIDG(HID,HID1,IH,HID2)
77         IF ( (HID1.LT.LID1) .OR. (IH.LT.IL) .OR. (HID2.LT.LID2) ) THEN
78!           WRITE Error Message:  Invalid Range,  Upper < Lower
79            CALL ERRHDL(PATH,MODNAM,'E','203','SRCRANGE')               !      0
80            GOTO 999
81         ENDIF
82         SOURCE_LOOP:DO I = 1 , NUMSRC                                  !      0
83!           See Whether It's In The Group
84            CALL ASNGRP(SRCID(I),LID,HID,INGRP)                         !      0
85            IF ( INGRP ) THEN
86               IING = I                                                 !      0
87               ISET = IWRK2(IING,6)
88               DO K = 4 , IFC
89!                 Get Numbers
90                  CALL STONUM(FIELD(K),ILEN_FLD,FNUM,IMIT)              !      0
91!                 Check The Numerical Field
92                  IF ( IMIT.EQ.-1 ) THEN
93                     CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD)          !      0
94                     GOTO 50
95                  ENDIF
96!                    WRITE Error Message: Mass Fraction Out-of-Range
97                  IF ( FNUM.LT.0.0 .OR. FNUM.GT.1.0 )                   &
98     &                 CALL ERRHDL(PATH,MODNAM,'E','332',SRCID(ISDX))
99                  DO J = 1 , IMIT
100                     ISET = ISET + 1                                    !      0
101                     IF ( ISET.LE.NPDMAX ) THEN
102                        APHI(ISET,I) = FNUM                             !      0
103                     ELSE
104!                       WRITE Error Message: Too Many PartDiam Categories
105                        WRITE (DUMMY,'(I8)') NPDMAX                     !      0
106                        CALL ERRHDL(PATH,MODNAM,'E','245',DUMMY)
107                     ENDIF
108                  ENDDO
109               ENDDO
110               IWRK2(IING,6) = ISET                                     !      0
111            ENDIF
112 50      ENDDO SOURCE_LOOP
113      ENDIF
114
115 999  CONTINUE                                                          !      0
116      END


HyperKWIC - Version 1.00DD executed at 20:00 on 1 Mar 2018 | Personal or Academic or Evaluation User | Free for Non-Commercial, Non-Government Use