1
2      SUBROUTINE INPPDN
3!***********************************************************************
4!                 INPPDN Module of the AMS/EPA Regulatory Model - AERMOD
5!
6!        PURPOSE: Processes Particle Density Input Values
7!
8!        PROGRAMMER:  D. Strimaitis, SRC
9!
10!        ADAPTED FROM "INPGAM"
11!        PROGRAMMER:  Jeff Wang, Roger Brode
12!
13!        DATE:    February 15, 1993
14!
15!        INPUTS:  Input Runstream Image Parameters
16!
17!        OUTPUTS: Particle Density Input Values
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 = 'INPPDN'
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,7)                                        !      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!                 WRITE Error Message: Particle Density Out-of-Range
56               IF ( FNUM.LE.0.0 )                                       &
57     &              CALL ERRHDL(PATH,MODNAM,'E','334',SRCID(ISDX))
58               DO J = 1 , IMIT
59                  ISET = ISET + 1                                       !      0
60                  IF ( ISET.LE.NPDMAX ) THEN
61!                    Assign The Field
62                     APDENS(ISET,ISDX) = FNUM                           !      0
63                  ELSE
64!                    WRITE Error Message: Too Many PartDiam Categories
65                     WRITE (DUMMY,'(I8)') NPDMAX                        !      0
66                     CALL ERRHDL(PATH,MODNAM,'E','245',DUMMY)
67                  ENDIF
68               ENDDO
69 20         ENDDO
70            IWRK2(ISDX,7) = ISET                                        !      0
71         ELSE
72!           WRITE Error Message     ! Source Location Has Not Been Identified
73            CALL ERRHDL(PATH,MODNAM,'E','300',KEYWRD)                   !      0
74         ENDIF
75      ELSE
76!        First Check Range for Upper Value < Lower Value
77         CALL SETIDG(LID,LID1,IL,LID2)                                  !      0
78         CALL SETIDG(HID,HID1,IH,HID2)
79         IF ( (HID1.LT.LID1) .OR. (IH.LT.IL) .OR. (HID2.LT.LID2) ) THEN
80!           WRITE Error Message:  Invalid Range,  Upper < Lower
81            CALL ERRHDL(PATH,MODNAM,'E','203','SRCRANGE')               !      0
82            GOTO 999
83         ENDIF
84         SOURCE_LOOP:DO I = 1 , NUMSRC                                  !      0
85!           See Whether It's In The Group
86            CALL ASNGRP(SRCID(I),LID,HID,INGRP)                         !      0
87            IF ( INGRP ) THEN
88               IING = I                                                 !      0
89               ISET = IWRK2(IING,7)
90               DO K = 4 , IFC
91!                 Get Numbers
92                  CALL STONUM(FIELD(K),ILEN_FLD,FNUM,IMIT)              !      0
93!                 Check The Numerical Field
94                  IF ( IMIT.NE.1 ) THEN
95                     CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD)          !      0
96                     GOTO 50
97                  ENDIF
98!                    WRITE Error Message: Particle Density Out-of-Range
99                  IF ( FNUM.LE.0.0 )                                    &
100     &                 CALL ERRHDL(PATH,MODNAM,'E','334',SRCID(ISDX))
101                  DO J = 1 , IMIT
102                     ISET = ISET + 1                                    !      0
103                     IF ( ISET.LE.NPDMAX ) THEN
104                        APDENS(ISET,I) = FNUM                           !      0
105                     ELSE
106!                       WRITE Error Message: Too Many PartDiam Categories
107                        WRITE (DUMMY,'(I8)') NPDMAX                     !      0
108                        CALL ERRHDL(PATH,MODNAM,'E','245',DUMMY)
109                     ENDIF
110                  ENDDO
111               ENDDO
112               IWRK2(IING,7) = ISET                                     !      0
113            ENDIF
114 50      ENDDO SOURCE_LOOP
115      ENDIF
116
117 999  CONTINUE                                                          !      0
118      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