1 2 SUBROUTINE XYPNTS 3 !*********************************************************************** 4 ! XYPNTS Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Cartesian Grid x,y Input Value 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! MODIFIED: To Fix Error Checking - Change Limit for DO 15 13 ! To 'JSET -1' - 9/29/92 14 ! 15 ! INPUTS: Input Runstream Image Parameters 16 ! 17 ! OUTPUTS: Cartesian Grid x,y Input Value 18 ! 19 ! CALLED FROM: RECART 20 !*********************************************************************** 21 22 ! Variable Declarations 23 USE MAIN1 24 IMPLICIT NONE 25 CHARACTER MODNAM*12 26 27 SAVE 28 INTEGER :: I , J , JSET 29 30 ! Variable Initializations 31 MODNAM = 'XYPNTS' ! 0 32 33 IF ( KTYPE.EQ.'XPNTS' ) THEN 34 ! Check for Location of Secondary Keyword, XPNTS 35 DO I = 1 , IFC ! 0 36 IF ( FIELD(I).EQ.'XPNTS' ) ISC = I + 1 ! 0 37 ENDDO 38 39 ! Determine Whether There Are Enough Parameter Fields 40 IF ( IFC.EQ.ISC-1 ) THEN ! 0 41 ! Error Message: Missing Parameter 42 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 43 RECERR = .TRUE. 44 GOTO 999 45 ENDIF 46 47 ISET = ICOUNT ! 0 48 DO I = ISC , IFC 49 CALL STONUM(FIELD(I),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 RECERR = .TRUE. 54 ENDIF 55 ISET = ISET + 1 ! 0 56 IF ( ISET.LE.IXM ) THEN 57 XCOORD(ISET,INNET) = FNUM ! 0 58 DO J = 1 , ISET - 1 59 ! WRITE Warning Message: X-Coord Specified More Than Once 60 IF ( FNUM.EQ.XCOORD(J,INNET) ) & 61 & CALL ERRHDL(PATH,MODNAM,'W','250',NETIDT) 62 ENDDO 63 ELSE 64 ! WRITE Error Message: Too Many X-Coordinates for This Network 65 WRITE (DUMMY,'(I8)') IXM ! 0 66 CALL ERRHDL(PATH,MODNAM,'E','225',DUMMY) 67 RECERR = .TRUE. 68 ENDIF 69 ENDDO 70 ICOUNT = ISET ! 0 71 72 ELSEIF ( KTYPE.EQ.'YPNTS' ) THEN 73 ! Check for Location of Secondary Keyword, YPNTS 74 DO I = 1 , IFC ! 0 75 IF ( FIELD(I).EQ.'YPNTS' ) ISC = I + 1 ! 0 76 ENDDO 77 78 ! Determine Whether There Are Enough Parameter Fields 79 IF ( IFC.EQ.ISC-1 ) THEN ! 0 80 ! Error Message: Missing Parameter 81 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 82 RECERR = .TRUE. 83 GOTO 999 84 ENDIF 85 86 JSET = JCOUNT ! 0 87 88 DO I = ISC , IFC 89 CALL STONUM(FIELD(I),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 RECERR = .TRUE. 94 ENDIF 95 JSET = JSET + 1 ! 0 96 IF ( JSET.LE.IYM ) THEN 97 YCOORD(JSET,INNET) = FNUM ! 0 98 DO J = 1 , JSET - 1 99 ! WRITE Warning Message: Y-Coord Specified More Than Once 100 IF ( FNUM.EQ.YCOORD(J,INNET) ) & 101 & CALL ERRHDL(PATH,MODNAM,'W','250',NETIDT) 102 ENDDO 103 ELSE 104 ! WRITE Error Message: Too Many Y-Coordinates for This Network 105 WRITE (DUMMY,'(I8)') IYM ! 0 106 CALL ERRHDL(PATH,MODNAM,'E','226',DUMMY) 107 RECERR = .TRUE. 108 ENDIF 109 ENDDO 110 JCOUNT = JSET ! 0 111 ENDIF 112 113 999 CONTINUE ! 0 114 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