



      SUBROUTINE SOUSYM





















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, IAA, OLDAAT, LOCAAF, NOWAAF, INUM, 
     +              GVFCBT, IERR, ORGAAT, ORGAAF
      REAL          GVFLNV
      LOGICAL       GVFIMU







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      ORGAAT=NUMAAT
      ORGAAF=NUMAAF



      INUM=GVFCBT(WRK1TF,NUMAAT)

      IF (NUMAAT+INUM*(NUMSYM-1).GT.MAXAA) THEN
         CALL GVSTTE ('?SYM054')
         GOTO 998
      END IF



      IF (NUMAAT.LE.NUMAAF) GOTO 110
      INUM=GVFCBT(WRK1TF(NUMAAF+1),NUMAAT-NUMAAF)
      IF (INUM.EQ.0) GOTO 110
      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            CALL GVSTT6 ('?SYM078')
            GOTO 100
         END IF
         CALL GVSTTI ('?SYM055',ISYM)



         OLDAAT=NUMAAT
         DO 30 IAA=ORGAAF+1,ORGAAT
            IF (WRK1TF(IAA)) CALL MOL104A (IAA,IERR)
            IF (IERR.NE.0) GOTO 900
   30    CONTINUE
         CALL WIF092 (OLDAAT+1,NUMAAT,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
  100 CONTINUE







  110 CONTINUE
      IF (NUMAAF.EQ.0) GOTO 998
      INUM=GVFCBT(WRK1TF,NUMAAF)
      IF (INUM.EQ.0) GOTO 998
      CALL KLONKSTART (IERR)
      CALL KLONKUP
      DO 200 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 200
         END IF



         NOWAAF=NUMAAF
         CUTFLG(NOWAAF)=.TRUE.
         DO 40 IAA=1,ORGAAF
            IF (.NOT.WRK1TF(IAA)) GOTO 40
            LOCAAF=NUMAAF
            CALL WIFPUSHPPP (1012,0)
            CALL MOL104 (ONESA3(IAA),NUMNAM(IAA),ONEORG(IAA),
     +       LOCAAF,' ',IERR)
            CALL WIFPOPPPP (1012)
            IF (IERR.NE.0) GOTO 900
            CALL WIF088 (IAA,NUMAAF)
   40    CONTINUE
         CALL WIF092 (NOWAAF+1,NUMAAF,SYMMAT(1,1,ISYM),
     +    SYMVEC(1,ISYM))



  200 CONTINUE
  900 CONTINUE
      CALL KLONKDOWN
      CALL KLONKEND



      CALL MOL220



      SYMHAS=.FALSE.
      WIFPAR(590)=0



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRASYM




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, IAA, IERR
      REAL          GVFLNV
      LOGICAL       GVFIMU







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GRTVIN



      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         DO 80 IAA=1,NUMAAT



            IF (WRK1TF(IAA)) CALL SYMADG (IAA, ISYM)
   80    CONTINUE
  100 CONTINUE



      CALL GRAMOL (' ')



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUBOX



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR
      REAL          BOXMIN(3),BOXMAX(3)







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL SYMGBX (BOXMIN,BOXMAX,IERR)
      IF (IERR.NE.0) GOTO 998



      CALL SYMASP



      CALL SYMPIB (BOXMIN,BOXMAX)



      CALL SYMBOX (BOXMIN,BOXMAX)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRABOX



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR
      REAL          BOXMIN(3), BOXMAX(3)







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL SYMGBX (BOXMIN,BOXMAX,IERR)
      IF (IERR.NE.0) GOTO 998



      CALL SYMASP



      CALL SYMPIB (BOXMIN, BOXMAX)



      CALL SYMBOX1 (BOXMIN, BOXMAX)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUSPH



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       I, GVFFFF
      REAL          BALL(4)







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



 10   CONTINUE
      CALL IPROMPT ('?SYM064')
      CALL GVSRT0 (BALL,4)
      I=GVFFFF(4,BALL)
      IF (I.EQ.1.AND.BALL(1).EQ.0.) GOTO 998
      IF (I.LT.3) THEN
         CALL GVSTT6 ('?SYMXYZ')
         GOTO 10
      END IF
      IF (I.EQ.3) BALL(4)=10.0



      CALL SYMASP



      CALL SYMPIS (BALL)



      CALL SYMSPH (BALL)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRASPH



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       I, GVFFFF
      REAL          BALL(4)
      LOGICAL       GVFYON, SELF







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



 10   CONTINUE
      CALL IPROMPT ('?SYM064')
      CALL GVSRT0 (BALL,4)
      I=GVFFFF(4,BALL)
      IF (I.EQ.1.AND.BALL(1).EQ.0.) GOTO 998
      IF (I.LT.3) THEN
         CALL GVSTT6 ('?SYMXYZ')
         GOTO 10
      END IF
      IF (I.EQ.3) BALL(4)=10.0



      CALL SYMASP



      CALL SYMPIS (BALL)



      SELF=GVFYON('?SYMYN8',' ')
      CALL SYMSPH1 (BALL,SELF)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUSRS



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      REAL          BALL(4), RAD
      INTEGER       I, DIM, IAA, GVFFFF







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL WIFGRS (IAA,' ')
      IF (IAA.EQ.0.) GOTO 998



      CALL IPROMPT ('?SYM065')
      RAD=0
      I=GVFFFF(1,RAD)
      IF (I.EQ.1.AND.RAD.EQ.0.) GOTO 998
      IF (I.EQ.0) THEN
         RAD=10.
      END IF
      BALL(4)=RAD
      DO 30 DIM=1,3
         BALL(DIM)=SPHRAD(DIM,IAA)
 30   CONTINUE



      CALL SYMASP



      CALL SYMPIS (BALL)



      CALL SYMSPH (BALL)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRASRS



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       I, DIM, IAA, GVFFFF
      REAL          BALL(4), RAD
      LOGICAL       SELF, GVFYON







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL WIFGRS (IAA,' ')
      IF (IAA.EQ.0.) GOTO 998



      CALL IPROMPT ('?SYM065')
      RAD=0
      I=GVFFFF(1,RAD)
      IF (I.EQ.1.AND.RAD.EQ.0.) GOTO 998
      IF (I.EQ.0) THEN
         RAD=10.
      END IF
      BALL(4)=RAD
      DO 30 DIM=1,3
         BALL(DIM)=SPHRAD(DIM,IAA)
 30   CONTINUE



      CALL SYMASP



      CALL SYMPIS (BALL)



      SELF=GVFYON('?SYMYN8',' ')
      CALL SYMSPH1 (BALL,SELF)



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUCEL



















      IMPLICIT      NONE







      CALL SYMASP



      CALL SYMPIC



      CALL SOUSYM





      RETURN
      END

      SUBROUTINE GRACEL



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL SYMASP



      CALL SYMPIC



      CALL GRASYM



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUSHL



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL SYMASP



      CALL SYMNEA



      CALL SYMSHS



      CALL MOL200



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRASHL



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL SYMASP



      CALL SYMNEA



      CALL SYMSHS1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE GRAWHL

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCPB (WRK3TF,WRK1TF,MAXAA)



      CALL SYMASP
      CALL SYMSHO (.FALSE.)



      CALL SYMNEA
      CALL SYMSHO (.FALSE.)



      CALL SYMSHS2



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SOUSM1




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, IAA, NUM, GVFFFI, IERR, INUM, NOWAAF, 
     +              LOCAAF, OLDAAT, GVFCBT, ORGAAF, ORGAAT
      REAL          GVFLNV
      LOGICAL       GVFIMU







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



 10   CONTINUE
      CALL IPROMPT ('?SYM021')
      NUM=GVFFFI(1,ISYM)
      IF (NUM.EQ.1.AND.ISYM.EQ.0) GOTO 998
      IF (NUM.EQ.0) THEN
         CALL SHOWTEXT ('?SYMNDF')
         GOTO 10
      END IF
      IF (ISYM.LT.0.OR.ISYM.GT.NUMSYM) THEN
         CALL GVSTTE ('?SYMTOR')
         GOTO 10
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      ORGAAF=NUMAAF
      ORGAAT=NUMAAT



      INUM=GVFCBT(WRK1TF,NUMAAT)
      IF (NUMAAT+INUM.GE.MAXAA) THEN
         CALL GVSTTE ('?SYM054')
         GOTO 998
      END IF



      IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +    GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
         CALL GVSTT6 ('?SYM078')
         GOTO 998
      END IF



      OLDAAT=NUMAAT
      IF (NUMAAT.LE.NUMAAF) GOTO 100
      INUM=GVFCBT(WRK1TF(NUMAAF),NUMAAT-NUMAAF)
      IF (INUM.EQ.0) GOTO 100
      DO 30 IAA=ORGAAF+1,ORGAAT
         IF (.NOT.WRK1TF(IAA)) GOTO 30
         CALL MOL104A (IAA,IERR)
         IF (IERR.NE.0) GOTO 900
   30 CONTINUE
      CALL WIF092 (OLDAAT+1,NUMAAT,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
      CALL MOL200



  100 CONTINUE
      IF (NUMAAF.LE.0) GOTO 998
      INUM=GVFCBT(WRK1TF,NUMAAF)
      IF (INUM.EQ.0) GOTO 998
      CALL KLONKSTART (IERR)
      CALL KLONKUP



      NOWAAF=NUMAAF
      CUTFLG(NOWAAF)=.TRUE.
      DO 40 IAA=1,ORGAAF
         IF (.NOT.WRK1TF(IAA)) GOTO 40
         LOCAAF=NUMAAF
         CALL MOL104 (ONESA3(IAA),NUMNAM(IAA),ONEORG(IAA),
     +    LOCAAF,' ',IERR)
         IF (IERR.NE.0) GOTO 900
         CALL WIF088 (IAA,NUMAAF)
   40 CONTINUE
      CALL WIF092 (NOWAAF+1,NUMAAF,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))



  900 CONTINUE
      CALL KLONKDOWN
      CALL KLONKEND
      CALL MOL200



  998 CONTINUE


      RETURN
      END

      SUBROUTINE GRASM1




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, IAA, NUM, GVFFFI, IERR







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTE ('?SOUEMT')
         GOTO 998
      END IF



 10   CONTINUE
      CALL IPROMPT ('?SYM021')
      NUM=GVFFFI(1,ISYM)
      IF (NUM.EQ.1.AND.ISYM.EQ.0) GOTO 998
      IF (NUM.EQ.0) THEN
         CALL GVSTT6 ('?SYMNDF')
         GOTO 10
      END IF
      IF (ISYM.LT.0.OR.ISYM.GT.NUMSYM) THEN
         CALL GVSTTE ('?SYMTOR')
         GOTO 10
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998



      CALL GRTVIN
      DO 80 IAA=1,NUMAAT



         IF (WRK1TF(IAA)) CALL SYMADG (IAA, ISYM)
 80   CONTINUE



      CALL GRAMOL (' ')



  998 CONTINUE


      RETURN
      END

      SUBROUTINE SYMSHS




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MAXCONTA, IERR
      PARAMETER     (MAXCONTA=8*MAXAA)
      INTEGER       CONTACT(MAXCONTA), CONTACTS(MAXCONTA)
      INTEGER       ISYM, IAA, LASADD, I, J, NCONTA, SAVAAF
      LOGICAL       COMOVE, GVFIMU
      REAL          GVFLNV
      EQUIVALENCE   (CONTACT(1),ESPACE(10001))
      EQUIVALENCE   (CONTACTS(1),ESPACE(10001+4*MAXAA))







      CALL SYMICMP
      SAVAAF=NUMAAF
      CALL KLONKSTART (IERR)
      CALL KLONKUP



      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         CALL SYMCMP (ISYM,CONTACT,CONTACTS,NCONTA,MAXCONTA)



         CALL SYMOVE (ISYM,CONTACT,CONTACTS,NCONTA,COMOVE)
         IF (COMOVE) THEN
            CALL SHOWTEXT ('?SYMCOV')
            GOTO 100
         END IF



         CALL GVSIR1 (CONTACTS,NCONTA)
         IF (NCONTA.LE.0) THEN
            CALL GVSTT6 ('?SYM058')
         ELSE
            J=1
            DO 75 I=2,NCONTA
               IF (CONTACTS(I).NE.CONTACTS(J)) THEN
                  J=J+1
                  CONTACTS(J)=CONTACTS(I)
               END IF
 75         CONTINUE
            NCONTA=J
            CALL GVSTTI ('?SYM059',nconta)
         END IF



         LASADD=0
         DO 90 I=1,NCONTA
            IAA=CONTACTS(I)



            IF (IAA.LE.SAVAAF) THEN
               CALL SYMADR (IAA,ISYM)



               IF (LASADD.EQ.0) THEN
                  CUTFLG(NUMAAF-1)=.TRUE.
               ELSE IF (LASADD.NE.IAA-1) THEN
                  PSTFLG(NUMAAF-1)=.TRUE.
               END IF
               LASADD=IAA
            END IF



            IF (NUMAAT.GT.MAXAA-1000) GOTO 101
   90    CONTINUE



  100 CONTINUE
  101 CONTINUE



      CALL KLONKDOWN
      CALL KLONKEND 
      CALL MOL200





      RETURN
      END

      SUBROUTINE SYMSHS1




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MAXCONTA
      PARAMETER     (MAXCONTA=8*MAXAA)
      INTEGER       CONTACT(MAXCONTA), CONTACTS(MAXCONTA)
      INTEGER       ISYM, IAA, I, J, NCONTA
      LOGICAL       COMOVE, GVFIMU
      REAL          GVFLNV
      EQUIVALENCE   (CONTACT(1),ESPACE(10001))
      EQUIVALENCE   (CONTACTS(1),ESPACE(10001+4*MAXAA))







      CALL SYMICMP



      CALL GRTVIN



      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         CALL SYMCMP (ISYM,CONTACT,CONTACTS,NCONTA,MAXCONTA)



         CALL SYMOVE (ISYM,CONTACT,CONTACTS,NCONTA,COMOVE)
         IF (COMOVE) THEN
            CALL SHOWTEXT ('?SYMCOV')
            GOTO 100
         END IF



         CALL GVSIR1 (CONTACTS,NCONTA)
         IF (NCONTA.LE.0) THEN
            CALL GVSTT6 ('?SYM058')
         ELSE
            J=1
            DO 75 I=2,NCONTA
               IF (CONTACTS(I).NE.CONTACTS(J)) THEN
                  J=J+1
                  CONTACTS(J)=CONTACTS(I)
               END IF
 75         CONTINUE
            NCONTA=J
            CALL GVSTTI ('?SYM059',nconta)
         END IF



         DO 90 I=1,NCONTA
            IAA=CONTACTS(I)



            CALL SYMADG (IAA,ISYM)



   90    CONTINUE



 100  CONTINUE



      CALL GRAMOL (' ')





      RETURN
      END
      SUBROUTINE SYMSHS2

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MAXCONTA
      PARAMETER     (MAXCONTA=8*MAXAA)
      INTEGER       CONTACT(MAXCONTA), CONTACTS(MAXCONTA), ISYM, IAA, 
     +              NCONTA
      REAL          GVFLNV
      LOGICAL       COMOVE, GVFIMU
      EQUIVALENCE   (CONTACT(1),ESPACE(10001))
      EQUIVALENCE   (CONTACTS(1),ESPACE(10001+4*MAXAA))







      CALL SYMICMP



      CALL GRTVIN



      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         CALL SYMCMP (ISYM,CONTACT,CONTACTS,NCONTA,MAXCONTA)



         CALL SYMOVE (ISYM,CONTACT,CONTACTS,NCONTA,COMOVE)
         IF (COMOVE) THEN
            CALL SHOWTEXT ('?SYMCOV')
            GOTO 100
         END IF



         CALL GVSIR1 (CONTACTS,NCONTA)
         IF (NCONTA.LE.0) THEN
            CALL GVSTT6 ('?SYM058')
            GOTO 100
         END IF



         DO 90 IAA=1,NUMAAT
            IF (WRK3TF(IAA)) THEN
               CALL SYMADG (IAA,ISYM)
            END IF
   90    CONTINUE
         CALL GRASAVE



 100  CONTINUE



      CALL GRAMOL (' ')





      RETURN
      END

      SUBROUTINE SYMBOX (BOXMIN,BOXMAX)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       DIM, ISYM, IAA, SAVAAF, LASADD, NUMADD, IERR
      REAL          BOXMIN(3), BOXMAX(3), TMP(3), GVFLNV
      LOGICAL       GVFIMU







      SAVAAF=NUMAAF
      CALL KLONKSTART (IERR)
      CALL KLONKUP
      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF




         LASADD=0
         NUMADD=0
         DO 90 IAA=1,SAVAAF



            TMP(1)=SPHRAD(1,IAA)
            TMP(2)=SPHRAD(2,IAA)
            TMP(3)=SPHRAD(3,IAA)
            CALL GVSMPV (TMP, SYMMAT(1,1,ISYM), SYMVEC(1,ISYM))
            DO 10 DIM=1,3
               IF (TMP(DIM).LT.BOXMIN(DIM).OR.TMP(DIM).GT.BOXMAX(DIM))
     +              GOTO 90
 10         CONTINUE



            CALL SYMADR (IAA,ISYM)



            IF (LASADD.EQ.0) THEN
               CUTFLG(NUMAAF-1)=.TRUE.
            ELSE IF (LASADD.NE.IAA-1) THEN
               PSTFLG(NUMAAF-1)=.TRUE.
            END IF
            LASADD=IAA
            NUMADD=NUMADD+1



 90      CONTINUE
         CALL GVSTTI ('?SYM067',NUMADD)



 100  CONTINUE



      CALL KLONKDOWN
      CALL KLONKEND
      CALL KLONKCLEAN
      CALL MOL200





      RETURN
      END

      SUBROUTINE SYMBOX1 (BOXMIN,BOXMAX)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       DIM, ISYM, IAA
      REAL          BOXMIN(3), BOXMAX(3), TMP(3), GVFLNV
      LOGICAL       GVFIMU







      CALL GRTVIN
      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         DO 90 IAA=1,NUMAAF



            TMP(1)=SPHRAD(1,IAA)
            TMP(2)=SPHRAD(2,IAA)
            TMP(3)=SPHRAD(3,IAA)
            CALL GVSMPV (TMP, SYMMAT(1,1,ISYM), SYMVEC(1,ISYM))
            DO 10 DIM=1,3
               IF (TMP(DIM).LT.BOXMIN(DIM).OR.TMP(DIM).GT.BOXMAX(DIM))
     +          GOTO 90
 10         CONTINUE



            CALL SYMADG (IAA,ISYM)



 90      CONTINUE



 100  CONTINUE



      CALL GRAMOL (' ')





      RETURN
      END

      SUBROUTINE SYMSPH (BALL)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       ISYM, IAA, SAVAAF, LASADD, NUMADD, IERR
      REAL          BALL(4), DST, TMP(3), GVFLNV
      LOGICAL       GVFIMU







      SAVAAF=NUMAAF
      CALL KLONKSTART (IERR)
      CALL KLONKUP
      DO 100 ISYM=1,NUMSYM



         IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +       GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
            GOTO 100
         END IF



         LASADD=0
         NUMADD=0
         DO 90 IAA=1,SAVAAF



            TMP(1)=SPHRAD(1,IAA)
            TMP(2)=SPHRAD(2,IAA)
            TMP(3)=SPHRAD(3,IAA)
            CALL GVSMPV (TMP, SYMMAT(1,1,ISYM), SYMVEC(1,ISYM))
            DST=SQRT((BALL(1)-TMP(1))**2+(BALL(2)-TMP(2))**2+(BALL(3)
     +           -TMP(3))**2)
            IF (DST.GT.BALL(4)) GOTO 90



            CALL SYMADR (IAA,ISYM)



            IF (LASADD.EQ.0) THEN
               CUTFLG(NUMAAF-1)=.TRUE.
            ELSE IF (LASADD.NE.IAA-1) THEN
               PSTFLG(NUMAAF-1)=.TRUE.
            END IF
            LASADD=IAA
            NUMADD=NUMADD+1



 90      CONTINUE
         CALL GVSTTI ('?SYM067',NUMADD)



 100  CONTINUE



      CALL KLONKDOWN
      CALL KLONKEND
      CALL KLONKCLEAN
      CALL MOL200





      RETURN
      END

      SUBROUTINE SYMSPH1 (BALL,SELF)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      REAL          BALL(4), DST, TMP(3), GVFLNV
      INTEGER       ISYM, IAA, SAVAAF, NUMADD
      LOGICAL       SELF, GVFIMU







      CALL GRTVIN



      SAVAAF=NUMAAF
      DO 100 ISYM=1,NUMSYM



         IF (.NOT.SELF) THEN



            IF (GVFIMU(SYMMAT(1,1,ISYM)).AND.
     +           GVFLNV(SYMVEC(1,ISYM)).LT.0.001) THEN
               GOTO 100
            END IF
         END IF
         NUMADD=0
         DO 90 IAA=1,SAVAAF



            TMP(1)=SPHRAD(1,IAA)
            TMP(2)=SPHRAD(2,IAA)
            TMP(3)=SPHRAD(3,IAA)
            CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
            DST=SQRT((BALL(1)-TMP(1))**2+(BALL(2)-TMP(2))**2+(BALL(3)
     +           -TMP(3))**2)
            IF (DST.GT.BALL(4)) GOTO 90



            CALL SYMADG (IAA,ISYM)
            NUMADD=NUMADD+1



 90      CONTINUE
         CALL GVSTTI ('?SYM067',NUMADD)



 100  CONTINUE



      CALL GRAMOL (' ')





      RETURN
      END
