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.
162 lines
4.9 KiB
162 lines
4.9 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
|
||
|
|
|
||
|
|
SUBROUTINE GETM5 (IA, ML, MS, MNNPS, NS, ISLIST, NINT, IFLINE,
|
||
|
|
& NLPS, ILLIST, LINKL, LINKS, X, Y, NID, NNPS, ANGLE, NPER,
|
||
|
|
& M1A, M1B, M2, M3A, M3B, M4A, M4B, M5, MC, XCEN, YCEN, CCW, ERR)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE GETM5 = GETS THE APPROPRIATE SIDE LENGTHS AND DIVISIONS
|
||
|
|
C FOR A PENTAGON REGION
|
||
|
|
|
||
|
|
C WRITTEN BY: HORACIO RECALDE DATE: JAN 1988
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE CALLED BY:
|
||
|
|
C QMESH = GENERATES QUAD ELEMENTS
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C VARIABLES USED:
|
||
|
|
C NNPS = ARRAY OF NUMBER OF NODES PER SIDE
|
||
|
|
C CCW = .TRUE. IF THE SIDE IS ORIENTED CCW
|
||
|
|
C NORM = .TRUE. IF THE FIRST SIDE IS TO BE TRIED AS THE BASE
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IA(1)
|
||
|
|
DIMENSION NNPS(MNNPS), ISLIST(NS), LINKL(2, ML), LINKS(MS*2)
|
||
|
|
DIMENSION NLPS(MS), NINT(ML), IFLINE(MS), ILLIST(MS*3)
|
||
|
|
DIMENSION X(NPER), Y(NPER), NID(NPER), ANGLE(NPER)
|
||
|
|
DIMENSION XJ(3), YJ(3)
|
||
|
|
|
||
|
|
LOGICAL CCW, ERR
|
||
|
|
|
||
|
|
C CALCULATE THE NUMBER OF NODES PER SIDE
|
||
|
|
|
||
|
|
CALL NPS (ML, MS, MNNPS, NS, ISLIST, NINT, IFLINE, NLPS, ILLIST,
|
||
|
|
& LINKL, LINKS, NNPS, ERR)
|
||
|
|
IF (ERR)RETURN
|
||
|
|
IF (.NOT.CCW) CALL IREVER (NNPS, NS)
|
||
|
|
|
||
|
|
C RESERVE MEMORY FOR THE STACKS
|
||
|
|
|
||
|
|
CALL MDRSRV ('IST2', IP2, NPER)
|
||
|
|
CALL MDRSRV ('IST3', IP3, NPER)
|
||
|
|
CALL MDRSRV ('IST4', IP4, NPER)
|
||
|
|
CALL MDRSRV ('IST5', IP5, NPER)
|
||
|
|
CALL MDRSRV ('INDST', INDP, NPER)
|
||
|
|
|
||
|
|
C FIND THE BEST CORNER NODES IN THE LIST
|
||
|
|
|
||
|
|
CALL PICKM5 (NPER, X, Y, ANGLE, IA(IP2), IA(IP3), IA(IP4),
|
||
|
|
& IA(IP5), IA(INDP), IFIRST, M1, M2, M3, M4)
|
||
|
|
IF (IFIRST .EQ. 0) THEN
|
||
|
|
ERR = .TRUE.
|
||
|
|
CALL MESSAGE('ERROR FITTING LOGICAL PENTAGON TO DATA')
|
||
|
|
RETURN
|
||
|
|
ELSE IF (IFIRST .EQ. -1) THEN
|
||
|
|
ERR = .TRUE.
|
||
|
|
CALL MESSAGE('TOLERANCE EXCEEDED')
|
||
|
|
RETURN
|
||
|
|
ELSE IF (IFIRST.NE.1) THEN
|
||
|
|
CALL FQ_ROTATE (NPER, X, Y, NID, IFIRST)
|
||
|
|
END IF
|
||
|
|
|
||
|
|
C DELETE THE STACKS
|
||
|
|
|
||
|
|
CALL MDDEL ('IST2')
|
||
|
|
CALL MDDEL ('IST3')
|
||
|
|
CALL MDDEL ('IST4')
|
||
|
|
CALL MDDEL ('IST5')
|
||
|
|
CALL MDDEL ('INDST')
|
||
|
|
|
||
|
|
C NOW SORT THE LIST SO THE LONGEST SIDE IS FIRST
|
||
|
|
|
||
|
|
M5 = NPER - M1 - M2 - M3 - M4
|
||
|
|
MMAX = MAX0(M1, M2, M3, M4, M5)
|
||
|
|
IF (M1 .EQ. MMAX) THEN
|
||
|
|
KNUM = 0
|
||
|
|
ELSE IF (M2 .EQ. MMAX) THEN
|
||
|
|
CALL FQ_ROTATE (NPER, X, Y, NID, M1 + 1)
|
||
|
|
KNUM = 1
|
||
|
|
ELSE IF (M3 .EQ. MMAX) THEN
|
||
|
|
CALL FQ_ROTATE (NPER, X, Y, NID, M1 + M2 + 1)
|
||
|
|
KNUM = 2
|
||
|
|
ELSE IF (M4 .EQ. MMAX) THEN
|
||
|
|
CALL FQ_ROTATE (NPER, X, Y, NID, M1 + M2 + M3 + 1)
|
||
|
|
KNUM = 3
|
||
|
|
ELSE IF (M5 .EQ. MMAX) THEN
|
||
|
|
CALL FQ_ROTATE (NPER, X, Y, NID, M1 + M2 + M3 + M4 + 1)
|
||
|
|
KNUM = 4
|
||
|
|
END IF
|
||
|
|
DO 100 KK = 1, KNUM
|
||
|
|
MHOLD = M1
|
||
|
|
M1 = M2
|
||
|
|
M2 = M3
|
||
|
|
M3 = M4
|
||
|
|
M4 = M5
|
||
|
|
M5 = MHOLD
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
C SPLIT THE SIDES INTO LOGICAL DIVISIONS
|
||
|
|
|
||
|
|
M1A = (M1 + M4 + M5 - M2 - M3)/2
|
||
|
|
M1B = (M1 + M2 + M3 - M4 - M5)/2
|
||
|
|
M3A = M1B
|
||
|
|
M3B = (M3 + M4 + M5 - M1 - M2)/2
|
||
|
|
M4A = (M2 + M3 + M4 - M1 - M5)/2
|
||
|
|
M4B = M1A
|
||
|
|
MC = (M1 + M2 + M5 - M3 - M4)/2
|
||
|
|
|
||
|
|
C DEFINE THE MIDDLE POINT AS THE AVERAGE OF PROPORIONAL DIVISIONS
|
||
|
|
C OF SIDE DIVISION POINT TO OPPOSITE TRIANGLE CORNER LINES
|
||
|
|
|
||
|
|
I1 = M1A + 1
|
||
|
|
I2 = I1 + M1B + M2 + M3A
|
||
|
|
I3 = I2 + M3B + M4A
|
||
|
|
|
||
|
|
C FIND DISTANCES FROM CORNER TO CORNER, AND CORNERS TO SIDE DIVISIONS
|
||
|
|
|
||
|
|
D1 = SQRT((X(I2) - X(I1))**2 + (Y(I2) - Y(I1))**2)
|
||
|
|
D2 = SQRT((X(I3) - X(I2))**2 + (Y(I3) - Y(I2))**2)
|
||
|
|
D3 = SQRT((X(I1) - X(I3))**2 + (Y(I1) - Y(I3))**2)
|
||
|
|
D1A = DBLE(M4B)*D1/DBLE(M4)
|
||
|
|
D1B = D1 - D1A
|
||
|
|
D2A = DBLE(M1B)*D2/DBLE(M1)
|
||
|
|
D2B = D2 - D1A
|
||
|
|
D3A = DBLE(M3B)*D3/DBLE(M3)
|
||
|
|
D3B = D3 - D3A
|
||
|
|
XJ(1) = X(I1) + (X(I2) - X(I1))*D1A/D1
|
||
|
|
YJ(1) = Y(I1) + (Y(I2) - Y(I1))*D1A/D1
|
||
|
|
XJ(2) = X(I2) + (X(I3) - X(I2))*D2A/D2
|
||
|
|
YJ(2) = Y(I2) + (Y(I3) - Y(I2))*D2A/D2
|
||
|
|
XJ(3) = X(I3) + (X(I1) - X(I3))*D3A/D3
|
||
|
|
YJ(3) = Y(I3) + (Y(I1) - Y(I3))*D3A/D3
|
||
|
|
|
||
|
|
C GET MIDPOINT TRIALS 1, 2, AND 3 AS PROPORTIONS
|
||
|
|
|
||
|
|
PRO1 = .5*((D3A/D3) + (D1B/D1))
|
||
|
|
X1 = XJ(2) - (PRO1*(XJ(2) - X(I1)))
|
||
|
|
Y1 = YJ(2) - (PRO1*(YJ(2) - Y(I1)))
|
||
|
|
PRO2 = .5*((D2B/D2) + (D1A/D1))
|
||
|
|
X2 = XJ(3) - (PRO2*(XJ(3) - X(I2)))
|
||
|
|
Y2 = YJ(3) - (PRO2*(YJ(3) - Y(I2)))
|
||
|
|
PRO3 = .5*((D2A/D2) + (D3B/D3))
|
||
|
|
X3 = XJ(1) - (PRO3*(XJ(1) - X(I3)))
|
||
|
|
Y3 = YJ(1) - (PRO3*(YJ(1) - Y(I3)))
|
||
|
|
|
||
|
|
C AVERAGE POINTS TO GET THE CENTER
|
||
|
|
|
||
|
|
XCEN = (X1 + X2 + X3)/3.
|
||
|
|
YCEN = (Y1 + Y2 + Y3)/3.
|
||
|
|
|
||
|
|
ERR = .FALSE.
|
||
|
|
RETURN
|
||
|
|
|
||
|
|
END
|