You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
89 lines
3.0 KiB
89 lines
3.0 KiB
C Copyright(C) 1999-2020 National Technology & Engineering Solutions
|
|
C of Sandia, LLC (NTESS). Under the terms of Contract DE-NA0003525 with
|
|
C NTESS, the U.S. Government retains certain rights in this software.
|
|
C
|
|
C See packages/seacas/LICENSE for details
|
|
SUBROUTINE GETINP( KIN,KOUT,PROMPT,LINE,IOSTAT )
|
|
CHARACTER*(*) PROMPT,LINE
|
|
CHARACTER*132 PREFIX
|
|
DATA KOUNT /0/
|
|
|
|
************************************************************************
|
|
|
|
C FREFLD INPUT SYSTEM - ANSI FORTRAN - UTILITY ROUTINE
|
|
|
|
C DESCRIPTION:
|
|
C This routine is performs all I/O for the SUPES Free Field Input
|
|
C system. Its operation depends on the input and output units
|
|
C specified by the caller as follows.
|
|
|
|
C KIN KOUT Source Echo
|
|
C ------------------------------------------------------------------
|
|
C 0 0 Standard Input Standard Output
|
|
C 0 M Standard Input Standard Output and File (M)
|
|
C N M File (N) File (N)
|
|
C N 0 File (N) none
|
|
|
|
C If the prompt string is 'AUTO' this routine will generate a prompt
|
|
C of the form ' n: ', where "n" is the current input line number.
|
|
C Only lines read under the AUTO feature are counted.
|
|
|
|
C This routine does not restrict the length of the input string, but
|
|
C no more than 132 characters, including the prompt, will be echoed.
|
|
|
|
C FORMAL PARAMETERS:
|
|
C KIN INTEGER Unit from which to read input.
|
|
C KOUT INTEGER Unit to which to echo input.
|
|
C PROMPT CHARACTER Prompt string.
|
|
C LINE CHARACTER Input record.
|
|
C IOSTAT INTEGER ANSI FORTRAN I/O status.
|
|
|
|
C ROUTINES CALLED:
|
|
C STRIPB Strip leading/trailing blanks from a string.
|
|
C EXREAD Prompt, read, and echo and input record.
|
|
|
|
************************************************************************
|
|
|
|
C Generate a prompt if autoincrement mode is requested; in any case
|
|
C PREFIX(1:LPRE) will contain the prompt -
|
|
IF( PROMPT .EQ. 'AUTO' ) THEN
|
|
KOUNT = KOUNT + 1
|
|
C Wrap-around counter, if it exceeds 4 digits -
|
|
IF ( KOUNT .EQ. 10000 ) KOUNT = 0
|
|
WRITE( PREFIX,1000 ) KOUNT
|
|
LPRE = 6
|
|
ELSE
|
|
PREFIX = PROMPT
|
|
LPRE = LEN( PROMPT )
|
|
END IF
|
|
|
|
C Read the input line -
|
|
IF ( KIN .EQ. 0 ) THEN
|
|
CALL EXREAD( PREFIX(1:LPRE),LINE,IOSTAT )
|
|
ELSE
|
|
READ( KIN,2000,IOSTAT=IOSTAT ) LINE
|
|
END IF
|
|
|
|
C Return if I/O error or EOF detected -
|
|
IF ( IOSTAT .NE. 0 ) RETURN
|
|
|
|
C Find the last non-blank character -
|
|
CALL STRIPB( LINE,ILEFT,IRIGHT )
|
|
|
|
C Truncate the string for echo, if necessary -
|
|
IRIGHT = MIN( IRIGHT,132-LPRE )
|
|
|
|
C Echo the input line, if requested -
|
|
IF ( KOUT .GT. 0 ) THEN
|
|
IF ( IRIGHT .EQ. 0 ) THEN
|
|
WRITE( KOUT,3000 ) PREFIX(1:LPRE)
|
|
ELSE
|
|
WRITE( KOUT,3000 ) PREFIX(1:LPRE),LINE(1:IRIGHT)
|
|
END IF
|
|
END IF
|
|
|
|
1000 FORMAT( I4,': ' )
|
|
2000 FORMAT( A )
|
|
3000 FORMAT( 1X,A,A )
|
|
|
|
END
|
|
|