1 2 3 SUBROUTINE URBANS 4 !*********************************************************************** 5 ! URBANS Module of AERMOD Model 6 ! 7 ! PURPOSE: Processes Urban Source Card 8 ! 9 ! PROGRAMMER: Roger Brode 10 ! 11 ! DATE: June 11, 1996 12 ! 13 ! INPUTS: Input Runstream Image Parameters 14 ! 15 ! OUTPUTS: Array of flags for Urban Sources 16 ! 17 ! CALLED FROM: SOCARD 18 !*********************************************************************** 19 ! 20 21 ! Variable Declarations 22 USE MAIN1 23 IMPLICIT NONE 24 CHARACTER MODNAM*12 25 26 SAVE 27 CHARACTER*8 LOWID , HIGID , LID1 , LID2 , HID1 , HID2 28 INTEGER :: I , IL , IH , K 29 LOGICAL INGRP , RMARK 30 31 ! Variable Initializations 32 MODNAM = 'URBANS' ! 0 33 34 ! Check The Number Of The Fields 35 IF ( IFC.LE.2 ) THEN 36 ! Error Message: No Parameters 37 CALL ERRHDL(PATH,MODNAM,'E','200',KEYWRD) ! 0 38 GOTO 999 39 ENDIF 40 41 ! Loop Through Fields 42 DO I = 3 , IFC ! 0 43 CALL FSPLIT(PATH,KEYWRD,FIELD(I),ILEN_FLD,'-',RMARK,LOWID, & 44 & HIGID) 45 ! First Check Range for Upper Value < Lower Value 46 CALL SETIDG(LOWID,LID1,IL,LID2) 47 CALL SETIDG(HIGID,HID1,IH,HID2) 48 IF ( (HID1.LT.LID1) .OR. (IH.LT.IL) .OR. (HID2.LT.LID2) ) THEN 49 ! WRITE Error Message: Invalid Range, Upper < Lower 50 CALL ERRHDL(PATH,MODNAM,'E','203','SRCRANGE') ! 0 51 GOTO 100 52 ENDIF 53 DO K = 1 , NUMSRC ! 0 54 CALL ASNGRP(SRCID(K),LOWID,HIGID,INGRP) ! 0 55 IF ( INGRP ) URBSRC(K) = 'Y' 56 ENDDO 57 100 ENDDO 58 59 999 CONTINUE ! 0 60 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