Cloned SEACAS for EXODUS library with extra build files for internal package management.
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.
 
 
 
 
 
 

128 lines
4.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
C=======================================================================
SUBROUTINE RMIXINT (INLINE, IFLD, INTYP, CFIELD, IFIELD,
& SELMSG, MAXSEL, NUMSEL, IXSEL, MAP, *)
C=======================================================================
C --*** RIXINT *** (BLOT) Parse selection command
C -- Written by Amy Gilkey - revised 05/20/88
C --
C --RMIXINT selects the items listed in the command. If there are no
C --fields, all the items are selected. If the first field is ADD, the
c --items are added to the items already selected, otherwise only the
C --listed items are selected.
C --
C --Parameters:
C -- INLINE - IN/OUT - the parsed input line for the log file
C -- IFLD - IN/OUT - the free-field reader index
C -- INTYP - IN - the free-field reader field types
C -- CFIELD - IN - the character fields
C -- IFIELD - IN - the integer fields
C -- SELMSG - IN - the type of item for error messages
C -- MAXSEL - IN - the number of the maximum selected items
C -- NUMSEL - IN/OUT - the number of selected items; set to zero
C -- upon entry unless ADD is the first field
C -- IXSEL - IN/OUT - the selected items
C -- MAP - IN - map local ids to global ids. User specifies global,
C ixsel stores local. Map size is MAXSEL
C -- * - return statement if error before any items selected
CHARACTER*(*) INLINE
INTEGER INTYP(*)
CHARACTER*(*) CFIELD(*)
INTEGER IFIELD(*)
CHARACTER*(*) SELMSG
INTEGER IXSEL(*)
INTEGER MAP(*)
LOGICAL FFEXST, FFNUMB, FFMATC
CHARACTER*80 ERRMSG
INTEGER IRNG(3)
CHARACTER*32 ISTR
IF (.NOT. (FFEXST (IFLD, INTYP))) THEN
C --Select all items if no fields
NUMSEL = MAXSEL
DO 100 I = 1, MAXSEL
IXSEL(I) = I
100 CONTINUE
ELSE IF (FFMATC (IFLD, INTYP, CFIELD, 'OFF', 3)) THEN
C --Select no items if OFF
CALL FFADDC ('OFF', INLINE)
NUMSEL = 0
ELSE
C --Reset to none selected unless ADD
IF (FFMATC (IFLD, INTYP, CFIELD, 'ADD', 3)) THEN
CALL FFADDC ('ADD', INLINE)
ELSE
IF (.NOT. FFNUMB (IFLD, INTYP)) THEN
ERRMSG =
& 'Expected "OFF" or "ADD" or ' // SELMSG // ' range'
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
GOTO 140
END IF
NUMSEL = 0
END IF
110 CONTINUE
IF (FFEXST (IFLD, INTYP)) THEN
C --Scan numeric range
CALL FFVRNG (IFLD, INTYP, CFIELD, IFIELD,
& SELMSG, -MAXSEL, IRNG, *130)
CALL FFADDV (IRNG, INLINE)
C --Store the range selected
DO 120 ID = IRNG(1), IRNG(2), IRNG(3)
C ... See if a node/element with id 'I' exists in map.
C Store the index of where this occurs.
I = LOCINT(ID, MAXSEL, MAP)
if (I .eq. 0) then
call intstr(1, -1, ID, ISTR, LSTR);
ERRMSG = 'No ' // SELMSG // ' with id equal '
* // ISTR(:LSTR) // ' found.'
ELSE
IF (LOCINT (I, NUMSEL, IXSEL) .LE. 0) THEN
IF (NUMSEL .GE. MAXSEL) THEN
ERRMSG = 'Too many ' // SELMSG // 's selected'
CALL PRTERR ('CMDERR', ERRMSG(:LENSTR(ERRMSG)))
GOTO 130
END IF
NUMSEL = NUMSEL + 1
IXSEL(NUMSEL) = I
END IF
END IF
120 CONTINUE
GOTO 110
END IF
130 CONTINUE
IF (NUMSEL .EQ. 0) THEN
ERRMSG = 'No ' // SELMSG // 's are selected'
CALL PRTERR ('CMDWARN', ERRMSG(:LENSTR(ERRMSG)))
END IF
END IF
RETURN
140 CONTINUE
RETURN 1
END