



      REAL FUNCTION GVFANG(VECT1,VECT2)


















      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3), L1, L2, CP, S12, GVFACS







      L1=VECT1(1)**2+VECT1(2)**2+VECT1(3)**2
      L2=VECT2(1)**2+VECT2(2)**2+VECT2(3)**2
      IF (L1.LT.1E-5.OR.L2.LT.1E-5) THEN
         GVFANG=0.0



      ELSE
         CP=VECT1(1)*VECT2(1)+VECT1(2)*VECT2(2)+VECT1(3)*VECT2(3)
         S12=SQRT(L1*L2)
         IF (ABS(CP).GE.S12) THEN
            IF (CP.GT.0.0) THEN
               GVFANG=GVFACS(1.0)
            ELSE
               GVFANG=GVFACS(-1.0)
            END IF
         ELSE
            GVFANG=GVFACS(CP/S12)
         END IF
      END IF





      RETURN
      END
      REAL FUNCTION GVF3PA(XYZ1,XYZ2,XYZ3)

















      IMPLICIT      NONE
      REAL          XYZ1(3), XYZ2(3), XYZ3(3), L1, L2, DP, S12, GVFACS,
     +              V1(3), V2(3)







      V1(1)=XYZ1(1)-XYZ2(1)
      V1(2)=XYZ1(2)-XYZ2(2)
      V1(3)=XYZ1(3)-XYZ2(3)
      V2(1)=XYZ3(1)-XYZ2(1)
      V2(2)=XYZ3(2)-XYZ2(2)
      V2(3)=XYZ3(3)-XYZ2(3)



      L1=V1(1)**2+V1(2)**2+V1(3)**2
      L2=V2(1)**2+V2(2)**2+V2(3)**2
      IF (L1.LT.1E-5.OR.L2.LT.1E-5) THEN
         GVF3PA=0.0



      ELSE
         DP=V1(1)*V2(1)+V1(2)*V2(2)+V1(3)*V2(3)
         S12=SQRT(L1*L2)
         IF (ABS(DP).GE.S12) THEN
            IF (DP.GT.0.0) THEN
               GVF3PA=GVFACS(1.0)
            ELSE
               GVF3PA=GVFACS(-1.0)
            END IF
         ELSE
            GVF3PA=GVFACS(DP/S12)
         END IF
      END IF





      RETURN
      END
      REAL FUNCTION GVFNGN(VECT1,VECT2,NUM)

















      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          VECT1(NUM), VECT2(NUM), GVFACS, L1, L2, L12







      L1=0.0
      L2=0.0
      L12=0.0
      DO 10 I=1,NUM
         L1=L1+VECT1(I)**2
         L2=L2+VECT2(1)**2
         L12=L12+VECT1(I)*VECT2(I)
   10 CONTINUE



      IF (L1.LT.1E-5.OR.L2.LT.1E-5) THEN
         GVFNGN=0.0



      ELSE
         GVFNGN=GVFACS(L12/SQRT(L1*L2))
      END IF





      RETURN
      END
      REAL FUNCTION GVF360(R)









      IMPLICIT      NONE
      REAL          R





      IF (R.LT.0.0) THEN
         GVF360=360.0-MOD(-R,360.0)
      ELSE IF (R.GT.360.0) THEN
         GVF360=MOD(R,360.0)
      ELSE
         GVF360=R
      END IF





      RETURN
      END
      REAL FUNCTION GVF2PI(R)









      IMPLICIT      NONE
      REAL          R, PI2
      PARAMETER     (PI2=2*3.1415927)




      
      IF (R.LT.0.0) THEN
         GVF2PI=PI2-MOD(-R,PI2)
      ELSE IF (R.GT.PI2) THEN
         GVF2PI=MOD(R,PI2)
      ELSE
         GVF2PI=R
      END IF





      RETURN
      END
      REAL FUNCTION GVFADF(ANG1,ANG2)








      IMPLICIT      NONE
      REAL          ANG1, ANG2, LANG1, LANG2, GVF360







      LANG1=GVF360(ANG1)
      LANG2=GVF360(ANG2)



      GVFADF=MIN(ABS(LANG1-LANG2),360.0-ABS(LANG1-LANG2))





      RETURN
      END
      REAL FUNCTION GVFDET(RMAT)












      IMPLICIT      NONE
      REAL          RMAT(3,3)







      GVFDET=
     + RMAT(1,1)*RMAT(2,2)*RMAT(3,3)-RMAT(1,1)*RMAT(2,3)*RMAT(3,2)+
     + RMAT(1,2)*RMAT(2,3)*RMAT(3,1)-RMAT(1,2)*RMAT(2,1)*RMAT(3,3)+
     + RMAT(1,3)*RMAT(2,1)*RMAT(3,2)-RMAT(1,3)*RMAT(2,2)*RMAT(3,1)





      RETURN
      END
      REAL FUNCTION GVFDP3(VECT1,VECT2)











      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3)





      GVFDP3=VECT1(1)*VECT2(1)+VECT1(2)*VECT2(2)+VECT1(3)*VECT2(3)





      RETURN
      END
      REAL FUNCTION GVFDPN(VECT1,VECT2,NUM)
















      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          VECT1(NUM), VECT2(NUM)







      GVFDPN=0.0



      IF (NUM.GT.0) THEN



         DO 10 I=1,NUM
            GVFDPN=GVFDPN+VECT1(I)*VECT2(I)
   10    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD50')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD51',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      REAL FUNCTION GVFDV3(VECT1,VECT2)











      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3)





      GVFDV3=SQRT((VECT1(1)-VECT2(1))**2+
     +            (VECT1(2)-VECT2(2))**2+
     +            (VECT1(3)-VECT2(3))**2)





      RETURN
      END
      REAL FUNCTION GVFDVN(VECT1,VECT2,NUM)











      IMPLICIT      NONE
      INTEGER       I, NUM
      REAL          X, VECT1(NUM), VECT2(NUM)





      X=0.0

      DO 10 I=1,NUM
         X=X+(VECT1(I)-VECT2(I))**2
 10   CONTINUE

      GVFDVN=SQRT(X)




   
      RETURN
      END
      REAL FUNCTION GVFGTA(MATRIX)














      IMPLICIT      NONE
      REAL          MATRIX(3,3), GVFDET, TRACE, GVFACS







      IF (ABS(GVFDET(MATRIX)-1.0).GT.0.001) THEN
         GVFGTA=0.0
         GOTO 998
      END IF



      TRACE=MATRIX(1,1)+MATRIX(2,2)+MATRIX(3,3)
      GVFGTA=GVFACS(0.5*TRACE-0.5)



 998  CONTINUE


      RETURN
      END
      LOGICAL FUNCTION GVFIMU(RMAT)










      IMPLICIT      NONE
      REAL          RMAT(3,3)





      GVFIMU=ABS(RMAT(1,1)-1.0).LT.0.0001.AND.
     +       ABS(RMAT(2,2)-1.0).LT.0.0001.AND.
     +       ABS(RMAT(3,3)-1.0).LT.0.0001.AND.
     +       ABS(RMAT(1,2)).LT.0.0001.AND.
     +       ABS(RMAT(1,3)).LT.0.0001.AND.
     +       ABS(RMAT(2,1)).LT.0.0001.AND.
     +       ABS(RMAT(2,3)).LT.0.0001.AND.
     +       ABS(RMAT(3,1)).LT.0.0001.AND.
     +       ABS(RMAT(3,2)).LT.0.0001





      RETURN
      END
      REAL FUNCTION GVFLNV(VECT)











      IMPLICIT      NONE
      REAL          VECT(3)





      GVFLNV=SQRT(VECT(1)**2+VECT(2)**2+VECT(3)**2)





      RETURN
      END
      REAL FUNCTION GVFLNN(VECT,NUM)











      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          VECT(3,NUM),SUM





      SUM=0
      GVFLNN=0.0
      IF (NUM.LE.0) GOTO 998
      DO 10 I=1,NUM
         SUM=SUM+SQRT(VECT(1,I)**2+VECT(2,I)**2+VECT(3,I)**2)
   10 CONTINUE
      GVFLNN=SUM/FLOAT(NUM)



 998  CONTINUE


      RETURN
      END
      REAL FUNCTION GVFTOR(XYZ1,XYZ2,XYZ3,XYZ4)









      IMPLICIT      NONE
      REAL          XYZ1(3) ,XYZ2(3), XYZ3(3) ,XYZ4(3) ,BOND1(3),
     +              BOND2(3), BOND3(3), VPROD1(3), VPROD2(3), 
     +              VPROD3(3), COSINE, GVFACS, GVFDP3







      CALL GVSTV3 (BOND1,XYZ2,XYZ1)
      CALL GVSTV3 (BOND2,XYZ3,XYZ2)
      CALL GVSTV3 (BOND3,XYZ4,XYZ3)



      CALL GVSNM3 (BOND1)
      CALL GVSNM3 (BOND2)
      CALL GVSNM3 (BOND3)
      CALL GVSCP3 (VPROD1,BOND2,BOND1)
      CALL GVSCP3 (VPROD2,BOND3,BOND2)
      CALL GVSNM3 (VPROD1)
      CALL GVSNM3 (VPROD2)
      CALL GVSCP3 (VPROD3,VPROD1,VPROD2)
      COSINE=GVFDP3(VPROD1,VPROD2)
      GVFTOR=GVFACS(COSINE)




      GVFTOR=SIGN(GVFTOR,GVFDP3(VPROD3,BOND2))





      RETURN
      END
      SUBROUTINE GVS3X3 (RMAT1,RMAT2,RMAT3)












      IMPLICIT      NONE
      REAL          RMAT1(3,3), RMAT2(3,3), RMAT3(3,3)





      RMAT1(1,1)=RMAT2(1,1)*RMAT3(1,1)+
     + RMAT2(1,2)*RMAT3(2,1)+RMAT2(1,3)*RMAT3(3,1)
      RMAT1(1,2)=RMAT2(1,1)*RMAT3(1,2)+
     + RMAT2(1,2)*RMAT3(2,2)+RMAT2(1,3)*RMAT3(3,2)
      RMAT1(1,3)=RMAT2(1,1)*RMAT3(1,3)+
     + RMAT2(1,2)*RMAT3(2,3)+RMAT2(1,3)*RMAT3(3,3)

      RMAT1(2,1)=RMAT2(2,1)*RMAT3(1,1)+
     + RMAT2(2,2)*RMAT3(2,1)+RMAT2(2,3)*RMAT3(3,1)
      RMAT1(2,2)=RMAT2(2,1)*RMAT3(1,2)+
     + RMAT2(2,2)*RMAT3(2,2)+RMAT2(2,3)*RMAT3(3,2)
      RMAT1(2,3)=RMAT2(2,1)*RMAT3(1,3)+
     + RMAT2(2,2)*RMAT3(2,3)+RMAT2(2,3)*RMAT3(3,3)

      RMAT1(3,1)=RMAT2(3,1)*RMAT3(1,1)+
     + RMAT2(3,2)*RMAT3(2,1)+RMAT2(3,3)*RMAT3(3,1)
      RMAT1(3,2)=RMAT2(3,1)*RMAT3(1,2)+
     + RMAT2(3,2)*RMAT3(2,2)+RMAT2(3,3)*RMAT3(3,2)
      RMAT1(3,3)=RMAT2(3,1)*RMAT3(1,3)+
     + RMAT2(3,2)*RMAT3(2,3)+RMAT2(3,3)*RMAT3(3,3)





      RETURN
      END
      SUBROUTINE GVS4X4 (RMAT1,RMAT2,RMAT3)












      IMPLICIT      NONE
      INTEGER       I, J, K
      REAL          RMAT1(4,4), RMAT2(4,4), RMAT3(4,4)





      DO 30 I=1,4
         DO 20 J=1,4
            RMAT1(I,J)=0.0
            DO 10 K=1,4
               RMAT1(I,J)=RMAT1(I,J)+RMAT2(I,K)*RMAT3(K,J)
   10       CONTINUE
   20    CONTINUE
   30 CONTINUE





      RETURN
      END
      SUBROUTINE GVSAOR (VECT1,VECT2,LENGTH)














      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3), LENGTH







      IF (ABS(VECT2(1)).LT.1E-10) THEN
         CALL GVSRT0 (VECT1,3)
         VECT1(1)=LENGTH
         GOTO 998
      END IF
      IF (ABS(VECT2(2)).LT.1E-10) THEN
         CALL GVSRT0 (VECT1,3)
         VECT1(2)=LENGTH
         GOTO 998
      END IF
      IF (ABS(VECT2(3)).LT.1E-10) THEN
         CALL GVSRT0 (VECT1,3)
         VECT1(3)=LENGTH
         GOTO 998
      END IF



      VECT1(1)=1.0
      VECT1(2)=1.0
      VECT1(3)=(VECT2(1)+VECT2(2))/(-VECT2(3))



      CALL GVSSCV (VECT1,LENGTH)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSAV3 (VECT1,VECT2)










      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3)





      VECT1(1)=VECT1(1)+VECT2(1)
      VECT1(2)=VECT1(2)+VECT2(2)
      VECT1(3)=VECT1(3)+VECT2(3)





      RETURN
      END
      SUBROUTINE GVSAVN (VECT1,VECT2,NUM)











      IMPLICIT      NONE
      INTEGER       I, NUM
      REAL          VECT1(NUM), VECT2(NUM)





      IF (NUM.GT.0) THEN



         DO 10 I=1,NUM
            VECT1(I)=VECT1(I)+VECT2(I)
   10    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD52')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD53',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSBV3 (VECT1,VECT2,VECT3)











      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3), VECT3(3)





      VECT1(1)=VECT2(1)+VECT3(1)
      VECT1(2)=VECT2(2)+VECT3(2)
      VECT1(3)=VECT2(3)+VECT3(3)





      RETURN
      END
      SUBROUTINE GVSCP3 (VECT1,VECT2,VECT3)













      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3), VECT3(3)





      VECT1(1) = VECT2(2)*VECT3(3) - VECT2(3)*VECT3(2)
      VECT1(2) = VECT2(3)*VECT3(1) - VECT2(1)*VECT3(3)
      VECT1(3) = VECT2(1)*VECT3(2) - VECT2(2)*VECT3(1)





      RETURN
      END
      SUBROUTINE GVSEIG (A,R,N,MV)












      IMPLICIT      NONE
      INTEGER       N, J,IQ, L, M, LQ, LM, IND, MM, MV, I, IJ, MQ, LL,
     +              IA, ILQ, IMQ, IM, IL, ILR, IMR
      REAL          A(6), R(9), RANGE, ANORM, ANRMX, THR, X, Y, SINX,
     +              SINX2, COSX, COSX2, SINCS





      RANGE=1.E-6

      IF (MV.NE.1) THEN
         IQ=-N
         DO 20 J=1,N
            IQ=IQ+N
            DO 10 I=1,N
               IJ=IQ+I
               R(IJ)=0.0
               IF (I.EQ.J) R(IJ)=1.0
   10       CONTINUE
   20    CONTINUE
      END IF



      ANORM=0.0
      DO 40 I=1,N-1
         DO 30 J=I+1,N
            IA=I+(J*J-J)/2
            ANORM=ANORM+A(IA)**2
   30    CONTINUE
   40 CONTINUE
      IF (ANORM.LE.0.0) GOTO 998
      ANORM=SQRT(2.0*ANORM)
      ANRMX=ANORM*RANGE/N



      IND=0
      THR=ANORM
   50 CONTINUE
      THR=THR/N
   60 CONTINUE
      L=1
   70 CONTINUE
      M=L+1



   80 CONTINUE
      MQ=(M*M-M)/2
      LQ=(L*L-L)/2
      LM=L+MQ
      IF (ABS(A(LM)).LT.THR) GOTO 160
      IND=1
      LL=L+LQ
      MM=M+MQ
      X=0.5*(A(LL)-A(MM))
      Y=(-A(LM))/SQRT(A(LM)**2+X*X)
      IF (X.LT.0.0) Y=-Y
      SINX=Y/SQRT(2.0*(1.0+(SQRT(1.0-Y*Y))))
      SINX2=SINX**2
      COSX=SQRT(1.0-SINX2)
      COSX2=COSX**2
      SINCS=SINX*COSX



      ILQ=N*(L-1)
      IMQ=N*(M-1)
      DO 150 I=1,N
         IQ=(I*I-I)/2
         IF (I.NE.L.AND.I.NE.M) THEN
            IF (I.LT.M) THEN
               IM=I+MQ
            ELSE
              IM=M+IQ
            END IF
            IF (I.LT.L) THEN
               IL=I+LQ
            ELSE
               IL=L+IQ
            END IF
            X=A(IL)*COSX-A(IM)*SINX
            A(IM)=A(IL)*SINX+A(IM)*COSX
            A(IL)=X
         END IF
         IF (MV.NE.1) THEN
            ILR=ILQ+I
            IMR=IMQ+I
            X=R(ILR)*COSX-R(IMR)*SINX
            R(IMR)=R(ILR)*SINX+R(IMR)*COSX
            R(ILR)=X
         END IF
  150 CONTINUE

      X=2.0*A(LM)*SINCS
      Y=A(LL)*COSX2+A(MM)*SINX2-X
      X=A(LL)*SINX2+A(MM)*COSX2+X
      A(LM)=(A(LL)-A(MM))*SINCS+A(LM)*(COSX2-SINX2)
      A(LL)=Y
      A(MM)=X



  160 CONTINUE
      IF (M.NE.N) THEN
         M=M+1
         GOTO 80
      END IF

      IF (L.NE.(N-1))THEN
         L=L+1
         GOTO 70
      END IF

      IF (IND.EQ.1) THEN
         IND=0
         GOTO 60
      END IF

      IF (THR.GT.ANRMX) GOTO 50



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMI2 (RMAT1,RMAT2,NUM,IERR)















      IMPLICIT      NONE
      INTEGER       NUM, IERR
      REAL          RMAT2(NUM,NUM), RMAT1(NUM,NUM)







      CALL GVSCPR (RMAT1,RMAT2,NUM*NUM)
      CALL GVSMIV (RMAT1,NUM,IERR)





      RETURN
      END
      SUBROUTINE GVSMIV (A,NP,IERR)

















      IMPLICIT      NONE
      INTEGER       IPIV(6), INDXR(6), INDXC(6), NP, N, I,
     +              J, K, ICOL, L, IROW, LL, IERR
      REAL          A(NP,NP), BIG, DUM, PIVINV







      IROW=0
      ICOL=0
      IERR=0
      N=NP
      DO 11 J=1,N
         IPIV(J)=0
