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 CMDVAR (MODDET, MODTYP, NAMES, & INLINE, IFLD, INTYP, CFIELD, & IDTVAR, *) C======================================================================= C --*** CMDVAR *** (DETOUR) Read the command variables C -- Written by Amy Gilkey - revised 03/03/88 C -- C --CMDVAR reads the variables associated with the command and checks C --that they are appropriate for the command. C -- C --Parameters: C -- MODDET - IN - the display mode for the command (as in /DETOPT/) C -- MODTYP - IN/OUT - the mode type for the command (set for vector mode) C -- (as in /DETOPT/) C -- NAMES - IN - the variable names C -- INLINE - IN/OUT - the parsed input line for the log file C -- IFLD - IN/OUT - the free-field current field number C -- INTYP - IN - the free-field type C -- CFIELD - IN - the free-field character field C -- IDTVAR - IN/OUT - the current variables C -- * - return statement if an error is encountered C -- C --Common Variables: C -- Uses NDIM, NVARNP, NVAREL, NSTEPW of /DBNUMS/ include 'params.blk' include 'dbnums.blk' INTEGER GETVNM CHARACTER*(*) INLINE CHARACTER*(*) MODDET, MODTYP CHARACTER*(*) NAMES(*) INTEGER INTYP(*) CHARACTER*(*) CFIELD(*) INTEGER IDTVAR(4) LOGICAL FFEXST CHARACTER*(MXNAME) WORD LOGICAL GIVEN1 INTEGER NVNEW(4) CHARACTER TYP1, TYP2 LOGICAL SHRTHD NEEDED = 0 IF (MODDET .EQ. 'CONTOUR') THEN NEEDED = 1 ELSE IF (MODDET .EQ. 'ELEMCONT') THEN NEEDED = 1 ELSE IF (MODDET .EQ. 'VECTOR') THEN IF ((MODTYP .NE. 'SIGMAX') .AND. (MODTYP .NE. 'SIGMIN')) THEN NEEDED = NDIM ELSE NEEDED = 3 END IF ELSE IF (MODDET .EQ. 'SYMBOL') THEN NEEDED = 1 ELSE IF (MODDET .EQ. 'GAUSS') THEN NEEDED = 4 END IF IF (NEEDED .GT. 0) THEN IF (NSTEPW .LE. 0) THEN CALL PRTERR ('CMDERR', & 'Display mode is invalid with no whole time steps') GOTO 110 END IF NMIN = 9999 NMAX = 0 GIVEN1 = (FFEXST (IFLD, INTYP)) SHRTHD = .FALSE. DO 100 IV = 1, NEEDED IF (.NOT. SHRTHD) THEN IF (GIVEN1) THEN IF (.NOT. FFEXST (IFLD, INTYP)) THEN CALL PRTERR ('CMDERR', & 'All variables must be given') GOTO 110 END IF END IF CALL FFCHAR (IFLD, INTYP, CFIELD, ' ', WORD) IF (WORD .NE. ' ') CALL FFADDC (WORD, INLINE) ENDIF IF ((MODDET .EQ. 'VECTOR') .AND. (WORD .EQ. '0')) THEN IVAR = 0 ELSE IF (WORD .NE. ' ') THEN IVAR = LOCSTR (WORD, NVARHI+NVARGL+NVARNP+NVAREL, NAMES) IF ((MODDET .EQ. 'VECTOR') .AND.(IVAR .LE. 0)) THEN IF (IV .EQ. 1) THEN ivar = getvnm(word(:lenstr(word)), 'X', & NVARHI+NVARGL+NVARNP+NVAREL, NAMES) IF (IVAR .GT. 0) SHRTHD = .TRUE. ELSE IF (IV .EQ. 2) THEN ivar = getvnm(word(:lenstr(word)), 'Y', & NVARHI+NVARGL+NVARNP+NVAREL, NAMES) ELSE IF (IV .EQ. 3) THEN ivar = getvnm(word(:lenstr(word)), 'Z', & NVARHI+NVARGL+NVARNP+NVAREL, NAMES) END IF END IF IF (IVAR .LE. 0) THEN CALL PRTERR ('CMDERR', & 'Variable "' // WORD(:LENSTR(WORD)) & // '" does not exist') GOTO 110 END IF ELSE IVAR = IDTVAR(IV) IF (IVAR .LE. 0) THEN CALL PRTERR ('CMDERR', & 'Variable must be given') GOTO 110 END IF END IF NVNEW(IV) = IVAR IF (IVAR .NE. 0) THEN NMIN = MIN (NMIN, IVAR) NMAX = MAX (NMAX, IVAR) END IF 100 CONTINUE SHRTHD = .FALSE. IF (NMIN .GT. NMAX) NMIN = NMAX CALL DBVTYP_BL (NMIN, TYP1, IDUM) CALL DBVTYP_BL (NMAX, TYP2, IDUM) IF (MODDET .EQ. 'CONTOUR') THEN IF ((TYP1 .NE. 'N') .AND. (TYP1 .NE. 'E')) THEN CALL PRTERR ('CMDERR', & 'Contour variable must be nodal or element variable') GOTO 110 END IF ELSE IF (MODDET .EQ. 'ELEMCONT') THEN IF (TYP1 .NE. 'E') THEN CALL PRTERR ('CMDERR', & 'Contour variable must be an element variable') GOTO 110 END IF ELSE IF (MODDET .EQ. 'VECTOR') THEN IF (MODTYP .EQ. ' ') THEN CALL DBVTYP_BL (NMIN, TYP1, IDUM) IF ((TYP1 .EQ. 'N') .OR. (TYP1 .EQ. ' ')) THEN MODTYP = 'NODE' ELSE MODTYP = 'ELEMENT' END IF END IF IF ((MODTYP .EQ. 'NODE') .OR. (MODTYP .EQ. 'ELEMENT')) THEN IF (((TYP1 .NE. 'N') .AND. (TYP1 .NE. 'E')) & .OR. (TYP1 .NE. TYP2)) THEN CALL PRTERR ('CMDERR', & 'Vector variables must' & // ' all be nodal or all be element') GOTO 110 END IF ELSE IF ((MODTYP .EQ. 'SIGMAX') & .OR. (MODTYP .EQ. 'SIGMIN')) THEN IF (TYP1 .NE. 'E') THEN CALL PRTERR ('CMDERR', & 'Stress variables must be element variables') GOTO 110 END IF END IF ELSE IF (MODDET .EQ. 'SYMBOL') THEN IF (TYP1 .NE. 'E') THEN CALL PRTERR ('CMDERR', & 'Symbol variable must be an element variable') GOTO 110 END IF ELSE IF (MODDET .EQ. 'GAUSS') THEN IF ((TYP1 .NE. 'E') .AND. (TYP2 .NE. 'E')) THEN CALL PRTERR ('CMDERR', & 'Gauss variables must be element variables') GOTO 110 END IF END IF CALL CPYINT (NEEDED, NVNEW, IDTVAR) END IF RETURN 110 CONTINUE RETURN 1 END integer function getvnm(word, suffix, icnt, names) include 'params.blk' CHARACTER*(MXNAME) WORD character*1 suffix CHARACTER*(*) NAMES(*) CHARACTER*(MXNAME) TEMP temp = word(:lenstr(word))//suffix getvnm = locstr(temp, icnt, names) if (getvnm .le. 0) then temp = word(:lenstr(word))//'_'// suffix getvnm = locstr(temp, icnt, names) endif if (getvnm .le. 0) then temp = word(:lenstr(word))//'.'// suffix getvnm = locstr(temp, icnt, names) endif return end