1 2 SUBROUTINE OLMGRP 3 !*********************************************************************** 4 ! OLMGRP Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Processes OLM Source Group Inputs 7 ! 8 ! PROGRAMMER: Roger W. Brode, PES, Inc. 9 ! 10 ! DATE: May 6, 2002 11 ! 12 ! INPUTS: Input Runstream Image Parameters 13 ! 14 ! OUTPUTS: OLM Source Group Inputs 15 ! 16 ! CALLED FROM: SOCARD 17 !*********************************************************************** 18 ! 19 20 ! Variable Declarations 21 USE MAIN1 22 IMPLICIT NONE 23 CHARACTER MODNAM*12 24 25 SAVE 26 INTEGER :: I , K , IH , IL 27 CHARACTER*8 LOWID , HIGID , LID1 , LID2 , HID1 , HID2 , TEMPID 28 LOGICAL CONT , INGRP , RMARK 29 30 ! Variable Initializations 31 CONT = .FALSE. ! 0 32 MODNAM = 'OLMGRP' 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 ELSEIF ( IFC.LE.3 .AND. FIELD(3).NE.'ALL' ) THEN 40 ! Error Message: Not Enough Parameters 41 CALL ERRHDL(PATH,MODNAM,'E','201',KEYWRD) ! 0 42 GOTO 999 43 ENDIF 44 45 ! READ in the Group ID and Check for Continuation Card 46 TEMPID = FIELD(3) ! 0 47 DO I = 1 , NUMOLM 48 IF ( TEMPID.EQ.OLMID(I) ) CONT = .TRUE. ! 0 49 ENDDO 50 51 ! Increment Counters and Assign Group ID If Not a Continuation Card 52 IF ( .NOT.CONT ) THEN ! 0 53 IOLM = IOLM + 1 ! 0 54 IF ( IOLM.GT.NOLM ) THEN 55 ! WRITE Error Message ! Too Many OLM Groups Specified 56 WRITE (DUMMY,'(I8)') NOLM ! 0 57 CALL ERRHDL(PATH,MODNAM,'E','281',DUMMY) 58 ! Exit to END 59 GOTO 999 60 ENDIF 61 NUMOLM = NUMOLM + 1 ! 0 62 OLMID(IOLM) = TEMPID 63 ENDIF 64 65 ! Set Up The Source Group Array 66 IF ( OLMID(IOLM).EQ.'ALL' .AND. .NOT.CONT ) THEN ! 0 67 DO I = 1 , NUMSRC ! 0 68 IGRP_OLM(I,IOLM) = 1 ! 0 69 L_OLMGRP(I) = .TRUE. 70 ENDDO 71 ELSE 72 ! Loop Through Fields 73 DO I = 4 , IFC ! 0 74 CALL FSPLIT(PATH,KEYWRD,FIELD(I),ILEN_FLD,'-',RMARK,LOWID, & 75 & HIGID) 76 ! First Check Range for Upper Value < Lower Value 77 CALL SETIDG(LOWID,LID1,IL,LID2) 78 CALL SETIDG(HIGID,HID1,IH,HID2) 79 IF ( (HID1.LT.LID1) .OR. (IH.LT.IL) .OR. (HID2.LT.LID2) ) & 80 & THEN 81 ! WRITE Error Message: Invalid Range, Upper < Lower 82 CALL ERRHDL(PATH,MODNAM,'E','203','SRCRANGE') ! 0 83 GOTO 50 84 ENDIF 85 DO K = 1 , NUMSRC ! 0 86 CALL ASNGRP(SRCID(K),LOWID,HIGID,INGRP) ! 0 87 IF ( INGRP ) THEN 88 IGRP_OLM(K,IOLM) = 1 ! 0 89 L_OLMGRP(K) = .TRUE. 90 ENDIF 91 ENDDO 92 50 ENDDO 93 ENDIF 94 95 999 CONTINUE ! 0 96 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