1 2 SUBROUTINE FSPLIT(PATHIN,KEYIN,INPFLD,LENGTH,DELIM,LFLAG,BEGFLD, & 3 & ENDFLD) 4 !*********************************************************************** 5 ! FSPLIT Module of the AMS/EPA Regulatory Model - AERMOD 6 ! 7 ! PURPOSE: SPLIT A FIELD, BASED ON AN INPUT DELIMITER 8 ! CHARACTER. SETS A LOGICAL FLAG AND RETURNS 9 ! BEGINNING AND ENDING PARTS OF FIELD. 10 ! 11 ! PROGRAMMER: Roger Brode, Jeff Wang 12 ! 13 ! DATE: March 2, 1992 14 ! 15 ! INPUTS: Pathway for Calling Routine 16 ! Keyword for Calling Routine 17 ! Input Field Variable 18 ! Length of Input Character Field 19 ! Delimiter Character 20 ! 21 ! OUTPUTS: Logical Flag to Indicate Presence of Delimiter 22 ! Beginning Part of Field (.LE. 8 Character) 23 ! Ending Part of Field (.LE. 8 Character) 24 ! 25 ! CALLED FROM: (This Is A Utility Program) 26 !*********************************************************************** 27 28 ! Variable Declarations 29 IMPLICIT NONE 30 31 INTEGER :: I , LENGTH , IDELM 32 CHARACTER CHK , INPFLD*(*) , DELIM , BEGFLD*8 , ENDFLD*8 , & 33 & MODNAM*6 , PATHIN*2 , KEYIN*8 34 LOGICAL LFLAG , MEND , IN 35 36 ! Variable Initialization 37 MODNAM = 'FSPLIT' ! 231 38 I = LENGTH 39 IDELM = LENGTH 40 BEGFLD = ' ' 41 ENDFLD = ' ' 42 MEND = .FALSE. 43 IN = .FALSE. 44 LFLAG = .FALSE. 45 46 ! Begin the Processing 47 DO WHILE ( .NOT.MEND .AND. I.GE.1 ) 48 CHK = INPFLD(I:I) ! 18480 49 IF ( CHK.NE.' ' ) THEN 50 IN = .TRUE. ! 1422 51 ! Check for the Group Delimiter 52 IF ( .NOT.LFLAG .AND. CHK.EQ.DELIM ) THEN 53 LFLAG = .TRUE. ! 6 54 IDELM = I 55 ENDFLD = INPFLD(I+1:LENGTH) 56 IF ( I.EQ.1 ) THEN 57 ! Write Error Message for Invalid Range Parameter 58 CALL ERRHDL(PATHIN,MODNAM,'E','203',KEYIN) ! 0 59 GOTO 999 60 ENDIF 61 ELSEIF ( LFLAG .AND. CHK.EQ.DELIM ) THEN 62 ! WRITE Error Message ! More Than One Delimiter in a Field 63 CALL ERRHDL(PATHIN,MODNAM,'E','217',KEYIN) ! 0 64 ENDIF 65 ELSEIF ( IN .AND. CHK.EQ.' ' ) THEN 66 MEND = .TRUE. ! 0 67 IF ( LFLAG ) THEN 68 BEGFLD = INPFLD(1:IDELM-1) ! 0 69 ELSE 70 BEGFLD = INPFLD ! 0 71 ENDIF 72 ENDIF 73 I = I - 1 ! 18480 74 ENDDO 75 76 IF ( .NOT.MEND ) THEN ! 231 77 IF ( LFLAG ) THEN ! 231 78 BEGFLD = INPFLD(1:IDELM-1) ! 6 79 ELSE 80 BEGFLD = INPFLD ! 225 81 ENDIF 82 ENDIF 83 84 ! In Case Of No Delimiter, Set ENDFLD = BEGFLD 85 IF ( .NOT.LFLAG ) ENDFLD = BEGFLD ! 231 86 87 999 CONTINUE ! 231 88 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