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.
250 lines
8.3 KiB
250 lines
8.3 KiB
2 years ago
|
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 CMDMOD (VERB, VERB2, INLINE,
|
||
|
|
& IFLD, INTYP, CFIELD, IFIELD, RFIELD,
|
||
|
|
& IVIEW, JVIEW, NAMES, NVOLD, NCOLD, FIXCON, VECSCL,
|
||
|
|
& ISSNPS, ISSESS, *)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** CMDMOD *** (DETOUR) Process display mode commands
|
||
|
|
C -- Written by Amy Gilkey - revised 04/11/88
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- VERB, VERB2 - IN/OUT - the verbs for the SHOW command
|
||
|
|
C -- INLINE - IN/OUT - the parsed input line for the log file
|
||
|
|
C -- IFLD, INTYP, CFIELD, IFIELD, RFIELD - IN/OUT - the free-field
|
||
|
|
C -- reader index and fields
|
||
|
|
C -- IVIEW - IN - the view number
|
||
|
|
C -- JVIEW - IN - IVIEW (if non-zero) or a defined non-empty view number
|
||
|
|
C -- (if any)
|
||
|
|
C -- NAMES - IN - the variable names
|
||
|
|
C -- NVOLD - IN/OUT - the old selected variables
|
||
|
|
C -- NCOLD - IN/OUT - the old contour variable
|
||
|
|
C -- FIXCON - IN/OUT - true iff contour parameters are fixed
|
||
|
|
C -- VECSCL - IN/OUT - the vector scale factor
|
||
|
|
C -- ISSNPS - IN/OUT - the indices of the selected node sets
|
||
|
|
C -- ISSESS - IN/OUT - the indices of the selected side sets
|
||
|
|
C --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses NVARNP, NVAREL of /DBNUMS/
|
||
|
|
C -- Uses IS3DIM of /D3NUMS/
|
||
|
|
C -- Sets and uses MSHDEF, MSHNUM, MSHLIN, MLNTYP of /MSHOPT/
|
||
|
|
C -- Sets and uses MODDET, MODTYP, IDTVAR, NNDVAR, NEDVAR of /DETOPT/
|
||
|
|
|
||
|
|
PARAMETER (MSHNON=0, MSHBOR=1, MSHDIV=2, MSHSEL=3, MSHALL=4)
|
||
|
|
|
||
|
|
include 'params.blk'
|
||
|
|
include 'dbnums.blk'
|
||
|
|
include 'dbnumgq.blk'
|
||
|
|
include 'd3nums.blk'
|
||
|
|
include 'mshopt.blk'
|
||
|
|
include 'detopt.blk'
|
||
|
|
|
||
|
|
CHARACTER*(*) VERB, VERB2
|
||
|
|
CHARACTER*(*) INLINE
|
||
|
|
INTEGER INTYP(*)
|
||
|
|
CHARACTER*(*) CFIELD(*)
|
||
|
|
INTEGER IFIELD(*)
|
||
|
|
REAL RFIELD(*)
|
||
|
|
CHARACTER*(*) NAMES(*)
|
||
|
|
INTEGER NVOLD(4), NCOLD
|
||
|
|
LOGICAL FIXCON
|
||
|
|
REAL VECSCL
|
||
|
|
INTEGER ISSNPS(NUMNPS,4)
|
||
|
|
INTEGER ISSESS(NUMESS,4)
|
||
|
|
LOGICAL FFEXST, MATSTR
|
||
|
|
INTEGER NUMMOD
|
||
|
|
CHARACTER*(MXNAME) WORD
|
||
|
|
CHARACTER*(MXNAME) MMOD, MTYP
|
||
|
|
INTEGER LTYP(-1:1)
|
||
|
|
LOGICAL LDUM
|
||
|
|
|
||
|
|
C --Get the appropriate verb for a variable, based on the display mode
|
||
|
|
|
||
|
|
MTYP = ' '
|
||
|
|
IF (VERB .EQ. ' ') THEN
|
||
|
|
IF (MODDET(JVIEW) .EQ. 'CONTOUR') THEN
|
||
|
|
IF (MODTYP(JVIEW) .EQ. 'LINE') THEN
|
||
|
|
VERB = 'CONTOUR'
|
||
|
|
ELSE
|
||
|
|
VERB = 'PAINT'
|
||
|
|
END IF
|
||
|
|
ELSE IF (MODDET(JVIEW) .EQ. 'CONTOUR') THEN
|
||
|
|
IF (MODTYP(JVIEW) .EQ. 'PAINT') THEN
|
||
|
|
VERB = 'EPAINT'
|
||
|
|
END IF
|
||
|
|
ELSE IF (MODDET(JVIEW) .EQ. 'VECTOR') THEN
|
||
|
|
VERB = 'VECTOR'
|
||
|
|
ELSE IF (MODDET(JVIEW) .EQ. 'SYMBOL') THEN
|
||
|
|
VERB = 'SYMBOL'
|
||
|
|
MTYP = MODTYP(JVIEW)
|
||
|
|
ELSE IF (MODDET(JVIEW) .EQ. 'GAUSS') THEN
|
||
|
|
VERB = 'GAUSS'
|
||
|
|
MTYP = MODTYP(JVIEW)
|
||
|
|
ELSE
|
||
|
|
VERB = 'CONTOUR'
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL INIINT (3, 1, LTYP)
|
||
|
|
|
||
|
|
IF (VERB .EQ. 'WIREFRAM') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHSEL, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, 'WIREFRAM', ' ', ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'SOLID') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
LTYP(1) = -1
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHSEL, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, 'SOLID', ' ', ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'CONTOUR') .OR. (VERB .EQ. 'PAINT')) THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
IF (VERB .EQ. 'CONTOUR') THEN
|
||
|
|
MTYP = 'LINE'
|
||
|
|
ELSE
|
||
|
|
MTYP = 'PAINT'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --If variable given, force the contour range to be re-calculated and
|
||
|
|
C --set the contour flag to undetermined
|
||
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
||
|
|
NCOLD = 0
|
||
|
|
FIXCON = .FALSE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL CMDVAR ('CONTOUR', MTYP, NAMES,
|
||
|
|
& INLINE, IFLD, INTYP, CFIELD, IDTVAR, *100)
|
||
|
|
|
||
|
|
LTYP(1) = 2
|
||
|
|
IF (MTYP .EQ. 'PAINT') LTYP(1) = -LTYP(1)
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHDIV, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, 'CONTOUR', MTYP, ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
IF ((.NOT. FIXCON) .AND. (IVIEW .NE. 0)) THEN
|
||
|
|
IF (((NUMMOD (MODDET, MODTYP, 'CONTOUR', 'LINE')
|
||
|
|
& + NUMMOD (MODDET, MODTYP, 'ELEMCONT', 'LINE')) .GE. 1)
|
||
|
|
& .AND. ((NUMMOD (MODDET, MODTYP, 'CONTOUR', 'PAINT')
|
||
|
|
& + NUMMOD (MODDET, MODTYP, 'ELEMCONT', 'PAINT')) .GE. 1))
|
||
|
|
& THEN
|
||
|
|
CALL PRTERR ('CMDWARN', 'Contradictory contour types')
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL CHKVAR (MODDET, MODTYP, IVIEW, IDTVAR, NVOLD,
|
||
|
|
& NNDVAR, NEDVAR, LDUM)
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'EPAINT') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
IF (VERB .EQ. 'EPAINT') THEN
|
||
|
|
MTYP = 'PAINT'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --If variable given, force the contour range to be re-calculated and
|
||
|
|
C --set the contour flag to undetermined
|
||
|
|
IF (FFEXST (IFLD, INTYP)) THEN
|
||
|
|
NCOLD = 0
|
||
|
|
FIXCON = .FALSE.
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL CMDVAR ('ELEMCONT', MTYP, NAMES,
|
||
|
|
& INLINE, IFLD, INTYP, CFIELD, IDTVAR, *100)
|
||
|
|
|
||
|
|
LTYP(1) = 2
|
||
|
|
IF (MTYP .EQ. 'PAINT') LTYP(1) = -LTYP(1)
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHDIV, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, 'ELEMCONT', MTYP, ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
IF ((.NOT. FIXCON) .AND. (IVIEW .NE. 0)) THEN
|
||
|
|
IF (((NUMMOD (MODDET, MODTYP, 'CONTOUR', 'LINE')
|
||
|
|
& + NUMMOD (MODDET, MODTYP, 'ELEMCONT', 'LINE')) .GE. 1)
|
||
|
|
& .AND. ((NUMMOD (MODDET, MODTYP, 'CONTOUR', 'PAINT')
|
||
|
|
& + NUMMOD (MODDET, MODTYP, 'ELEMCONT', 'PAINT')) .GE. 1))
|
||
|
|
& THEN
|
||
|
|
CALL PRTERR ('CMDWARN', 'Contradictory contour types')
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL CHKVAR (MODDET, MODTYP, IVIEW, IDTVAR, NVOLD,
|
||
|
|
& NNDVAR, NEDVAR, LDUM)
|
||
|
|
|
||
|
|
ELSE IF (VERB .EQ. 'VECTOR') THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
C --The vector type (nodal or element) is set in CHKVAR
|
||
|
|
MTYP = ' '
|
||
|
|
|
||
|
|
CALL CMDVAR ('VECTOR', MTYP, NAMES,
|
||
|
|
& INLINE, IFLD, INTYP, CFIELD, IDTVAR, *100)
|
||
|
|
|
||
|
|
LTYP(1) = 2
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHDIV, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, 'VECTOR', MTYP, ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
C --Reset the vector/symbol scaling factor
|
||
|
|
VECSCL = 1.0
|
||
|
|
VERB2 = 'VECSCL'
|
||
|
|
|
||
|
|
CALL CHKVAR (MODDET, MODTYP, IVIEW, IDTVAR, NVOLD,
|
||
|
|
& NNDVAR, NEDVAR, LDUM)
|
||
|
|
|
||
|
|
ELSE IF ((VERB .EQ. 'SYMBOL') .OR. (VERB .EQ. 'GAUSS')) THEN
|
||
|
|
CALL FFADDC (VERB, INLINE)
|
||
|
|
IF (VERB .EQ. 'SYMBOL') THEN
|
||
|
|
MMOD = 'SYMBOL'
|
||
|
|
ELSE
|
||
|
|
MMOD = 'GAUSS'
|
||
|
|
END IF
|
||
|
|
|
||
|
|
IF (MTYP .EQ. ' ') THEN
|
||
|
|
CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD)
|
||
|
|
IF (MATSTR (WORD, 'ANGLE', 1)) THEN
|
||
|
|
CALL FFADDC ('ANGLE', INLINE)
|
||
|
|
MTYP = 'ANGLE'
|
||
|
|
ELSE IF (MATSTR (WORD, 'CRACK', 1)) THEN
|
||
|
|
CALL FFADDC ('CRACK', INLINE)
|
||
|
|
MTYP = 'CRACK'
|
||
|
|
ELSE IF (MATSTR (WORD, 'STATE', 2)) THEN
|
||
|
|
CALL FFADDC ('STATE', INLINE)
|
||
|
|
MTYP = 'STATE'
|
||
|
|
ELSE IF (MATSTR (WORD, 'USER', 1)) THEN
|
||
|
|
CALL FFADDC ('USER', INLINE)
|
||
|
|
MTYP = 'USER'
|
||
|
|
ELSE
|
||
|
|
CALL PRTERR ('CMDERR',
|
||
|
|
& 'Expected "ANGLE", "CRACK", OR "STATE"'
|
||
|
|
& // ' before variable name')
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL CMDVAR (MMOD, MTYP, NAMES,
|
||
|
|
& INLINE, IFLD, INTYP, CFIELD, IDTVAR, *100)
|
||
|
|
|
||
|
|
LTYP(1) = 2
|
||
|
|
CALL SETMSH (IVIEW, 'DEFORM', 'NONE', MSHDIV, LTYP,
|
||
|
|
& 0, IDUM, 0, IDUM, MMOD, MTYP, ISSNPS, ISSESS)
|
||
|
|
|
||
|
|
IF (MTYP .NE. 'SPHERE' .AND. MTYP .NE. 'FSPHERE') THEN
|
||
|
|
C --Reset the vector/symbol scaling factor
|
||
|
|
VECSCL = 1.0
|
||
|
|
VERB2 = 'VECSCL'
|
||
|
|
CALL CHKVAR (MODDET, MODTYP, IVIEW, IDTVAR, NVOLD,
|
||
|
|
& NNDVAR, NEDVAR, LDUM)
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
ELSE
|
||
|
|
GOTO 100
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
100 CONTINUE
|
||
|
|
RETURN 1
|
||
|
|
END
|