11    CONTINUE



      DO 22 I=1,N
         BIG=0.0
         DO 13 J=1,N
            IF(IPIV(J).NE.1)THEN
               DO 12 K=1,N
                  IF (IPIV(K).EQ.0) THEN
                     IF (ABS(A(J,K)).GE.BIG) THEN
                        BIG=ABS(A(J,K))
                        IROW=J
                        ICOL=K
                     END IF
                  ELSE IF (IPIV(K).GT.1) THEN
                     CALL GVSTTE ('?TLSD66')
                     IERR=1
                     GOTO 998
                  END IF
12             CONTINUE
            ENDIF
13       CONTINUE
         IPIV(ICOL)=IPIV(ICOL)+1
         IF (IROW.NE.ICOL) THEN
            DO 14 L=1,N
               DUM=A(IROW,L)
               A(IROW,L)=A(ICOL,L)
               A(ICOL,L)=DUM
 14         CONTINUE
         END IF
         INDXR(I)=IROW
         INDXC(I)=ICOL
         IF (A(ICOL,ICOL).EQ.0.) THEN
             CALL GVSTTE ('?TLSD66')
             IERR=1
             GOTO 998
          END IF
         PIVINV=1.0/A(ICOL,ICOL)
         A(ICOL,ICOL)=1.
         DO 16 L=1,N
            A(ICOL,L)=A(ICOL,L)*PIVINV
