1 2 SUBROUTINE PRBASE 3 !*********************************************************************** 4 ! PRBASE Module of the AERMOD Model 5 ! 6 ! PURPOSE: Process Inputs for Profile Base Elevation 7 ! From Runstream Input Image 8 ! 9 ! PROGRAMMER: Roger Brode 10 ! 11 ! DATE: November 9, 1998 12 ! 13 ! INPUTS: Input Runstream Image Parameters 14 ! 15 ! OUTPUTS: Profile Base Elevation (m MSL), ZBASE 16 ! 17 ! ERROR HANDLING: Checks for No Parameters; 18 ! Checks for No Units (uses default of m); 19 ! Checks for Invalid or Suspicious Values of ZBASE; 20 ! Checks for Too Many Parameters 21 ! 22 ! CALLED FROM: MECARD 23 !*********************************************************************** 24 25 ! Variable Declarations 26 USE MAIN1 27 IMPLICIT NONE 28 CHARACTER MODNAM*12 29 30 SAVE 31 32 ! Variable Initializations 33 MODNAM = 'PRBASE' ! 3 34 35 IF ( IFC.EQ.3 .OR. IFC.EQ.4 ) THEN 36 CALL STONUM(FIELD(3),ILEN_FLD,ZBASE,IMIT) ! 3 37 ! Check The Numerical Field 38 IF ( IMIT.EQ.-1 ) THEN 39 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 40 GOTO 999 41 ENDIF 42 IF ( IFC.EQ.4 .AND. FIELD(4).EQ.'FEET' ) THEN ! 3 43 ZBASE = 0.3048*ZBASE ! 0 44 ELSEIF ( IFC.EQ.4 .AND. FIELD(4).NE.'METERS' ) THEN 45 ! WRITE Warning Message - Invalid ZRUNIT Parameter 46 CALL ERRHDL(PATH,MODNAM,'W','203','ZRUNIT') ! 0 47 ENDIF 48 IF ( ZBASE.LT.0.0 .AND. IMIT.EQ.1 ) THEN ! 3 49 ! WRITE Warning Message - Possible Error In ZBASE 50 CALL ERRHDL(PATH,MODNAM,'W','340',KEYWRD) ! 0 51 ELSEIF ( IMIT.NE.1 ) THEN 52 ! WRITE Error Message - Invalid Numeric Field 53 CALL ERRHDL(PATH,MODNAM,'E','208',KEYWRD) ! 0 54 ENDIF 55 ELSEIF ( IFC.GT.4 ) THEN 56 ! WRITE Error Message ! Too Many Parameters 57 CALL ERRHDL(PATH,MODNAM,'E','202',KEYWRD) ! 0 58 ELSE 59 ! WRITE Error Message ! No Parameters 60 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 61 ENDIF 62 63 ! Reinitialize AZS, AZELEV, and AZHILL arrays for FLAT terrain 64 IF ( FLAT ) THEN ! 3 65 DO ISRC = 1 , NUMSRC ! 3 66 AZS(ISRC) = ZBASE ! 27 67 ENDDO 68 DO IREC = 1 , NUMREC ! 3 69 AZELEV(IREC) = ZBASE ! 432 70 AZHILL(IREC) = ZBASE 71 ENDDO 72 ENDIF 73 74 999 CONTINUE ! 3 75 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