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.
93 lines
3.3 KiB
93 lines
3.3 KiB
C Copyright(C) 1999-2020, 2022 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 FREFLD( KIN,KOUT,PROMPT,MFIELD,IOSTAT,NFIELD,KVALUE,
|
|
* CVALUE,IVALUE,RVALUE )
|
|
CHARACTER*(*) PROMPT,CVALUE(MFIELD)
|
|
CHARACTER*1024 LINE
|
|
CHARACTER*132 PREFIX
|
|
INTEGER KVALUE(MFIELD),IVALUE(MFIELD)
|
|
REAL RVALUE(MFIELD)
|
|
|
|
************************************************************************
|
|
|
|
C FREFLD INPUT SYSTEM - ANSI FORTRAN - USER INTERFACE ROUTINE
|
|
|
|
C DESCRIPTION:
|
|
C This routine is the main user interface to the SUPES Free Field
|
|
C Input system. It obtains a record from the input stream, then
|
|
C call FFISTR to parse the record into data fields.
|
|
|
|
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 MFIELD INTEGER Maximum number of data fields to be returned.
|
|
C IOSTAT INTEGER ANSI FORTRAN I/O status.
|
|
C NFIELD INTEGER Number of data fields found.
|
|
C KVALUE INTEGER Translation states of the data fields:
|
|
C -1 = This is a null field.
|
|
C 0 = This is a non-numeric field.
|
|
C 1 = This is a REAL numeric field.
|
|
C 2 = This is an INTEGER numeric field.
|
|
C CVALUE CHARACTER Character values of the data fields.
|
|
C RVALUE REAL Floating-point values of the data fields.
|
|
C IVALUE INTEGER Integer values of the data fields.
|
|
|
|
C ROUTINES CALLED:
|
|
C GETINP Get input line.
|
|
C FFISTR Parse input line.
|
|
|
|
************************************************************************
|
|
|
|
C PHASE 1: Initialize output arrays to their default values and zero
|
|
C field counter. Set continuation flag to suppress further
|
|
C initialization by FFISTR.
|
|
|
|
DO 300 I = 1 , MFIELD
|
|
KVALUE(I) = -1
|
|
CVALUE(I) = ' '
|
|
RVALUE(I) = 0.
|
|
IVALUE(I) = 0
|
|
300 CONTINUE
|
|
NFIELD = 0
|
|
IDCONT = 1
|
|
|
|
C Initialize prompt to the caller's -
|
|
PREFIX = PROMPT
|
|
LPRE = LEN( PROMPT )
|
|
|
|
************************************************************************
|
|
|
|
C PHASE 2: Get the next input record via GETINP. Return to caller if an
|
|
C end-of-file or error was detected by GETINP.
|
|
C Re-enter here to process a continuation line.
|
|
|
|
500 CONTINUE
|
|
|
|
C Get the next input line -
|
|
CALL GETINP( KIN,KOUT,PREFIX(1:LPRE),LINE,IOSTAT )
|
|
|
|
C Return if I/O error or EOF detected -
|
|
IF ( IOSTAT .NE. 0 ) RETURN
|
|
|
|
C Call FFISTR to parse input record -
|
|
CALL FFISTR( LINE,MFIELD,IDCONT,NFIELD,KVALUE,CVALUE,IVALUE,
|
|
* RVALUE )
|
|
|
|
C If the continuation flag is set, define a continuation prompt and
|
|
C re-enter at phase 2. Otherwise, return to the caller -
|
|
IF ( IDCONT .NE. 0 ) THEN
|
|
IF ( PROMPT .EQ. 'AUTO' ) THEN
|
|
PREFIX = ' *: '
|
|
LPRE = 6
|
|
ELSE
|
|
IF ( LPRE .GT. 3 ) PREFIX(1:LPRE-3) = ' '
|
|
IF ( LPRE .GE. 3 ) PREFIX(LPRE-2:LPRE-2) = '*'
|
|
END IF
|
|
GO TO 500
|
|
END IF
|
|
|
|
END
|
|
|