16       CONTINUE
         DO 21 LL=1,N
            IF (LL.NE.ICOL) THEN
               DUM=A(LL,ICOL)
               A(LL,ICOL)=0.
               DO 18 L=1,N
                  A(LL,L)=A(LL,L)-A(ICOL,L)*DUM
18             CONTINUE
            END IF
21       CONTINUE
22    CONTINUE
      DO 24 L=N,1,-1
         IF (INDXR(L).NE.INDXC(L)) THEN
            DO 23 K=1,N
               DUM=A(K,INDXR(L))
               A(K,INDXR(L))=A(K,INDXC(L))
               A(K,INDXC(L))=DUM
23          CONTINUE
         END IF
24    CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMPV (VECT1,RMAT,VECT2)













      IMPLICIT      NONE
      REAL          RMAT(3,3), VECT1(3), VECT2(3), TVEC(3)





      TVEC(1)=VECT2(1)+RMAT(1,1)*VECT1(1)+
     +                 RMAT(1,2)*VECT1(2)+
     +                 RMAT(1,3)*VECT1(3)
      TVEC(2)=VECT2(2)+RMAT(2,1)*VECT1(1)+
     +                 RMAT(2,2)*VECT1(2)+
     +                 RMAT(2,3)*VECT1(3)
      TVEC(3)=VECT2(3)+RMAT(3,1)*VECT1(1)+
     +                 RMAT(3,2)*VECT1(2)+
     +                 RMAT(3,3)*VECT1(3)

      VECT1(1)=TVEC(1)
      VECT1(2)=TVEC(2)
      VECT1(3)=TVEC(3)





      RETURN
      END
      SUBROUTINE GVSMGM (RMAT,VECT,ANGLE)












      IMPLICIT      NONE
      REAL          VECT(3), RMAT(3,3), LVECT(3), ANGLE







      CALL GVSCPR (LVECT,VECT,3)
      CALL GVSNM3 (LVECT)



      RMAT(1,1)=COS(ANGLE) + LVECT(1)**2 * (1.0-COS(ANGLE))
      RMAT(2,2)=COS(ANGLE) + LVECT(2)**2 * (1.0-COS(ANGLE))
      RMAT(3,3)=COS(ANGLE) + LVECT(3)**2 * (1.0-COS(ANGLE))
      RMAT(1,2)=LVECT(1)*LVECT(2)*(1.0-COS(ANGLE))-LVECT(3)*SIN(ANGLE)
      RMAT(1,3)=LVECT(1)*LVECT(3)*(1.0-COS(ANGLE))+LVECT(2)*SIN(ANGLE)
      RMAT(2,1)=LVECT(2)*LVECT(1)*(1.0-COS(ANGLE))+LVECT(3)*SIN(ANGLE)
      RMAT(2,3)=LVECT(2)*LVECT(3)*(1.0-COS(ANGLE))-LVECT(1)*SIN(ANGLE)
      RMAT(3,1)=LVECT(3)*LVECT(1)*(1.0-COS(ANGLE))-LVECT(2)*SIN(ANGLE)
      RMAT(3,2)=LVECT(3)*LVECT(2)*(1.0-COS(ANGLE))+LVECT(1)*SIN(ANGLE)





      RETURN
      END
      SUBROUTINE GVSMTA (RMAT,ANGLES)















      IMPLICIT      NONE
      REAL          RMAT(3,3), ANGLES(3), SINX,SINZ, COSX,COSY,COSZ







      IF (ABS(RMAT(1,3)).GT.0.99999) THEN



         CALL GVSTTE ('?TLSD67')
         ANGLES(1)=0.0
         ANGLES(2)=ASIN(-RMAT(1,3))
         ANGLES(3)=0.0
         GOTO 998
      ELSE



         ANGLES(2)=ASIN(-RMAT(1,3))
         COSY=COS(ANGLES(2))
      END IF



      SINX=(-RMAT(2,3))/COSY
      COSX=RMAT(3,3)/COSY
      ANGLES(1)=ATAN2(SINX,COSX)



      COSZ=RMAT(1,1)/COSY
      SINZ=RMAT(1,2)/COSY
      ANGLES(3)=ATAN2(SINZ,COSZ)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMTM (RMAT1,RMAT2,NUM)












      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          RMAT1(NUM*NUM), RMAT2(NUM*NUM)





      IF (NUM.GT.0) THEN



         DO 10 I=1,NUM*NUM
            RMAT1(I)=RMAT2(I)
   10    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD54')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD55',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMTU (RMAT,NUM)










      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          RMAT(NUM,NUM)





      IF (NUM.GT.0) THEN



         CALL GVSRT0 (RMAT,NUM*NUM)
         DO 10 I=1,NUM
            RMAT(I,I) = 1.0
   10    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD56')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD57',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMV3 (VECT1,RMAT,VECT2)













      IMPLICIT      NONE
      REAL          RMAT(3,3), VECT1(3), VECT2(3)





      VECT1(1)=RMAT(1,1)*VECT2(1)+RMAT(1,2)*VECT2(2)+RMAT(1,3)*VECT2(3)
      VECT1(2)=RMAT(2,1)*VECT2(1)+RMAT(2,2)*VECT2(2)+RMAT(2,3)*VECT2(3)
      VECT1(3)=RMAT(3,1)*VECT2(1)+RMAT(3,2)*VECT2(2)+RMAT(3,3)*VECT2(3)





      RETURN
      END
      SUBROUTINE GVSMVN (VECT1,RMAT,VECT2,NUM,DIM)













      IMPLICIT      NONE
      INTEGER       NUM, I, J, DIM
      REAL          RMAT(DIM,DIM), VECT1(DIM), VECT2(DIM)





      IF (NUM.GT.0) THEN



         DO 20 I=1,NUM
            VECT1(I)=0.0
            DO 10 J=1,NUM
               VECT1(I)=VECT1(I)+RMAT(I,J)*VECT2(J)
   10       CONTINUE
   20    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD58')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD59',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMVP (VECT1,RMAT,VECT2)















      IMPLICIT      NONE
      INTEGER       J, I, IERR
      REAL          RMAT(3,3), RINV(3,3), VECT1(3), VECT2(3), TVEC(3),
     +              GVFDET







      IF (ABS(GVFDET(RMAT)).LT.0.001) THEN
         CALL GVSTTE ('?TLSD66')
         CALL GVSKIL
         GOTO 998
      ELSE
         CALL GVSMI2 (RINV,RMAT,3,IERR)
         IF (IERR.NE.0) GOTO 998
      END IF



      CALL GVSTV3 (TVEC,VECT1,VECT2)
      CALL GVSRT0 (VECT1,3)
      DO 20 I=1,3
         DO 10 J=1,3
            VECT1(I)=VECT1(I)+RINV(I,J)*TVEC(J)
   10    CONTINUE
   20 CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSMVV (VECT,RMAT)












      IMPLICIT      NONE
      INTEGER       J, I
      REAL          RMAT(3,3), VECT(3), TEMP(3)







      CALL GVSCPR (TEMP,VECT,3)



      DO 20 I=1,3
         VECT(I)=0.0
         DO 10 J=1,3
            VECT(I)=VECT(I)+RMAT(I,J)*TEMP(J)
   10    CONTINUE
   20 CONTINUE





      RETURN
      END
      SUBROUTINE GVSMXM (RMAT,ANGLE)









      IMPLICIT      NONE
      REAL          RMAT(3,3), ANGLE





      RMAT(1,1) = 1.0
      RMAT(1,2) = 0.0
      RMAT(1,3) = 0.0
      RMAT(2,1) = 0.0
      RMAT(2,2) = COS(ANGLE)
      RMAT(2,3) = -SIN(ANGLE)
      RMAT(3,1) = 0.0
      RMAT(3,2) = SIN(ANGLE)
      RMAT(3,3) = COS(ANGLE)





      RETURN
      END
      SUBROUTINE GVSMYM (RMAT,ANGLE)









      IMPLICIT      NONE
      REAL          RMAT(3,3), ANGLE





      RMAT(1,1) = COS(ANGLE)
      RMAT(1,2) = 0.0
      RMAT(1,3) = SIN(ANGLE)
      RMAT(2,1) = 0.0
      RMAT(2,2) = 1.0
      RMAT(2,3) = 0.0
      RMAT(3,1) = -SIN(ANGLE)
      RMAT(3,2) = 0.0
      RMAT(3,3) = COS(ANGLE)





      RETURN
      END
      SUBROUTINE GVSMZM (RMAT,ANGLE)









      IMPLICIT      NONE
      REAL          RMAT(3,3), ANGLE





      RMAT(1,1) = COS(ANGLE)
      RMAT(1,2) = -SIN(ANGLE)
      RMAT(1,3) = 0.0
      RMAT(2,1) = SIN(ANGLE)
      RMAT(2,2) = COS(ANGLE)
      RMAT(2,3) = 0.0
      RMAT(3,1) = 0.0
      RMAT(3,2) = 0.0
      RMAT(3,3) = 1.0





      RETURN
      END
      SUBROUTINE GVSNM3 (VECT)











      IMPLICIT      NONE
      INTEGER       I
      REAL          VECT(3), VECLEN







      VECLEN=SQRT(VECT(1)**2+VECT(2)**2+VECT(3)**2)



      IF (VECLEN.LT.1E-15) GOTO 998



      DO 10 I=1,3
         VECT(I)=VECT(I)/VECLEN
