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.
 
 
 
 
 
 

192 lines
6.3 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 NEWXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, NPCEN,
& ZCORD, SINANG, COSANG, A)
C=======================================================================
C --*** NEWXYZ *** (GEN3D) Calculate 3D coordinates
C -- Written by Amy Gilkey - revised 05/09/88
C -- Modified by Greg Sjaardema - 02/06/89
C -- Added Warp Function
C -- Added Gradient to Rotations (not for center blocks)
C -- Split transformations into separate subroutines
C --
C --NEWXYZ calculates the coordinate array for the 3D database.
C --
C --Parameters:
C -- XN, YN - IN - the 2D coordinates, destroyed
C -- XN3, YN3, ZN3 - OUT - the 3D coordinates
C -- IXNP - IN - the new index for each node
C -- NRNP - IN - the number of new nodes generated for each node
C -- NPCEN - IN - the node numbers of the center nodes by column and row
C -- ZCORD - SCRATCH - size = NNREPL, holds z coordinate for transformations
C -- SINANG, COSANG - SCRATCH - size = NNREPL, holds sin and cos of
C -- angles for rotations
C --
C --Common Variables:
C -- Uses NDIM, NUMNP of /DBNUMS/
C -- Uses NDIM3, NUMNP3 of /DBNUM3/
C -- Uses ITRANT, NNREPL, DIM3, NRTRAN, D3TRAN, ZGRAD,
C -- CENTER, NUMCOL, NUMROW of /PARAMS/
C -- Uses XOFFS, YOFFS, ZOFFS of /XYZOFF/
C -- Uses ROT3D, ROTMAT of /XYZROT/
INCLUDE 'g3_dbnums.blk'
INCLUDE 'g3_dbnum3.blk'
INCLUDE 'g3_params.blk'
INCLUDE 'g3_xyzoff.blk'
INCLUDE 'g3_xyzrot.blk'
INCLUDE 'g3_xyzmir.blk'
INCLUDE 'g3_xyzero.blk'
INCLUDE 'g3_xyzscl.blk'
INCLUDE 'g3_twist.blk'
INCLUDE 'g3_splxyz.blk'
REAL XN(NUMNP), YN(NUMNP),
& XN3(NUMNP3), YN3(NUMNP3), ZN3(NUMNP3)
INTEGER IXNP(*), NRNP(*)
INTEGER NPCEN(NUMCDM,*)
REAL ZCORD(NNREPL)
REAL SINANG(NNREPL), COSANG(NNREPL)
REAL A(*)
IF (ITRANT .EQ. 1) THEN
CALL TRNXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD)
ELSE IF (ITRANT .EQ. 2) THEN
if (rotax .eq. 0) then
CALL ARCXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, NPCEN,
& SINANG, COSANG)
else
CALL ARCYXZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, NPCEN,
& SINANG, COSANG)
end if
ELSE IF (ITRANT .EQ. 4) THEN
CALL WRPXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD )
ELSE IF (ITRANT .EQ. 8) THEN
CALL TWIXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD,
* SINANG, COSANG)
ELSE IF (ITRANT .EQ. 16) THEN
CALL PROXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD,
* SINANG, COSANG)
ELSE IF (ITRANT .EQ. 32) THEN
CALL EXPARC (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, NPCEN,
& SINANG, COSANG)
ELSE IF (ITRANT .EQ. 64) THEN
CALL SPLXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD,
$ NSPL(1), NSPL(2),
& A(KRSPLA), A(KZSPLA), A(KSPL2A), A(KDISTA), A(KSCRA),
& A(KRSPLB), A(KZSPLB), A(KSPL2B), A(KDISTB), A(KSCRB),
$ SLLFT, SLRGT, RDTHET, SWEEP, NOSCAL)
ELSE IF (ITRANT .EQ. 128) THEN
CALL SPTXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD, NSPLT,
$ A(KZSPL), A(KXSPL), A(KXSPL2), A(KYSPL), A(KYSPL2),
$ A(KSCR))
END IF
C --Revolve 3D mesh, if needed
IF (ROT3D) THEN
DO 30 JNP = 1, NUMNP3
X = XN3(JNP) - ROTCEN(1)
Y = YN3(JNP) - ROTCEN(2)
Z = ZN3(JNP) - ROTCEN(3)
XN3(JNP) = X*ROTMAT(1,1) + Y*ROTMAT(2,1) + Z*ROTMAT(3,1)
& + ROTCEN(1)
YN3(JNP) = X*ROTMAT(1,2) + Y*ROTMAT(2,2) + Z*ROTMAT(3,2)
& + ROTCEN(2)
ZN3(JNP) = X*ROTMAT(1,3) + Y*ROTMAT(2,3) + Z*ROTMAT(3,3)
& + ROTCEN(3)
30 CONTINUE
END IF
C --Add offset, if any, to coordinates
IF (XOFFS .NE. 0.0) THEN
DO 40 JNP = 1, NUMNP3
XN3(JNP) = XN3(JNP) + XOFFS
40 CONTINUE
END IF
IF (YOFFS .NE. 0.0) THEN
DO 50 JNP = 1, NUMNP3
YN3(JNP) = YN3(JNP) + YOFFS
50 CONTINUE
END IF
IF (ZOFFS .NE. 0.0) THEN
DO 60 JNP = 1, NUMNP3
ZN3(JNP) = ZN3(JNP) + ZOFFS
60 CONTINUE
END IF
C --Mirror coordinates if any specified
IF (XMIRR .LT. 0.) THEN
DO 70 JNP = 1, NUMNP3
XN3(JNP) = -1.0 * XN3(JNP)
70 CONTINUE
END IF
IF (YMIRR .LT. 0.) THEN
DO 80 JNP = 1, NUMNP3
YN3(JNP) = -1.0 * YN3(JNP)
80 CONTINUE
END IF
IF (ZMIRR .LT. 0.) THEN
DO 90 JNP = 1, NUMNP3
ZN3(JNP) = -1.0 * ZN3(JNP)
90 CONTINUE
END IF
C --- Zero coordinates if *ZERO is not equal to zero
IF (XZERO .NE. 0.) THEN
DO 100 JNP = 1, NUMNP3
if (ABS(XN3(JNP)) .LT. XZERO) XN3(JNP) = 0.0
100 CONTINUE
END IF
IF (YZERO .NE. 0.) THEN
DO 110 JNP = 1, NUMNP3
if (ABS(YN3(JNP)) .LT. YZERO) YN3(JNP) = 0.0
110 CONTINUE
END IF
IF (ZZERO .NE. 0.) THEN
DO 120 JNP = 1, NUMNP3
if (ABS(ZN3(JNP)) .LT. ZZERO) ZN3(JNP) = 0.0
120 CONTINUE
END IF
C --- Scale the coordinates if any Scaled
IF (XSCAL .NE. 1.) THEN
DO 130 JNP = 1, NUMNP3
XN3(JNP) = XSCAL * XN3(JNP)
130 CONTINUE
END IF
IF (YSCAL .NE. 1.) THEN
DO 140 JNP = 1, NUMNP3
YN3(JNP) = YSCAL * YN3(JNP)
140 CONTINUE
END IF
IF (ZSCAL .NE. 1. .AND. NDIM .EQ. 3) THEN
DO 150 JNP = 1, NUMNP3
ZN3(JNP) = ZSCAL * ZN3(JNP)
150 CONTINUE
END IF
CALL MINMAX (NUMNP3, XN3, XMIN, XMAX)
CALL MINMAX (NUMNP3, YN3, YMIN, YMAX)
CALL MINMAX (NUMNP3, ZN3, ZMIN, ZMAX)
WRITE (*, 155) 'Output Mesh Limits:'
WRITE (*, 160) 'X', XMIN, 'X', XMAX, XMAX-XMIN
WRITE (*, 160) 'Y', YMIN, 'Y', YMAX, YMAX-YMIN
WRITE (*, 160) 'Z', ZMIN, 'Z', ZMAX, ZMAX-ZMIN
155 FORMAT(/' ',A)
160 FORMAT( ' Minimum ',A1,' = ',1PE12.5,', Maximum ',A1,' = ',
& 1PE12.5,', Range = ',1PE12.5)
RETURN
END