1 2 SUBROUTINE PREPOLR 3 !*********************************************************************** 4 ! PREPOLR Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes Polar Grid Receptor Network Inputs 7 ! 8 ! PROGRAMMER: Roger Brode 9 ! 10 ! DATE: September 24, 1996 11 ! 12 ! INPUTS: Input Runstream Image Parameters 13 ! 14 ! OUTPUTS: Polar Receptor Network Inputs 15 ! 16 ! CALLED FROM: RECSIZ, PREREINC 17 !*********************************************************************** 18 19 ! Variable Declarations 20 USE MAIN1 21 IMPLICIT NONE 22 CHARACTER MODNAM*12 23 24 SAVE 25 26 ! Variable Initializations 27 MODNAM = 'PREPOLR' ! 15 28 29 ! Missing Data Field 30 IF ( IFC.LT.3 ) GOTO 999 31 32 ! READ in the Netid and Nettype 33 NETIDT = FIELD(3) ! 15 34 IF ( .NOT.NEWID .AND. (NETIDT.EQ.' ' .OR. NETIDT.EQ.'ORIG' .OR.& 35 & NETIDT.EQ.'DIST' .OR. NETIDT.EQ.'DDIR' .OR. & 36 & NETIDT.EQ.'ELEV' .OR. NETIDT.EQ.'HILL' .OR. & 37 & NETIDT.EQ.'FLAG' .OR. NETIDT.EQ.'GDIR' .OR. NETIDT.EQ.'END') & 38 & ) THEN 39 NETIDT = PNETID ! 9 40 KTYPE = FIELD(3) 41 ELSEIF ( .NOT.NEWID .AND. NETIDT.EQ.PNETID ) THEN 42 KTYPE = FIELD(4) ! 3 43 ELSEIF ( NEWID .AND. NETIDT.NE.' ' ) THEN 44 NEWID = .FALSE. ! 3 45 KTYPE = FIELD(4) 46 ! The Keyword Counter 47 NNET = NNET + 1 48 ELSE 49 ! Invalid Secondary Keyword 50 RECERR = .TRUE. ! 0 51 GOTO 999 52 ENDIF 53 54 ! Start to Set Up the Network 55 IF ( KTYPE.EQ.'STA' ) THEN ! 15 56 ISTA = .TRUE. ! 3 57 IEND = .FALSE. 58 NEWID = .FALSE. 59 RECERR = .FALSE. 60 ICOUNT = 0 61 JCOUNT = 0 62 ELSEIF ( KTYPE.EQ.'DIST' ) THEN 63 ! Read in the Distance Set --- CALL PREPOLDST 64 CALL PREPOLDST ! 3 65 ELSEIF ( KTYPE.EQ.'GDIR' ) THEN 66 CALL PREGENPOL ! 3 67 ELSEIF ( KTYPE.EQ.'DDIR' ) THEN 68 CALL PRERADRNG ! 0 69 ELSEIF ( KTYPE.EQ.'END' ) THEN 70 IEND = .TRUE. ! 3 71 ! Get the Final Result 72 IF ( .NOT.RECERR ) NREC = NREC + ICOUNT*JCOUNT 73 ISTA = .FALSE. 74 NEWID = .TRUE. 75 76 ELSEIF ( KTYPE.NE.'ELEV' .AND. KTYPE.NE.'FLAG' .AND. & 77 & KTYPE.NE.'HILL' .AND. KTYPE.NE.'ORIG' ) THEN 78 ! Invalid Secondary Keyword 79 RECERR = .TRUE. ! 0 80 GOTO 999 81 82 ENDIF 83 84 PNETID = NETIDT ! 15 85 86 999 CONTINUE ! 15 87 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