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