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.
311 lines
9.6 KiB
311 lines
9.6 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 SPLXYZ (XN, YN, XN3, YN3, ZN3, IXNP, NRNP, ZCORD,
|
|
& NSPL1, NSPL2, RSA, ZSA, ZS2A, DISTA, SCRA,
|
|
& RSB, ZSB, ZS2B, DISTB, SCRB, SLLFT, SLRGT, RDTHET,
|
|
& SWEEP, NOSCAL)
|
|
C=======================================================================
|
|
|
|
C --*** SPLXYZ *** (GEN3D) Calculate 3D coordinates for Double-surface
|
|
C Spline projection
|
|
C -- Written by Greg Sjaardema - 01/08/90
|
|
C --
|
|
C --SPLXYZ calculates the coordinate array for the 3D spline translations.
|
|
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 -- ZCORD - SCRATCH - size = NNREPL, holds z coordinate for transformations
|
|
C --
|
|
C --Common Variables:
|
|
C -- Uses NDIM, NUMNP of /DBNUMS/
|
|
C -- Uses NDIM3, NUMNP3 of /DBNUM3/
|
|
C -- Uses DOTRAN, NNREPL, DIM3, NRTRAN, D3TRAN, ZGRAD,
|
|
C -- CENTER, NUMCOL, NUMROW of /PARAMS/
|
|
|
|
INCLUDE 'g3_dbnums.blk'
|
|
INCLUDE 'g3_dbnum3.blk'
|
|
INCLUDE 'g3_params.blk'
|
|
|
|
PARAMETER (BINGO = 1.0E38)
|
|
PARAMETER (TOLER = 1.0E-8)
|
|
|
|
INTEGER XSWEEP, YSWEEP, SPHERI, SWEEP
|
|
PARAMETER (XSWEEP = 10)
|
|
PARAMETER (YSWEEP = 1)
|
|
PARAMETER (SPHERI = 11)
|
|
|
|
REAL XN(NUMNP), YN(NUMNP),
|
|
& XN3(NUMNP3), YN3(NUMNP3), ZN3(NUMNP3)
|
|
INTEGER IXNP(*), NRNP(*)
|
|
REAL ZCORD(NNREPL)
|
|
REAL RSA(NSPL1), ZSA(NSPL1), ZS2A(NSPL1), DISTA(NSPL1),
|
|
& SCRA(NSPL1)
|
|
REAL RSB(NSPL2), ZSB(NSPL2), ZS2B(NSPL2), DISTB(NSPL2),
|
|
& SCRB(NSPL2)
|
|
REAL SLLFT(2), SLRGT(2)
|
|
|
|
LOGICAL RDTHET, NOSCAL
|
|
|
|
PI = ATAN2(0.0, -1.0)
|
|
xb = 0.0
|
|
xt = 0.0
|
|
yb = 0.0
|
|
yt = 0.0
|
|
|
|
C ... Check for valid options...
|
|
IF (RDTHET .AND. NOSCAL) THEN
|
|
CALL PRTERR('ERROR', 'Cannot use NOSCALE with ANGULAR spline')
|
|
RETURN
|
|
END IF
|
|
|
|
C ... CALCULATE THE THICKNESS INCREMENT FOR EACH TRANSLATION
|
|
IBLK = 0
|
|
ZTOT = 0.0
|
|
1 CONTINUE
|
|
IBLK = IBLK + 1
|
|
IF (NRTRAN(IBLK) .GT. 0) THEN
|
|
ZTOT = ZTOT + D3TRAN(IBLK)
|
|
IF (IBLK .LT. MAXINT) GO TO 1
|
|
END IF
|
|
|
|
NXTNR = 1
|
|
IBLK = 0
|
|
ZEND = 0.0
|
|
|
|
2 CONTINUE
|
|
IBLK = IBLK + 1
|
|
IF (NRTRAN(IBLK) .GT. 0) THEN
|
|
ZBEG = ZEND
|
|
ZEND = ZBEG + D3TRAN(IBLK)
|
|
CALL INIGRD (ZBEG/ZTOT, ZEND/ZTOT, ZGRAD(IBLK),
|
|
* NRTRAN(IBLK), NRTRAN(IBLK)+1, ZCORD(NXTNR) )
|
|
NXTNR = NXTNR + NRTRAN(IBLK)
|
|
IF (IBLK .LT. MAXINT) GO TO 2
|
|
END IF
|
|
|
|
C ... Convert angles from degrees to radians
|
|
|
|
IF (RDTHET) THEN
|
|
DO 10 IPT = 1, NSPL1
|
|
RSA(IPT) = RSA(IPT) * PI / 180.0
|
|
10 CONTINUE
|
|
DO 20 IPT = 1, NSPL2
|
|
RSB(IPT) = RSB(IPT) * PI / 180.0
|
|
20 CONTINUE
|
|
|
|
END IF
|
|
|
|
CALL SPLINE (RSA, ZSA, NSPL1, SLLFT(1), SLRGT(1), ZS2A, SCRA)
|
|
CALL SPLINE (RSB, ZSB, NSPL2, SLLFT(2), SLRGT(2), ZS2B, SCRB)
|
|
|
|
C ... Calculate approximate distance along curve. Distance is computed
|
|
C as the straight line distance of the segments. Accurate for
|
|
C smooth curves; bad for non-smooth curves.
|
|
C ... If 'NOSCALE' is set, then the spline must be linear and
|
|
C we use the input RSA values for the distance.
|
|
|
|
IF (NOSCAL) THEN
|
|
DO 22 IPT = 1, NSPL1
|
|
DISTA(IPT) = RSA(IPT)
|
|
22 CONTINUE
|
|
DO 24 IPT = 1, NSPL2
|
|
DISTB(IPT) = RSB(IPT)
|
|
24 CONTINUE
|
|
ELSE
|
|
IF (RDTHET) THEN
|
|
DISTA(1) = ZSA(1) * SIN(RSA(1))
|
|
DISTB(1) = ZSB(1) * SIN(RSB(1))
|
|
DO 30 IPT = 2, NSPL1
|
|
DISTA(IPT) = DISTA(IPT-1) + SQRT(
|
|
& (ZSA(IPT) * SIN(RSA(IPT)) -
|
|
& ZSA(IPT-1) * SIN(RSA(IPT-1)))**2 +
|
|
& (ZSA(IPT) * COS(RSA(IPT)) -
|
|
& ZSA(IPT-1) * COS(RSA(IPT-1)))**2)
|
|
30 CONTINUE
|
|
DO 40 IPT = 2, NSPL2
|
|
DISTB(IPT) = DISTB(IPT-1) + SQRT(
|
|
& (ZSB(IPT) * SIN(RSB(IPT)) -
|
|
& ZSB(IPT-1) * SIN(RSB(IPT-1)))**2 +
|
|
& (ZSB(IPT) * COS(RSB(IPT)) -
|
|
& ZSB(IPT-1) * COS(RSB(IPT-1)))**2)
|
|
40 CONTINUE
|
|
ELSE
|
|
DISTA(1) = RSA(1)
|
|
DO 50 IPT = 2, NSPL1
|
|
DISTA(IPT) = SQRT( (RSA(IPT-1) - RSA(IPT))**2 +
|
|
& (ZSA(IPT-1) - ZSA(IPT))**2 ) + DISTA(IPT-1)
|
|
50 CONTINUE
|
|
DISTB(1) = RSB(1)
|
|
DO 60 IPT = 2, NSPL2
|
|
DISTB(IPT) = SQRT( (RSB(IPT-1) - RSB(IPT))**2 +
|
|
& (ZSB(IPT-1) - ZSB(IPT))**2 ) + DISTB(IPT-1)
|
|
60 CONTINUE
|
|
END IF
|
|
END IF
|
|
|
|
C... Determine maximum radius of mesh
|
|
|
|
RMAX = 0.0
|
|
RMIN = BINGO
|
|
IF (SWEEP .EQ. SPHERI) THEN
|
|
DO 80 INP = 1, NUMNP
|
|
DX = XN(INP)
|
|
DY = YN(INP)
|
|
RMIN = MIN (RMIN, (DX**2 + DY**2))
|
|
RMAX = MAX (RMAX, (DX**2 + DY**2))
|
|
80 CONTINUE
|
|
RMAX = SQRT(RMAX)
|
|
RMIN = SQRT(RMIN)
|
|
ELSE IF (SWEEP .EQ. XSWEEP) THEN
|
|
DO 82 INP = 1, NUMNP
|
|
DY = YN(INP)
|
|
RMIN = MIN (RMIN, DY)
|
|
RMAX = MAX (RMAX, DY)
|
|
82 CONTINUE
|
|
ELSE IF (SWEEP .EQ. YSWEEP) THEN
|
|
DO 84 INP = 1, NUMNP
|
|
DX = XN(INP)
|
|
RMIN = MIN (RMIN, DX)
|
|
RMAX = MAX (RMAX, DX)
|
|
84 CONTINUE
|
|
END IF
|
|
|
|
C... If there is not a node at 0,0 - RMIN will not equal zero, therefore,
|
|
C we assume that if the spline starts at zero, the mesh also starts
|
|
C at zero.
|
|
IF (DISTA(1) .EQ. 0.0 .OR. DISTB(1) .EQ. 0.0) THEN
|
|
RMIN = 0.0
|
|
END IF
|
|
|
|
IF (NOSCAL) THEN
|
|
PROPA = 1.0
|
|
PROPB = 1.0
|
|
ELSE
|
|
PROPA = (DISTA(NSPL1) - DISTA(1)) / (RMAX - RMIN)
|
|
PROPB = (DISTB(NSPL2) - DISTB(1)) / (RMAX - RMIN)
|
|
END IF
|
|
|
|
C ... Echo spline data
|
|
WRITE (*,*) ' '
|
|
WRITE (*,70) 'top spline', DISTA(NSPL1), PROPA
|
|
WRITE (*,70) 'bottom spline',DISTB(NSPL2), PROPB
|
|
70 FORMAT (' Total length of ',A,T32,' = ',1PE12.5,
|
|
& ', Proportion = ',1PE12.5)
|
|
|
|
KLOA = 1
|
|
KLOB = 1
|
|
DO 100 INP = 1, NUMNP
|
|
JNP0 = IXNP(INP) - 1
|
|
DX = XN(INP)
|
|
DY = YN(INP)
|
|
RAD = 0.0
|
|
IF (SWEEP .EQ. SPHERI) THEN
|
|
RAD = SQRT (DX**2 + DY**2)
|
|
ELSE IF (SWEEP .EQ. XSWEEP) THEN
|
|
RAD = DY
|
|
ELSE IF (SWEEP .EQ. YSWEEP) THEN
|
|
RAD = DX
|
|
END IF
|
|
|
|
RADA = DISTA(1) + PROPA * (RAD - RMIN)
|
|
RADB = DISTB(1) + PROPB * (RAD - RMIN)
|
|
|
|
C ... Determine segment containing point and proportion within segment
|
|
C Assume last segment was close to this segment and start search
|
|
C there.
|
|
|
|
CALL HUNT (DISTA, NSPL1, RADA, KLOA)
|
|
KLOA = MIN(NSPL1-1, MAX(1, KLOA))
|
|
|
|
CALL HUNT (DISTB, NSPL2, RADB, KLOB)
|
|
KLOB = MIN(NSPL2-1, MAX(1, KLOB))
|
|
|
|
C ... We want to map the X-Y plane onto the spline surface without
|
|
C stretching. Therefore, calculate a new radius RNEW which is
|
|
C the distance from the Z axis to the point on the spline such
|
|
C that the arc length from R=0 to R=RAD is the distance RNEW.
|
|
C The new X and Y coordinates corresponding to RNEW are calculated
|
|
C as the proportion of RNEW / RAD. FIXR is added to RAD in case
|
|
C RAD is 0; FIXR = 1 iff RAD = 0, else FIXR = 0
|
|
|
|
IF (RAD .EQ. 0.0) THEN
|
|
FIXR = 1.0
|
|
ELSE
|
|
FIXR = 0.0
|
|
END IF
|
|
C FIXR = SIGN(0.5, RAD) + SIGN(0.5, -RAD)
|
|
|
|
PROP = (RADA - DISTA(KLOA)) / (DISTA(KLOA+1) - DISTA(KLOA))
|
|
RNEWA = RSA(KLOA) + PROP * (RSA(KLOA+1) - RSA(KLOA))
|
|
PROP = (RADB - DISTB(KLOB)) / (DISTB(KLOB+1) - DISTB(KLOB))
|
|
RNEWB = RSB(KLOB) + PROP * (RSB(KLOB+1) - RSB(KLOB))
|
|
|
|
H = RSA(KLOA+1) - RSA(KLOA)
|
|
A = (RSA(KLOA+1)-RNEWA) / H
|
|
B = (RNEWA-RSA(KLOA)) / H
|
|
|
|
ZT = A * ZSA(KLOA) + B * ZSA(KLOA+1) +
|
|
* ((A**3-A) * ZS2A(KLOA)+(B**3-B) * ZS2A(KLOA+1)) * (H**2)/6.
|
|
|
|
H = RSB(KLOB+1) - RSB(KLOB)
|
|
A = (RSB(KLOB+1)-RNEWB) / H
|
|
B = (RNEWB-RSB(KLOB)) / H
|
|
|
|
ZB = A * ZSB(KLOB) + B * ZSB(KLOB+1) +
|
|
* ((A**3-A) * ZS2B(KLOB)+(B**3-B) * ZS2B(KLOB+1)) * (H**2)/6.
|
|
|
|
IF (RDTHET) THEN
|
|
RSAV = RNEWA
|
|
ZSAV = ZT
|
|
ZT = ZSAV * COS(RSAV)
|
|
RNEWA = ZSAV * SIN(RSAV)
|
|
|
|
RSAV = RNEWB
|
|
ZSAV = ZB
|
|
ZB = ZSAV * COS(RSAV)
|
|
RNEWB = ZSAV * SIN(RSAV)
|
|
END IF
|
|
|
|
IF (SWEEP .EQ. SPHERI) THEN
|
|
C ... Spherical Sweep of Spline Surface
|
|
XT = RNEWA * DX / (RAD + FIXR)
|
|
YT = RNEWA * DY / (RAD + FIXR)
|
|
XB = RNEWB * DX / (RAD + FIXR)
|
|
YB = RNEWB * DY / (RAD + FIXR)
|
|
|
|
ELSE IF (SWEEP .EQ. XSWEEP) THEN
|
|
C ... Sweep spline along the X axis
|
|
XT = DX
|
|
YT = RNEWA * DY / (RAD + FIXR)
|
|
XB = DX
|
|
YB = RNEWB * DY / (RAD + FIXR)
|
|
|
|
ELSE IF (SWEEP .EQ. YSWEEP) THEN
|
|
C ... Sweep spline along the X axis
|
|
XT = RNEWA * DX / (RAD + FIXR)
|
|
YT = DY
|
|
XB = RNEWB * DX / (RAD + FIXR)
|
|
YB = DY
|
|
|
|
END IF
|
|
DELZ = ZT - ZB
|
|
DELX = XT - XB
|
|
DELY = YT - YB
|
|
|
|
DO 90 NR = 1, NRNP(INP)
|
|
ZN3(JNP0+NR) = ZT - DELZ * ZCORD(NR)
|
|
YN3(JNP0+NR) = YT - DELY * ZCORD(NR)
|
|
XN3(JNP0+NR) = XT - DELX * ZCORD(NR)
|
|
90 CONTINUE
|
|
100 CONTINUE
|
|
|
|
RETURN
|
|
END
|
|
|