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.
186 lines
6.3 KiB
186 lines
6.3 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 SPRING (MP, ML, MS, MXNPER, MXND, MAXNBC, MAXSBC, L,
|
||
|
|
& IPOINT, COOR, IPBOUN, LINKP, ILINE, LTYPE, NINT, FACTOR, LCON,
|
||
|
|
& ILBOUN, ISBOUN, LINKL, NLPB, JFLINE, JLLIST, LINKPB, NPPF,
|
||
|
|
& IFPB, LISTPB, LINKLB, NLPF, IFLB, LISTLB, LINKSB, NSPF, IFSB,
|
||
|
|
& LISTSB, LSTNBC, X, Y, NID, XN, YN, NUID, LXK, NNN, KKK, LLL,
|
||
|
|
& KNBC, KSBC, ERR, ADDLNK, COUNT, NOROOM, AMESUR, XNOLD, YNOLD,
|
||
|
|
& NXKOLD, MMPOLD, LINKEG, LISTEG, BMESUR, MLINK, NPROLD, NPNOLD,
|
||
|
|
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS,
|
||
|
|
& SIZMIN, EMAX, EMIN, GRAPH)
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
C SUBROUTINE SPRING = GENERATES SPRING ELEMENTS FROM A BARSET
|
||
|
|
|
||
|
|
C***********************************************************************
|
||
|
|
|
||
|
|
DIMENSION IPOINT(MP), COOR(2, MP), IPBOUN(MP), LINKP(2, MP)
|
||
|
|
DIMENSION ILINE(ML), LTYPE(ML), NINT(ML), FACTOR(ML), LCON(3, ML)
|
||
|
|
DIMENSION ILBOUN(ML), ISBOUN(ML), LINKL(2, ML)
|
||
|
|
DIMENSION NLPB(MS), JFLINE(MS), JLLIST(MS*3)
|
||
|
|
DIMENSION NPPF(MP), IFPB(MP), LISTPB(2, MP)
|
||
|
|
DIMENSION NLPF(ML), IFLB(ML), LISTLB(2, ML)
|
||
|
|
DIMENSION NSPF(ML), IFSB(ML), LISTSB(2, ML)
|
||
|
|
DIMENSION LINKPB(2, MP)
|
||
|
|
DIMENSION LINKLB(2, ML), LINKSB(2, ML)
|
||
|
|
DIMENSION X(MXNPER), Y(MXNPER), NID(MXNPER)
|
||
|
|
DIMENSION XN(MXND), YN(MXND), NUID(MXND), LXK(4,MXND)
|
||
|
|
|
||
|
|
DIMENSION AMESUR(NPEOLD), XNOLD(NPNOLD), YNOLD(NPNOLD)
|
||
|
|
DIMENSION NXKOLD(NNXK, NPEOLD), MMPOLD(3, NPROLD)
|
||
|
|
DIMENSION LINKEG(2, MLINK), LISTEG(4 * NPEOLD), BMESUR(NPNOLD)
|
||
|
|
|
||
|
|
LOGICAL NOROOM, ERR, REAL, TEST, ADDLNK, COUNT, GRAPH
|
||
|
|
|
||
|
|
REAL = .TRUE.
|
||
|
|
TEST = .FALSE.
|
||
|
|
KKK = 0
|
||
|
|
NNN = 0
|
||
|
|
KNBC = 0
|
||
|
|
KSBC = 0
|
||
|
|
LLL = 1
|
||
|
|
|
||
|
|
C CHECK THAT THE BARSET HAS ONLY TWO SIDES AND THAT THE SIDES HAVE
|
||
|
|
C EQUAL INTERVALS
|
||
|
|
|
||
|
|
IF (NLPB (L) .NE. 2) THEN
|
||
|
|
ERR = .TRUE.
|
||
|
|
CALL MESSAGE(' SPRINGS CAN ONLY BE GENERATED FOR 2 LINE BAR '//
|
||
|
|
& 'SETS')
|
||
|
|
GOTO 130
|
||
|
|
ELSE
|
||
|
|
J1 = JFLINE(L)
|
||
|
|
J2 = JFLINE(L) + 1
|
||
|
|
CALL LTSORT (ML, LINKL, JLLIST(J1), KK1, ADDLNK)
|
||
|
|
CALL LTSORT (ML, LINKL, JLLIST(J2), KK2, ADDLNK)
|
||
|
|
IF (NINT (KK1) .NE. NINT (KK2)) THEN
|
||
|
|
CALL MESSAGE('SPRING BAR SETS MUST CONTAIN EQUAL '//
|
||
|
|
& 'INTERVALS ON OPPOSING SIDES')
|
||
|
|
ERR = .TRUE.
|
||
|
|
GOTO 130
|
||
|
|
ENDIF
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C NOW GENERATE THE NODES FOR THE FIRST LINE
|
||
|
|
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(1, KK1), IP1, ADDLNK)
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(2, KK1), IP2, ADDLNK)
|
||
|
|
IF (LCON(3, KK1) .GT. 0) THEN
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(3, KK1), IP3, ADDLNK)
|
||
|
|
ELSE IF (LCON(3, KK1) .LT. 0) THEN
|
||
|
|
CALL LTSORT (MP, LINKP, ABS(LCON(3, KK1)), IP3,
|
||
|
|
& ADDLNK)
|
||
|
|
IP3 = -IP3
|
||
|
|
ELSE
|
||
|
|
IP3 = 0
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL PLINE (MP, ML, MXNPER, MAXNBC, MAXSBC, IPOINT,
|
||
|
|
& COOR, LINKP, ILINE(KK1), LTYPE(KK1), NINT(KK1),
|
||
|
|
& FACTOR(KK1), IP1, IP2, IP3, X, Y, NID,
|
||
|
|
& IPBOUN(IP1), IPBOUN(IP2), ILBOUN(KK1), ISBOUN(KK1),
|
||
|
|
& LINKPB, NPPF, IFPB, LISTPB, LINKLB, NLPF, IFLB,
|
||
|
|
& LISTLB, LINKSB, NSPF, IFSB, LISTSB, LSTNBC, KNBC,
|
||
|
|
& KSBC, ERR, TEST, REAL, COUNT, NOROOM, AMESUR, XNOLD, YNOLD,
|
||
|
|
& NXKOLD, MMPOLD, LINKEG, LISTEG, BMESUR, MLINK, NPROLD, NPNOLD,
|
||
|
|
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS,
|
||
|
|
& SIZMIN, EMAX, EMIN, GRAPH, DXMAX)
|
||
|
|
IF (ERR) THEN
|
||
|
|
CALL MESSAGE('PROBLEMS GENERATING NODES FOR FIRST SPRING LINE')
|
||
|
|
GOTO 130
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C ADD THESE NODES TO THE CURRENT LIST
|
||
|
|
|
||
|
|
NNN0 = NNN + 1
|
||
|
|
NNN = NNN + ABS(NINT(KK1)) + 1
|
||
|
|
KOUNT = 0
|
||
|
|
DO 100 I = NNN0, NNN
|
||
|
|
KOUNT = KOUNT+1
|
||
|
|
XN(I) = X(KOUNT)
|
||
|
|
YN(I) = Y(KOUNT)
|
||
|
|
NUID(I) = NID(KOUNT)
|
||
|
|
100 CONTINUE
|
||
|
|
|
||
|
|
C MARK THESE POINTS AND THE LINE AS BEING USED
|
||
|
|
|
||
|
|
NINT(KK1) = -ABS(NINT(KK1))
|
||
|
|
IPOINT(IP1) = -ABS(IPOINT(IP1))
|
||
|
|
IPOINT(IP2) = -ABS(IPOINT(IP2))
|
||
|
|
|
||
|
|
C NOW GENERATE THE NODES FOR THE SECOND LINE
|
||
|
|
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(1, KK2), IP1, ADDLNK)
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(2, KK2), IP2, ADDLNK)
|
||
|
|
IF (LCON(3, KK2) .GT. 0) THEN
|
||
|
|
CALL LTSORT (MP, LINKP, LCON(3, KK2), IP3, ADDLNK)
|
||
|
|
ELSE IF (LCON(3, KK2) .LT. 0) THEN
|
||
|
|
CALL LTSORT (MP, LINKP, ABS(LCON(3, KK2)), IP3,
|
||
|
|
& ADDLNK)
|
||
|
|
IP3 = -IP3
|
||
|
|
ELSE
|
||
|
|
IP3 = 0
|
||
|
|
END IF
|
||
|
|
|
||
|
|
CALL PLINE (MP, ML, MXNPER, MAXNBC, MAXSBC, IPOINT,
|
||
|
|
& COOR, LINKP, ILINE(KK2), LTYPE(KK2), NINT(KK2),
|
||
|
|
& FACTOR(KK2), IP1, IP2, IP3, X, Y, NID,
|
||
|
|
& IPBOUN(IP1), IPBOUN(IP2), ILBOUN(KK2), ISBOUN(KK2),
|
||
|
|
& LINKPB, NPPF, IFPB, LISTPB, LINKLB, NLPF, IFLB,
|
||
|
|
& LISTLB, LINKSB, NSPF, IFSB, LISTSB, LSTNBC, KNBC,
|
||
|
|
& KSBC, ERR, TEST, REAL, COUNT, NOROOM, AMESUR, XNOLD, YNOLD,
|
||
|
|
& NXKOLD, MMPOLD, LINKEG, LISTEG, BMESUR, MLINK, NPROLD, NPNOLD,
|
||
|
|
& NPEOLD, NNXK, REMESH, REXMIN, REXMAX, REYMIN, REYMAX, IDIVIS,
|
||
|
|
& SIZMIN, EMAX, EMIN, GRAPH, DXMAX)
|
||
|
|
IF (ERR) THEN
|
||
|
|
CALL MESSAGE('PROBLEMS GENERATING NODES FOR FIRST SPRING LINE')
|
||
|
|
GOTO 130
|
||
|
|
ENDIF
|
||
|
|
|
||
|
|
C ADD THESE NODES TO THE CURRENT LIST
|
||
|
|
|
||
|
|
NNN1 = NNN + 1
|
||
|
|
NNN = NNN + ABS(NINT(KK2)) + 1
|
||
|
|
KOUNT = 0
|
||
|
|
DO 110 I = NNN1, NNN
|
||
|
|
KOUNT = KOUNT + 1
|
||
|
|
XN(I) = X(KOUNT)
|
||
|
|
YN(I) = Y(KOUNT)
|
||
|
|
NUID(I) = NID(KOUNT)
|
||
|
|
110 CONTINUE
|
||
|
|
|
||
|
|
C MARK THESE POINTS AND THE LINE AS BEING USED
|
||
|
|
|
||
|
|
NINT(KK2) = -ABS(NINT(KK2))
|
||
|
|
IPOINT(IP1) = -ABS(IPOINT(IP1))
|
||
|
|
IPOINT(IP2) = -ABS(IPOINT(IP2))
|
||
|
|
|
||
|
|
C NOW GENERATE THE ELEMENTS BY SEEING WHICH END OF THE LINE MATCHES
|
||
|
|
C UP THE CLOSEST.
|
||
|
|
|
||
|
|
DIST1 = SQRT ( (XN(NNN0) - XN(NNN1))**2 +
|
||
|
|
& (YN(NNN0) - YN(NNN1))**2 )
|
||
|
|
DIST2= SQRT ( (XN(NNN0) - XN(NNN))**2 +
|
||
|
|
& (YN(NNN0) - YN(NNN))**2 )
|
||
|
|
NK = ABS(NINT(KK1)) + 1
|
||
|
|
DO 120 I = 1, NK
|
||
|
|
KKK = KKK + 1
|
||
|
|
LXK(1,KKK) = I
|
||
|
|
IF (DIST1 .LE. DIST2) THEN
|
||
|
|
LXK(2,KKK) = I + NK
|
||
|
|
ELSE
|
||
|
|
LXK(2,KKK) = NNN - I + 1
|
||
|
|
ENDIF
|
||
|
|
LXK(3,KKK) = 0
|
||
|
|
LXK(4,KKK) = 0
|
||
|
|
120 CONTINUE
|
||
|
|
|
||
|
|
130 CONTINUE
|
||
|
|
|
||
|
|
END
|