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 VECTOR (ISYTYP, VAR, NUM, LENF, NLNKF, HIDENE, & XNE, YNE, ZNE, IN2ELB, ISVOK, VECMAX, BLKCOL, IDELB, *) C======================================================================= C --*** VECTOR *** (DETOUR) Plot nodal or element vector C -- Written by Amy Gilkey - revised 03/10/88 C -- D. P. Flanagan, 12/08/83 C -- C --VECTOR draws a vector representing 2 or 3 variables for each node C --or element. It processes each node or element by element block. C --Only nodes or elements of selected element blocks are drawn. C -- C --Parameters: C -- ISYTYP - IN - the vector type (as in MODTYP of /DETOPT/) C -- VAR - IN - the vector variable values C -- NUM - IN - the number of nodes (if nodal) or faces (if element) C -- LENF - IN - the cumulative face counts by element block C -- (only if element) C -- NLNKF - IN - the number of nodes per face (only if element) C -- HIDENE(i) - IN - true iff node i or face i is hidden (3D only) C -- XNE, YNE, ZNE - IN - the nodal coordinates (if nodal) C -- or the face center coordinates (if element) C -- IN2ELB - IN - the element block for each node; (only if nodal) C -- <0 if not in any selected element block C -- =0 if in more than one selected element block C -- ISVOK - IN - ISVOK(i) is true iff the vector variables are defined C -- for element block i (only if element) C -- VECMAX - IN - the maximum vector variable value, scaled C -- BLKCOL - IN - the user selected colors of the element blocks. C -- BLKCOL(0) = 1 if the user defined material C -- colors should be used in mesh plots. C -- = -1 if program selected colors should C -- be used. C -- BLKCOL(i) = the user selected color of element C -- block i: C -- -2 - no color selected by user. C -- -1 - black C -- 0 - white C -- 1 - red C -- 2 - green C -- 3 - yellow C -- 4 - blue C -- 5 - cyan C -- 6 - magenta C -- * - return statement if cancel function active C -- * - return statement if the cancel function is active C -- C --Common Variables: C -- Uses NELBLK of /DBNUMS/ C -- Uses IS3DIM, NUMNPF of /D3NUMS/ C -- Uses VECSCL of /ETCOPT/ C -- Uses ROTMAT of /ROTOPT/ C -- Uses DTW, VWSCL of /DEVDAT/ include 'dbnums.blk' include 'd3nums.blk' include 'etcopt.blk' include 'rotopt.blk' include 'devdat.blk' CHARACTER*(*) ISYTYP REAL VAR(NUM,*) INTEGER LENF(0:NELBLK) INTEGER NLNKF(NELBLK) LOGICAL HIDENE(NUM) REAL XNE(NUM), YNE(NUM), ZNE(NUM) INTEGER IN2ELB(NUMNPF) LOGICAL ISVOK(NELBLK) REAL VECMAX INTEGER BLKCOL(0:NELBLK) INTEGER IDELB(*) LOGICAL GRABRT REAL ZERO3(3) SAVE ZERO3 DATA ZERO3 / 0.0, 0.0, 0.0 / IF (VECSCL .EQ. 0.0) THEN VSCL = 1.0 ELSE VSCL = VECSCL * 0.05 * VECMAX END IF ASCL = VWSCL IF (ISYTYP .EQ. 'NODE') THEN DO 110 IELB = 0, NELBLK C --Set the vector color c IF (IELB .GT. 0) THEN c ITEMP = IDELB(IELB) c ELSE ITEMP = IELB c ENDIF CALL UGRCOL (ITEMP, BLKCOL) DO 100 INP = 1, NUMNPF IF (IS3DIM) THEN IF (HIDENE(INP)) GOTO 100 END IF IF (IN2ELB(INP) .EQ. IELB) THEN IF (GRABRT ()) RETURN 1 C --Call vector routine IF (.NOT. IS3DIM) THEN CALL VEC (IS3DIM, XNE(INP), YNE(INP), 0.0, & VAR(INP,1), VAR(INP,2), 0.0, VSCL, ASCL) ELSE XVAR = VAR(INP,1) YVAR = VAR(INP,2) ZVAR = VAR(INP,3) CALL BL_ROTATE (1, 1, ROTMAT, ZERO3, & XVAR, YVAR, ZVAR, XVAR, YVAR, ZVAR) CALL VEC (IS3DIM, XNE(INP), YNE(INP), ZNE(INP), & XVAR, YVAR, ZVAR, VSCL, ASCL) END IF END IF 100 CONTINUE CALL PLTFLU 110 CONTINUE ELSE IF (ISYTYP .EQ. 'ELEMENT') THEN DO 130 IELB = 1, NELBLK IF (ISVOK(IELB)) THEN C --Set the vector color c CALL UGRCOL (IDELB(IELB), BLKCOL) CALL UGRCOL (IELB, BLKCOL) DO 120 IFAC = LENF(IELB-1)+1, LENF(IELB) IF (IS3DIM) THEN IF (HIDENE(IFAC)) GOTO 120 END IF C --Call vector routine IF (GRABRT ()) RETURN 1 IF (.NOT. IS3DIM) THEN CALL VEC (IS3DIM, XNE(IFAC), YNE(IFAC), 0.0, & VAR(IFAC,1), VAR(IFAC,2), 0.0, VSCL, ASCL) ELSE XVAR = VAR(IFAC,1) YVAR = VAR(IFAC,2) ZVAR = VAR(IFAC,3) CALL BL_ROTATE (1, 1, ROTMAT, ZERO3, & XVAR, YVAR, ZVAR, XVAR, YVAR, ZVAR) CALL VEC (IS3DIM, XNE(IFAC), YNE(IFAC), ZNE(IFAC), & XVAR, YVAR, ZVAR, VSCL, ASCL) END IF 120 CONTINUE CALL PLTFLU END IF 130 CONTINUE ELSE IF ((ISYTYP .EQ. 'SIGMAX') .OR. (ISYTYP .EQ. 'SIGMIN')) THEN DEG180 = 2.0 * ATAN (1.0) DO 150 IELB = 1, NELBLK IF (ISVOK(IELB)) THEN C --Set the vector color c CALL UGRCOL (IDELB(IELB), BLKCOL) CALL UGRCOL (IELB, BLKCOL) DO 140 IFAC = LENF(IELB-1)+1, LENF(IELB) IF (IS3DIM) THEN IF (HIDENE(IFAC)) GOTO 140 END IF SIGXX = VAR(IFAC,1) SIGYY = VAR(IFAC,2) TAUXY = VAR(IFAC,3) Q1 = 0.5 * (SIGXX + SIGYY) Q2 = 0.5 * (SIGXX - SIGYY) Q3 = SQRT (Q2 * Q2 + TAUXY * TAUXY) SIGMAX = Q1 + Q3 SIGMIN = Q1 - Q3 IF ((TAUXY .EQ. 0.0) .AND. (SIGMAX-SIGYY .EQ. 0.0)) & GOTO 140 THETA = ATAN2 (TAUXY, SIGMAX - SIGYY) IF (ISYTYP .EQ. 'SIGMAX') THEN XSIG = SIGMAX * COS (THETA) YSIG = SIGMAX * SIN (THETA) ELSE XSIG = SIGMIN * COS (THETA + DEG180) YSIG = SIGMIN * SIN (THETA + DEG180) END IF C --Call vector routine IF (GRABRT ()) RETURN 1 IF (.NOT. IS3DIM) THEN CALL VEC (IS3DIM, XNE(IFAC), YNE(IFAC), 0.0, & XSIG, YSIG, 0.0, VSCL, ASCL) ELSE ZSIG = 0.0 CALL BL_ROTATE (1, 1, ROTMAT, ZERO3, & XSIG, YSIG, ZSIG, XSIG, YSIG, ZSIG) CALL VEC (IS3DIM, XNE(IFAC), YNE(IFAC), ZNE(IFAC), & XSIG, YSIG, ZNE(IFAC), VSCL, ASCL) END IF 140 CONTINUE CALL PLTFLU END IF 150 CONTINUE END IF RETURN END C======================================================================= SUBROUTINE VECTORN (ISYTYP, VAR, NUM, HIDENE, & XNE, YNE, ZNE, IN2ELB, VECMAX, BLKCOL, IDELB, *) C======================================================================= C --*** VECTOR *** (DETOUR) Plot nodal or element vector C -- Written by Amy Gilkey - revised 03/10/88 C -- D. P. Flanagan, 12/08/83 C -- C --VECTOR draws a vector representing 2 or 3 variables for each node C --or element. It processes each node or element by element block. C --Only nodes or elements of selected element blocks are drawn. C -- C --Parameters: C -- ISYTYP - IN - the vector type (as in MODTYP of /DETOPT/) C -- VAR - IN - the vector variable values C -- NUM - IN - the number of nodes (if nodal) or faces (if element) C -- LENF - IN - the cumulative face counts by element block C -- (only if element) C -- NLNKF - IN - the number of nodes per face (only if element) C -- HIDENE(i) - IN - true iff node i or face i is hidden (3D only) C -- XNE, YNE, ZNE - IN - the nodal coordinates (if nodal) C -- or the face center coordinates (if element) C -- IN2ELB - IN - the element block for each node; (only if nodal) C -- <0 if not in any selected element block C -- =0 if in more than one selected element block C -- VECMAX - IN - the maximum vector variable value, scaled C -- BLKCOL - IN - the user selected colors of the element blocks. C -- BLKCOL(0) = 1 if the user defined material C -- colors should be used in mesh plots. C -- = -1 if program selected colors should C -- be used. C -- BLKCOL(i) = the user selected color of element C -- block i: C -- -2 - no color selected by user. C -- -1 - black C -- 0 - white C -- 1 - red C -- 2 - green C -- 3 - yellow C -- 4 - blue C -- 5 - cyan C -- 6 - magenta C -- * - return statement if cancel function active C -- * - return statement if the cancel function is active C -- C --Common Variables: C -- Uses NELBLK of /DBNUMS/ C -- Uses IS3DIM, NUMNPF of /D3NUMS/ C -- Uses VECSCL of /ETCOPT/ C -- Uses ROTMAT of /ROTOPT/ C -- Uses DTW, VWSCL of /DEVDAT/ include 'dbnums.blk' include 'd3nums.blk' include 'etcopt.blk' include 'rotopt.blk' include 'devdat.blk' CHARACTER*(*) ISYTYP REAL VAR(NUM,*) LOGICAL HIDENE(NUM) REAL XNE(NUM), YNE(NUM), ZNE(NUM) INTEGER IN2ELB(NUMNPF) LOGICAL ISVOK(NELBLK) REAL VECMAX INTEGER BLKCOL(0:NELBLK) LOGICAL GRABRT REAL ZERO3(3) SAVE ZERO3 DATA ZERO3 / 0.0, 0.0, 0.0 / IF (VECSCL .EQ. 0.0) THEN VSCL = 1.0 ELSE VSCL = VECSCL * 0.05 * VECMAX END IF ASCL = VWSCL IF (ISYTYP .EQ. 'NODE') THEN DO 110 IELB = 0, NELBLK C --Set the vector color ITEMP = IELB CALL UGRCOL (ITEMP, BLKCOL) DO 100 INP = 1, NUMNPF IF (IS3DIM) THEN IF (HIDENE(INP)) GOTO 100 END IF IF (IN2ELB(INP) .EQ. IELB) THEN IF (GRABRT ()) RETURN 1 C --Call vector routine IF (.NOT. IS3DIM) THEN CALL VEC (IS3DIM, XNE(INP), YNE(INP), 0.0, & VAR(INP,1), VAR(INP,2), 0.0, VSCL, ASCL) ELSE XVAR = VAR(INP,1) YVAR = VAR(INP,2) ZVAR = VAR(INP,3) CALL BL_ROTATE (1, 1, ROTMAT, ZERO3, & XVAR, YVAR, ZVAR, XVAR, YVAR, ZVAR) CALL VEC (IS3DIM, XNE(INP), YNE(INP), ZNE(INP), & XVAR, YVAR, ZVAR, VSCL, ASCL) END IF END IF 100 CONTINUE CALL PLTFLU 110 CONTINUE END IF RETURN END