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.
264 lines
10 KiB
264 lines
10 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 DTPLT1 (A, MSHNUM, MSHLIN, MLNTYP, MODDET, MODTYP,
|
||
|
|
& LENF, NLNKF, LINKF, LENL, LINSET,
|
||
|
|
& HIDENP, HIDEF, DOIXF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, XF, YF, ZF,
|
||
|
|
& IELBST, ISEVOK, IN2ELB, IVN2B, DODEAD, IDN2B,
|
||
|
|
& NNPSET, ISSNPS, NESSET, ISSESS,
|
||
|
|
& IDTVAR, VARNP, VARFAC, NMIN, NMAX, FMIN, FMAX, VECMAX, ISVOK,
|
||
|
|
& BLKCOL, IDELB, IHIDOP, MAPEL, MAPND, *)
|
||
|
|
C=======================================================================
|
||
|
|
|
||
|
|
C --*** DTPLT1 *** (DETOUR) Plot one view
|
||
|
|
C -- Modified by John Glick - 11/28/88
|
||
|
|
C -- Written by Amy Gilkey - revised 04/11/88
|
||
|
|
C -- Modified version 1.1a - November 1990 - R.J. Meyers
|
||
|
|
C -- added color coded sphere capability
|
||
|
|
C --
|
||
|
|
C --DTPLT1 does the plotting for a single view. The labeling of the view
|
||
|
|
C --is done elsewhere.
|
||
|
|
C --
|
||
|
|
C --Parameters:
|
||
|
|
C -- A - IN - the dynamic memory array
|
||
|
|
C -- MSHNUM - IN - the mesh numbering (as in /MSHOPT/)
|
||
|
|
C -- MSHLIN - IN - the display type for the mesh lines (as in /MSHOPT/)
|
||
|
|
C -- MLNTYP - IN - the line type of lines (as in /MSHOPT/)
|
||
|
|
C -- MODDET - IN - the display mode (as in /DETOPT/)
|
||
|
|
C -- MODTYP - IN - the display mode type (as in /DETOPT/)
|
||
|
|
C -- LENF - IN - the cumulative face counts by element block
|
||
|
|
C -- NLNKF - IN - the number of nodes per face
|
||
|
|
C -- LINKF - IN - the connectivity for all faces
|
||
|
|
C -- LENL - IN - the cumulative line counts by element block
|
||
|
|
C -- LINSET - IN - the sorted line set
|
||
|
|
C -- HIDENP(i) - IN - true iff node i is hidden (3D only)
|
||
|
|
C -- HIDEF(i) - IN - true iff face i is hidden (3D only)
|
||
|
|
C -- DOIXF - IN - IXFAC valid iff true
|
||
|
|
C -- NXFAC - IN - the number of ordered faces (if DOIXF)
|
||
|
|
C -- IXFAC - IN - the indices of the ordered faces (if DOIXF)
|
||
|
|
C -- XN, YN, ZN - IN - the nodal coordinates
|
||
|
|
C -- XF, YF, ZF - IN - the face center coordinates
|
||
|
|
C -- IELBST - IN - the element block status (>0 if selected)
|
||
|
|
C -- ISEVOK - IN - the element block variable truth table;
|
||
|
|
C -- variable i of block j exists iff ISEVOK(j,i)
|
||
|
|
C -- IN2ELB - IN - the element block for each node;
|
||
|
|
C -- <0 if not in any selected element block
|
||
|
|
C -- =0 if in more than one selected element block
|
||
|
|
C -- IVN2B - IN - the element block for each node for the contour variable;
|
||
|
|
C -- <0 if not in any selected element block
|
||
|
|
C -- =0 if in more than one selected element block
|
||
|
|
C -- DODEAD - IN - true iff dead nodes are to be displayed
|
||
|
|
C -- IDN2B - IN - the element block for each dead node; dead if >= 0
|
||
|
|
C -- NNPSET - IN - the number of selected node sets
|
||
|
|
C -- ISSNPS - IN - the indices of the selected node sets
|
||
|
|
C -- NESSET - IN - the number of selected side sets
|
||
|
|
C -- ISSESS - IN - the indices of the selected side sets
|
||
|
|
C -- IDTVAR - IN - the variable numbers, if any
|
||
|
|
C -- VARNP - IN - the nodal variable values
|
||
|
|
C -- VARFAC - IN - the face variable values
|
||
|
|
C -- NMIN, NMAX - IN - the number of variables values matching the
|
||
|
|
C -- minimum and the maximum (for contour plots only)
|
||
|
|
C -- FMIN, FMAX - IN - the nodal variable minimum and maximum
|
||
|
|
C -- (for contour modes only)
|
||
|
|
C -- VECMAX - IN - the vector maximum, scaled (for vector only)
|
||
|
|
C -- ISVOK - SCRATCH - size = NELBLK, only if any variables
|
||
|
|
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 --
|
||
|
|
C --Common Variables:
|
||
|
|
C -- Uses NELBLK of /DBNUMS/
|
||
|
|
C -- Uses IS3DIM, NUMNPF of /D3NUMS/
|
||
|
|
|
||
|
|
include 'dbnums.blk'
|
||
|
|
include 'dbnumgq.blk'
|
||
|
|
include 'd3nums.blk'
|
||
|
|
|
||
|
|
DIMENSION A(*)
|
||
|
|
CHARACTER*(*) MSHNUM
|
||
|
|
INTEGER MLNTYP(-1:1)
|
||
|
|
CHARACTER*8 MODDET, MODTYP
|
||
|
|
INTEGER LENF(0:NELBLK)
|
||
|
|
INTEGER NLNKF(NELBLK)
|
||
|
|
INTEGER LINKF(*)
|
||
|
|
INTEGER LENL(-2:NELBLK), LINSET(LLNSET,*)
|
||
|
|
LOGICAL HIDENP(NUMNPF)
|
||
|
|
LOGICAL HIDEF(*)
|
||
|
|
LOGICAL DOIXF
|
||
|
|
INTEGER IXFAC(*)
|
||
|
|
REAL XN(NUMNPF), YN(NUMNPF), ZN(NUMNPF)
|
||
|
|
REAL XF(*), YF(*), ZF(*)
|
||
|
|
INTEGER IELBST(NELBLK)
|
||
|
|
LOGICAL ISEVOK(NELBLK,*)
|
||
|
|
INTEGER IN2ELB(NUMNPF)
|
||
|
|
INTEGER IVN2B(NUMNPF)
|
||
|
|
LOGICAL DODEAD
|
||
|
|
INTEGER IDN2B(NUMNPF)
|
||
|
|
INTEGER ISSNPS(*)
|
||
|
|
INTEGER ISSESS(*)
|
||
|
|
INTEGER IDTVAR(*)
|
||
|
|
REAL VARNP(*), VARFAC(*)
|
||
|
|
REAL VECMAX
|
||
|
|
LOGICAL ISVOK(NELBLK)
|
||
|
|
INTEGER BLKCOL(0:NELBLK)
|
||
|
|
INTEGER IDELB(*)
|
||
|
|
INTEGER MAPEL(*), MAPND(*)
|
||
|
|
|
||
|
|
LOGICAL WIDLIN
|
||
|
|
LOGICAL LDUM
|
||
|
|
|
||
|
|
C --Call appropriate paint function routine, if any; mesh is drawn
|
||
|
|
C --over paint
|
||
|
|
|
||
|
|
IF (MODDET .EQ. 'SOLID') THEN
|
||
|
|
IF (DOIXF) THEN
|
||
|
|
IF (is3dim .and. IHIDOP .EQ. 5) then
|
||
|
|
CALL MDFIND('SHDCOL', KSHDCL, LEN)
|
||
|
|
CALL MDFIND('ISHDCL', KISHCL, LEN)
|
||
|
|
CALL SHADE (LENF, NLNKF, LINKF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, IELBST, BLKCOL, IDELB,
|
||
|
|
* A(KSHDCL), A(KISHCL), IHIDOP, *100)
|
||
|
|
else if (is3dim .and. ihidop .ge. 6) then
|
||
|
|
CALL WRTRAY (LENF, NLNKF, LINKF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
|
||
|
|
ELSE
|
||
|
|
CALL SOLID (LENF, NLNKF, LINKF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
|
||
|
|
END IF
|
||
|
|
ELSE
|
||
|
|
CALL QSOLID (LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, IELBST, BLKCOL, IDELB, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'CONTOUR') THEN
|
||
|
|
IF (MODTYP .EQ. 'PAINT') THEN
|
||
|
|
C --Use the selected color table
|
||
|
|
CALL GRCOLU ('ALTERNATE')
|
||
|
|
|
||
|
|
CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
IF (DOIXF) THEN
|
||
|
|
CALL PAINT (VARNP, LENF, NLNKF, LINKF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, XF, YF, ZF, ISVOK, FMIN, FMAX, *100)
|
||
|
|
ELSE
|
||
|
|
CALL QPAINT (VARNP, LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, XF, YF, ZF, ISVOK, FMIN, FMAX, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Use the standard color table
|
||
|
|
CALL GRCOLU ('STANDARD')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'ELEMCONT') THEN
|
||
|
|
IF (MODTYP .EQ. 'PAINT') THEN
|
||
|
|
C --Use the selected color table
|
||
|
|
CALL GRCOLU ('ALTERNATE')
|
||
|
|
|
||
|
|
CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
IF (DOIXF) THEN
|
||
|
|
CALL EPAINT (VARFAC, LENF, NLNKF, LINKF, NXFAC, IXFAC,
|
||
|
|
& XN, YN, ZN, ISVOK, FMIN, FMAX, *100)
|
||
|
|
ELSE
|
||
|
|
CALL QEPAIN (VARFAC, LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, ISVOK, FMIN, FMAX, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Use the standard color table
|
||
|
|
CALL GRCOLU ('STANDARD')
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C --Draw mesh (with numbering, etc.)
|
||
|
|
|
||
|
|
WIDLIN = (MODDET .EQ. 'WIREFRAM')
|
||
|
|
|
||
|
|
CALL MSPLT1 (A, WIDLIN, MSHNUM, MSHLIN, MLNTYP,
|
||
|
|
& LENF, NLNKF, LINKF, LENL, LINSET,
|
||
|
|
& HIDENP, HIDEF, XN, YN, ZN, XF, YF, ZF,
|
||
|
|
& IELBST, IN2ELB, DODEAD, IDN2B,
|
||
|
|
& .FALSE., 0, IDUM,
|
||
|
|
& NNPSET, ISSNPS, NESSET, ISSESS, BLKCOL,
|
||
|
|
& IDELB, VARNP, MODDET, IHIDOP, MAPEL, MAPND, *100)
|
||
|
|
|
||
|
|
C --Call appropriate function routine
|
||
|
|
|
||
|
|
IF (MODDET .EQ. 'CONTOUR') THEN
|
||
|
|
IF (MODTYP .EQ. 'LINE') THEN
|
||
|
|
C --Use the selected color table
|
||
|
|
CALL GRCOLU ('ALTERNATE')
|
||
|
|
|
||
|
|
CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
CALL CONTOR (VARNP, LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, XF, YF, ZF, LENL, LINSET,
|
||
|
|
& IVN2B, ISVOK, FMIN, FMAX, *100)
|
||
|
|
|
||
|
|
C --Use the standard color table
|
||
|
|
CALL GRCOLU ('STANDARD')
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL MRKNOD (VARNP, HIDENP,
|
||
|
|
& XN, YN, ZN, IVN2B, NMIN, NMAX, FMIN, FMAX,
|
||
|
|
& BLKCOL, *100)
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'ELEMCONT') THEN
|
||
|
|
CALL MRKFAC (LENF(NELBLK), VARFAC, HIDEF, XF, YF, ZF,
|
||
|
|
& NMIN, NMAX, FMIN, FMAX, BLKCOL, *100)
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'VECTOR') THEN
|
||
|
|
IF ((MODTYP .EQ. 'NODE') .OR. (MODTYP .EQ. 'ELEMENT')) THEN
|
||
|
|
N = NDIM
|
||
|
|
ELSE
|
||
|
|
N = 3
|
||
|
|
END IF
|
||
|
|
IF (MODTYP .EQ. 'NODE') THEN
|
||
|
|
CALL VECTORN (MODTYP, VARNP, NUMNPF,
|
||
|
|
& HIDENP, XN, YN, ZN, IN2ELB, VECMAX,
|
||
|
|
& BLKCOL, IDELB, *100)
|
||
|
|
ELSE
|
||
|
|
CALL EVAROK (N, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
CALL VECTOR (MODTYP, VARFAC, LENF(NELBLK), LENF, NLNKF,
|
||
|
|
& HIDEF, XF, YF, ZF, IDUM, ISVOK, VECMAX, BLKCOL,
|
||
|
|
& IDELB, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'SYMBOL') THEN
|
||
|
|
CALL EVAROK (1, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
IF (MODTYP .NE. 'STATE') THEN
|
||
|
|
CALL SYMBOL_BL (MODTYP, VARFAC, LENF, NLNKF, HIDEF,
|
||
|
|
& XF, YF, ZF, ISVOK, BLKCOL, IDELB, *100)
|
||
|
|
ELSE
|
||
|
|
CALL ELESTA (MODTYP, VARFAC, LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, ISVOK, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
ELSE IF (MODDET .EQ. 'GAUSS') THEN
|
||
|
|
CALL EVAROK (4, IDTVAR, NELBLK, IELBST, ISEVOK, ISVOK)
|
||
|
|
LVARF = LENF(NELBLK)
|
||
|
|
CALL GAUSS_BL (MODTYP, VARFAC, LENF, NLNKF, LINKF, HIDEF,
|
||
|
|
& XN, YN, ZN, ISVOK, LVARF, *100)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
100 CONTINUE
|
||
|
|
RETURN 1
|
||
|
|
END
|