10    CONTINUE



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSNMN (VECT,NUM)












      IMPLICIT      NONE
      INTEGER       NUM, I
      REAL          VECT(NUM), VECLEN





      IF (NUM.GT.0) THEN



         VECLEN=0.0



         DO 10 I=1,NUM
            VECLEN=VECLEN+VECT(I)**2
   10    CONTINUE
         VECLEN=SQRT(VECLEN)



         IF (VECLEN .LT. 1E-15) THEN
            CALL GVSTTE ('?TLSD68')
            GOTO 998
         END IF



         DO 20 I=1,NUM
            VECT(I)=VECT(I)/VECLEN
20       CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD60')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD61',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSNRV (VNORM,VECT1,VECT2,VECT3)











      IMPLICIT      NONE
      REAL          VNORM(3), VECT1(3), VECT2(3), VECT3(3),
     +              SVEC1(3), SVEC2(3), GVFLNV







      CALL GVSRT0 (VNORM,3)



      CALL GVSTV3 (SVEC1,VECT1,VECT2)
      CALL GVSTV3 (SVEC2,VECT1,VECT3)



      CALL GVSCP3 (VNORM,SVEC1,SVEC2)



      IF (GVFLNV(VNORM).GT.1E-15) CALL GVSNM3 (VNORM)





      RETURN
      END
      SUBROUTINE GVSNX3 (RMAT1,RMAT2)












      IMPLICIT      NONE
      INTEGER       I, J, K
      REAL          RMAT1(3,3), RMAT2(3,3), RMAT3(3,3)







      DO 30 I=1,3
         DO 20 J=1,3
            RMAT3(I,J)=0.0
            DO 10 K=1,3
               RMAT3(I,J)=RMAT3(I,J)+RMAT1(I,K)*RMAT2(K,J)
   10       CONTINUE
   20    CONTINUE
   30 CONTINUE



      CALL GVSMTM (RMAT1,RMAT3,3)





      RETURN
      END
      SUBROUTINE GVSNXN (RMAT1,RMAT2,RMAT3,NUM)













      IMPLICIT      NONE
      INTEGER       NUM, I, J, K
      REAL          RMAT1(NUM,NUM), RMAT2(NUM,NUM), RMAT3(NUM,NUM)





      IF (NUM.GT.0) THEN



         DO 30 I=1,NUM
            DO 20 J=1,NUM
               RMAT1(I,J)=0.0
               DO 10 K=1,NUM
                  RMAT1(I,J)=RMAT1(I,J)+RMAT2(I,K)*RMAT3(K,J)
   10          CONTINUE
   20       CONTINUE
   30    CONTINUE
         GOTO 998
      ELSE IF (NUM.EQ.0) THEN



         CALL GVSTTB ('?TLSD62')
         GOTO 998
      ELSE IF (NUM.LT.0) THEN



         CALL GVSTTI ('?TLSD63',NUM)
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSREN (RMAT)














      IMPLICIT      NONE
      INTEGER       I, J, K, L
      REAL          A(6), RMAT(3,3), S(3,3), T(3,3), X(3,3), Y







      L=0
      DO 30 I=1,3
         DO 20 J=1,I
            L=L+1
            A(L)=0.0
            DO 10 K=1,3
               A(L)=A(L)+RMAT(I,K)*RMAT(J,K)
   10       CONTINUE
   20    CONTINUE
   30 CONTINUE



      CALL GVSEIG (A,X,3,0)



      A(1)=1.0/SQRT(AMAX1(A(1),1.E-12))
      A(2)=1.0/SQRT(AMAX1(A(3),1.E-12))
      A(3)=1.0/SQRT(AMAX1(A(6),1.E-12))



      DO 50 I=1,3
         DO 40 J=1,3
            S(I,J)=X(I,J)*A(J)
   40    CONTINUE
   50 CONTINUE



      DO 70 I=2,3
         DO 60 J=1,I-1
            Y=X(I,J)
            X(I,J)=X(J,I)
            X(J,I)=Y
   60    CONTINUE
   70 CONTINUE



      CALL GVS3X3 (T,X,RMAT)
      CALL GVS3X3 (RMAT,S,T)





      RETURN
      END
      SUBROUTINE GVSRRV (V1,V2,V3,ANGLE,WORKM,WORKV)







      IMPLICIT      NONE
      REAL          V1(3), V2(3), V3(3), WORKM(3,3), WORKV(3), 
     +              ANGLE, GVFDTR







      CALL GVSMGM (WORKM,V2,GVFDTR(ANGLE))



      CALL GVSTV3 (WORKV,V1,V3)
      CALL GVSMVV (WORKV,WORKM)
      CALL GVSBV3 (V1,WORKV,V3)





      RETURN
      END
      SUBROUTINE GVSSCV (VECT,LENGTH)













      IMPLICIT      NONE
      INTEGER       I
      REAL          VECT(3), LENGTH







      CALL GVSNM3 (VECT)



      DO 10 I=1,3
         VECT(I)=VECT(I)*ABS(LENGTH)
   10 CONTINUE





      RETURN
      END
      SUBROUTINE GVSSV3 (VECT1,VECT2)











      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3)





      VECT1(1)=VECT1(1)-VECT2(1)
      VECT1(2)=VECT1(2)-VECT2(2)
      VECT1(3)=VECT1(3)-VECT2(3)





      RETURN
      END
      SUBROUTINE GVSTP2 (RMAT1,RMAT2,NUM)












      IMPLICIT      NONE
      INTEGER       NUM, I1, I2
      REAL          RMAT1(NUM,NUM), RMAT2(NUM,NUM)





      IF (NUM.GT.1) THEN



         DO 20 I1=1,NUM
            DO 10 I2=1,NUM
               RMAT1(I1,I2)=RMAT2(I2,I1)
   10       CONTINUE
   20    CONTINUE
         GOTO 998
      ELSE IF (NUM.LE.1) THEN



         CALL GVSTTB ('?TLSD64')
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSTPS (RMAT,NUM)












      IMPLICIT      NONE
      INTEGER       NUM, I1, I2
      REAL          RMAT(NUM,NUM)





      IF (NUM.GT.1) THEN



         DO 20 I1=2,NUM
            DO 10 I2=1,I1-1
               CALL GVSWAP (RMAT(I1,I2),RMAT(I2,I1))
   10       CONTINUE
   20    CONTINUE
         GOTO 998
      ELSE IF (NUM.LE.1) THEN



         CALL GVSTTB ('?TLSD65')
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSTV3 (VECT1,VECT2,VECT3)











      IMPLICIT      NONE
      REAL          VECT1(3), VECT2(3), VECT3(3)





      VECT1(1)=VECT2(1)-VECT3(1)
      VECT1(2)=VECT2(2)-VECT3(2)
      VECT1(3)=VECT2(3)-VECT3(3)






      RETURN
      END
      SUBROUTINE GVSWVC (NUMUNT,TEXT,VECT)










      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      CHARACTER*(*) TEXT
      REAL          VECT(3)
      INTEGER       NUMUNT, GVFLEN, I







      CALL GVSFMT ('?FMT318')
      IF (GVFLEN(TEXT).GE.1) THEN
         WRITE (NUMUNT,FMT,ERR=999)
     +    (TEXT(I:I),I=1,MIN(GVFLEN(TEXT),132))
      END IF



      CALL GVSFMT ('?FMT807')
      WRITE (NUMUNT,FMT,ERR=999) VECT
      GOTO 998



  999 CONTINUE
      CALL GVSTTI ('?TLSD69',NUMUNT)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE GVSEIG2 (NDIMENSIONS,MATRIX,E_VALUE,E_VECTOR)



















      IMPLICIT      NONE
      REAL          FOURTHIRDS, HALF, THIRD, QUARTER,
     +              SIXTH, NINTH, TWENTYSEVENTH, RT3O2
      PARAMETER     (FOURTHIRDS     = 1.3333333)
      PARAMETER     (HALF           = 0.5)
      PARAMETER     (THIRD          = 0.3333333)
      PARAMETER     (QUARTER        = 0.25)
      PARAMETER     (SIXTH          = 0.1666667)
      PARAMETER     (NINTH          = 0.1111111)
      PARAMETER     (TWENTYSEVENTH  = 0.03703704)
      PARAMETER     (RT3O2          = 0.86602540)
      REAL          A,B,C,D,E,F,G,H,J,K,L,N,P,Q,R,S,T,U,W,X,Y
      INTEGER       I, NDIMENSIONS, O
      COMPLEX       V,Z

      REAL          MATRIX(NDIMENSIONS,NDIMENSIONS)
      REAL          E_VALUE(NDIMENSIONS)
      REAL          E_VECTOR(NDIMENSIONS,NDIMENSIONS)





      DO 20 I=1,NDIMENSIONS
         DO 10 O=1,NDIMENSIONS
            E_VECTOR(O,I) = 0.0
   10    CONTINUE
   20 CONTINUE
      IF (NDIMENSIONS .EQ. 1) THEN
         E_VALUE(1) = MATRIX(1,1)
         E_VECTOR(1,1) = 1.0
      ELSE IF (NDIMENSIONS .EQ. 2) THEN
         A = MATRIX(1,1)
         B = MATRIX(2,2)
         C = HALF*(MATRIX(1,2)+MATRIX(2,1))
         S = HALF*(A + B)
         T = HALF*(A - B)
         Y = SQRT( MAX( 0.0, T**2 + C**2 ) )
         E_VALUE(1) = S + Y
         E_VALUE(2) = S - Y
         IF (T .GE. 0.0) THEN
            E_VECTOR(1,1) = Y + T
            E_VECTOR(2,1) =  C
            E_VECTOR(1,2) = -C
            E_VECTOR(2,2) = Y + T
         ELSE
            E_VECTOR(1,1) =   C
            E_VECTOR(2,1) = Y - T
            E_VECTOR(1,2) = Y - T
            E_VECTOR(2,2) = - C
         END IF
      ELSE IF (NDIMENSIONS .EQ. 3) THEN
         A = MATRIX(1,1)
         B = MATRIX(2,2)
         C = MATRIX(3,3)
         D = HALF*(MATRIX(3,2)+MATRIX(2,3))
         E = HALF*(MATRIX(1,3)+MATRIX(3,1))
         F = HALF*(MATRIX(2,1)+MATRIX(1,2))
         S = A + B + C
         X = A*B + A*C + B*C - D**2 - E**2 - F**2
         U = HALF * ( A*B*C - A*D**2 - B*E**2 - C*F**2 ) + D*E*F +
     +    TWENTYSEVENTH * (S**3) - SIXTH * (S*X)
         Q = NINTH * (S**2) - THIRD*X
         V = CMPLX( U, SQRT( MAX( 0.0, Q**3 - U**2 ) ) )
         IF (V .NE. CMPLX(0.0,0.0)) THEN
            V = V**THIRD
            Z = - (Q / V)
         ELSE
            Z = CMPLX(0.0,0.0)
         END IF
         W = REAL(V-Z)
         Y = AIMAG(V+Z) * RT3O2
         N = THIRD * S
         E_VALUE(1) = N + W
         E_VALUE(2) = N - HALF*W + Y
         E_VALUE(3) = N - HALF*W - Y
         IF ( E_VALUE(1) .NE. E_VALUE(2) .AND.
     +       E_VALUE(2) .NE. E_VALUE(3) .AND.
     +       E_VALUE(3) .NE. E_VALUE(1) ) THEN
            DO 30 I=1,NDIMENSIONS,1
               X = E_VALUE(I)
               E_VECTOR(1,I) = + B*C - D**2 - B*X - C*X + X**2
     +          + D*E - C*F + F*X
     +          - B*E + D*F + E*X
               E_VECTOR(2,I) = + D*E - C*F + F*X
     +          + A*C - E**2 - A*X - C*X + X**2
     +          - A*D + E*F + D*X
               E_VECTOR(3,I) = - (B*E) + D*F + E*X
     +          - A*D + E*F + D*X
     +          + A*B - F**2 - A*X - B*X + X**2
   30       CONTINUE
         ELSE
            IF (E_VALUE(2) .EQ. E_VALUE(3)) THEN
               I = 1
            ELSE IF (E_VALUE(3) .EQ. E_VALUE(1)) THEN
               I = 2
            ELSE IF (E_VALUE(1) .EQ. E_VALUE(2)) THEN
               I = 3
            ELSE
               I = 0
            END IF
            IF (I .NE. 0) THEN
               X = E_VALUE(I)
               E_VECTOR(1,I) = + B*C - D**2 - B*X - C*X + X**2
     +          + D*E - C*F + F*X
     +          - B*E + D*F + E*X
               E_VECTOR(2,I) = + D*E - C*F + F*X
     +          + A*C - E**2 - A*X - C*X + X**2
     +          - A*D + E*F + D*X
               E_VECTOR(3,I) = - (B*E) + D*F + E*X
     +          - A*D + E*F + D*X
     +          + A*B - F**2 - A*X - B*X + X**2
            END IF
         END IF
      ELSE IF (NDIMENSIONS .EQ. 4) THEN
         A = MATRIX(1,1)
         B = MATRIX(2,2)
         C = MATRIX(3,3)
         D = MATRIX(4,4)
         E = HALF*(MATRIX(3,4)+MATRIX(4,3))
         F = HALF*(MATRIX(2,4)+MATRIX(4,2))
         G = HALF*(MATRIX(1,4)+MATRIX(4,1))
         H = HALF*(MATRIX(1,3)+MATRIX(3,1))
         J = HALF*(MATRIX(1,2)+MATRIX(2,1))
         K = HALF*(MATRIX(2,3)+MATRIX(3,2))
         U = A*B*C*D - A*B*E**2 - A*C*F**2 - B*C*G**2 + 2*B*E*G*H -
     +    B*D*H**2 + F**2*H**2 + 2*C*F*G*J - 2*E*F*H*J - C*D*J**2 +
     +    E**2*J**2 + 2*A*E*F*K - 2*F*G*H*K - 2*E*G*J*K + 2*D*H*J*K -
     +    A*D*K**2 + G**2*K**2
         T = - (A*B*C) - A*B*D - A*C*D - B*C*D + A*E**2 + B*E**2 +
     +    A*F**2 + C*F**2 + B*G**2 + C*G**2 - 2*E*G*H + B*H**2 +
     +    D*H**2 - 2*F*G*J + C*J**2 + D*J**2 - 2*E*F*K - 2*H*J*K +
     +    A*K**2 + D*K**2
         S = + A*B + A*C + B*C + A*D + B*D + C*D -
     +    E**2 - F**2 - G**2 - H**2 - J**2 - K**2
         R = - (A + B + C + D)
         W = - (QUARTER * R)
         Q = FOURTHIRDS * ( W*T + U )
         N = TWENTYSEVENTH*S**3 - 2.0*S*U + HALF*(S*Q + T**2 + U*R**2)
         P = NINTH * S**2 + Q
         Z = CMPLX( N, SQRT( P**3 - N**2 ) )
         IF (Z .NE. CMPLX(0.0,0.0)) THEN
            Z = Z**THIRD
            L = HALF*REAL( THIRD*S + P/Z + Z )
            X = SQRT( L**2 - U )
            Y = ( W*L + QUARTER*T ) / X
         ELSE
            L = 0.0
            X = 0.0
            Y = W
         END IF
         E_VALUE(1) = W + Y + SQRT( (Y+W)**2 - L - X )
         E_VALUE(2) = W + Y - SQRT( (Y+W)**2 - L - X )
         E_VALUE(3) = W - Y + SQRT( (Y-W)**2 - L + X )
         E_VALUE(4) = W - Y - SQRT( (Y-W)**2 - L + X )
         CALL GVSTTB ('?TLSD70')
      ELSE IF (NDIMENSIONS .GT. 4) THEN
         CALL GVSTT6 ('?TLSD71')
      END IF
      DO 40 I=1,NDIMENSIONS
         CALL MODULUS (NDIMENSIONS,E_VECTOR(1,I),E_VECTOR(1,I))
         E_VALUE(I) = MAX( 0.0, E_VALUE(I) )
   40 CONTINUE





      RETURN
      END
      SUBROUTINE GVSMMS (MATRIX,NUM,DIM)

















      IMPLICIT      NONE
      INTEGER       NUM, DIM, I, J
      REAL          MATRIX(DIM,DIM)
      LOGICAL       UPPER, LOWER







      IF (NUM.GT.DIM) THEN
         CALL GVSTTB ('?M2579')
         GOTO 998
      END IF



      UPPER=.FALSE.
      LOWER=.FALSE.




      DO 20 I=2,NUM
         DO 10 J=1,I-1
            IF (ABS(MATRIX(I,J)).GT.0.0001) THEN
               GOTO 21
            END IF
 10      CONTINUE
 20   CONTINUE
      UPPER=.TRUE.
 21   CONTINUE
      DO 40 I=2,NUM
         DO 30 J=1,I-1
            IF (ABS(MATRIX(J,I)).GT.0.0001) THEN
               GOTO 41
            END IF
 30      CONTINUE
 40   CONTINUE
      LOWER=.TRUE.
 41   CONTINUE



      IF (UPPER.AND.(.NOT.LOWER)) THEN
         DO 60 I=2,NUM
            DO 50 J=1,I-1
               MATRIX(I,J)=MATRIX(J,I)
 50         CONTINUE
 60      CONTINUE
      ELSE IF (LOWER.AND.(.NOT.UPPER)) THEN
         DO 80 I=2,NUM
            DO 70 J=1,I-1
               MATRIX(J,I)=MATRIX(I,J)
 70         CONTINUE
 80      CONTINUE
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE GVSSVC (A,M,N,MP,NP,W,V)


















      IMPLICIT      NONE
      INTEGER       N, M, NP, MP, NMAX, I, L, K, J, ITS, NM
      PARAMETER     (NMAX=200)
      REAL          SCALE, G, ANORM, S, H, F, C, X, Y, Z
      REAL          A(MP,NP), W(NP), V(NP,NP), RV1(NMAX)







      L=0
      NM=0
      G=0.0
      SCALE=0.0
      ANORM=0.0



      DO 100 I=1,N
         L=I+1
         RV1(I)=SCALE*G
         G=0.0
         S=0.0
         SCALE=0.0
         IF (I.LE.M) THEN
            DO 10 K=I,M
               SCALE=SCALE+ABS(A(K,I))
   10       CONTINUE
            IF (SCALE.NE.0.0) THEN
               DO 20 K=I,M
                  A(K,I)=A(K,I)/SCALE
                  S=S+A(K,I)*A(K,I)
   20          CONTINUE
               F=A(I,I)
               G=-SIGN(SQRT(S),F)
               H=F*G-S
               A(I,I)=F-G
               IF (I.NE.N) THEN
                  DO 35 J=L,N
                     S=0.0
                     DO 25 K=I,M
                        S=S+A(K,I)*A(K,J)
   25                CONTINUE
                     F=S/H
                     DO 30 K=I,M
                        A(K,J)=A(K,J)+F*A(K,I)
   30                CONTINUE
   35             CONTINUE
               ENDIF
               DO 40 K= I,M
                  A(K,I)=SCALE*A(K,I)
   40          CONTINUE
            ENDIF
         ENDIF
         W(I)=SCALE*G
         G=0.0
         S=0.0
         SCALE=0.0
         IF ((I.LE.M).AND.(I.NE.N)) THEN
            DO 45 K=L,N
               SCALE=SCALE+ABS(A(I,K))
   45       CONTINUE
            IF (SCALE.NE.0.0) THEN
               DO 50 K=L,N
                  A(I,K)=A(I,K)/SCALE
                  S=S+A(I,K)*A(I,K)
   50          CONTINUE
               F=A(I,L)
               G=-SIGN(SQRT(S),F)
               H=F*G-S
               A(I,L)=F-G
               DO 55 K=L,N
                  RV1(K)=A(I,K)/H
   55          CONTINUE
               IF (I.NE.M) THEN
                  DO 70 J=L,M
                     S=0.0
                     DO 60 K=L,N
                        S=S+A(J,K)*A(I,K)
   60                CONTINUE
                     DO 65 K=L,N
                        A(J,K)=A(J,K)+S*RV1(K)
   65                CONTINUE
   70             CONTINUE
               ENDIF
               DO 75 K=L,N
                  A(I,K)=SCALE*A(I,K)
   75          CONTINUE
            ENDIF
         END IF
         ANORM=MAX(ANORM,(ABS(W(I))+ABS(RV1(I))))
  100 CONTINUE



      DO 200 I=N,1,-1
         IF (I.LT.N) THEN
            IF (G.NE.0.0) THEN
               DO 110 J=L,N
                  V(J,I)=(A(I,J)/A(I,L))/G
  110          CONTINUE
               DO 140 J=L,N
                  S=0.0
                  DO 120 K=L,N
                     S=S+A(I,K)*V(K,J)
  120             CONTINUE
                  DO 130 K=L,N
                     V(K,J)=V(K,J)+S*V(K,I)
  130             CONTINUE
  140          CONTINUE
            ENDIF
            DO 150 J=L,N
               V(I,J)=0.0
               V(J,I)=0.0
  150       CONTINUE
         END IF
         V(I,I)=1.0
         G=RV1(I)
         L=I
  200 CONTINUE



      DO 300 I=N,1,-1
         L=I+1
         G=W(I)
         IF (I.LT.N) THEN
            DO 210 J=L,N
               A(I,J)=0.0
  210       CONTINUE
         ENDIF
         IF (G.NE.0.0) THEN
            G=1.0/G
            IF (I.NE.N) THEN
               DO 240 J=L,N
                  S=0.0
                  DO 220 K=L,M
                     S=S+A(K,I)*A(K,J)
  220             CONTINUE
                  F=(S/A(I,I))*G
                  DO 230 K=I,M
                     A(K,J)=A(K,J)+F*A(K,I)
  230             CONTINUE
  240          CONTINUE
            ENDIF
            DO 250 J=I,M
               A(J,I)=A(J,I)*G
  250       CONTINUE
         ELSE
            DO 260 J= I,M
               A(J,I)=0.0
  260       CONTINUE
         ENDIF
         A(I,I)=A(I,I)+1.0
  300 CONTINUE



      DO 400 K=N,1,-1
         DO 390 ITS=1,30
            DO 310 L=K,1,-1
               NM=L-1
               IF ((ABS(RV1(L))+ANORM).EQ.ANORM)  GO TO 2
               IF ((ABS(W(NM))+ANORM).EQ.ANORM)  GO TO 1
  310       CONTINUE
    1       C=0.0
            S=1.0
            DO 330 I=L,K
               F=S*RV1(I)
               IF ((ABS(F)+ANORM).NE.ANORM) THEN
                  G=W(I)
                  H=SQRT(F*F+G*G)
                  W(I)=H
                  H=1.0/H
                  C= (G*H)
                  S=-(F*H)
                  DO 320 J=1,M
                     Y=A(J,NM)
                     Z=A(J,I)
                     A(J,NM)=(Y*C)+(Z*S)
                     A(J,I)=-(Y*S)+(Z*C)
  320             CONTINUE
               ENDIF
  330       CONTINUE
    2       Z=W(K)
            IF (L.EQ.K) THEN
               IF (Z.LT.0.0) THEN
                  W(K)=-Z
                  DO 340 J=1,N
                     V(J,K)=-V(J,K)
  340             CONTINUE
               ENDIF
               GOTO 3
            ENDIF
            IF (ITS.EQ.30) RETURN
            X=W(L)
            NM=K-1
            Y=W(NM)
            G=RV1(NM)
            H=RV1(K)
            F=((Y-Z)*(Y+Z)+(G-H)*(G+H))/(2.0*H*Y)
            G=SQRT(F*F+1.0)
            F=((X-Z)*(X+Z)+H*((Y/(F+SIGN(G,F)))-H))/X
            C=1.0
            S=1.0
            DO 360 J=L,NM
               I=J+1
               G=RV1(I)
               Y=W(I)
               H=S*G
               G=C*G
               Z=SQRT(F*F+H*H)
               RV1(J)=Z
               C=F/Z
               S=H/Z
               F= (X*C)+(G*S)
               G=-(X*S)+(G*C)
               H=Y*S
               Y=Y*C
               DO 350 NM=1,N
                  X=V(NM,J)
                  Z=V(NM,I)
                  V(NM,J)= (X*C)+(Z*S)
                  V(NM,I)=-(X*S)+(Z*C)
  350          CONTINUE
               Z=SQRT(F*F+H*H)
               W(J)=Z
               IF (Z.NE.0.0) THEN
                  Z=1.0/Z
                  C=F*Z
                  S=H*Z
               ENDIF
               F= (C*G)+(S*Y)
               X=-(S*G)+(C*Y)
               DO 355 NM=1,M
                  Y=A(NM,J)
                  Z=A(NM,I)
                  A(NM,J)= (Y*C)+(Z*S)
                  A(NM,I)=-(Y*S)+(Z*C)
  355          CONTINUE
  360       CONTINUE
            RV1(L)=0.0
            RV1(K)=F
            W(K)=X
  390    CONTINUE
    3    CONTINUE
  400 CONTINUE





      RETURN
      END
      SUBROUTINE GVSKSB (U,W,V,M,N,MP,NP,B,X)

















      IMPLICIT      NONE
      INTEGER       NMAX, J, N, M, NP, MP, I, JJ
      PARAMETER     (NMAX=100)
      REAL          U(MP,NP), W(NP), V(NP,NP), B(MP), X(NP), 
     +              TMP(NMAX), S





      DO 20 J=1,N
         S=0.0
         IF (W(J).GT.0.000001)THEN
            DO 10 I=1,M
               S=S+U(I,J)*B(I)
   10       CONTINUE
            S=S/W(J)
         END IF
         TMP(J)=S
   20 CONTINUE
      DO 40 J=1,N
         S=0.0
         DO 30 JJ=1,N
            S=S+V(J,JJ)*TMP(JJ)
   30    CONTINUE
         X(J)=S
   40 CONTINUE





      RETURN
      END
