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