



      SUBROUTINE WIF650 (DONE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'OPTION.INC'
      LOGICAL       DONE






      RETURN
      END

      SUBROUTINE WIF664

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SUPPOS.INC'







      CALL GVSIT0 (IRNG1,MAXAA)
      CALL GVSRT0 (XRNG1,3*MAXAA)
      CALL GVSIT0 (IRNG2,MAXAA)
      CALL GVSRT0 (XRNG2,3*MAXAA)





      RETURN
      END

      SUBROUTINE WIF671 (IAA1,JAA1,LEN1,IAA2,JAA2,LEN2,QRMS,QMAX)





















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SUPPOS.INC'
      INTEGER       IAA1, JAA1, LEN1, IAA2, JAA2, LEN2, I,
     +              IAA, JAA, IUSE, J
      LOGICAL       GVFIBN
      REAL          RMAT(3,3), TVEC(3), QRMS, QMAX







      IF (LEN1.EQ.0.OR.LEN2.EQ.0) THEN
         CALL GVSTTB ('?SUPB28')
         GOTO 998
      END IF



      DO 10 I=1,LEN1
         IAA=IAA1+I-1
         JAA=JAA1+I-1
         XYZ1(1,I)=XCOORD(PNTAAC(IAA))
         XYZ1(2,I)=YCOORD(PNTAAC(IAA))
         XYZ1(3,I)=ZCOORD(PNTAAC(IAA))
         XYZ2(1,I)=XCOORD(PNTAAC(JAA))
         XYZ2(2,I)=YCOORD(PNTAAC(JAA))
         XYZ2(3,I)=ZCOORD(PNTAAC(JAA))
   10 CONTINUE



      IUSE=0
      DO 20 I=1,LEN2
         IAA=IAA2+I-1
         IF (.NOT.GVFIBN(IAA,IAA1,IAA2)) GOTO 20
         IUSE=IUSE+1
         JAA=JAA2+I-1
         J=IUSE+LEN1
         XYZ1(1,J)=XCOORD(PNTAAC(IAA))
         XYZ1(2,J)=YCOORD(PNTAAC(IAA))
         XYZ1(3,J)=ZCOORD(PNTAAC(IAA))
         XYZ2(1,J)=XCOORD(PNTAAC(JAA))
         XYZ2(2,J)=YCOORD(PNTAAC(JAA))
         XYZ2(3,J)=ZCOORD(PNTAAC(JAA))
   20 CONTINUE




      CALL GVSSPN (LEN1+IUSE,XYZ1,XYZ2,RMAT,TVEC,QRMS,QMAX)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE WIF676 (IFT1,IFT2,JFT1,JFT2)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, JFT1, JFT2
      LOGICAL       WIFIRR







   10 CONTINUE
      CALL WIFGRN (IFT1,IFT2,'?SUP017')
      IF (IFT1.EQ.0) GOTO 998



      IF ((.NOT.WIFIRR(IFT1)).OR.(.NOT.WIFIRR(IFT2))) THEN
         CALL GVSTTE ('?RNGNPN')
         GOTO 10
      END IF
      IF (IFT2-IFT1.LT.2*WIFPAR(81)-1) THEN
         CALL GVSTTI ('?SUPB31',2*WIFPAR(81))
         GOTO 10
      END IF



   20 CONTINUE
      CALL WIFGRN (JFT1,JFT2,'?SUP018')
      IF (JFT1.EQ.0) THEN
         IFT1=0
         GOTO 998
      END IF



      IF ((.NOT.WIFIRR(JFT1)).OR.(.NOT.WIFIRR(JFT2))) THEN
         CALL GVSTTE ('?RNGNPN')
         GOTO 20
      END IF
      IF (JFT2-JFT1.LT.2*WIFPAR(81)-1) THEN
         CALL GVSTTI ('?SUPB31',2*WIFPAR(81))
         GOTO 20
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF680

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SUPPOS.INC'
      INTEGER       IRNG, NUMUSE, ISHIFT, I
      REAL          GVFRTD, X2OLD(3,MAXAA), ANGLES(3), X1CEN,
     +              X2CEN, X3CEN, Y1CEN, Y2CEN, Y3CEN, QRMS
      EQUIVALENCE   (X2OLD(1,1),ESPACE(100001))







      CALL ESPSET (100001,100000+3*MAXAA,37)



      IF (IRNG1(3).EQ.0.OR.IRNG2(3).EQ.0) THEN
         CALL GVSTTE ('?>3AT')
         GOTO 998
      END IF



      DO 20 IRNG=1,MAXAA
         IF (IRNG2(IRNG).EQ.0) THEN
            IF (IRNG1(IRNG).EQ.0) THEN
               NUMUSE=IRNG-1
               GOTO 21
            END IF
            DO 10 ISHIFT=IRNG,MAXAA-1
               IRNG1(ISHIFT)=IRNG1(ISHIFT+1)
               IRNG2(ISHIFT)=IRNG2(ISHIFT+1)
               XRNG1(1,ISHIFT)=XRNG1(1,ISHIFT+1)
               XRNG1(2,ISHIFT)=XRNG1(2,ISHIFT+1)
               XRNG1(3,ISHIFT)=XRNG1(3,ISHIFT+1)
               XRNG2(1,ISHIFT)=XRNG2(1,ISHIFT+1)
               XRNG2(2,ISHIFT)=XRNG2(2,ISHIFT+1)
               XRNG2(3,ISHIFT)=XRNG2(3,ISHIFT+1)
   10       CONTINUE
         END IF
   20 CONTINUE



   21 CONTINUE
      X1CEN=0.0
      X2CEN=0.0
      X3CEN=0.0
      Y1CEN=0.0
      Y2CEN=0.0
      Y3CEN=0.0
      DO 23 I=1,NUMUSE
         X1CEN=X1CEN+XRNG1(1,I)
         X2CEN=X2CEN+XRNG1(2,I)
         X3CEN=X3CEN+XRNG1(3,I)
         Y1CEN=Y1CEN+XRNG2(1,I)
         Y2CEN=Y2CEN+XRNG2(2,I)
         Y3CEN=Y3CEN+XRNG2(3,I)
   23 CONTINUE
      DO 25 I=1,NUMUSE
         XRNG1(1,I)=XRNG1(1,I)-X1CEN/NUMUSE
         XRNG1(2,I)=XRNG1(2,I)-X2CEN/NUMUSE
         XRNG1(3,I)=XRNG1(3,I)-X3CEN/NUMUSE
         XRNG2(1,I)=XRNG2(1,I)-Y1CEN/NUMUSE
         XRNG2(2,I)=XRNG2(2,I)-Y2CEN/NUMUSE
         XRNG2(3,I)=XRNG2(3,I)-Y3CEN/NUMUSE
   25 CONTINUE



      CALL GVSTTI ('?ANAUSA',NUMUSE)



      CALL GVSCPR (X2OLD,XRNG2,3*NUMUSE)



      CALL GVSSUP (NUMUSE,XRNG1,XRNG2,SUPMAT,SUPVEC,QRMS)



      CALL GVSCPR (XRNG2,X2OLD,3*NUMUSE)



      CALL GVSTTR ('?SUP011',QRMS)



      SUPVEC(1)=SUPVEC(1)+X1CEN/NUMUSE-Y1CEN/NUMUSE
      SUPVEC(2)=SUPVEC(2)+X2CEN/NUMUSE-Y2CEN/NUMUSE
      SUPVEC(3)=SUPVEC(3)+X3CEN/NUMUSE-Y3CEN/NUMUSE



      CALL GVSMTA (SUPMAT,ANGLES)
      CALL GVSTTR ('?SUP019',GVFRTD(ANGLES(1)))
      CALL GVSTTR ('?SUP020',GVFRTD(ANGLES(2)))
      CALL GVSTTR ('?SUP021',GVFRTD(ANGLES(3)))



      DO 40 I=1,NUMUSE
         XRNG1(1,I)=XRNG1(1,I)+X1CEN/NUMUSE
         XRNG1(2,I)=XRNG1(2,I)+X2CEN/NUMUSE
         XRNG1(3,I)=XRNG1(3,I)+X3CEN/NUMUSE
         XRNG2(1,I)=XRNG2(1,I)+Y1CEN/NUMUSE
         XRNG2(2,I)=XRNG2(2,I)+Y2CEN/NUMUSE
         XRNG2(3,I)=XRNG2(3,I)+Y3CEN/NUMUSE
   40 CONTINUE



      CALL ESPKIL (100001,100000+3*MAXAA,37,'WIF680')



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SUPINI



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SUPPOS.INC'







      NUMSUP=0
      CALL GVSMTU (SUPMAT,3)
      CALL GVSRT0 (SUPVEC,3)
      CALL GVSIT0 (INDSUP,MAXSUP)
      CALL GVSCTB (SUPNAM,MAXSUP*80)





      RETURN
      END
      SUBROUTINE SUP3SP

















      IMPLICIT      NONE
      INCLUDE       'DATBAS.INC'







      CALL GVSRT0 (MAT3SP,3*3*MAXSEQ)
      CALL GVSRT0 (VEC3SP,3*MAXSEQ)
      CALL GVSIT0 (ADM3SP,5*MAXSEQ)





      RETURN
      END   
