1 2 SUBROUTINE ARVERT 3 !*********************************************************************** 4 ! ARVERT Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Vertices for AREAPOLY Sources 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: August 15, 1995 11 ! 12 ! INPUTS: Input Runstream Image Parameters 13 ! 14 ! OUTPUTS: Area Sources Vertices 15 ! 16 ! CALLED FROM: SOCARD 17 !*********************************************************************** 18 ! 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: K , ISDX 26 REAL :: FNUMX , FNUMY 27 CHARACTER SOID*8 28 LOGICAL FIND 29 30 ! Variable Initializations 31 FIND = .FALSE. ! 0 32 MODNAM = 'ARVERT' 33 34 ! Get The Source ID 35 SOID = FIELD(3) 36 37 ! Search For The Index 38 CALL SINDEX(SRCID,NSRC,SOID,ISDX,FIND) 39 IF ( FIND ) THEN 40 ISET = IWRK2(ISDX,10) ! 0 41 DO K = 4 , IFC - 1 , 2 42 ! Change Fields To Numbers 43 CALL STONUM(FIELD(K),ILEN_FLD,FNUMX,IMIT) ! 0 44 ! Check The Numerical Field 45 IF ( IMIT.EQ.-1 ) THEN 46 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 47 GOTO 50 48 ENDIF 49 CALL STONUM(FIELD(K+1),ILEN_FLD,FNUMY,IMIT) ! 0 50 ! Check The Numerical Field 51 IF ( IMIT.EQ.-1 ) THEN 52 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 53 GOTO 50 54 ENDIF 55 56 ISET = ISET + 1 ! 0 57 IF ( ISET.EQ.1 ) THEN 58 ! Compare First Vertex to Source Location 59 IF ( FNUMX.NE.AXS(ISDX) ) & 60 & CALL ERRHDL(PATH,MODNAM,'E','262',SRCID(ISDX)) 61 IF ( FNUMY.NE.AYS(ISDX) ) & 62 & CALL ERRHDL(PATH,MODNAM,'E','262',SRCID(ISDX)) 63 ENDIF 64 65 IF ( ISET.LE.NVERTS(ISDX) ) THEN ! 0 66 ! Assign The Field 67 AXVERT(ISET,ISDX) = FNUMX ! 0 68 AYVERT(ISET,ISDX) = FNUMY 69 ELSE 70 ! WRITE Error Message: Too Many Vertices For This Source 71 CALL ERRHDL(PATH,MODNAM,'E','264',SRCID(ISDX)) ! 0 72 ENDIF 73 50 ENDDO 74 IWRK2(ISDX,10) = ISET ! 0 75 ELSE 76 ! WRITE Error Message ! Source Location Has Not Been Identified 77 CALL ERRHDL(PATH,MODNAM,'E','300',KEYWRD) ! 0 78 ENDIF 79 80 CONTINUE ! 0 81 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