



      SUBROUTINE SYM000 (DONE)


















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







      IF (OPTIN.EQ.MEN6COD(46)) GOTO 998
      CALL MEN028 (OPTIN,DONE)



  998 CONTINUE


      END
      SUBROUTINE CELCKM



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR
      LOGICAL       GVFFOP, GVFISF







      CALL GVSCLF (1)
      CALL GETFILE (1,'?FILNAM',' ',IERR)
      IF (IERR.NE.0) GOTO 998



   40 CONTINUE
      CALL GVSCTB (LINE2,80)



      CALL GETLINE (1,LINE2,IERR)
      IF (IERR.NE.0) GOTO 100
      CALL MOL712 (LINE2)



      IF (.NOT.GVFISF(LINE2)) THEN
         CALL GVST6C ('?SYM011',LINE2,.TRUE.)
         GOTO 40
      END IF



      CALL GVSCLF (11)
      CALL GVSOPF (LINE2,11,'OLD')
      IF (.NOT.GVFFOP(11)) THEN
         CALL GVST6C ('?SYM012',LINE2,.TRUE.)
         GOTO 40
      END IF



      CALL MOL018
      FILNMS(62)=LINE2
      CALL GVST6C ('?SYM013',LINE2,.TRUE.)

         CALL TEXSTORE (LINE2)

      CALL MOL007
      CALL SYMIPG (IERR,' ')
      GOTO 40



  100 CONTINUE
      CALL GVSCLF (11)
      CALL GVSSTX (LINE,'?SYM014')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMCLS (CC,CLASS)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      REAL          CC(6)
      CHARACTER*(*) CLASS
      INTEGER       NO90, NO120, EQA, EQL, I







      NO90=0
      NO120=0
      EQA=0
      EQL=0



      DO 10 I=4,6
         IF (ABS(CC(I)-90.0).LT.0.05) NO90 =NO90 +1
         IF (ABS(CC(I)-120.).LT.0.05) NO120=NO120+1
 10   CONTINUE



      IF (WIFPAR(393).EQ.0) THEN
         IF (ABS(CC(4)-CC(5)).LT.0.05) EQA=EQA+1
         IF (ABS(CC(5)-CC(6)).LT.0.05) EQA=EQA+1
         IF (ABS(CC(4)-CC(6)).LT.0.05) EQA=EQA+1
         IF (ABS(CC(1)-CC(2)).LT.0.05) EQL=EQL+1
         IF (ABS(CC(2)-CC(3)).LT.0.05) EQL=EQL+1
         IF (ABS(CC(1)-CC(3)).LT.0.05) EQL=EQL+1



      ELSE
         IF (ABS(CC(4)-CC(5)).LT.0.0005) EQA=EQA+1
         IF (ABS(CC(5)-CC(6)).LT.0.0005) EQA=EQA+1
         IF (ABS(CC(4)-CC(6)).LT.0.0005) EQA=EQA+1
         IF (ABS(CC(1)-CC(2)).LT.0.0005) EQL=EQL+1
         IF (ABS(CC(2)-CC(3)).LT.0.0005) EQL=EQL+1
         IF (ABS(CC(1)-CC(3)).LT.0.0005) EQL=EQL+1
      END IF

      IF (NO90.EQ.0) THEN
         IF (EQA.EQ.3) THEN
            IF (EQL.EQ.3) THEN
               CALL GVSSTX (CLASS,'?M3359')
            ELSE
               CALL GVSSTX (CLASS,'?M3360')
            END IF
         ELSE
            CALL GVSSTX (CLASS,'?M3360')
         END IF
      ELSE IF (NO90.EQ.2) THEN
         IF (NO120.EQ.1) THEN
            IF (EQL.GT.0) THEN
               CALL GVSSTX (CLASS,'?M3361')
            ELSE
               CALL GVSSTX (CLASS,'?M3362')
            END IF
         ELSE
            CALL GVSSTX (CLASS,'?M3362')
         END IF
      ELSE IF (NO90.EQ.3) THEN
         IF (EQL.EQ.3) THEN
            CALL GVSSTX (CLASS,'?M3363')
         ELSE IF (EQL.EQ.1) THEN
            CALL GVSSTX (CLASS,'?M3364')
         ELSE
            CALL GVSSTX (CLASS,'?M3365')
         END IF
      ELSE
         CALL GVSSTX (CLASS,'?M3360')
      END IF





      RETURN
      END
      SUBROUTINE SYMCLG (NAME,BASENAME,NUMBER,CLASS)




















      IMPLICIT      NONE
      INCLUDE       'SYMDAT.INC'
      CHARACTER*(*) NAME, CLASS, BASENAME
      CHARACTER*12  S1, S2
      INTEGER       I, J, NUMBER







      NUMBER=1
      J=0



      DO 10 I=1, NUMSPC
         IF (NAME.EQ.SPCNMS(I)) THEN 
            J=I
            GOTO 90
         END IF
   10 CONTINUE



      DO 20 I=1, NUMOTH
         IF (NAME.EQ.ONAMS(I)) THEN
            J=I
            GOTO 95
         END IF
   20 CONTINUE



      CALL GVSSTX (S1,NAME)
      CALL GVSTCP (S1)
      DO 40 I=1, NUMSPC
         CALL GVSSTX (S2,SPCNMS(I))
         CALL GVSTCP (S2)
         IF (S1.EQ.S2) THEN
            J=I
            GOTO 90
         END IF
   40 CONTINUE



      DO 50 I=1, NUMOTH
         CALL GVSSTX (S2,ONAMS(I))
         CALL GVSTCP (S2)
         IF (S1.EQ.S2) THEN
            J=I
            GOTO 95
         END IF
   50 CONTINUE



      CALL GVSSTX (CLASS,'?M3366')
      NUMBER=0
      CALL GVSSTX (BASENAME,'?M3366')
      GOTO 998



   90 CONTINUE
      CALL GVSSTX (NAME,SPCNMS(J))
      CALL GVSSTX (BASENAME,NAME)
      NUMBER=SPCNUS(J)
      CALL GVSSTX (CLASS,SPCCSS(J))
      GOTO 998



   95 CONTINUE
      NAME=ONAMS(J)
      NUMBER=J
      DO 30 I=1, NUMSPC
         IF (SPCNUS(I).EQ.ONUMS(NUMBER)) J=I
   30 CONTINUE
      CALL GVSSTX (BASENAME,SPCNMS(J))
      CALL GVSSTX (CLASS,SPCCSS(J))



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMRES




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       I, J, IERR
      LOGICAL       ISFRAC, GVFFOP, GVFYON, GVFISF
      REAL          DET, GVFDET







   10 CONTINUE
      CALL IPROMPT ('?SYM016')
      CALL NEEDWORD (LINE,' ',IERR)
      IF (IERR.NE.0) GOTO 998



      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTTE ('?SYM017')
         GOTO 10
      END IF



      CALL GVSCLF (11)
      CALL GVSOPF (LINE,11,'OLD')
      IF (.NOT.GVFFOP(11)) THEN
         CALL GVSTTE ('?SYM018')
         GOTO 998
      ENDIF
      ISFRAC=GVFYON('?SYMYN1',' ')



      NUMSYM=0
   20 CONTINUE
      NUMSYM=NUMSYM+1
      SYMNAM(NUMSYM)=0
      CALL GVSFMT ('?FMT1091')
      READ (11,FMT,END=30,ERR=40) ((SYMMAT(I,J,NUMSYM),J=1,3),I=1,3),
     + (SYMVEC(I,NUMSYM),I=1,3)
      DET=GVFDET(SYMMAT(1,1,NUMSYM))
      IF (ABS(DET-1.).GT.0.002) THEN
         CALL GVSTT6 ('?SYMDN1')
         CALL RHSWMV (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM))
         IF (GVFYON('?SYMYN2',' ')) THEN
            NUMSYM=NUMSYM-1
            GOTO 20
         END IF
      END IF
      IF (ISFRAC) THEN
         SYMSTS(NUMSYM)=SYMSTATFILEF
         CALL SYMF2O (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM))
      ELSE
         SYMSTS(NUMSYM)=SYMSTATFILEO
      END IF
      GOTO 20



   30 CONTINUE
      NUMSYM=NUMSYM-1
      CALL GVSTTI ('?SYM019',NUMSYM)
      GOTO 998



   40 CONTINUE
      NUMSYM=NUMSYM-1
      CALL GVSTTE ('?SYM020')
      CALL GVSTTI ('?SYM019',NUMSYM)



  998 CONTINUE
      CALL GVSCLF (11)


      RETURN
      END
      SUBROUTINE SYMINI



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'







      IF (WIFPAR(592).GT.0) THEN
         CALL GVSTT6 ('?M0303')

         GOTO 998
      END IF



      IF (NUMSYM.LE.0) THEN
         CALL GVSIT0 (SYMSTS,MAXSYM)
         CALL GVSRT0 (SYMMAT,3*3*MAXSYM)
         CALL GVSRT0 (SYMVEC,3*MAXSYM)
         CALL GVSIT0 (SYMNIN,MAXSYM)
      ELSE
         CALL GVSIT0 (SYMSTS,NUMSYM)
         CALL GVSRT0 (SYMMAT,3*3*NUMSYM)
         CALL GVSRT0 (SYMVEC,3*NUMSYM)
         CALL GVSIT0 (SYMNIN,NUMSYM)
      END IF
      NEADST=-1000.0
      SYMMAT(1,1,1)=1.0
      SYMMAT(2,2,1)=1.0
      SYMMAT(3,3,1)=1.0
      SYMNIN(1)=1
      SYMNAM(1)=1555
      NUMSYM=1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMIPG (IERR,TEXT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       IERR, GVFLEN
      CHARACTER*(*) TEXT







      IERR=0



      CALL SYMINI



      CALL SYMSPG (IERR)



      IF (IERR.NE.0) THEN
         IF (GVFLEN(TEXT).NE.0) THEN
            CALL GVSTT6 (TEXT)
         ELSE
            CALL GVSTT6 ('?SYMCANNOT')
         END IF
      END IF





      RETURN
      END   
      SUBROUTINE SYMDEL



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INTEGER       I, NUM, GVFFFI





 10   CONTINUE
      CALL IPROMPT ('?SYM021')
      NUM=GVFFFI(1,I)
      IF (NUM.EQ.1.AND.I.EQ.0) GOTO 20
      IF (NUM.EQ.0) GOTO 10
      IF (I.LT.0.OR.I.GT.NUMSYM) THEN
         CALL GVSTTE ('?SYMTOR')
      ELSE IF (I.EQ.1) THEN
         CALL GVSTTE ('?NEWE888')
      ELSE
         SYMSTS(I)=SYMSTAT_DELETED
      ENDIF
      GOTO 10



 20   CONTINUE
      CALL MATDFL





      RETURN
      END
      SUBROUTINE MATDFL



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       I, J





      IF (WIFPAR(592).GT.0) GOTO 998



      NEADST=-1000.0
      J=0
      DO 10 I=1,NUMSYM
         IF (SYMSTS(I).NE.SYMSTAT_DELETED) THEN
            J=J+1
            IF (J.LT.I) THEN
               IF (SYMNIN(I).GT.0) THEN
                  SYMNIN(SYMNIN(I))=J
               END IF
               CALL GVSMTM (SYMMAT(1,1,J), SYMMAT(1,1,I), 3)
               CALL GVSCPR (SYMVEC(1,J), SYMVEC(1,I), 3)
               SYMSTS(J)=SYMSTS(I)
               SYMNAM(J)=SYMNAM(I)
            END IF
         ELSE
            IF (SYMNIN(I).GT.0) SYMNIN(SYMNIN(I))=0
         END IF
 10   CONTINUE
      DO 20 I=J+1,NUMSYM
         SYMSTS(I)=SYMSTAT_UNDEF
 20   CONTINUE
      NUMSYM=J



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMSAV






















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       I, J, K, IERR
      LOGICAL       ISFRAC, GVFFOP, GVFYON, GVFISF
      REAL          VEC_1(3), MAT(3,3)







   10 CONTINUE
      CALL IPROMPT ('?SYM016')
      CALL NEEDWORD (LINE,' ',IERR)
      IF (IERR.EQ.1) GOTO 998



      IF (GVFISF(LINE)) THEN
         IF (GVFYON('?SYMYN3',' ')) THEN
            CALL GVSDEL (LINE)
         ELSE
            GOTO 10
         END IF
      END IF



      CALL GVSCLF (11)
      CALL GVSOPF (LINE,11,'NEW')
      IF (.NOT.GVFFOP(11)) THEN
         CALL GVSTTE ('?SYM018')
         GOTO 998
      ENDIF
      ISFRAC=GVFYON('?SYMYN4',' ')



      CALL GVSFMT ('?FMT1092')
      DO 20 K=1,NUMSYM
         IF (ISFRAC) THEN
            CALL SYMO2F (SYMMAT(1,1,K),SYMVEC(1,K),MAT,VEC_1)
            WRITE (11,FMT,ERR=999) ((MAT(I,J),J=1,3),I=1,3),
     +       (VEC_1(I),I=1,3)
         ELSE
            WRITE (11,FMT,ERR=999) ((SYMMAT(I,J,K),J=1,3),I=1,3),
     +       (SYMVEC(I,K),I=1,3)
         END IF
 20   CONTINUE
      GOTO 998



 999  CONTINUE
      CALL GVSTTE ('?SYM023')



  998 CONTINUE
      CALL GVSCLF (11)


      RETURN
      END
      SUBROUTINE SYMSHO (ASKIT)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       FRC, I, GVFLEN
      REAL          ANG, DOT, DET, VEC_1(3), VEC_2(3), MAT1(3,3),
     +              GVFDP3, GVFRTD, GVFDET, GVFGTA
      LOGICAL       FRAC, GVFYON, ASKIT
      CHARACTER*80  LIN, DIR








      IF (ASKIT) THEN
         FRAC=GVFYON('?SYMYN5',' ')
      ELSE
         FRAC=.TRUE.
      END IF



      DO 20 I=1,NUMSYM
         CALL GVSTTI ('?SYM024',I)
         IF (FRAC) THEN
            CALL SYMO2F (SYMMAT(1,1,I), SYMVEC(1,I), MAT1, VEC_1)
         ELSE
            CALL GVSCPR (MAT1, SYMMAT(1,1,I), 9)
            CALL GVSCPR (VEC_1, SYMVEC(1,I), 3)
         END IF



         DET = GVFDET(MAT1)
         IF (ABS(DET-1.).GT.0.002) THEN
            CALL GVSTTR ('?SYM025',DET)
            GOTO 10
         END IF
         IF (.NOT.FRAC) GOTO 10
         ANG=GVFRTD(GVFGTA(MAT1))
         IF (ANG.LT.1.0) THEN
            CALL GVSTT6 ('?SYM026')
            GOTO 10
         END IF
         FRC=NINT(360./ANG)
         IF (ABS(FRC*ANG-360.).GT.1.0) THEN



            CALL GVSFMT ('?SYMFMT3')
            WRITE (LIN,FMT,ERR=999) ANG
            CALL GVSTT6 (LIN)
            CALL MATFAX (MAT1,VEC_2)
            CALL GVSFMT ('?SYMFMT6')
            WRITE (LIN,FMT,ERR=999) VEC_2
            CALL GVSTT6 (LIN)
            GOTO 10
         END IF



         CALL MATFAX (MAT1,VEC_2)

         IF (ABS(ABS(VEC_2(1))-1.).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM027')
         ELSE IF (ABS(ABS(VEC_2(2))-1.).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM028')
         ELSE IF (ABS(ABS(VEC_2(3))-1.).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM029')
         ELSE IF (ABS(ABS(VEC_2(1))-0.707).LT.0.001.AND.
     +            ABS(ABS(VEC_2(2))-0.707).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM030')
         ELSE IF (ABS(ABS(VEC_2(1))-0.707).LT.0.001.AND.
     +            ABS(ABS(VEC_2(3))-0.707).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM031')
         ELSE IF (ABS(ABS(VEC_2(2))-0.707).LT.0.001.AND.
     +            ABS(ABS(VEC_2(3))-0.707).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM032')
         ELSE IF (ABS(ABS(VEC_2(2))-0.577).LT.0.001.AND.
     +            ABS(ABS(VEC_2(3))-0.577).LT.0.001.AND.
     +            ABS(ABS(VEC_2(1))-0.577).LT.0.001) THEN
            CALL GVSSTX (DIR,'?SYM033')
         ELSE
            CALL GVSFMT ('?SYMFMT4')
            WRITE (LIN,FMT,ERR=999) FRC,VEC_2
            CALL GVSTT6 (LIN)
            GOTO 10
         END IF
         IF (.NOT.FRAC) THEN
            CALL GVSFMT ('?SYMFMT5')
            WRITE(LIN,FMT,ERR=999) FRC,DIR(1:GVFLEN(DIR))
            CALL GVSTT6 (LIN)
            GOTO 10
         END IF



         DOT=GVFDP3(VEC_2,VEC_1)
         DOT=MOD(DOT+100.0,1.0)

         IF (ABS(DOT).LT.0.001) THEN



            CALL GVSFMT ('?SYMFMT1')
            WRITE(LIN,FMT,ERR=999) FRC,DIR(1:GVFLEN(DIR))
            CALL GVSTT6 (LIN)
            GOTO 10
         END IF



         CALL GVSFMT ('?SYMFMT7')
         WRITE (LIN,FMT,ERR=999) FRC,DIR(1:GVFLEN(DIR))
         CALL GVSTT6 (LIN)
   10    CONTINUE
         CALL GVSFMT ('?SYMFMT8')
         WRITE (LIN,FMT,ERR=999) SYMNAM(I)
         IF (SYMNAM(I).GT.0) CALL GVSTT6 (LIN)
         CALL RHSWMV (MAT1,VEC_1)
   20 CONTINUE
      GOTO 998



 999  CONTINUE
      CALL GVSEIW ('SYMSHO')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMPNI (IERR)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      REAL          ANG, DET, MAT1(3,3), VEC_1(3), GVFGTA, GVFDET,
     +              GVFRTD
      INTEGER       FRC, I, IERR





      IERR=0
      DO 20 I=1,NUMSYM
         CALL SYMO2F (SYMMAT(1,1,I), SYMVEC(1,I), MAT1, VEC_1)
         DET = GVFDET(MAT1)



         IF (ABS(DET-1.).GT.0.002) THEN
            CALL GVSFMT ('?SYMFMT11')
            WRITE(LINE,FMT,ERR=999) I
            CALL GVSTT6 (LINE)
            IF (IERR.LT.2) IERR=2
            GOTO 20
         END IF



         ANG=GVFRTD(GVFGTA(MAT1))
         IF (ANG.EQ.0) GOTO 20
         FRC=NINT(360./ANG)
         IF (ABS(FRC*ANG-360.).GT.1.) THEN
            CALL GVSFMT ('?SYMFMT12')
            WRITE(LINE,FMT,ERR=999) I
            CALL GVSTT6 (LINE)
            IF (IERR.LT.1) IERR=1
         END IF
 20   CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('SYMPNI')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMRDU (IERR)





















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       ISYM, JSYM, STS, IERR







      IF (WIFPAR(592).GT.0) THEN
         CALL GVSTT6 ('?M0305')
         GOTO 998
      END IF
      IERR=0
      DO 20 ISYM=2,NUMSYM
         DO 10 JSYM=1,ISYM-1
            IF (SYMSTS(JSYM).NE.SYMSTAT_DELETED) THEN



               CALL MATCMP (STS, SYMMAT(1,1,ISYM),
     +              SYMMAT(1,1,JSYM), 0.001)
               IF (STS.EQ.0) THEN



                  CALL VECCMP (STS,SYMVEC(1,ISYM),SYMVEC(1,JSYM))
                  IF (STS.EQ.1) THEN
                     CALL GVSFMT ('?SYMFMT22')
                     WRITE (LINE,FMT,ERR=999) ISYM,JSYM
                     CALL GVSTT6 (LINE)
                     IERR=1
                  END IF
               END IF
               IF (STS.EQ.0) THEN
                  CALL GVSFMT ('?SYMFMT21')
                  WRITE (LINE,FMT,ERR=999) ISYM,JSYM
                  CALL GVSTT6 (LINE)
                  SYMSTS(ISYM)=SYMSTAT_DELETED
                  GOTO 20
               END IF
            END IF
 10      CONTINUE
 20   CONTINUE



      CALL MATDFL
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('SYMRDU')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMINP



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      LOGICAL       FRAC, GVFYON, GVFIMU
      REAL          DET, GVFDET, GVFLNV
      INTEGER       IERR





      IF (NUMSYM.GE.MAXSYM) THEN
         CALL GVSTTE ('?SYM034')
         GOTO 998
      END IF
      FRAC=GVFYON('?SYMYN6',' ')
 10   CONTINUE
      NUMSYM=NUMSYM+1
      SYMNAM(NUMSYM)=0
      IF (FRAC) THEN
         SYMSTS(NUMSYM)=SYMSTATUSERF
      ELSE
         SYMSTS(NUMSYM)=SYMSTATUSERO
      END IF
      CALL GVSMTI (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM),IERR)
      IF (IERR.NE.0) THEN
         NUMSYM=NUMSYM-1
         GOTO 998
      END IF
      IF (FRAC) CALL SYMF2O (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM))
      IF (GVFIMU(SYMMAT(1,1,NUMSYM)).AND.
     +    GVFLNV(SYMVEC(1,NUMSYM)).LT.0.001) THEN
         CALL GVSTT6 ('?SYMUNI')
         GOTO 10
      END IF
      DET=GVFDET(SYMMAT(1,1,NUMSYM))
      IF (ABS(DET+1.).LT.0.002) THEN
         CALL GVSTT6 ('?SYMMIR')
      ELSE IF (ABS(DET-1.).GT.0.002) THEN
         CALL GVSTT6 ('?SYMDN1')
         IF (.NOT.GVFYON('?SYMYN7',' ')) NUMSYM=NUMSYM-1
      END IF
      GOTO 10



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMSPG (IERR)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       I, J, IERR, UNT, NUMREAD, GVFLEN
      REAL          GVFLNV, GVFDET, DET, TMPVEC(3)
      LOGICAL       GVFFOP, GVFIMU
      CHARACTER*80  FILNAM
      CHARACTER*132 BUFFER







      IERR=0



      CALL GVSCCC (FILNAM,WHERIS,'SPCSYM.DAT')
      CALL GVSROF (UNT,IERR)
      IF (IERR.NE.0) GOTO 996
      CALL GVSOPF (FILNAM,UNT,'OLD')
      IF (.NOT.GVFFOP(UNT)) THEN
         CALL GVSTTE ('?SYM035')
         GOTO 996
      END IF
      NUMREAD=0



      CALL GVSFMT ('?FMT027A')
 10   CONTINUE
         READ (UNT,FMT,ERR=999,END=998) LINE
      IF (LINE(2:13).NE.SPCNAM) GOTO 10



 20   CONTINUE
      CALL GVSFMT ('?FMT027A')
      READ (UNT,FMT,ERR=999,END=100) BUFFER



      IF (BUFFER(2:2).GE.'A'.AND.BUFFER(2:2).LE.'Z') GOTO 100
      IF (GVFLEN(BUFFER).LE.0) GOTO 100



      IF (BUFFER(1:1).EQ.'!') GOTO 20



      IF (NUMSYM.GE.MAXSYM) THEN
         CALL GVSTTE ('?SYM036')
         CALL GVSCLF (UNT)
         IERR=1
         GOTO 996
      END IF
      NUMSYM=NUMSYM+1
      NUMREAD=NUMREAD+1
      SYMNAM(NUMSYM)=555+1000*NUMREAD
      CALL GVSFMT ('?FMT1338')
      READ (BUFFER,FMT,ERR=997) ((SYMMAT(I,J,NUMSYM),J=1,3),I=1,3),
     + (SYMVEC(I,NUMSYM),I=1,3)



      DET=GVFDET(SYMMAT(1,1,NUMSYM))
      IF (ABS(DET-1.).GT.0.002) THEN
         CALL GVSTTB ('?SYM037')
         CALL GVSWM3 (SYMMAT(1,1,NUMSYM))
      END IF



      DO 18 I=1,3
         IF (ABS(SYMVEC(I,NUMSYM)-0.1667).LT.0.001) THEN
            SYMVEC(I,NUMSYM)=1.0/6.0
         ELSE IF (ABS(SYMVEC(I,NUMSYM)-0.3333).LT.0.001) THEN
            SYMVEC(I,NUMSYM)=1.0/3.0
         ELSE IF (ABS(SYMVEC(I,NUMSYM)-0.6667).LT.0.001) THEN
            SYMVEC(I,NUMSYM)=2.0/3.0
         ELSE IF (ABS(SYMVEC(I,NUMSYM)-0.8333).LT.0.001) THEN
            SYMVEC(I,NUMSYM)=5.0/6.0
         END IF
   18 CONTINUE



      IF (GVFIMU(SYMMAT(1,1,NUMSYM)).AND.
     +     GVFLNV(SYMVEC(1,NUMSYM)).LT.0.0001) THEN
         NUMSYM=NUMSYM-1
         GOTO 20
      END IF



      SYMSTS(NUMSYM)=SYMSTATSPGRP
      CALL SYMF2O (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM))




      DO 50 I=1,3
         CALL GVSRT0 (TMPVEC,3)
         TMPVEC(I)=1.0
         CALL GVSMVV (TMPVEC,SYMMAT(1,1,NUMSYM))
         IF (ABS(GVFLNV(TMPVEC)-1.0).GT.0.01) THEN
            CALL GVSTTE ('?M0374')
            IERR=1
            NUMSYM=NUMSYM-1
            GOTO 20
         END IF
   50 CONTINUE
      GOTO 20



 100  CONTINUE
      CALL GVSCLF (UNT)
      GOTO 996



 999  CONTINUE
      CALL GVSTTE ('?SYM038')
      CALL GVSCLF (UNT)
      IERR=1
      GOTO 996
 998  CONTINUE
      CALL SHOWTEXT ('?SYM039')
      CALL GVSCLF (UNT)
      SYMHAS=.FALSE.
      WIFPAR(590)=0
      IERR=1
      GOTO 996
 997  CONTINUE
      CALL GVSTTE ('?SYM040')
      NUMSYM=NUMSYM-1
      CALL GVSKIL
      GOTO 100



 996  CONTINUE


      END
      SUBROUTINE CELINP



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          CELL(6)
      INTEGER       I, GVFFFF







 10   CONTINUE
      CALL IPROMPT ('?SYM041')
      CALL GVSRT0 (CELL,6)
      I=GVFFFF(6,CELL)
      IF (I.EQ.1.AND.CELL(1).EQ.0.) GOTO 998
      IF (I.LT.3) THEN
         CALL GVSTT6 ('?SYMDF1')
         GOTO 10
      END IF
      IF (CELL(4).EQ.0.0) CELL(4) = 90.0
      IF (CELL(5).EQ.0.0) CELL(5) = 90.0
      IF (CELL(6).EQ.0.0) CELL(6) = 90.0
      CALL GVSCPR (CELDIM,CELL,6)
      SYMHAS=.TRUE.



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMISG



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      CHARACTER*12  SP, TMPBAS
      CHARACTER*12  TMPCLASS
      INTEGER       TMPNUM, IERR







 10   CONTINUE
      CALL IPROMPT ('?SYM042')
      CALL GVSCTB (SP,12)
      CALL NEEDFULLLINE (SP,' ',IERR)
      IF (IERR.EQ.1) GOTO 998
      CALL GVSCUC (SP)
      CALL SYMCLG (SP,TMPBAS,TMPNUM,TMPCLASS)
      IF (TMPCLASS.EQ.'UNKNOWN') THEN
         CALL GVSTTE ('?SYM043')
         GOTO 10
      ELSE IF (TMPBAS.NE.SP) THEN
         CALL SHOWTEXT ('?SYMNSS')
      ELSE IF (CLASS.NE.TMPCLASS) THEN
         CALL SHOWTEXT ('?SYMSDF')
      END IF
      CALL GVSSTX (SPCNAM,SP)
      CALL GVSSTX (CLASS2,TMPCLASS)
      SPCNUM=TMPNUM
      SPCNAMB=TMPBAS



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMIIT



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INTEGER       I, IERR
      CHARACTER*80  STRING







 10   CONTINUE
      I=NUMSYM+1
 100  CONTINUE
      CALL IPROMPT ('?SYM044')
      CALL GETFULLLINE (STRING,IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCUC (STRING)



      CALL MATITM (I,STRING,IERR)
      IF (IERR.NE.0) THEN
         IERR=1
         CALL SHOWTEXT ('?SYMESO')
         GOTO 100
      END IF
      NUMSYM=I
      SYMNAM(NUMSYM)=0
      CALL SYMF2O (SYMMAT(1,1,NUMSYM),SYMVEC(1,NUMSYM))
      SYMSTS(NUMSYM)=SYMSTATUSERF
      GOTO 10



  998 CONTINUE


      END
      SUBROUTINE SYMNEA



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, I, DXHI, DXLO, DYHI, DYLO, DZHI, DZLO, 
     +              NNMSYM, IERR
      REAL          XYZMIN(3), XYZMAX(3), XYZCEN(3), FRCMIN(3), 
     +              FRCMAX(3), XYZMIS(3), XYZMAS(3), FRCMIS(3), 
     +              FRCMAS(3), HCUTOFF





      HCUTOFF=4.0+WIFPAR(56)/200.0



      CALL WIFMMX (1,NUMAAT,XYZMIN,XYZMAX,XYZCEN)



      DO 3 I=1,3
         XYZMIN(I)=XYZMIN(I)-HCUTOFF
         XYZMAX(I)=XYZMAX(I)+HCUTOFF
 3    CONTINUE



      CALL SYMMMY (XYZMIN,XYZMAX,FRCMIN,FRCMAX,SYMSCL,SYMTRN)



      NNMSYM=NUMSYM
      DO 100 ISYM=1,NUMSYM



         CALL SYMMMX (XYZMIN,XYZMAX,XYZMIS,XYZMAS,ISYM)
         CALL SYMMMY (XYZMIS,XYZMAS,FRCMIS,FRCMAS,SYMSCL,SYMTRN)



         DXLO=NINT(FRCMIN(1)-FRCMAS(1)+0.5)
         DXHI=NINT(FRCMAX(1)-FRCMIS(1)-0.5)
         DYLO=NINT(FRCMIN(2)-FRCMAS(2)+0.5)
         DYHI=NINT(FRCMAX(2)-FRCMIS(2)-0.5)
         DZLO=NINT(FRCMIN(3)-FRCMAS(3)+0.5)
         DZHI=NINT(FRCMAX(3)-FRCMIS(3)-0.5)



         CALL SYMATR (ISYM,NNMSYM,DXLO,DXHI,DYLO,DYHI,DZLO,DZHI,IERR)
         IF (IERR.NE.0) GOTO 998



 100  CONTINUE
      NUMSYM=NNMSYM



      CALL MATDFL



      CALL SYMDNT



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMDNT



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      LOGICAL       GVFIMU
      REAL          GVFLNV
      INTEGER       MAXCONTA
      PARAMETER     (MAXCONTA=0)
      INTEGER       CONTACT(1), CONTACTS(1), ISYM, NCONTA







      CALL SYMICMP



      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)

         IF (NCONTA.EQ.0) SYMSTS(ISYM)=SYMSTAT_DELETED



 100  CONTINUE



      CALL MATDFL





      RETURN
      END
      SUBROUTINE SYMICMP



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CMPINC.INC'
      INTEGER       POW2
      REAL          XYZCEN(3), CUTHALF
      INTEGER       I, J, K, DIM, L





      CUTHALF=WIFPAR(56)/200.0+4.0



      POW2=1
      IF (WIFPAR(1508).GT.0.OR.NUMAAF.LE.0) THEN
         NUM(1)=NUMAAT
      ELSE
         NUM(1)=NUMAAF
      END IF
      INDEX(1)=1
      DO 10 I=1,NUM(1)
         CALL WIFMMX (I,I,XYZMIN(1,I),XYZMAX(1,I),XYZCEN)



         REF(1,I)=I
         REF(2,I)=0



         DO 5 DIM=1,3
            XYZMIN(DIM,I)=XYZMIN(DIM,I)-CUTHALF
            XYZMAX(DIM,I)=XYZMAX(DIM,I)+CUTHALF
    5    CONTINUE
 10   CONTINUE



      J=1



 20   CONTINUE
      J=J+1



      POW2=POW2*2



      NUM(J)=1+(NUM(J-1)-1)/2



      INDEX(J)=INDEX(J-1)+NUM(J-1)
      DO 40 I=1,NUM(J)
         K=INDEX(J)+(I-1)
         L=INDEX(J-1)+2*(I-1)



         IF (L.EQ.INDEX(J-1)+NUM(J-1)-1) THEN
            DO 30 DIM=1,3
               XYZMIN(DIM,K)=XYZMIN(DIM,L)
               XYZMAX(DIM,K)=XYZMAX(DIM,L)
 30         CONTINUE
            REF(1,K)=L
            REF(2,K)=0
         ELSE
            DO 35 DIM=1,3
               XYZMIN(DIM,K)=MIN(XYZMIN(DIM,L),XYZMIN(DIM,L+1))
               XYZMAX(DIM,K)=MAX(XYZMAX(DIM,L),XYZMAX(DIM,L+1))
 35         CONTINUE
            REF(1,K)=L
            REF(2,K)=L+1
         END IF
 40   CONTINUE

      IF (POW2.LT.NUM(1)) GOTO 20
      HIGHLEV=J





      RETURN
      END
      SUBROUTINE SYMCMP (ISYM,CONTACT,CONTACTS,NCONTA,MAXCONTA)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CMPINC.INC'
      INTEGER       NCONTA, MAXCONTA, CONTACT(MAXCONTA), 
     +              CONTACTS(MAXCONTA), STACK(2,MAXSTACK), ISYM,
     +              J, JS, SP, DIM
      REAL          XYZMIS(3), XYZMAS(3), CUTOFF
      LOGICAL       SYMCUT





      CUTOFF=WIFPAR(56)/100.0



      NCONTA=0
      SP=1
      STACK(1,SP)=INDEX(HIGHLEV)
      STACK(2,SP)=INDEX(HIGHLEV)



 50   CONTINUE
      IF (SP.LE.0) GOTO 998
      J=STACK(1,SP)
      JS=STACK(2,SP)
      SP=SP-1



      CALL SYMMMX (XYZMIN(1,JS),XYZMAX(1,JS),XYZMIS,XYZMAS,ISYM)



      DO 65 DIM=1,3
         IF (XYZMAS(DIM).LT.XYZMIN(DIM,J)) GOTO 50
         IF (XYZMIS(DIM).GT.XYZMAX(DIM,J)) GOTO 50
 65   CONTINUE





      IF (J.LE.NUM(1).AND.JS.LE.NUM(1)) THEN




         IF (SYMCUT(J,JS,ISYM,CUTOFF)) THEN



            IF (NCONTA.GE.MAXCONTA) THEN
               IF (MAXCONTA.GT.0) THEN
                  CALL GVSTTE ('?SYM056')
               ELSE
                  NCONTA=1
               END IF
               GOTO 998
            END IF
            NCONTA=NCONTA+1
            CONTACT(NCONTA)=J
            CONTACTS(NCONTA)=JS
         END IF
      ELSE



         IF (SP+4.GT.MAXSTACK) THEN
            CALL GVSTTE ('?SYM057')
            GOTO 998
         END IF
         SP=SP+1
         STACK(1,SP)=REF(1,J)
         STACK(2,SP)=REF(1,JS)
         IF (REF(2,JS).GT.0) THEN
            SP=SP+1
            STACK(1,SP)=REF(1,J)
            STACK(2,SP)=REF(2,JS)
            IF (REF(2,J).GT.0) THEN
               SP=SP+1
               STACK(1,SP)=REF(2,J)
               STACK(2,SP)=REF(2,JS)
            END IF
         END IF
         IF (REF(2,J).GT.0) THEN
            SP=SP+1
            STACK(1,SP)=REF(2,J)
            STACK(2,SP)=REF(1,JS)
         END IF
      END IF
      GOTO 50



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMMMX (MIO,MAO,MIS,MAS,ISYM)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          MIO(3), MAO(3), MIS(3), MAS(3)
      INTEGER       ISYM





      IF (ISYM.LT.1.OR.ISYM.GT.NUMSYM) THEN
         CALL GVSTTB ('?SYM060')
      ELSE
         CALL SYMMMY (MIO,MAO,MIS,MAS,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
      END IF





      RETURN
      END
      SUBROUTINE SYMMMY (MIO,MAO,MIS,MAS,RMAT,VEC)





















      IMPLICIT      NONE
      REAL          MIO(3), MAO(3), MIS(3), MAS(3), TMP(3),
     +              RMAT(3,3), VEC(3), TVEC(3)







      TMP(1)=MAO(1)
      TMP(2)=MAO(2)
      TMP(3)=MAO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=TMP(1)
      MAS(2)=TMP(2)
      MAS(3)=TMP(3)
      MIS(1)=TMP(1)
      MIS(2)=TMP(2)
      MIS(3)=TMP(3)



      TMP(1)=MAO(1)
      TMP(2)=MAO(2)
      TMP(3)=MIO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))



      TMP(1)=MAO(1)
      TMP(2)=MIO(2)
      TMP(3)=MAO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)







      TMP(1)=MAO(1)
      TMP(2)=MIO(2)
      TMP(3)=MIO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))



      TMP(1)=MIO(1)
      TMP(2)=MAO(2)
      TMP(3)=MAO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))



      TMP(1)=MIO(1)
      TMP(2)=MAO(2)
      TMP(3)=MIO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))



      TMP(1)=MIO(1)
      TMP(2)=MIO(2)
      TMP(3)=MAO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))



      TMP(1)=MIO(1)
      TMP(2)=MIO(2)
      TMP(3)=MIO(3)

      TVEC(1)=VEC(1)+RMAT(1,1)*TMP(1)+
     +               RMAT(1,2)*TMP(2)+
     +               RMAT(1,3)*TMP(3)
      TVEC(2)=VEC(2)+RMAT(2,1)*TMP(1)+
     +               RMAT(2,2)*TMP(2)+
     +               RMAT(2,3)*TMP(3)
      TVEC(3)=VEC(3)+RMAT(3,1)*TMP(1)+
     +               RMAT(3,2)*TMP(2)+
     +               RMAT(3,3)*TMP(3)
      TMP(1)=TVEC(1)
      TMP(2)=TVEC(2)
      TMP(3)=TVEC(3)




      MAS(1)=MAX(MAS(1),TMP(1))
      MAS(2)=MAX(MAS(2),TMP(2))
      MAS(3)=MAX(MAS(3),TMP(3))
      MIS(1)=MIN(MIS(1),TMP(1))
      MIS(2)=MIN(MIS(2),TMP(2))
      MIS(3)=MIN(MIS(3),TMP(3))





      RETURN
      END
      SUBROUTINE SYMPIC




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      REAL          XYZMIN(3), XYZMAX(3), XYZCEN(3), FRCCEN(3),
     +              XYZCES(3), FRCCES(3), VECT(3), TMPMAT(3,3),
     +              TMPVEC(3)
      INTEGER       ISYM, I





      IF (WIFPAR(592).GT.0) THEN
         CALL GVSTT6 ('?M0307')
         GOTO 998
      END IF

      CALL SHOWTEXT ('?SYMTCL')



      IF (NUMAAF.LE.0) THEN
         CALL WIFMMX (1,NUMAAT,XYZMIN,XYZMAX,XYZCEN)
      ELSE
         CALL WIFMMX (1,NUMAAF,XYZMIN,XYZMAX,XYZCEN)
      END IF



      CALL SYMCTF (FRCCEN, XYZCEN)



      DO 100 ISYM=2,NUMSYM



         CALL GVSCPR (XYZCES, XYZCEN, 3)
         CALL GVSMPV (XYZCES, SYMMAT(1,1,ISYM), SYMVEC(1,ISYM))
         CALL SYMCTF (FRCCES, XYZCES)



         DO 40 I=1,3
            VECT(I)=FLOAT(NINT(0.5-FRCCES(I)))
 40      CONTINUE
         CALL SYMO2F (SYMMAT(1,1,ISYM),SYMVEC(1,ISYM),TMPMAT,TMPVEC)
         CALL GVSCPR (SYMMAT(1,1,ISYM),TMPMAT,9)
         CALL GVSCPR (SYMVEC(1,ISYM),TMPVEC,3)
         CALL GVSAV3 (SYMVEC(1,ISYM),VECT)
         CALL SYMF2O (SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
         SYMNAM(ISYM)=SYMNAM(ISYM)+NINT(VECT(1))*100+
     +                NINT(VECT(2))*10+NINT(VECT(3))
 100  CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMGBX (BOXMIN,BOXMAX,IERR)



















      IMPLICIT      NONE
      REAL          BOXMIN(3), BOXMAX(3), TEMP
      INTEGER       IERR, I, DIM, GVFFFF





      IERR=1
 10   CONTINUE
      CALL IPROMPT ('?SYM061')
      CALL GVSRT0 (BOXMIN,3)
      I=GVFFFF(3,BOXMIN)
      IF (I.EQ.1.AND.BOXMIN(1).EQ.0.) GOTO 998
      IF (I.LT.3) THEN
         CALL GVSTT6 ('?SYM063')
         GOTO 10
      END IF
 20   CONTINUE
      CALL IPROMPT ('?SYM062')
      CALL GVSRT0 (BOXMAX,3)
      I=GVFFFF(3,BOXMAX)
      IF (I.EQ.1.AND.BOXMAX(1).EQ.0.) GOTO 998
      IF (I.LT.3) THEN
         CALL GVSTT6 ('?SYM063')
         GOTO 20
      END IF
      DO 30 DIM=1,3
         IF (BOXMIN(DIM).GT.BOXMAX(DIM)) THEN
            CALL SHOWTEXT ('?SYMEXM')
            TEMP=BOXMIN(DIM)
            BOXMIN(DIM)=BOXMAX(DIM)
            BOXMAX(DIM)=TEMP
         END IF
 30   CONTINUE
      IERR=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMASP



















      IMPLICIT      NONE
      INCLUDE       'OPTION.INC'
      INTEGER       IERR
      LOGICAL       GVFYON







      IF (MENMORE(46)) THEN
         CALL SHOWTEXT ('?SYMCHS')
         CALL GVSNL6 (1)
         IF (.NOT.GVFYON('?SYMYN9',' ')) THEN
            CALL SYMIPG (IERR,' ')
         END IF
      ELSE
         CALL SYMIPG (IERR,' ')
      END IF





      RETURN
      END
      SUBROUTINE SYMPIB (BOXMIN,BOXMAX)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, DXHI, DXLO, DYHI, DYLO, DZHI, DZLO, NNMSYM,
     +              IERR
      REAL          BOXMIN(3), BOXMAX(3), BOFMIN(3), BOFMAX(3),
     +              XYZMIN(3), XYZMAX(3), XYZCEN(3), XYZMIS(3), 
     +              XYZMAS(3), FRCMIS(3), FRCMAS(3)





      CALL GVSTT6 ('?SYMFBX')



      IF (NUMAAF.LE.0) THEN
         CALL WIFMMX (1,NUMAAT,XYZMIN,XYZMAX,XYZCEN)
      ELSE
         CALL WIFMMX (1,NUMAAF,XYZMIN,XYZMAX,XYZCEN)
      END IF



      CALL SYMMMY (BOXMIN,BOXMAX,BOFMIN,BOFMAX,SYMSCL,SYMTRN)



      NNMSYM=NUMSYM
      DO 100 ISYM=1,NUMSYM



         CALL SYMMMX (XYZMIN,XYZMAX,XYZMIS,XYZMAS,ISYM)
         CALL SYMMMY (XYZMIS,XYZMAS,FRCMIS,FRCMAS,SYMSCL,SYMTRN)



         DXLO=NINT(BOFMIN(1)-FRCMAS(1)+0.5)
         DXHI=NINT(BOFMAX(1)-FRCMIS(1)-0.5)
         DYLO=NINT(BOFMIN(2)-FRCMAS(2)+0.5)
         DYHI=NINT(BOFMAX(2)-FRCMIS(2)-0.5)
         DZLO=NINT(BOFMIN(3)-FRCMAS(3)+0.5)
         DZHI=NINT(BOFMAX(3)-FRCMIS(3)-0.5)



         CALL SYMATR (ISYM,NNMSYM,DXLO,DXHI,DYLO,DYHI,DZLO,DZHI,IERR)
         IF (IERR.NE.0) GOTO 998



  100 CONTINUE
      NUMSYM=NNMSYM



      CALL MATDFL



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMPIS (BALL)




















      IMPLICIT      NONE
      REAL          BALL(4), BOXMIN(3), BOXMAX(3)
      INTEGER       DIM







      DO 10 DIM=1,3
         BOXMIN(DIM)=BALL(DIM)-BALL(4)
         BOXMAX(DIM)=BALL(DIM)+BALL(4)
 10   CONTINUE



      CALL SYMPIB (BOXMIN,BOXMAX)





      RETURN
      END
      SUBROUTINE SYMATR (ISYM,NNMSYM,DXLO,DXHI,DYLO,DYHI,DZLO,DZHI,IERR)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, NNMSYM, DXLO, DXHI, DYLO, DYHI, DZLO, DZHI,
     +              DX, DY, DZ, SAVSTAT, IERR
      REAL          VECT(3)







      IERR=0



      SAVSTAT=SYMSTS(ISYM)
      SYMSTS(ISYM)=SYMSTAT_DELETED
      DO 30 DX=DXLO,DXHI
         DO 20 DY=DYLO,DYHI
            DO 10 DZ=DZLO,DZHI
               IF (DX.EQ.0.AND.DY.EQ.0.AND.DZ.EQ.0) THEN



                  SYMSTS(ISYM)=SAVSTAT
               ELSE



                  IF (NNMSYM.GE.MAXSYM) THEN
                     CALL SHOWTEXT ('?SYM066')
                     IERR=1
                     CALL GVSKIL
                     GOTO 998
                  END IF
                  NNMSYM=NNMSYM+1
                  SYMNAM(NNMSYM)=SYMNAM(ISYM)+DX*100+DY*10+DZ
                  SYMSTS(NNMSYM)=SYMSTATTRANS
                  CALL SYMO2F (SYMMAT(1,1,ISYM),SYMVEC(1,ISYM),
     +                         SYMMAT(1,1,NNMSYM),SYMVEC(1,NNMSYM))
                  VECT(1)=DX
                  VECT(2)=DY
                  VECT(3)=DZ
                  CALL GVSAV3 (SYMVEC(1,NNMSYM), VECT)
                  CALL SYMF2O (SYMMAT(1,1,NNMSYM),SYMVEC(1,NNMSYM))
               END IF
 10         CONTINUE
 20      CONTINUE
 30   CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMADR (IAA,ISYM)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, ISYM, LOCAAF, IAT, IERR







      IF (IAA.GT.NUMAAF) THEN
         CALL GVSTTB ('?M3351')
         GOTO 998
      END IF
      LOCAAF=NUMAAF
      CALL MOL104 (ONESA3(IAA),NUMNAM(IAA),ONEORG(IAA),LOCAAF,' ',IERR)
      IF (IERR.NE.0) THEN
         CALL GVSTTB ('?M3352')
         GOTO 998
      END IF



      CALL WIF088 (IAA,NUMAAF)



      DO 10 IAT=PNTAAS(NUMAAF),PNTAAE(NUMAAF)
         CV(1)=XCOORD(IAT)
         CV(2)=YCOORD(IAT)
         CV(3)=ZCOORD(IAT)
         CALL GVSMPV (CV,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
         XCOORD(IAT)=CV(1)
         YCOORD(IAT)=CV(2)
         ZCOORD(IAT)=CV(3)
   10 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMADG (IAA,ISYM)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SOLIDS.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'VECTOR.INC'
      INTEGER       IAA, ISYM, NUMOLD, IGRV
      LOGICAL       OLDSOLID


      RETURN
      END
      SUBROUTINE SYMCGP
































      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       STS, NSGEN, NS1, NS2, IERR
      REAL          ROT12(3,3), TRL12(3), GVFLNV
      LOGICAL       FOUND(MAXSYM), ANYERR, GVFIBN, GVFIMU





      ANYERR = .FALSE.



      IF (NUMSYM.EQ.0) THEN
         CALL SHOWTEXT ('?SYMNSM')
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(NUMSYM,0,MAXSYM)) THEN
         CALL GVSTTE ('?SYM068')
         GOTO 998
      ENDIF



      IF (.NOT.GVFIMU(SYMMAT(1,1,1)).OR.
     +    GVFLNV(SYMVEC(1,1)).GE.0.001) THEN
         CALL GVSTTE ('?SYM069')
      END IF



      CALL SYMRDU (IERR)
      IF (IERR.NE.0) THEN
         CALL GVSNL6 (1)
         CALL SHOWTEXT ('?SYMGRP')
         GOTO 998
      END IF



      CALL SYMPNI (IERR)
      IF (IERR.NE.0) THEN
         CALL GVSNL6 (1)
         CALL SHOWTEXT ('?SYMGNC')
         GOTO 998
      END IF





      DO 100 NS1=1,NUMSYM
         DO 30 NSGEN=1,NUMSYM
            FOUND(NSGEN) = .FALSE.
30       CONTINUE
         DO 70 NS2=1,NUMSYM



            CALL GVS3X3 (ROT12, SYMMAT(1,1,NS2), SYMMAT(1,1,NS1))
            CALL GVSCPR (TRL12, SYMVEC(1,NS1), 3)
            CALL GVSMPV (TRL12, SYMMAT(1,1,NS2), SYMVEC(1,NS2))



            DO 50 NSGEN=1,NUMSYM



               CALL MATCMP (STS, SYMMAT(1,1,NSGEN), ROT12, 0.0001)



               IF (STS.EQ.0) THEN
                  CALL VECCMP (STS, TRL12, SYMVEC(1,NSGEN))
                  IF (STS.EQ.1) STS=0
               END IF
               IF (STS.EQ.0) THEN



                  FOUND(NSGEN) = .TRUE.
                  GOTO 70
               END IF
 50         CONTINUE
            CALL GVSFMT ('?SYMFMT31')
            WRITE (LINE,FMT,ERR=100) NS1,NS2
            CALL GVSTT6 (LINE)
            CALL RHSWMV (ROT12,TRL12)
            ANYERR=.TRUE.
 70      CONTINUE
         DO 90 NSGEN=1,NUMSYM
            IF (.NOT. FOUND(NSGEN)) THEN
               CALL GVSFMT ('?SYMFMT32')
               WRITE(LINE,FMT,ERR=100) NS1,NSGEN
               CALL GVSTT6 (LINE)
               ANYERR=.TRUE.
            END IF
 90      CONTINUE
 100  CONTINUE
      IF (.NOT.ANYERR) THEN
         CALL SHOWTEXT ('?SYMCLG')
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMANA



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'SYMANA.INC'
      INTEGER       MAXCONTA
      PARAMETER     (MAXCONTA=8*MAXAA)
      INTEGER       CONTACT(MAXCONTA), CONTACTS(MAXCONTA), ISYM, IAT,
     +              JAT, I, NCONTA, IAA, JAA, IBIN, IAAT, JAAT, IATT,
     +              JATT, P, Q
      REAL          TMP(3),DST,DST2, GVFLNV
      LOGICAL       COMOVE, FIRST1(2,2), FIRST(2,2), GVFIMU
      EQUIVALENCE   (CONTACT(1),ESPACE(10001))
      EQUIVALENCE   (CONTACTS(1),ESPACE(10001+8*MAXAA))







      CALL SYMICMP



      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 GVSTTI ('?SYM073',nconta)
         IF (NCONTA.GT.NUMAAF) THEN



            CALL SYMOVE (ISYM,CONTACT,CONTACTS,NCONTA,COMOVE)
            IF (COMOVE) THEN
               CALL SHOWTEXT ('?SYMCOV')
               GOTO 100
            ELSE
               CALL GVSTT6 ('?SYM074')
               CALL RHSWMV (SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
            END IF
         END IF
         DO 30 I=1,NCONTA
            IAA=CONTACT(I)
            JAA=CONTACTS(I)
            CALL GVSBTT (FIRST,4)
            CALL GVSBTT (FIRST1,4)
            DO 20 JAT=PNTAAS(JAA),PNTAAE(JAA)
               TMP(1)=XCOORD(JAT)
               TMP(2)=YCOORD(JAT)
               TMP(3)=ZCOORD(JAT)
               CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
               DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
                  DST2 = (TMP(1)-XCOORD(IAT))**2 +
     +                 (TMP(2)-YCOORD(IAT))**2 +
     +                 (TMP(3)-ZCOORD(IAT))**2
                  DST=SQRT(DST2)-VDWRAD(IAT)-VDWRAD(JAT)
                  IBIN=40+INT(DST*10.0)
                  IF (IBIN.LE.50) THEN
                     IF (IBIN.LT.1) IBIN=1
                     IAAT=RESTYP(IAA)
                     JAAT=RESTYP(JAA)
                     IATT=IAT-PNTAAS(IAA)+1
                     JATT=JAT-PNTAAS(JAA)+1



                     IF (DST.LT.-2.0.AND.IAAT.LE.20) THEN
                        IF (IATT.LT.5) THEN
                           P=1
                        ELSE
                           P=2
                        END IF
                        IF (JATT.LT.5) THEN
                           Q=1
                        ELSE
                           Q=2
                        END IF
                        IF (FIRST(P,Q)) THEN
                           FIRST(P,Q)=.FALSE.
                           INVOLVED(P,Q,IAA)=INVOLVED(P,Q,IAA)+1
                        END IF
                     END IF
                     IF (DST.LT.-1.0.AND.IAAT.LE.20) THEN
                        IF (IATT.LT.5) THEN
                           P=1
                        ELSE
                           P=2
                        END IF
                        IF (JATT.LT.5) THEN
                           Q=1
                        ELSE
                           Q=2
                        END IF
                        IF (FIRST1(P,Q)) THEN
                           FIRST1(P,Q)=.FALSE.
                           INVOLVED1(P,Q,IAA)=INVOLVED1(P,Q,IAA)+1
                        END IF
                     END IF
                     IF (JAAT.LE.0.OR.JAAT.GT.20) THEN

                     ELSE IF (IAAT.LE.0.OR.IAAT.GT.20) THEN

                     ELSE IF (JATT.LE.0.OR.JATT.GT.14) THEN
                        PRINT *,' HUH? JATT=',JATT
                     ELSE IF (IATT.LE.0.OR.IATT.GT.14) THEN
                        PRINT *,' HUH? IATT=',IATT
                     ELSE
                        KBIN(IBIN)=KBIN(IBIN)+1
                     END IF
                  END IF
 10            CONTINUE
 20         CONTINUE
 30      CONTINUE
 100  CONTINUE





      RETURN
      END
      SUBROUTINE SYMDBA1



















      IMPLICIT      NONE

      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'SYMANA.INC'
      INCLUDE       'PDBINC.INC'
      INTEGER       IERR, STS, IAA
      CHARACTER*23  IAAS





      IF (.NOT.SYMHAS) THEN
         CALL CELPRN (CELDIM)
         CALL SHOWTEXT ('?SYMCANNOT')
         GOTO 998
      END IF



      CALL GVSIT0 (KBIN,50)
      CALL GVSIT0 (HBIN,50)
      CALL GVSIT0 (INVOLVED,2*2*MAXAA)
      CALL GVSIT0 (INVOLVED1,2*2*MAXAA)



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



      CALL SYMDSM



      CALL SYMNEA



      CALL SYMANA



      CALL PDBTAB ('?TSYMCON')
      DO 10 IAA=1,NUMAAF
         CALL PDBC92A (IAA,0)
         CALL GVSSTX (IAAS,LINE92(1:23))
         IF (INVOLVED(1,1,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'very',IAAS,'B-B',
     +       INVOLVED(1,1,IAA)
            CALL PDBC93 (LINE2)
         ELSE IF (INVOLVED1(1,1,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'less',IAAS,'B-B',
     +       INVOLVED1(1,1,IAA)
            CALL PDBC93 (LINE2)
         ENDIF
         IF (INVOLVED(1,2,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'very',IAAS,'B-S',
     +       INVOLVED(1,2,IAA)
            CALL PDBC93 (LINE2)
         ELSE IF (INVOLVED1(1,2,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'less',IAAS,'B-S',
     +       INVOLVED1(1,2,IAA)
            CALL PDBC93 (LINE2)
         ENDIF
         IF (INVOLVED(2,1,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'very',IAAS,'S-B',
     +       INVOLVED(2,1,IAA)
            CALL PDBC93 (LINE2)
         ELSE IF (INVOLVED1(2,1,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'less',IAAS,'S-B',
     +       INVOLVED1(2,1,IAA)
            CALL PDBC93 (LINE2)
         ENDIF
         IF (INVOLVED(2,2,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'very',IAAS,'S-S',
     +       INVOLVED(2,2,IAA)
            CALL PDBC93 (LINE2)
         ELSE IF (INVOLVED1(2,2,IAA).GT.0) THEN
            WRITE(LINE2,PDBFMT,ERR=999) 'less',IAAS,'S-S',
     +       INVOLVED1(2,2,IAA)
            CALL PDBC93 (LINE2)
         END IF
 10   CONTINUE
      CALL PDBTND (IERR)
      IF (SYMALT) THEN
         CALL MATCMP (STS,SYMAL1,SYMSCL,0.0001)
         IF (STS.NE.0) THEN
            CALL TEXSECT ('?SYM075')
         ELSE
            CALL TEXSECT ('?SYM076')
         ENDIF
      END IF
      IF (IERR.EQ.0) THEN
         CALL PDBMES ('SYMCONTAC')
      END IF
      IF (IERR.NE.0.AND..NOT.SYMALT) THEN
         CALL GVSFMT ('?FMT027A')
         WRITE (18,FMT,ERR=999) FILNMS(62)
      ENDIF
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('SYMDBA1')



  998 CONTINUE



      RETURN
      END
      SUBROUTINE SYMOVE (ISYM,CONTACT,CONTACTS,NCONTA,COMOVE)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ISYM, NCONTA, CONTACT(NCONTA), CONTACTS(NCONTA),
     +              I, J, IAA, JAA, IAT, JAT
      LOGICAL       COMOVE,OVELAP(MAXAA)
      REAL          DST2, TMP(3)
      EQUIVALENCE   (OVELAP,ESPACE(10001+8*MAXAA))







      COMOVE=.FALSE.
      IF (NCONTA.LT.3*NUMAAF) GOTO 998
      CALL GVSBTF (OVELAP,MAXAA)



      DO 30 I=1,NCONTA
         IAA=CONTACT(I)
         IF (OVELAP(IAA)) GOTO 30
         JAA=CONTACTS(I)



         IF (PNTAAE(JAA)-PNTAAS(JAA).EQ.PNTAAE(IAA)-PNTAAS(IAA)) THEN
            DO 20 J=0,PNTAAE(JAA)-PNTAAS(JAA)
               IAT=PNTAAS(IAA)+J
               JAT=PNTAAS(JAA)+J
               TMP(1)=XCOORD(JAT)
               TMP(2)=YCOORD(JAT)
               TMP(3)=ZCOORD(JAT)
               CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
               DST2 = (TMP(1)-XCOORD(IAT))**2 +
     +              (TMP(2)-YCOORD(IAT))**2 +
     +              (TMP(3)-ZCOORD(IAT))**2
               IF (DST2.GT.0.01) GOTO 30
 20         CONTINUE
            OVELAP(IAA)=.TRUE.
         END IF
 30   CONTINUE
      COMOVE=.FALSE.
      DO 40 IAA=1,NUMAAF
         IF (.NOT.OVELAP(IAA)) GOTO 998
 40   CONTINUE
      COMOVE=.TRUE.



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMPAR



















      IMPLICIT      NONE




      CALL GETREALPAR (56,100.0,0.0,100.0,' ','?M0308')





      RETURN
      END
      SUBROUTINE SYMDSM



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       ISOUP1, ISOUP2, IAA, JAA, IAT, JAT, I, STS, ISYM,
     +              IATCHK, IATLOC
      REAL          CV2(3)
      LOGICAL       DELSOU(MAXMOL)





      DO 5 I=1,NUMSOU
         DELSOU(I)=.FALSE.
 5    CONTINUE
      DO 100 ISOUP1=1,NUMSOU-1
         IF (DELSOU(ISOUP1)) GOTO 100
         DO 90 ISOUP2=ISOUP1+1,NUMSOU
            IF (DELSOU(ISOUP2)) GOTO 90



            IF (SOUADM(5,ISOUP1).NE.SOUADM(5,ISOUP2)) GOTO 90



            IF (SOUADM(3,ISOUP1).NE.SOUADM(3,ISOUP2)) GOTO 90
            IF (SOUADM(3,ISOUP1).EQ.1) THEN
               IF (SOUADM(4,ISOUP1).NE.SOUADM(4,ISOUP2)) GOTO 90
            END IF



            DO 10 I=1,SOUADM(3,ISOUP1)
               IAA=SOUADM(1,ISOUP1)+I-1
               JAA=SOUADM(1,ISOUP2)+I-1
               IF (RESTYP(IAA).NE.RESTYP(JAA)) GOTO 90
 10         CONTINUE



            IATCHK=0
            DO 40 ISYM=1,NUMSYM
               DO 30 I=1,SOUADM(3,ISOUP1)
                  IAA=SOUADM(1,ISOUP1)+I-1
                  JAA=SOUADM(1,ISOUP2)+I-1
                  IF (RESTYP(IAA).NE.RESTYP(JAA)) GOTO 90
                  DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
                     IATLOC=IAT-PNTAAS(IAA)+1
                     JAT=PNTAAS(JAA)+IATLOC-1
                     IF (ISATOK(IAT).NEQV.ISATOK(JAT)) GOTO 90
                     IF (ISATOK(IAT)) THEN
                       CV(1)=XCOORD(IAT)
                       CV(2)=YCOORD(IAT)
                       CV(3)=ZCOORD(IAT)
                       IATCHK=IATCHK+1
                       CALL GVSMPV (CV,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
                       CV2(1)=XCOORD(JAT)
                       CV2(2)=YCOORD(JAT)
                       CV2(3)=ZCOORD(JAT)
                       CALL VECCMP (STS, CV, CV2)
                       IF (STS.GT.1) GOTO 40
                    END IF
 20              CONTINUE
 30           CONTINUE



              CALL GVSFMT ('?SYMFMT33')
              WRITE (LINE,FMT,ERR=100) ISOUP2,ISOUP1,ISYM
              CALL GVSTT6 (LINE)
              DELSOU(ISOUP2)=.TRUE.
              GOTO 90
 40        CONTINUE
 90     CONTINUE
 100  CONTINUE



      DO 200 I=NUMSOU,1,-1
         IF (DELSOU(I)) CALL MOL101 (I)
 200  CONTINUE





      RETURN
      END
      SUBROUTINE SYMAMB



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'SYMANA.INC'
      REAL          SAVMAT(3,3)
      INTEGER       IAA, CR1, CR2, SC1, SC2, P, Q, IERR







      IF (.NOT.SYMALT) THEN
         CALL SHOWTEXT ('?SYMNAMB')
         GOTO 998
      END IF
      CALL GVSCPR (SAVMAT,SYMSCL,9)



      CALL GVSCPR (SYMSCL, SYMAL1, 9)
      CALL GVSMI2 (SYMSCL,SYMINV,3,IERR)



      CALL GVSIT0 (KBIN,50)
      CALL GVSIT0 (HBIN,50)
      CALL GVSIT0 (INVOLVED,2*2*MAXAA)
      CALL GVSIT0 (INVOLVED1,2*2*MAXAA)



      CALL SYMIPG (IERR,'?SYM080')
      IF (IERR.NE.0) GOTO 998



      CALL SYMDSM



      CALL SYMNEA



      CALL SYMANA
      SC1=0
      SC2=0
      DO 30 IAA=1,NUMAAF
         DO 20 P=1,2
            DO 10 Q=1,2
               SC2=SC2+INVOLVED(P,Q,IAA)
               SC1=SC1+INVOLVED1(P,Q,IAA)
 10         CONTINUE
 20      CONTINUE
 30   CONTINUE
      SC1=SC1+SC2



      CALL GVSCPR (SYMSCL, SYMAL2, 9)
      CALL GVSNX3 (SYMSCL, MPRIME)
      CALL GVSMI2 (SYMSCL,SYMINV,3,IERR)



      CALL GVSIT0 (KBIN,50)
      CALL GVSIT0 (HBIN,50)
      CALL GVSIT0 (INVOLVED,2*2*MAXAA)
      CALL GVSIT0 (INVOLVED1,2*2*MAXAA)



      CALL SYMIPG (IERR,'?SYM080')
      IF (IERR.NE.0) GOTO 998



      CALL SYMDSM



      CALL SYMNEA



      CALL SYMANA
      CR1=0
      CR2=0
      DO 60 IAA=1,NUMAAF
         DO 50 P=1,2
            DO 40 Q=1,2
               CR2=CR2+INVOLVED(P,Q,IAA)
               CR1=CR1+INVOLVED(P,Q,IAA)
 40         CONTINUE
 50      CONTINUE
 60   CONTINUE
      CR1=CR1+CR2



      CALL GVSFMT ('?FMT1339')
      WRITE (LINE,FMT,ERR=998) CR1,CR2
      CALL GVSTT6 (LINE)
      CALL GVSFMT ('?FMT1340')
      WRITE (LINE,FMT,ERR=998) SC1,SC2
      CALL GVSTT6 (LINE)
      IF (CR2.LT.SC2/3.OR.(CR2.LT.3.AND.CR1.LT.SC1/2)) THEN



         CALL PDBMES ('CRYSTGOOD')
         CALL GVSCPR (SYMSCL, SYMAL2, 9)
         SYMALT=.FALSE.
      ELSE IF (SC2.LT.CR2/3.OR.(SC2.LT.3.AND.SC1.LT.CR1/2)) THEN



         CALL PDBMES ('SCALEGOOD')
         CALL GVSCPR (SYMSCL,SYMAL1,9)
         CALL GVSMI2 (SYMSCL,SYMINV,3,IERR)
         SYMALT=.FALSE.
      ELSE



         CALL PDBMES ('BUMP2BAD')
         CALL GVSCPR (SYMSCL, SAVMAT, 9)
         CALL GVSMI2 (SYMSCL, SYMINV, 3,IERR)
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CELRED (CELDIM,SPCNAM,RCELDIM,CELTRR)
























      IMPLICIT      NONE
      INTEGER       DIM, IERR, COUNTER
      REAL          CELDIM(6), RCELDIM(6), CELMAT(3,3), CELTRR(3,3),
     +              OUTMAT(3,3), A(3), B(3), C(3), AP, BP, CP, LA, LB,
     +              LC, V(3), LV, ALPH, BETA, GAMM, GVFLNV, GVFRTD,
     +              GVFANG, GVFDET
      CHARACTER     SPCNAM*(*)







      COUNTER=0



      CALL CEL001 (CELDIM(1),CELDIM(2),CELDIM(3),
     +     CELDIM(4),CELDIM(5),CELDIM(6),CELMAT)
      A(1)=1.
      A(2)=0.
      A(3)=0.
      CALL GVSMVV (A, CELMAT)
      B(1)=0.
      B(2)=1.
      B(3)=0.
      CALL GVSMVV (B, CELMAT)
      C(1)=0.
      C(2)=0.
      C(3)=1.
      CALL GVSMVV (C, CELMAT)



      IF (SPCNAM(1:1).EQ.'P') THEN
         CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'Z') THEN
         CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'A') THEN
         DO 2 DIM=1,3
            C(DIM)=(B(DIM)+C(DIM))/2.
 2       CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'B') THEN
         DO 3 DIM=1,3
            C(DIM)=(A(DIM)+C(DIM))/2.
 3       CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'C') THEN
         DO 4 DIM=1,3
            B(DIM)=(B(DIM)+A(DIM))/2.
 4       CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'I') THEN
         DO 5 DIM=1,3
            C(DIM)=(A(DIM)+B(DIM)+C(DIM))/2.
 5       CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'F') THEN
         DO 6 DIM=1,3
            AP=(A(DIM)+C(DIM))/2.
            BP=(A(DIM)+B(DIM))/2.
            CP=(B(DIM)+C(DIM))/2.
            A(DIM)=AP
            B(DIM)=BP
            C(DIM)=CP
 6       CONTINUE
      ELSE IF (SPCNAM(1:1).EQ.'R'.OR.SPCNAM(1:1).EQ.'H') THEN
         DO 7 DIM=1,3
            AP=(2*A(DIM)+B(DIM)+C(DIM))/3.
            BP=(-A(DIM)+B(DIM)+C(DIM))/3.
            CP=(-A(DIM)-2*B(DIM)+C(DIM))/3.
            A(DIM)=AP
            B(DIM)=BP
            C(DIM)=CP
 7       CONTINUE
      ELSE
         CALL GVSTTB ('?SYM081')
      END IF



      LA=GVFLNV(A)
      LB=GVFLNV(B)
      LC=GVFLNV(C)
      IF (LA.GT.LB) THEN
         CALL VECEX (A,B)
         LA=GVFLNV(A)
         LB=GVFLNV(B)
      END IF
      IF (LB.GT.LC) THEN
         CALL VECEX (B,C)
         LB=GVFLNV(B)
         LC=GVFLNV(C)
      END IF
      IF (LA.GT.LB) THEN
         CALL VECEX (A,B)
         LA=GVFLNV(A)
         LB=GVFLNV(B)
      END IF
 10   CONTINUE
      COUNTER=COUNTER+1
      IF (COUNTER.GT.1000) GOTO 100
      LA=GVFLNV(A)
      LB=GVFLNV(B)
      LC=GVFLNV(C)



      CALL GVSBV3 (V,A,B)
      LV=GVFLNV(V)
      IF (LV.LT.LA) THEN
         CALL VECEX (A,B)
         CALL VECEX (A,V)
         GOTO 10
      ELSE IF (LV.LT.LB) THEN
         CALL VECEX (B,V)
         GOTO 10
      ENDIF
      CALL GVSTV3 (V,A,B)
      LV=GVFLNV(V)
      IF (LV.LT.LA) THEN
         CALL VECEX (A,B)
         CALL VECEX (A,V)
         GOTO 10
      ELSE IF (LV.LT.LB) THEN
         CALL VECEX (B,V)
         GOTO 10
      ENDIF
      CALL GVSBV3 (V,A,C)
      LV=GVFLNV(V)
      IF (LV.LT.LA) THEN
         CALL VECEX (A,B)
         CALL VECEX (A,C)
         CALL VECEX (A,V)
         GOTO 10
      ELSE IF (LV.LT.LB) THEN
         CALL VECEX (B,C)
         CALL VECEX (B,V)
         GOTO 10
      ELSE IF (LV.LT.LC) THEN
         CALL VECEX (C,V)
         GOTO 10
      ENDIF
      CALL GVSTV3 (V,A,C)
      LV=GVFLNV(V)
      IF (LV.LT.LA) THEN
         CALL VECEX (A,B)
         CALL VECEX (A,C)
         CALL VECEX (A,V)
         GOTO 10
      ELSE IF (LV.LT.LB) THEN
         CALL VECEX (B,C)
         CALL VECEX (B,V)
         GOTO 10
      ELSE IF (LV.LT.LC) THEN
         CALL VECEX (C,V)
         GOTO 10
      ENDIF





      CALL GVSBV3 (V,B,C)
      LV=GVFLNV(V)
      IF (LV.LT.LB) THEN
         CALL VECEX (B,C)
         CALL VECEX (B,V)
         GOTO 10
      ELSE IF (LV.LT.LC) THEN
         CALL VECEX (C,V)
         GOTO 10
      ENDIF
      CALL GVSTV3 (V,B,C)
      LV=GVFLNV(V)
      IF (LV.LT.LB) THEN
         CALL VECEX (B,C)
         CALL VECEX (B,V)
         GOTO 10
      ELSE IF (LV.LT.LC) THEN
         CALL VECEX (C,V)
         GOTO 10
      ENDIF



      DO 17 DIM=1,3
         OUTMAT(DIM,1)=A(DIM)
         OUTMAT(DIM,2)=B(DIM)
         OUTMAT(DIM,3)=C(DIM)
 17   CONTINUE
      IF (GVFDET(OUTMAT).LT.0) THEN
         DO 18 DIM=1,3
            A(DIM)=-A(DIM)
 18      CONTINUE
      END IF



      ALPH=GVFRTD(GVFANG(B,C))
      BETA=GVFRTD(GVFANG(A,C))
      GAMM=GVFRTD(GVFANG(A,B))
      IF ((ALPH.LT.89.95.AND.BETA.LT.89.95.AND.GAMM.GE.89.95).OR.
     +     (ALPH.GT.89.95.AND.BETA.GT.89.95.AND.GAMM.LT.89.95)) THEN
         DO 12 DIM=1,3
            A(DIM)=-A(DIM)
            B(DIM)=-B(DIM)
 12      CONTINUE
      ELSE IF ((ALPH.LT.89.95.AND.BETA.GE.89.95.AND.GAMM.GE.89.95).OR.
     +        (ALPH.GE.89.95.AND.BETA.LT.89.95.AND.GAMM.LT.89.95)) THEN
         DO 14 DIM=1,3
            C(DIM)=-C(DIM)
            B(DIM)=-B(DIM)
 14      CONTINUE
      ELSE IF ((ALPH.LT.89.95.AND.BETA.GE.89.95.AND.GAMM.LT.89.95).OR.
     +        (ALPH.GE.89.95.AND.BETA.LT.89.95.AND.GAMM.GE.89.95)) THEN
         DO 16 DIM=1,3
            C(DIM)=-C(DIM)
            A(DIM)=-A(DIM)
 16      CONTINUE
      END IF
 100  CONTINUE
      RCELDIM(1)=LA
      RCELDIM(2)=LB
      RCELDIM(3)=LC
      RCELDIM(4)=GVFRTD(GVFANG(B,C))
      RCELDIM(5)=GVFRTD(GVFANG(A,C))
      RCELDIM(6)=GVFRTD(GVFANG(A,B))
      CALL GVSCPR (OUTMAT(1,1),A,3)
      CALL GVSCPR (OUTMAT(1,2),B,3)
      CALL GVSCPR (OUTMAT(1,3),C,3)
      CALL GVSTPS (OUTMAT,3)
      CALL GVSTPS (CELMAT,3)
      CALL GVSMIV (CELMAT,3,IERR)
      CALL GVS3X3 (CELTRR,OUTMAT,CELMAT)





      RETURN
      END
      SUBROUTINE VECEX (A,B)



















      IMPLICIT      NONE
      REAL          A(3), B(3), T
      INTEGER       I




      DO 10 I=1,3
         T=A(I)
         A(I)=-B(I)
         B(I)=T
 10   CONTINUE





      RETURN
      END
      SUBROUTINE CELCON (RCELDIM,CCELDIM,BRAVAIS,CCLASS,CELTRC)





















      IMPLICIT      NONE
      REAL          LIMDELTA,MAXDELTA
      INTEGER       MAXAX
      PARAMETER     (MAXAX=30)
      PARAMETER     (LIMDELTA=1.0)
      PARAMETER     (MAXDELTA=1.0)
      INTEGER       DIM, N90, N30, N60, N45, IMIL, JMIL, NMIL, I, J,
     +              I1, I2, I3, SM, NAX, IAX, JAX, IERR
      REAL          RCELDIM(6), CCELDIM(6), CELMAT(3,3), OUTMAT(3,3),
     +              RECCEL(6), INV(3,3), CELTRC(3,3), OUTTR(3,3),
     +              DIR(3,MAXAX), DELTA(MAXAX),LEN1,LEN3,CURLEN,
     +              MILLER(3,125), CURDEL, OUTP, INP, T(3), TAU(3),
     +              L(3,3), LPI(3,3), OUTV(3), GVFDTR, GVFRTD, GVFDP3,
     +              GVFLNV, GVFANG, GVFDET, ANG(MAXAX,MAXAX), A,
     +              LAST(3), V(3)
      CHARACTER     BRAVAIS, CCLASS*12
      LOGICAL       REDUNDANT(MAXAX), VECINT







      CALL GVSCPR (CCELDIM,RCELDIM,6)
      BRAVAIS='P'
      CCLASS='UNKNOWN'



      CALL CELREC (RECCEL,RCELDIM)



      CALL GVSRT0 (L,9)
      L(1,1)=RCELDIM(1)*SIN(GVFDTR(RCELDIM(5)))*SIN(GVFDTR(RECCEL(6)))
      L(2,1)=(-RCELDIM(1))*
     +                  SIN(GVFDTR(RCELDIM(5)))*COS(GVFDTR(RECCEL(6)))
      L(3,1)=RCELDIM(1)*COS(GVFDTR(RCELDIM(5)))
      L(2,2)=RCELDIM(2)*SIN(GVFDTR(RCELDIM(4)))
      L(3,2)=RCELDIM(2)*COS(GVFDTR(RCELDIM(4)))
      L(3,3)=RCELDIM(3)



      CALL GVSTP2 (LPI,L,3)
      CALL GVSMIV (LPI,3,IERR)




      NMIL=0
      DO 120 I1=0,2
         DO 110 I2=-2,2
            DO 100 I3=-2,2
               IF (ABS(I1).EQ.1.OR.ABS(I2).EQ.1.OR.ABS(I3).EQ.1) THEN
                  IF (I1.GT.0.OR.(I1.EQ.0.AND.I2.GT.0).OR.
     &                 (I1.EQ.0.AND.I2.EQ.0.AND.I3.GT.0)) THEN
                     NMIL=NMIL+1
                     MILLER(1,NMIL)=I1
                     MILLER(2,NMIL)=I2
                     MILLER(3,NMIL)=I3
                  END IF
               END IF
  100       CONTINUE
  110    CONTINUE
  120 CONTINUE




      NAX=0
      DO 160 IMIL=1,NMIL
         DO 150 JMIL=1,NMIL
            SM=0
            DO 130 I=1,3
               SM=SM+NINT(MILLER(I,IMIL))*NINT(MILLER(I,JMIL))
  130       CONTINUE
            IF (ABS(SM).NE.1..AND.ABS(SM).NE.2.) GOTO 150



            CALL GVSMV3 (T,L,MILLER(1,IMIL))



            CALL GVSMV3 (TAU,LPI,MILLER(1,JMIL))



            INP=ABS(GVFDP3(T,TAU))



            CALL GVSCP3 (OUTV, T, TAU)
            OUTP=GVFLNV(OUTV)
            CURDEL=GVFRTD(ATAN2(OUTP,INP))
            IF (CURDEL.LT.LIMDELTA) THEN
               IF (NAX.GE.MAXAX) THEN
                  CALL GVSTTB ('?SYM082')
               ELSE
                  NAX=NAX+1
                  DO 140 I=1,3
                     DIR(I,NAX)=T(I)
                     DELTA(NAX)=CURDEL
 140              CONTINUE
               END IF
            END IF
 150     CONTINUE
 160  CONTINUE



      IF (NAX.EQ.0) GOTO 221
      CALL GVSBTF (REDUNDANT,NAX)
      DO 180 IAX=1,NAX
         IF (.NOT.REDUNDANT(IAX)) THEN
            DO 170 JAX=IAX+1,NAX
               A=GVFRTD(GVFANG(DIR(1,IAX),DIR(1,JAX)))
               IF (A.LT.2.OR.A.GT.178) REDUNDANT(JAX)=.TRUE.
 170        CONTINUE
         END IF
 180  CONTINUE
      JAX=0
      DO 190 IAX=1,NAX
         IF (.NOT.REDUNDANT(IAX)) THEN
            JAX=JAX+1
            IF (JAX.LT.IAX) CALL GVSCPR (DIR(1,JAX), DIR(1,IAX), 3)
         END IF
 190  CONTINUE
      NAX=JAX



 200  CONTINUE
      CALL GVSRT0 (ANG,MAXAX*MAXAX)
      DO 220 IAX=1,NAX
         DO 210 JAX=1,NAX
            ANG(IAX,JAX)=GVFRTD(GVFANG(DIR(1,IAX),DIR(1,JAX)))
            IF (ANG(IAX,JAX).GT.90) ANG(IAX,JAX)=180-ANG(IAX,JAX)
 210     CONTINUE
 220  CONTINUE

 221  CONTINUE
      IF (NAX.LT.1) THEN



         CALL GVSCPR (OUTMAT, L, 9)
         CCLASS='TRICLINIC'
      ELSE IF (NAX.EQ.1) THEN



         CCLASS='MONOCLINIC'
         CALL GVSRT0 (OUTMAT,9)
         DO 230 DIM=1,3
            OUTMAT(DIM,2)=DIR(DIM,NAX)
  230    CONTINUE



         LEN1=10000.0
         DO 250 IMIL=1,NMIL
            CALL GVSMV3 (T,L,MILLER(1,IMIL))
            CURLEN=GVFLNV(T)
            IF (CURLEN.LT.LEN1.AND.
     &           ABS(GVFRTD(GVFANG(OUTMAT(1,2),T))-90).LT.MAXDELTA)
     &           THEN
               DO 240 DIM=1,3
                  OUTMAT(DIM,1)=T(DIM)
  240          CONTINUE
               LEN1=CURLEN
            END IF
  250    CONTINUE




         LEN3=10000.0
         DO 280 IMIL=1,NMIL
            CALL GVSMV3 (T,L,MILLER(1,IMIL))
            CURLEN=GVFLNV(T)
            IF (CURLEN.LT.LEN3.AND.
     &           ABS(GVFRTD(GVFANG(OUTMAT(1,2),T))-90).LT.MAXDELTA)
     &           THEN
               DO 260 DIM=1,3
                  OUTMAT(DIM,3)=T(DIM)
  260          CONTINUE
               IF (ABS(GVFDET(OUTMAT)).GT.1.) THEN
                  LEN3=CURLEN
                  DO 270 DIM=1,3
                     LAST(DIM)=T(DIM)
  270             CONTINUE
               END IF
            END IF
  280    CONTINUE
         DO 290 DIM=1,3
            OUTMAT(DIM,3)=LAST(DIM)
  290    CONTINUE



         IF (GVFRTD(GVFANG(OUTMAT(1,1),OUTMAT(1,3))).LT.90) THEN
            DO 300 DIM=1,3
               OUTMAT(DIM,1)=-OUTMAT(DIM,1)
  300       CONTINUE
         END IF



         IF (GVFDET(OUTMAT).LT.0) THEN
            DO 310 DIM=1,3
               OUTMAT(DIM,2)=-OUTMAT(DIM,2)
  310       CONTINUE
         END IF



         IF (ABS(GVFDET(OUTMAT)).LT.1.) THEN
            CALL GVSTTB ('?SYM083')
            CALL GVSWM3 (OUTMAT)
            GOTO 500
         END IF
      ELSE IF (NAX.EQ.2) THEN
         GOTO 500
      ELSE IF (NAX.EQ.3) THEN



         DO 330 I=1,NAX-1
            DO 320 J=I+1,NAX
               IF (ABS(ANG(I,J)-90.0).GT.MAXDELTA) GOTO 520
  320       CONTINUE
  330    CONTINUE
         CCLASS='ORTHORHOMBIC'



         CALL GVSCPR (OUTMAT,DIR,9)



         IF (GVFLNV(OUTMAT(1,1)).GT.GVFLNV(OUTMAT(1,2)))
     +        CALL VECEX (OUTMAT(1,1),OUTMAT(1,2))
         IF (GVFLNV(OUTMAT(1,2)).GT.GVFLNV(OUTMAT(1,3)))
     +        CALL VECEX (OUTMAT(1,2),OUTMAT(1,3))
         IF (GVFLNV(OUTMAT(1,1)).GT.GVFLNV(OUTMAT(1,2)))
     +        CALL VECEX (OUTMAT(1,1),OUTMAT(1,2))



         IF (GVFDET(OUTMAT).LT.0) THEN
            DO 340 DIM=1,3
               OUTMAT(DIM,1)=-OUTMAT(DIM,1)
  340       CONTINUE
         END IF
      ELSE IF (NAX.EQ.4) THEN
         GOTO 500
      ELSE IF (NAX.EQ.5) THEN





         A=10000.0
         DO 370 I=1,NAX
            N90=0
            DO 360 J=1,NAX
               IF (ABS(ANG(I,J)-90.0).LE.MAXDELTA) N90=N90+1
  360       CONTINUE
            IF (N90.EQ.4) THEN
               CALL GVSCPR (OUTMAT(1,3),DIR(1,I),3)
            ELSE IF (N90.NE.2) THEN
               GOTO 500
            ELSE IF (GVFLNV(DIR(1,I)).LT.0.95*A) THEN
               CALL GVSCPR (OUTMAT(1,1),DIR(1,I),3)
               A=GVFLNV(DIR(1,I))
            ELSE IF (GVFLNV(DIR(1,I)).LT.1.05*A) THEN
               CALL GVSCPR (OUTMAT(1,2),DIR(1,I),3)
            END IF
  370    CONTINUE



         IF (ABS(GVFDET(OUTMAT)).LT.1.) GOTO 500
         CCLASS='TETRAGONAL'



         IF (GVFDET(OUTMAT).LT.0) THEN
            DO 380 DIM=1,3
               OUTMAT(DIM,1)=-OUTMAT(DIM,1)
  380       CONTINUE
         END IF
      ELSE IF (NAX.EQ.6) THEN
         GOTO 500
      ELSE IF (NAX.EQ.7) THEN
         A=10000.0
         DO 400 I=1,NAX
            N90=0
            N30=0
            N60=0
            DO 390 J=1,NAX
               IF (ABS(ANG(I,J)-90.0).LE.MAXDELTA) N90=N90+1
               IF (ABS(ANG(I,J)-60.0).LE.MAXDELTA) N60=N60+1
               IF (ABS(ANG(I,J)-30.0).LE.MAXDELTA) N30=N30+1
  390       CONTINUE
            IF (N90.EQ.6) THEN
               CALL GVSCPR (OUTMAT(1,3),DIR(1,I),3)
            ELSE IF (N90.NE.2.OR.N60.NE.2.OR.N30.NE.2) THEN
               GOTO 500
            ELSE IF (GVFLNV(DIR(1,I)).LT.0.95*A) THEN
               CALL GVSCPR (OUTMAT(1,1),DIR(1,I),3)
               A=GVFLNV(DIR(1,I))
            ELSE IF (GVFLNV(DIR(1,I)).LT.1.05*A.AND.
     &              (GVFRTD(GVFANG(DIR(1,I),OUTMAT(1,1))).GT.90.)) THEN
               CALL GVSCPR (OUTMAT(1,2),DIR(1,I),3)
            END IF
  400    CONTINUE



         IF (ABS(GVFDET(OUTMAT)).LT.1.) GOTO 500
         CCLASS='HEXAGONAL'



         IF (GVFDET(OUTMAT).LT.0) THEN
            DO 410 DIM=1,3
               OUTMAT(DIM,3)=-OUTMAT(DIM,3)
  410       CONTINUE
         END IF
      ELSE IF (NAX.EQ.8) THEN
         GOTO 500
      ELSE IF (NAX.EQ.9) THEN
         J=0
         DO 430 IAX=1,NAX
            N90=0
            N60=0
            N45=0
            DO 420 JAX=1,NAX
               IF (ABS(ANG(IAX,JAX)-90.0).LE.MAXDELTA) N90=N90+1
               IF (ABS(ANG(IAX,JAX)-60.0).LE.MAXDELTA) N60=N60+1
               IF (ABS(ANG(IAX,JAX)-45.0).LE.MAXDELTA) N45=N45+1
  420       CONTINUE
            IF (N60.EQ.0.AND.N90.EQ.4.AND.N45.EQ.4) THEN
               J=J+1
               IF (J.EQ.4) GOTO 500
               CALL GVSCPR (OUTMAT(1,J),DIR(1,IAX),3)
            ELSE IF (N60.EQ.4.AND.N45.EQ.2.AND.N90.EQ.2) THEN
               CONTINUE
            ELSE
               GOTO 500
            END IF
  430    CONTINUE



         IF (J.NE.3) GOTO 500
         CCLASS='CUBIC'



         IF (GVFDET(OUTMAT).LT.0) THEN
            DO 440 DIM=1,3
               A=OUTMAT(DIM,1)
               OUTMAT(DIM,1)=OUTMAT(DIM,2)
               OUTMAT(DIM,2)=A
  440       CONTINUE
         END IF
      ELSE
         GOTO 500
      END IF



  450 CONTINUE
      BRAVAIS='P'
      T(1)=1.0
      T(2)=1.0
      T(3)=0.0
      CALL GVSMI2 (INV, OUTMAT, 3,IERR)
      CALL CEL004 (INV, CCELDIM(1), CCELDIM(2), CCELDIM(3),
     +     CCELDIM(4), CCELDIM(5), CCELDIM(6))
      CCELDIM(4)=GVFRTD(CCELDIM(4))
      CCELDIM(5)=GVFRTD(CCELDIM(5))
      CCELDIM(6)=GVFRTD(CCELDIM(6))



      CALL GVSCPR (CELMAT,L,9)
      CALL GVSTP2 (OUTTR,OUTMAT,3)
      CALL GVSTPS (CELMAT,3)
      CALL GVSMIV (CELMAT,3,IERR)
      CALL GVS3X3 (CELTRC,OUTTR,CELMAT)



      A=GVFDET(CELTRC)
      IF (ABS(A-4.0).LT.0.02) THEN
         BRAVAIS='F'
      ELSE IF (ABS(A-3.0).LT.0.02) THEN
         BRAVAIS='R'
      ELSE IF (ABS(A-1.0).LT.0.02) THEN
         BRAVAIS='P'
      ELSE IF (ABS(A-2.0).LT.0.02) THEN



         CALL GVSTP2 (INV, CELTRC, 3)
         V(1)=0.5
         V(2)=0
         V(3)=0.5
         CALL GVSMVV (V,INV)
         IF (VECINT(V)) THEN
            BRAVAIS='B'
            GOTO 460
         END IF
         V(1)=0.5
         V(2)=0.5
         V(3)=0
         CALL GVSMVV (V,INV)
         IF (VECINT(V)) THEN
            BRAVAIS='C'
            GOTO 998
         END IF
         V(1)=0
         V(2)=0.5
         V(3)=0.5
         CALL GVSMVV (V,INV)
         IF (VECINT(V)) THEN
            BRAVAIS='A'
            GOTO 460
         END IF
         V(1)=0.5
         V(2)=0.5
         V(3)=0.5
         CALL GVSMVV (V,INV)
         IF (VECINT(V)) THEN
            BRAVAIS='I'
            GOTO 460
         END IF
         CALL GVSTTB ('?SYM084')
      ELSE



         CALL GVSTTB ('?SYM085')
         CALL GVSTTR ('?SYM086',A)
      END IF
      GOTO 998



 460  CONTINUE
      IF (NAX.LT.3) THEN
         IF (BRAVAIS.EQ.'A') THEN
            DO 470 I=1,3
               A=OUTMAT(I,1)
               OUTMAT(I,1)=OUTMAT(I,3)
               OUTMAT(I,3)=A
               OUTMAT(I,2)=-OUTMAT(I,2)
 470        CONTINUE
            BRAVAIS='C'
         ELSE IF (BRAVAIS.EQ.'I') THEN
            DO 475 I=1,3
               A=OUTMAT(I,3)
               OUTMAT(I,3)=OUTMAT(I,1)
               OUTMAT(I,1)=-OUTMAT(I,1)-A
 475        CONTINUE
            BRAVAIS='C'
         ELSE
            GOTO 998
         END IF
      ELSE IF (NAX.EQ.3) THEN
         IF (BRAVAIS.EQ.'A') THEN
            DO 480 I=1,3
               A=OUTMAT(I,1)
               OUTMAT(I,1)=OUTMAT(I,2)
               OUTMAT(I,2)=OUTMAT(I,3)
               OUTMAT(I,3)=A
 480        CONTINUE
            BRAVAIS='C'
         ELSE IF (BRAVAIS.EQ.'B') THEN
            DO 490 I=1,3
               A=OUTMAT(I,2)
               OUTMAT(I,2)=OUTMAT(I,3)
               OUTMAT(I,3)=A
               OUTMAT(I,1)=-OUTMAT(I,1)
 490        CONTINUE
            BRAVAIS='C'
         ELSE
            GOTO 998
         END IF
      ELSE
         GOTO 998
      END IF
      GOTO 450



 500  CONTINUE
      IF (NAX.EQ.0) THEN
         CALL GVSTTB ('?SYM087')
         GOTO 998
      END IF
      A=DELTA(1)
      JAX=1
      DO 510 IAX=2,NAX
         IF (DELTA(IAX).GT.A) THEN
            A=DELTA(IAX)
            JAX=IAX
         END IF
 510  CONTINUE
      IF (JAX.LT.NAX) THEN
         DIR(1,JAX)=DIR(1,NAX)
         DIR(2,JAX)=DIR(2,NAX)
         DIR(3,JAX)=DIR(3,NAX)
         DELTA(JAX)=DELTA(NAX)
      END IF
      NAX=NAX-1
      GOTO 200






 520  CONTINUE
      DO 540 I=1,NAX-1
         DO 530 J=I+1,NAX
            IF (ABS(ANG(I,J)-60.0).GT.MAXDELTA) GOTO 500
 530     CONTINUE
 540  CONTINUE

      DO 545 DIM=1,3
         OUTMAT(DIM,1)=L(DIM,1)-L(DIM,2)
         OUTMAT(DIM,2)=L(DIM,2)-L(DIM,3)
         OUTMAT(DIM,3)=L(DIM,1)+L(DIM,2)+L(DIM,3)
 545  CONTINUE
      CCLASS='TRIGONAL'
      GOTO 450



  998 CONTINUE


      END
      SUBROUTINE CELREC (CELDIMS,CELDIM)



















      IMPLICIT      NONE
      REAL          A, B, C, ALFA, BETA, GAMMA, AS, BS, CS, ALFAS,
     +              BETAS, GAMMAS, CELDIM(6), CELDIMS(6), GVFDTR, 
     +              GVFRTD, GVFACS





      IF (CELDIM(4).LT.5.OR.CELDIM(5).LT.5.OR.CELDIM(6).LT.5) THEN
         CALL GVSTTE ('?SYM088')
         CALL GVSTTR3 ('?M3353',CELDIM(1),CELDIM(2),CELDIM(3))
         CALL GVSTTR3 ('?M3354',CELDIM(4),CELDIM(5),CELDIM(6))
         GOTO 998
      END IF
      A=CELDIM(1)
      B=CELDIM(2)
      C=CELDIM(3)
      ALFA=GVFDTR(CELDIM(4))
      BETA=GVFDTR(CELDIM(5))
      GAMMA=GVFDTR(CELDIM(6))
      ALFAS=(COS(BETA)*COS(GAMMA)-COS(ALFA))/(SIN(BETA)*SIN(GAMMA))
      ALFAS=GVFACS(ALFAS)
      BETAS=(COS(ALFA)*COS(GAMMA)-COS(BETA))/(SIN(ALFA)*SIN(GAMMA))
      BETAS=GVFACS(BETAS)
      GAMMAS=(COS(ALFA)*COS(BETA)-COS(GAMMA))/(SIN(ALFA)*SIN(BETA))
      GAMMAS=GVFACS(GAMMAS)
      AS=1/(A*SIN(BETA)*SIN(GAMMAS))
      BS=1/(B*SIN(ALFA)*SIN(GAMMAS))
      CS=1/(C*SIN(ALFA)*SIN(BETAS))
      CELDIMS(1)=AS
      CELDIMS(2)=BS
      CELDIMS(3)=CS
      CELDIMS(4)=GVFRTD(ALFAS)
      CELDIMS(5)=GVFRTD(BETAS)
      CELDIMS(6)=GVFRTD(GAMMAS)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CELNEW





















      IMPLICIT      NONE

      INCLUDE       'SYMINC.INC'
      INCLUDE       'BIGINC.INC'
      INTEGER       ISOUP1, ISOUP2, I, J, IERR, FOUND(MAXMOL), NMATCH
      REAL          THEMAT(3,3), THEVEC(3), FRCMAT(3,3), FRCVEC(3), RMS,
     +              NEWMAT(3,3), NEWVEC(3), TMPMAT(3,3), 
     +              IMAT(3,3), D, TMP
      LOGICAL       ANYEQTYP, WIFISR, RESULT





      CALL GVSTP2 (TMPMAT, CELTR, 3)
      CALL GVSMI2 (IMAT, TMPMAT, 3, IERR)
      NMATCH=0
      RESULT=.FALSE.



      IF (NUMAAF.GT.MAXAA) THEN
         CALL GVSTTE ('?SYM089')
         GOTO 998
      END IF
      DO 5 I=1,NUMSOU
         FOUND(I)=1
         IF (.NOT.WIFISR(I)) FOUND(I)=-1
         IF (SOUADM(3,I).GT.MAXAA) THEN
            CALL GVSTTE ('?SYM090')
            GOTO 998
         END IF
 5    CONTINUE



      CALL MOL311A
      ANYEQTYP=.FALSE.



      DO 100 ISOUP1=1,NUMSOU-1
         IF (.NOT.WIFISR(ISOUP1)) GOTO 100
         DO 90 ISOUP2=ISOUP1+1,NUMSOU
            IF (.NOT.WIFISR(ISOUP2)) GOTO 90



            IF (SOUADM(5,ISOUP1).NE.SOUADM(5,ISOUP2)) GOTO 90
            ANYEQTYP=.TRUE.
            CALL SUP024 (ISOUP1,ISOUP2,THEMAT,THEVEC,RMS,IERR)
            IF (IERR.EQ.0) THEN
               RESULT=.TRUE.



               NMATCH=NMATCH+1
               IF (NMATCH.LE.WIFPAR(943)) THEN
                  CALL PDBC16 (ISOUP1, ISOUP2, THEMAT, THEVEC)
               ELSE IF (NMATCH.EQ.WIFPAR(943)+1.AND.NMATCH.GT.1) THEN
                  CALL PDBMES ('NOMORNCS')
               END IF



               IF (WIFPAR(279).LE.0) CALL GVSTTI ('?SYM091',ISOUP1)
               IF (WIFPAR(279).LE.0) CALL GVSTTI ('?SYM092',ISOUP2)
               IF (WIFPAR(279).LE.0) CALL RHSWMV (THEMAT, THEVEC)
               IF (WIFPAR(279).LE.0) CALL GVSTTR ('RMS =',RMS)
               CALL SYMO2F (THEMAT, THEVEC, FRCMAT, FRCVEC)
               IF (WIFPAR(279).LE.0) CALL GVSTT6 ('?SYMIFRC')
               IF (WIFPAR(279).LE.0) CALL RHSWMV (FRCMAT, FRCVEC)

               CALL GVSMV3 (NEWVEC, IMAT, FRCVEC)

               CALL GVS3X3 (NEWMAT, IMAT, FRCMAT)
               CALL GVSNX3 (NEWMAT, TMPMAT)

               IF (WIFPAR(279).LE.0) CALL SHOWTEXT ('?SYMNFRC')
               IF (WIFPAR(279).LE.0) CALL RHSWMV (NEWMAT, NEWVEC)



               D=0.0
               DO 50 I=1,3
                  DO 60 J=1,3
                     TMP=MOD(NEWMAT(I,J),1.0)
                     IF (TMP.LT.0.0) TMP=TMP+1.0
                     IF (TMP.GT.0.5) TMP=1.0-TMP
                     D=MAX(TMP,D)
 60               CONTINUE
 50            CONTINUE
               IF (WIFPAR(279).LE.0) CALL GVSTTR ('?SYM093',D)
               IF (D.LT.0.01) THEN
                  FOUND(ISOUP1)=FOUND(ISOUP1)+1
                  FOUND(ISOUP2)=FOUND(ISOUP2)+1
               END IF
            END IF
 90      CONTINUE
 100  CONTINUE
      IF (.NOT.RESULT.AND.WIFPAR(279).LE.0) CALL SHOWTEXTIF ('?M1465')




      DO 110 I=1,NUMSOU
         IF (FOUND(I).EQ.1) THEN
            IF (NEWCLS) THEN
               CALL PDBMES ('NONEWCLS')
            ELSE
               IF (ANYEQTYP) CALL PDBMES ('NONEWSYM')
            END IF
            GOTO 998
         END IF
 110  CONTINUE



      IF (WIFPAR(1507).GT.0) THEN
         CALL PDBMES ('NEWSYM')
      ELSE
         CALL PDBMES ('NEWSYM2')
      END IF



  998 CONTINUE
      CALL MOL312



      RETURN
      END
      SUBROUTINE CELAPP



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INTEGER       IERR
      LOGICAL       GVFIMU





      IF (GVFIMU(CELTR)) THEN
         CALL GVSTTE ('?SYM094')
         GOTO 998
      END IF
      CALL GVSTPS (CELTR, 3)
      CALL GVSNX3 (SYMINV, CELTR)
      CALL GVSMI2 (SYMSCL, SYMINV, 3, IERR)
      CALL GVSCPR (CELDIM, CCELDIM, 6)
      CALL GVSMIV (CELTR, 3, IERR)
      CALL GVSMVV (SYMTRN, CELTR)
      CALL GVSMTU (CELTR, 3)
      CALL SHOWTEXT ('?SYMNOVAL')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CELROT



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          GVFGTA, TMP(3,3)





      CALL CEL001 (CELDIMS(1),CELDIMS(2),CELDIMS(3),
     +     CELDIMS(4),CELDIMS(5),CELDIMS(6),TMP)
      CALL GVS3X3 (MPRIME,TMP,SYMSCL)
      IF (GVFGTA(MPRIME).LT.0.1) THEN
         CALL GVSMTU (MPRIME,3)
         MPRIMS=0
         GOTO 998
      END IF
      MPRIMS=1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SYMMOV



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MAXN
      PARAMETER     (MAXN=1000)
      INTEGER       IAA, JAAARR(MAXN), JAASYM(MAXN), NUM, LAST, CNT, I,
     +              HIGHEST, HIGHESTCOUNT, SYMNEG, IAAARR(1), ISYM
      REAL          RAD







      CALL WIFGRS (IAA,' ')



      CALL ENVPROT
      CALL WIFPUSHPPP (590,1)
      RAD=5.0
 10   CONTINUE
      CALL FCONAAI (IAA,5.0,.FALSE.,JAAARR,JAASYM,NUM,MAXN)



      IF (NUM.EQ.0) THEN
         IF (NUMSYM.LT.MAXSYM/2.AND.RAD.LT.100.0) THEN
            RAD=RAD*1.3
            WIFPAR(592)=0
            CALL SYMSD (RAD)
            WIFPAR(592)=1
            GOTO 10
         END IF
         CALL GVSTTE ('?M3355')
         GOTO 998
      END IF
      CALL GVSTTI ('?M3356',NUM)
      CALL WIFPOPPPP (590)



      CALL GVSIR1 (JAASYM,NUM)



      LAST=0
      CNT=0
      HIGHESTCOUNT=0
      HIGHEST=0
      DO 100 I=1,NUM
         IF (JAASYM(I).EQ.LAST) THEN
            CNT=CNT+1
         ELSE
            CNT=1
            LAST=JAASYM(I)
         END IF
         IF (CNT.GT.HIGHESTCOUNT) THEN
            HIGHESTCOUNT=CNT
            HIGHEST=JAASYM(I)
         END IF
  100 CONTINUE



      CALL GVSTTI ('?M3357',HIGHEST)
      CALL GVSTTI ('?M3358',HIGHESTCOUNT)
      ISYM=SYMNEG(HIGHEST)



      IAAARR(1)=IAA
      CALL WIF092A (IAAARR,1,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
      WIFPAR(592)=0



  998 CONTINUE


      RETURN
      END
      BLOCK DATA SYM
      IMPLICIT      NONE
      INCLUDE       'SYMDAT.INC'

      DATA SPCNMS/
     + 'P 1',
     + 'P 2','P 21','C 2',
     + 'P 2 2 2','P 2 2 21','P 21 21 2','P 21 21 21','C 2 2 21',
     +    'C 2 2 2','F 2 2 2','I 2 2 2','I 21 21 21',
     + 'P 4','P 41','P 42','P 43','I 4','I 41',
     + 'P 4 2 2','P 4 21 2','P 41 2 2','P 41 21 2','P 42 2 2',
     +    'P 42 21 2','P 43 2 2','P 43 21 2','I 4 2 2','I 41 2 2',
     + 'P 3','P 31','P 32','R 3',
     + 'P 3 1 2','P 3 2 1','P 31 1 2','P 31 2 1',
     + 'P 32 1 2','P 32 2 1','R 3 2',
     + 'P 6','P 61','P 65','P 62','P 64','P 63',
     + 'P 6 2 2','P 61 2 2','P 65 2 2','P 62 2 2','P 64 2 2','P 63 2 2',
     + 'P 2 3','F 2 3','I 2 3','P 21 3','I 21 3',
     + 'P 4 3 2','P 42 3 2','F 4 3 2','F 41 3 2','I 4 3 2',
     +    'P 43 3 2','P 41 3 2','I 41 3 2',
     + 'C 1 2 1','P 1 2 1','P 1 21 1',
     +     'H 3', 'H 3 2'/
      DATA SPCNUS/
     + 1,
     + 3,4,5,
     + 16,17,18,19,20,21,22,23,24,
     + 75,76,77,78,79,80,
     + 89,90,91,92,93,94,95,96,97,98,
     + 143,144,145,146,
     + 149,150,151,152,
     + 153,154,155,
     + 168,169,170,171,172,173,
     + 177,178,179,180,181,182,
     + 195,196,197,198,199,
     + 207,208,209,210,211,212,213,214,
     +     5,3,4,
     +     146,155/
      DATA SPCCSS/
     +  1*'TRICLINIC',
     +  3*'MONOCLINIC',
     +  9*'ORTHORHOMBIC',
     + 16*'TETRAGONAL',
     + 11*'TRIGONAL',
     + 12*'HEXAGONAL',
     + 13*'CUBIC',
     +  3*'MONOCLINIC',
     +  2*'HEXAGONAL'/
      DATA ONAMS/
     + 'C 21','A 2','A 21','B 2','B 21','I 2','I 21',
     + 'P 2 21 2','P 21 2 2',
     + 'P 2 21 21','P 21 2 21',
     + 'A 21 2 2','B 2 21 2',
     + 'A 2 2 2','B 2 2 2',
     + 'F 21 21 21','F 21 21 2','F 21 2 21','F 21 2 2','F 2 21 21',
     +    'F 2 21 2','F 2 2 21',
     + 'C 4','C 41','C 42','C 43','F 4','F 41',
     + 'C 4 2 2','C 4 2 21','C 41 2 2','C 41 2 21','C 42 2 2',
     +    'C 42 2 21','C 43 2 2','C 43 2 21','F 4 2 2','F 41 2 2',
     + 'P 1 1 21',
     + 'Z 3','Z 3 2',
     +     'I 1 2 1'/
      DATA ONUMS/
     + 7*5, 2*17, 2*18, 2*20, 2*21, 7*22, 75, 76, 77, 78, 79, 80,
     + 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 4, 146, 155,
     +     5/

      END
