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