C     SPACE TRUSS 
      DIMENSION NP(100),NM(100),S(100) 
      DOUBLE PRECISION R(100),P(100),C(100,100),UVEC(3)
     1,C1,D1,F1,F2,FAC
      MAXC=100
C
C     INITIALIZE PARAMETERS/ARRAYS
C
      E = 30.0D06 
100   READ(5,150)NB,NN,NS 
150   FORMAT (3I5)
      WRITE(6,1)NB,NN,NS
    1 FORMAT(I5,'  NO. MEMBERS'/I5,'  NO. NODES'/I5,
     1'  NO.SUPPORTS'//)
      READ(5,156)(R(3*K-2),R(3*K-1),R(3*K),P(3*K-2),
     1P(3*K-1),P(3*K),K=1,NN)
      WRITE(6,157)(K,R(3*K-2),R(3*K-1),R(3*K),K=1,NN)
157   FORMAT (1H1,25X,11HCOORDINATES//14X,1HX,19X,1HY,
     1 19X,1HZ//(I4,3D20.8))
      WRITE(6,257)(K,P(3*K-2),P(3*K-1),P(3*K),K=1,NN)
257   FORMAT (1H1,30X,5HLOADS//13X,2HPX,18X,2HPY,18X,
     1 2HPZ//(I4,3D20.8))
      NNN = NN - NS 
      N=3*NNN
C
C     SET UP SYSTEM MATRIX
C
      DO 30 I = 1,N 
      DO 30 J = 1,N 
   30 C(I,J) = 0. 
      WRITE(6,159) 
      DO 999 L=1,NB
      READ(5,151)NP(L),NM(L),S(L) 
      WRITE(6,160)L,NP(L),NM(L),S(L) 
151   FORMAT (2I5,8X,E10.6) 
160   FORMAT (3I10,E20.8) 
      K = 3*NP(L) 
      M = 3*NM(L) 
      CALL UNITV(K,M,C1,UVEC,R)
      CALL INSERT(C,K,M,UVEC,MAXC,N,E,S(L),C1)
 999  CONTINUE
C
C     SOLVE FOR JOINT DISPLACEMENTS
C
      M = N - 1 
      DO 17 I = 1,M 
      L = I + 1 
      DO 17 J = L,N 
      IF(C(J,I)) 19,17,19 
   19 DO 18 K = L,N 
   18 C(J,K) = C(J,K) - C(I,K)*C(J,I)/C(I,I) 
      P(J) = P(J) - P(I)*C(J,I)/C(I,I) 
   17 CONTINUE
      P(N) = P(N)/C(N,N) 
      DO 20 I = 1,M 
      K = N - I 
      L = K + 1 
      DO 21 J = L,N 
   21 P(K) = P(K) - P(J)*C(K,J) 
      P(K) = P(K)/C(K,K) 
   20 CONTINUE 
      WRITE(6,161)(I,P(3*I-2),P(3*I-1),P(3*I),I=1,NNN) 
  161 FORMAT (1H1,13HDISPLACEMENTS/20X,1HX,19X,1HY,19X,1HZ
     1//(I10,3D20.8))
      WRITE(6,162) 
  162 FORMAT(1H1,3X,6HMEMBER,9X,2HDL,17X,5HFORCE,
     1 14X,6HSTRESS//)
C
C     COMPUTE MEMBER FORCES AND DISPLACEMENTS
C
      DO 998 I=1,NB
      K = 3*NP(I) 
      M = 3*NM(I) 
      CALL UNITV(K,M,C1,UVEC,R)
      K1=K
      D1=0.
      FAC=1.
      DO 997 J=1,2
      IF(K1.GT.N) GO TO 996
      D1=D1+FAC*(P(K1-2)*UVEC(1)+P(K1-1)*UVEC(2)+P(K1)*UVEC(3))
 996  FAC=-1.
      K1=M
 997  CONTINUE
      F1=D1*E*S(I)/C1 
      F2=F1/S(I) 
      WRITE(6,1000) I,D1,F1,F2 
  998 CONTINUE
      STOP
  156 FORMAT (8X,6F11.6) 
 1000 FORMAT (I10,3D20.8) 
  159 FORMAT (1H1,3X,6HMEMBER,5X,5H+ END,5X,5H- END,6X,4HAREA//) 
      END 
C 
      SUBROUTINE UNITV(K,M,C1,UVEC,R) 
      DOUBLE PRECISION R(1),C1,UVEC(3) 
      C1=0. 
      DO 1 I=1,3 
      UVEC(I)=R(K+I-3)-R(M+I-3) 
    1 C1=C1+UVEC(I)**2 
      C1=DSQRT(C1) 
      DO 2 I=1,3 
    2 UVEC(I)=UVEC(I)/C1 
      RETURN 
      END 
C
      SUBROUTINE INSERT(C,K,M,UVEC,MAXC,N,E,S,C1)
      DOUBLE PRECISION C(MAXC,MAXC),UVEC(3),C1
      K1=K
      DO 1 I=1,2
      IF(K1.GT.N) GO TO 1
      M1=K
      DO 2 J=1,2
      IF(M1.GT.N) GO TO 2
      FAC=1.
      IF(I.NE.J) FAC=-1.
      DO 3 L=1,3
      I1=K1-3+L
      DO 3 L1=1,3
      J1=M1-3+L1
    3 C(I1,J1)=C(I1,J1)+UVEC(L)*UVEC(L1)*S*E*FAC/C1
    2 M1=M
    1 K1=M
      RETURN
      END
