1 2 SUBROUTINE SETIDG(INID,IDCHR1,IDNUM,IDCHR2) 3 !*********************************************************************** 4 ! SETIDG Module of the AMS/EPA Regulatory Model - AERMOD 5 ! 6 ! PURPOSE: Find A Source ID's Character Part and 7 ! Numerical Part 8 ! 9 ! PROGRAMMER: Jeff Wang, Roger Brode, Kevin Stroupe 10 ! 11 ! DATE: March 2, 1992 12 ! 13 ! REVISION HISTORY: 14 ! 15 ! Modified conversion of numeric portion to use internal 16 ! read rather than using call to STONUM in order to 17 ! avoid precision problems for 8-digit integer IDs. 18 ! R. Brode, PES, 8/9/01 19 ! 20 ! INPUTS: Input Field Parameters 21 ! 22 ! OUTPUTS: An Initial Character String, a Number, and 23 ! a Second Character String 24 ! 25 ! CALLED FROM: (This is An Utility Program) 26 !*********************************************************************** 27 ! 28 ! Variable Declarations 29 USE MAIN1 30 IMPLICIT NONE 31 CHARACTER MODNAM*12 32 33 SAVE 34 INTEGER :: I , II , ISTR , IDNUM 35 CHARACTER INID*8 , IDCHR1*8 , IDCHR2*8 , CHKI 36 CHARACTER(LEN=ILEN_FLD) :: NUMID 37 LOGICAL HIT 38 39 ! Variable Initializations 40 MODNAM = 'SETIDG' ! 0 41 I = 8 42 NUMID = ' ' 43 IDCHR1 = ' ' 44 IDCHR2 = ' ' 45 IDNUM = 0 46 HIT = .FALSE. 47 48 ! Find The Length of the Input Field, II (<= 8) 49 DO WHILE ( .NOT.HIT .AND. I.GE.1 ) 50 CHKI = INID(I:I) ! 0 51 IF ( CHKI.NE.' ' ) THEN 52 II = I ! 0 53 HIT = .TRUE. 54 ENDIF 55 I = I - 1 ! 0 56 ENDDO 57 58 ! Divide the Input Id into 3 parts (char1, int, and char2) 59 I = 1 ! 0 60 ISTR = I 61 CHKI = INID(I:I) 62 ! Get first character part 63 DO WHILE ( CHKI.LT.'0' .OR. CHKI.GT.'9' ) 64 IDCHR1 = INID(ISTR:I) ! 0 65 I = I + 1 66 IF ( I.GT.II ) THEN 67 GOTO 20 ! 0 68 ELSE 69 CHKI = INID(I:I) ! 0 70 ENDIF 71 ENDDO 72 73 ! Get integer part 74 ISTR = I ! 0 75 DO WHILE ( CHKI.GE.'0' .AND. CHKI.LE.'9' ) 76 NUMID = INID(ISTR:I) ! 0 77 I = I + 1 78 IF ( I.GT.II ) THEN 79 GOTO 20 ! 0 80 ELSE 81 CHKI = INID(I:I) ! 0 82 ENDIF 83 ENDDO 84 85 ! Get second character part 86 ISTR = I ! 0 87 DO WHILE ( I.LE.II ) 88 IDCHR2 = INID(ISTR:I) ! 0 89 I = I + 1 90 IF ( I.GT.II ) THEN 91 GOTO 20 ! 0 92 ELSE 93 CHKI = INID(I:I) ! 0 94 ENDIF 95 ENDDO 96 97 20 CONTINUE ! 0 98 99 ! Convert Numeric Part to Integer Variable 100 !JRA replaced by list directed input 23/9/2005 101 ! READ (NUMID,'(I)') IDNUM 102 READ (NUMID,*) IDNUM 103 104 CONTINUE 105 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