1 2 SUBROUTINE RADRNG 3 !*********************************************************************** 4 ! RADRNG Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Non-Uniform Polar Network Value 7 ! 8 ! PROGRAMMER: Jeff Wang, Roger Brode 9 ! 10 ! DATE: March 2, 1992 11 ! 12 ! INPUTS: Input Runstream Image Parameters 13 ! 14 ! OUTPUTS: Polar Network Directions in Non-Uniform Spacing 15 ! 16 ! CALLED FROM: REPOLR 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 INTEGER :: I , J 26 27 ! Variable Initializations 28 MODNAM = 'RADRNG' ! 0 29 30 ! Skip the non-useful Fields 31 DO I = 1 , IFC 32 IF ( FIELD(I).EQ.'DDIR' ) ISC = I + 1 ! 0 33 ENDDO 34 35 ! Determine Whether There Are Enough Parameter Fields 36 IF ( IFC.EQ.ISC-1 ) THEN ! 0 37 ! Error Message: Missing Parameter 38 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 39 RECERR = .TRUE. 40 GOTO 999 41 ENDIF 42 43 ISET = JCOUNT ! 0 44 45 DO I = ISC , IFC 46 CALL STONUM(FIELD(I),ILEN_FLD,FNUM,IMIT) ! 0 47 ! Check The Numerical Field 48 IF ( IMIT.EQ.-1 ) THEN 49 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 50 RECERR = .TRUE. 51 ENDIF 52 ISET = ISET + 1 ! 0 53 IF ( ISET.LE.IYM ) THEN 54 ! Store Direction to YCOORD Array, Adjust to 0-360 Range if Needed, 55 ! and Check for Previous Occurrence 56 YCOORD(ISET,INNET) = FNUM ! 0 57 IF ( YCOORD(ISET,INNET).GT.360. ) THEN 58 YCOORD(ISET,INNET) = YCOORD(ISET,INNET) - 360. ! 0 59 ELSEIF ( YCOORD(ISET,INNET).LE.0. ) THEN 60 YCOORD(ISET,INNET) = YCOORD(ISET,INNET) + 360. ! 0 61 ENDIF 62 DO J = 1 , ISET - 1 ! 0 63 ! WRITE Warning Message: Direction Specified More Than Once 64 IF ( FNUM.EQ.YCOORD(J,INNET) ) & 65 & CALL ERRHDL(PATH,MODNAM,'W','250',NETIDT) 66 ENDDO 67 ELSE 68 ! WRITE Error Message: Too Many Y-Coordinates for This Network 69 WRITE (DUMMY,'(I8)') IYM ! 0 70 CALL ERRHDL(PATH,MODNAM,'E','226',DUMMY) 71 RECERR = .TRUE. 72 ENDIF 73 ENDDO 74 75 JCOUNT = ISET ! 0 76 77 999 CONTINUE ! 0 78 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