



      SUBROUTINE CELPRN (V)




















      IMPLICIT      NONE
      REAL          V(6)

      CALL CELPR6 (V(1),V(2),V(3),V(4),V(5),V(6))

      RETURN
      END
      SUBROUTINE CELPR6 (V1,V2,V3,V4,V5,V6)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'PDBINC.INC'
      REAL          V1, V2, V3, V4, V5, V6
      LOGICAL       GVFFOP

      WRITE (6,1000,ERR=997) V1,V2,V3,V4,V5,V6
      IF (GVFFOP(PDBUNT)) WRITE (PDBUNT,1000,ERR=999) V1,V2,V3,V4,V5,V6
      IF (TEXLEVEL.NE.' ') WRITE (TEXUNT,1010,ERR=998) V1,V2,V3,V4,V5,V6
      IF (WIFPAR(1202).NE.0.AND.WIFPAR(1203).NE.0) THEN
         CALL SHOWTEXTU (WIFPAR(1203),'?M2106')
         CALL GVSFMT ('?M0132')
         WRITE (WIFPAR(1203),FMT,ERR=996) V1,V2,V3
         CALL GVSFMT ('?M0133')
         WRITE (WIFPAR(1203),FMT,ERR=996) V4,V5,V6
      END IF
      RETURN



 996  CALL GVSTTE ('?SYM009B')
      RETURN
 997  CALL GVSTTE ('?SYM009A')
      RETURN
 998  CALL GVSTTE ('?SYM009')
      RETURN
 999  CALL GVSTTE ('?SYM010')

 1000 FORMAT(
     + '    A    =',F8.3,'  B   =',F8.3,'  C    =',F8.3,/
     + '    Alpha=',F8.3,'  Beta=',F8.3,'  Gamma=',F8.3)

 1010 FORMAT(
     +     '\\fullpage{'/,'$\\begin{array}{lrlrlr}'/,
     +     'A =&',F8.3,'&B =&',F8.3,'&C =&',F8.3,'\\\\'/
     +     '\\alpha =&',F8.3,'&\\beta =&',F8.3,
     +     '&\\gamma =&',F8.3,'\\\\'/,
     +     '\\end{array}$}')


      RETURN
      END
      SUBROUTINE SYMF2O (RMAT,VEC)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          RMAT(3,3), VEC(3), MAT(3,3), TMPVEC(3)



      CALL GVSCPR (TMPVEC,SYMTRN,3)
      CALL GVSMPV (TMPVEC,RMAT,VEC)
      CALL GVSMPV (TMPVEC,SYMINV,SYMIVV)
      CALL GVSCPR (VEC,TMPVEC,3)



      CALL GVS3X3 (MAT,RMAT,SYMSCL)
      CALL GVS3X3 (RMAT,SYMINV,MAT)

      RETURN
      END
      SUBROUTINE SYMO2F (RMAT,VEC,OUTMAT,OUTVEC)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          RMAT(3,3), VEC(3), OUTMAT(3,3), OUTVEC(3)
      REAL          MATTMP(3,3)



      CALL GVSCPR (OUTVEC,SYMIVV,3)
      CALL GVSMPV (OUTVEC,RMAT,VEC)
      CALL GVSMPV (OUTVEC,SYMSCL,SYMTRN)



      CALL GVS3X3 (MATTMP,RMAT,SYMINV)
      CALL GVS3X3 (OUTMAT,SYMSCL,MATTMP)

      RETURN
      END
      SUBROUTINE MATCMP (STS,MAT1,MAT2,TOL)



















      IMPLICIT      NONE
      REAL          MAT1(3,3), MAT2(3,3), TOL, GVFDV3, D
      INTEGER       STS, I

      DO 10 I=1,3
        D=GVFDV3(MAT1(1,I),MAT2(1,I))
        IF (D.GT.TOL) THEN
          STS=1
          RETURN
        END IF
 10   CONTINUE
      STS=0

      RETURN
      END
      SUBROUTINE CELSHO



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'



      CALL GVSTT6 ('?SYMSCL')
      CALL RHSWMV (SYMSCL,SYMTRN)
      CALL GVSNL6 (1)
      CALL GVSTT6 ('?SYMINV')
      CALL RHSWMV (SYMINV,SYMIVV)
      CALL GVSNL6 (1)
      CALL GVSTT6 ('?SYMDUC')
      CALL CELPRN (CELDIM)
      CALL GVST6C ('?SYM015',SPCNAM,.TRUE.)

      RETURN
      END
      SUBROUTINE MATITM (IMAT,INLINE,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'

      INCLUDE       'SYMINC.INC'
      CHARACTER     INLINE*(*)
      CHARACTER*80  LLINE80, LOCLIN
      CHARACTER*1   LLINE(80), ICH(17)
      INTEGER       S(3,4), IERR, GVFFCP, IMAT, I, NUMERATE,
     +              LD, MINUS, L, N, J, GVFLEN
      EQUIVALENCE   (LLINE,LLINE80)
      SAVE          ICH
      DATA ICH      /'1','2','3','4','5','6','7','8','9',
     +               'X','Y','Z','/',',','-','+',' '/



      CALL GVSSTX (LLINE80,INLINE)
      CALL GVSIT0 (S,12)
      I = 1
      NUMERATE = 0
      LD = 0
      MINUS = 1
      IERR = 0



      DO 200 L = 1, GVFLEN(LLINE80)



         N=GVFFCP(ICH,LLINE(L),17,1)
         IF (N.EQ.0) THEN
            CALL GVSFMT ('?SYMFMT34')
            WRITE (LOCLIN,FMT,ERR=200) LLINE(L)
            CALL GVSTTE (LOCLIN)
            GOTO 200
         END IF



         GOTO (130,130,130,130,130,130,130,130,130,
     +        140,140,140,150,160,170,200,200),N



  130    CONTINUE
         IF (LD.EQ.0) THEN



            S(I,4) = MINUS * 24 * N
            NUMERATE = 0
            MINUS = 1
            GOTO 200
         END IF



         IF (NUMERATE.EQ.0) THEN
            IF (MOD(S(I,4),N).NE.0) THEN
               CALL GVSFMT ('?SYMFMT35')
               WRITE(LOCLIN,FMT,ERR=200) N
               CALL GVSTTE (LOCLIN)
               IERR = 1
            END IF
            S(I,4)=S(I,4)/N
            LD=0
         ELSE



           CALL GVSTTE ('?SYM045')
           IERR = 1
           LD=0
        END IF
        GOTO 200



 140    CONTINUE
        J = N - 9
        S(I,J) = MINUS
        MINUS = 1
        GOTO 200



 150    CONTINUE
        LD = 1
        GOTO 200



 160    CONTINUE
        IF(I.EQ.3)THEN
           CALL GVSTTE ('?SYM046')
           GOTO 210
        ELSE
           I=I+1
           GOTO 200
        END IF



 170    CONTINUE
        MINUS = -1
 200  CONTINUE

      IF (I.NE.3)THEN
         CALL GVSTTE ('?SYM047')
         IERR = 1
      END IF



 210  CONTINUE
      IF (S(1,1)*(S(2,2)*S(3,3)-S(3,2)*S(2,3))+
     +    S(1,2)*(S(2,3)*S(3,1)-S(3,3)*S(2,1))+
     +    S(1,3)*(S(2,1)*S(3,2)-S(3,1)*S(2,2)).EQ.1) THEN
         DO 410 I=1,3
            DO 400 J=1,3
               SYMMAT(I,J,IMAT)=FLOAT(S(I,J))
  400       CONTINUE
            SYMVEC(I,IMAT)=FLOAT(S(I,4))/24.0
  410    CONTINUE
      ELSE
         CALL GVSTTE ('?SYM048')
         IERR = 1
      END IF

      RETURN
      END
      SUBROUTINE MATFAX (MAT,VEC)



















      IMPLICIT      NONE
      INTEGER       INDX(3), I
      REAL          MAT(3,3), VEC(3), MAT1(3,3), SAV(3), D, LV, GVFRAN,
     +              GVFLNV, GVFDP3, GVFDV3

      CALL GVSCPR (MAT1, MAT, 9)





      MAT1(1,1)=MAT1(1,1)-0.999
      MAT1(2,2)=MAT1(2,2)-0.999
      MAT1(3,3)=MAT1(3,3)-0.999



      CALL LUDCMP (MAT1,3,3,INDX,D)
      DO 20 I=1,3
         VEC(I)=GVFRAN(-1., 1.)
 20   CONTINUE
 25   CONTINUE
      CALL GVSNM3 (VEC)
      CALL GVSCPR (SAV, VEC, 3)



      CALL LUBKSB (MAT1,3,3,INDX,VEC)



      LV=GVFLNV(VEC)
      IF (LV.LT.20.) GOTO 25
      IF (GVFDP3(VEC,SAV).LT.0) GOTO 25



      CALL GVSNM3 (VEC)
      DO 30 I=1,10
         CALL LUBKSB (MAT1, 3, 3, INDX, VEC)
         CALL GVSNM3 (VEC)
 30   CONTINUE
      CALL GVSMV3 (SAV, MAT, VEC)
      IF (GVFDV3(SAV,VEC).GT.1.E-4) THEN
         CALL GVSTT6 ('?SYM050')
      END IF
      RETURN
      END
      SUBROUTINE SYMCTF (FRAC,ORTH)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          ORTH(3), FRAC(3)



      CALL GVSCPR (FRAC,ORTH,3)
      CALL GVSMPV (FRAC,SYMSCL,SYMTRN)

      RETURN
      END
      SUBROUTINE SYMCTO (ORTH,FRAC)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      REAL          VECT(3), ORTH(3), FRAC(3)



      CALL GVSCPR (VECT,FRAC,3)
      CALL GVSSV3 (VECT,SYMTRN)
      CALL GVSMV3 (ORTH,SYMINV,VECT)

      RETURN
      END
      LOGICAL FUNCTION SYMCUT(IAA,JAA,ISYM,CUTOFF)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      REAL          TMP(3), CUTOFF, DST, TMPRAD
      INTEGER       IAA, JAA, IAT, JAT, ISYM



      SYMCUT=.FALSE.
      TMP(1)=SPHRAD(1,JAA)
      TMP(2)=SPHRAD(2,JAA)
      TMP(3)=SPHRAD(3,JAA)
      IF (ISYM.GT.1) CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),
     + SYMVEC(1,ISYM))
      DST=(SPHRAD(1,IAA)-TMP(1))**2+
     +    (SPHRAD(2,IAA)-TMP(2))**2+
     +    (SPHRAD(3,IAA)-TMP(3))**2
      IF (DST.GT.(CUTOFF+SPHRAD(4,IAA)+SPHRAD(4,JAA))**2) THEN
         SYMCUT=.FALSE.
         RETURN
      END IF



      DO 20 JAT=PNTAAS(JAA),PNTAAE(JAA)
         IF (.NOT.ISATOK(JAT)) GOTO 20
         IF (PROTON(JAT).AND.WIFPAR(1183).GE.1) GOTO 20
         TMP(1)=XCOORD(JAT)
         TMP(2)=YCOORD(JAT)
         TMP(3)=ZCOORD(JAT)
         IF (ISYM.GT.1) CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),
     +    SYMVEC(1,ISYM))
         TMPRAD=VDWRAD(JAT)+CUTOFF
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(IAT)) GOTO 10
            IF (PROTON(IAT).AND.WIFPAR(1183).GE.1) GOTO 10
            DST = (TMP(1)-XCOORD(IAT))**2 +
     +            (TMP(2)-YCOORD(IAT))**2 +
     +            (TMP(3)-ZCOORD(IAT))**2
            IF (DST.LT.(TMPRAD+VDWRAD(IAT))**2) THEN
               SYMCUT=.TRUE.
               RETURN
            END IF
   10    CONTINUE
   20 CONTINUE
      SYMCUT=.FALSE.

      RETURN
      END
      SUBROUTINE VECCMP (STS,VEC1,VEC2)
























      IMPLICIT      NONE
      INTEGER       STS, IDIM
      REAL          VEC1(3), VEC2(3), D, TMPVEC(3), FRCVEC(3), GVFLNV



      CALL GVSTV3 (TMPVEC, VEC1, VEC2)
      D=GVFLNV(TMPVEC)



      STS=0
      IF (D.LE.0.1) RETURN



      CALL SYMCTF (FRCVEC, TMPVEC)



      DO 10 IDIM=1,3
         FRCVEC(IDIM)=FRCVEC(IDIM)-NINT(FRCVEC(IDIM))
 10   CONTINUE



      CALL SYMCTO (TMPVEC, FRCVEC)

      D=GVFLNV(TMPVEC)
      STS=1
      IF (D.GT.0.1) STS=2

      RETURN
      END
      REAL FUNCTION VECDIF (VEC1, VEC2)



















      IMPLICIT      NONE
      INTEGER       IDIM
      REAL          VEC1(3), VEC2(3), TMPVEC(3), FRCVEC(3), GVFLNV



      CALL GVSTV3 (TMPVEC, VEC1, VEC2)



      CALL SYMCTF (FRCVEC, TMPVEC)



      DO 10 IDIM=1,3
         FRCVEC(IDIM)=FRCVEC(IDIM)-NINT(FRCVEC(IDIM))
 10   CONTINUE



      CALL SYMCTO (TMPVEC, FRCVEC)

      VECDIF=GVFLNV(TMPVEC)

      RETURN
      END
      LOGICAL FUNCTION VECINT(V)



















      IMPLICIT      NONE
      REAL          V(3), FRC(3)
      INTEGER       I

      DO 10 I=1,3
         FRC(I)=MOD(ABS(V(I)),1.)
         IF (FRC(I).GT.0.5) FRC(I)=1.0-FRC(I)
 10   CONTINUE
      VECINT=(FRC(1).LT.0.05).AND.(FRC(2).LT.0.05).AND.(FRC(3).LT.0.05)

      RETURN
      END
      FUNCTION SYMIAR(RMAT,TOL)



















      IMPLICIT      NONE
      INTEGER       I
      REAL          RMAT(3,3),GVFDET,VEC(3),TOL,GVFLNV
      LOGICAL       SYMIAR

      SYMIAR=.FALSE.
      IF (ABS(GVFDET(RMAT)-1.0).GT.TOL) RETURN
      DO 10 I=1,3
         CALL GVSRT0 (VEC,3)
         VEC(I)=1.0
         CALL GVSMVV (VEC,RMAT)
         IF (ABS(GVFLNV(VEC)-1.0).GT.TOL) RETURN
 10   CONTINUE
      SYMIAR=.TRUE.

      RETURN
      END
      INTEGER FUNCTION SYMNEG(ISYM)



















      IMPLICIT      NONE 
      INCLUDE       'SYMINC.INC'
      REAL          RMAT(3,3), TMP(3), GVFLNV
      INTEGER       ISYM, JSYM, IERR
      LOGICAL       GVFIMU

      IF (ISYM.LT.1.OR.ISYM.GT.NUMSYM) THEN
         CALL GVSTTI2 ('?M3061',ISYM,NUMSYM)
         SYMNEG=1
         CALL GVSKIL
         RETURN
      END IF
      IF (SYMNIN(ISYM).GE.1.AND.SYMNIN(ISYM).LE.NUMSYM) THEN
         SYMNEG=SYMNIN(ISYM)
         RETURN
      END IF
      DO 100 JSYM=1,NUMSYM
         TMP(1)=SYMVEC(1,ISYM)
         TMP(2)=SYMVEC(2,ISYM)
         TMP(3)=SYMVEC(3,ISYM)
         CALL GVSMPV (TMP, SYMMAT(1,1,JSYM), SYMVEC(1,JSYM))
         IF (GVFLNV(TMP).LT.0.1) THEN
            CALL GVS3X3 (RMAT,SYMMAT(1,1,ISYM),SYMMAT(1,1,JSYM))
            IF (GVFIMU(RMAT)) THEN
               SYMNIN(ISYM)=JSYM
               SYMNIN(JSYM)=ISYM
               SYMNEG=SYMNIN(ISYM)
               RETURN
            END IF
         END IF
 100  CONTINUE
      NUMSYM=NUMSYM+1






      CALL GVSTTI ('?NEWZ188',NUMSYM)
      CALL GVSMI2 (SYMMAT(1,1,NUMSYM),SYMMAT(1,1,ISYM),3,IERR)
      CALL GVSMV3 (SYMVEC(1,NUMSYM),SYMMAT(1,1,NUMSYM),SYMVEC(1,ISYM))
      SYMVEC(1,NUMSYM)=-SYMVEC(1,NUMSYM)
      SYMVEC(2,NUMSYM)=-SYMVEC(2,NUMSYM)
      SYMVEC(3,NUMSYM)=-SYMVEC(3,NUMSYM)
      SYMNIN(ISYM)=NUMSYM
      SYMNIN(NUMSYM)=ISYM
      SYMNAM(NUMSYM)=0
      SYMNEG=NUMSYM

      RETURN
      END
      INTEGER FUNCTION SYMMUL(ISYM,JSYM)



















      IMPLICIT      NONE
      INCLUDE       'SYMINC.INC'
      INTEGER       ISYM, JSYM, KSYM, STS, SYMNEG
      REAL          RMAT(3,3), TMP(3)
      LOGICAL       GVFIBN



      IF (.NOT.GVFIBN(ISYM,1,NUMSYM)) THEN
         CALL GVSTTB ('?M0309')
         SYMMUL=1
         RETURN
      END IF
      IF (.NOT.GVFIBN(JSYM,1,NUMSYM)) THEN
         CALL GVSTTB ('?M0310')
         SYMMUL=1
         RETURN
      END IF



      IF (ISYM.EQ.1) THEN
         SYMMUL=JSYM
         RETURN
      END IF
      IF (JSYM.EQ.1) THEN
         SYMMUL=ISYM
         RETURN
      END IF
      IF (JSYM.EQ.SYMNEG(ISYM)) THEN
         SYMMUL=1
         RETURN
      END IF



      CALL GVS3X3 (RMAT,SYMMAT(1,1,JSYM),SYMMAT(1,1,ISYM))
      CALL GVSCPR (TMP,SYMVEC(1,ISYM),3)
      CALL GVSMPV (TMP,SYMMAT(1,1,JSYM),SYMVEC(1,JSYM))



      DO 100 KSYM=1,NUMSYM



         CALL MATCMP (STS, RMAT, SYMMAT(1,1,KSYM), 0.001)
         IF (STS.EQ.0) THEN



            CALL VECCMP (STS,TMP,SYMVEC(1,KSYM))
         END IF



         IF (STS.EQ.0) THEN
            SYMMUL=KSYM
            RETURN
         END IF
 100  CONTINUE



      NUMSYM=NUMSYM+1
      CALL GVSTTI ('?M0311',NUMSYM)
      CALL GVSCPR (SYMVEC(1,NUMSYM),TMP,3)
      CALL GVSCPR (SYMMAT(1,1,NUMSYM),RMAT,9)
      SYMNAM(NUMSYM)=0
      SYMMUL=NUMSYM

      RETURN
      END
      SUBROUTINE WIF092 (IFT1,IFT2,M,V)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IFT1, IFT2, IAA, IAT, JAA, JAT, IB
      REAL          M(3,3), V(3), W(3), GVFDET



      IF (WIFPAR(1012).NE.0) THEN
         IF (ABS(1.0-GVFDET(M)).GT.0.01) THEN
            CALL GVSWM4 (M,V)
            CALL GVSKIL
         END IF
      END IF
      IF (IFT1.LT.1.OR.IFT1.GT.IFT2.OR.IFT2.GT.NUMAAT) THEN
         CALL GVSTTE ('?BUGG10')
         RETURN
      END IF



      DO 100 IAA=IFT1,IFT2
         PREVSHOW(IAA)=-1



         W(1)=SPHRAD(1,IAA)*M(1,1)+SPHRAD(2,IAA)*M(1,2)
     +        +SPHRAD(3,IAA)*M(1,3)+V(1)
         W(2)=SPHRAD(1,IAA)*M(2,1)+SPHRAD(2,IAA)*M(2,2)
     +        +SPHRAD(3,IAA)*M(2,3)+V(2)
         W(3)=SPHRAD(1,IAA)*M(3,1)+SPHRAD(2,IAA)*M(3,2)
     +        +SPHRAD(3,IAA)*M(3,3)+V(3)
         SPHRAD(1,IAA)=W(1)
         SPHRAD(2,IAA)=W(2)
         SPHRAD(3,IAA)=W(3)



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF ((.NOT.ISATOK(IAT)).AND.
     +          ABS(XCOORD(IAT)).LT.0.0001.AND.
     +          ABS(YCOORD(IAT)).LT.0.0001.AND.
     +          ABS(ZCOORD(IAT)).LT.0.0001) GOTO 90
            W(1)=XCOORD(IAT)*M(1,1)+YCOORD(IAT)*M(1,2)
     +           +ZCOORD(IAT)*M(1,3)+V(1)
            W(2)=XCOORD(IAT)*M(2,1)+YCOORD(IAT)*M(2,2)
     +           +ZCOORD(IAT)*M(2,3)+V(2)
            W(3)=XCOORD(IAT)*M(3,1)+YCOORD(IAT)*M(3,2)
     +           +ZCOORD(IAT)*M(3,3)+V(3)
            XCOORD(IAT)=W(1)
            YCOORD(IAT)=W(2)
            ZCOORD(IAT)=W(3)



            DO 200 IB=1,8
               IF (BOUND_TO(IB,IAT).NE.0) THEN
                  JAT=BOUND_TO(IB,IAT)





                  IF (IAT.NE.BOUND_TO(1,JAT)) GOTO 200
                  JAA=ATIAA(JAT)
                  DO 60 JAT=PNTAAS(JAA),BOUND_TO(IB,IAT)-1
                     IF (BOUND_TO(1,JAT).GT.0) GOTO 200
   60             CONTINUE



                  IF ((JAA.GE.1.AND.JAA.LT.IFT1).OR.
     +                 (JAA.GT.IFT2.AND.JAA.LE.NUMAAT)) THEN
                     DO 70 JAT=PNTAAS(JAA),PNTAAE(JAA)
                        IF ((.NOT.ISATOK(JAT)).AND.
     +                       ABS(XCOORD(JAT)).LT.0.0001.AND.
     +                       ABS(YCOORD(JAT)).LT.0.0001.AND.
     +                       ABS(ZCOORD(JAT)).LT.0.0001) GOTO 70
                        W(1)=XCOORD(JAT)*M(1,1)+YCOORD(JAT)*M(1,2)
     +                       +ZCOORD(JAT)*M(1,3)+V(1)
                        W(2)=XCOORD(JAT)*M(2,1)+YCOORD(JAT)*M(2,2)
     +                       +ZCOORD(JAT)*M(2,3)+V(2)
                        W(3)=XCOORD(JAT)*M(3,1)+YCOORD(JAT)*M(3,2)
     +                       +ZCOORD(JAT)*M(3,3)+V(3)
                        XCOORD(JAT)=W(1)
                        YCOORD(JAT)=W(2)
                        ZCOORD(JAT)=W(3)
   70                CONTINUE
                  END IF
               END IF
  200       CONTINUE
   90    CONTINUE
  100 CONTINUE

      RETURN
      END
      SUBROUTINE WIF092A (JAAARR,NUM,M,V)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IAA, IAT, NUM, JAAARR(NUM), I
      REAL          M(3,3),V(3),W(3), GVFDET



      IF (WIFPAR(1012).NE.0) THEN
         IF (ABS(1.0-GVFDET(M)).GT.0.01) THEN
            CALL GVSWM4 (M,V)
            CALL GVSKIL
         END IF
      END IF



      DO 100 I=1,NUM
         IAA=JAAARR(I)
         PREVSHOW(IAA)=-1



         W(1)=SPHRAD(1,IAA)*M(1,1)+SPHRAD(2,IAA)*M(1,2)
     +        +SPHRAD(3,IAA)*M(1,3)+V(1)
         W(2)=SPHRAD(1,IAA)*M(2,1)+SPHRAD(2,IAA)*M(2,2)
     +        +SPHRAD(3,IAA)*M(2,3)+V(2)
         W(3)=SPHRAD(1,IAA)*M(3,1)+SPHRAD(2,IAA)*M(3,2)
     +        +SPHRAD(3,IAA)*M(3,3)+V(3)
         SPHRAD(1,IAA)=W(1)
         SPHRAD(2,IAA)=W(2)
         SPHRAD(3,IAA)=W(3)



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            W(1)=XCOORD(IAT)*M(1,1)+YCOORD(IAT)*M(1,2)
     +           +ZCOORD(IAT)*M(1,3)+V(1)
            W(2)=XCOORD(IAT)*M(2,1)+YCOORD(IAT)*M(2,2)
     +           +ZCOORD(IAT)*M(2,3)+V(2)
            W(3)=XCOORD(IAT)*M(3,1)+YCOORD(IAT)*M(3,2)
     +           +ZCOORD(IAT)*M(3,3)+V(3)
            XCOORD(IAT)=W(1)
            YCOORD(IAT)=W(2)
            ZCOORD(IAT)=W(3)
   90    CONTINUE
  100 CONTINUE

      RETURN
      END
      SUBROUTINE WIF092B (M,V)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IAA, IAT, JAA, JAT, IB
      REAL          M(3,3), V(3), W(3), GVFDET
      LOGICAL       BOUND_DONE



      IF (WIFPAR(1012).NE.0) THEN
         IF (ABS(1.0-GVFDET(M)).GT.0.01) THEN
            CALL GVSWM4 (M,V)
            CALL GVSKIL
         END IF
      END IF



      BOUND_DONE=.FALSE.



      DO 100 IAA=1,NUMAAT
         IF (.NOT.WRK1TF(IAA)) GOTO 100
         PREVSHOW(IAA)=-1



         W(1)=SPHRAD(1,IAA)*M(1,1)+SPHRAD(2,IAA)*M(1,2)
     +        +SPHRAD(3,IAA)*M(1,3)+V(1)
         W(2)=SPHRAD(1,IAA)*M(2,1)+SPHRAD(2,IAA)*M(2,2)
     +        +SPHRAD(3,IAA)*M(2,3)+V(2)
         W(3)=SPHRAD(1,IAA)*M(3,1)+SPHRAD(2,IAA)*M(3,2)
     +        +SPHRAD(3,IAA)*M(3,3)+V(3)
         SPHRAD(1,IAA)=W(1)
         SPHRAD(2,IAA)=W(2)
         SPHRAD(3,IAA)=W(3)



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF ((.NOT.ISATOK(IAT)).AND.
     +       ABS(XCOORD(IAT)).LT.0.0001.AND.
     +       ABS(YCOORD(IAT)).LT.0.0001.AND.
     +       ABS(ZCOORD(IAT)).LT.0.0001) GOTO 90
            W(1)=XCOORD(IAT)*M(1,1)+YCOORD(IAT)*M(1,2)
     +           +ZCOORD(IAT)*M(1,3)+V(1)
            W(2)=XCOORD(IAT)*M(2,1)+YCOORD(IAT)*M(2,2)
     +           +ZCOORD(IAT)*M(2,3)+V(2)
            W(3)=XCOORD(IAT)*M(3,1)+YCOORD(IAT)*M(3,2)
     +           +ZCOORD(IAT)*M(3,3)+V(3)
            XCOORD(IAT)=W(1)
            YCOORD(IAT)=W(2)
            ZCOORD(IAT)=W(3)



            DO 200 IB=1,8
               IF (BOUND_TO(IB,IAT).NE.0) THEN
                  JAT=BOUND_TO(IB,IAT)
                  BOUND_DONE=.TRUE.





                  IF (IAT.NE.BOUND_TO(1,JAT)) GOTO 200
                  JAA=ATIAA(JAT)




                  IF (IAA.GT.NUMAAF.AND.JAA.LE.NUMAAF) GOTO 200
                  DO 60 JAT=PNTAAS(JAA),BOUND_TO(IB,IAT)-1
                     IF (BOUND_TO(1,JAT).GT.0) GOTO 200
   60             CONTINUE



                  IF (.NOT.WRK1TF(JAA)) THEN
                     DO 70 JAT=PNTAAS(JAA),PNTAAE(JAA)
                        IF ((.NOT.ISATOK(JAT)).AND.
     +                       ABS(XCOORD(JAT)).LT.0.0001.AND.
     +                       ABS(YCOORD(JAT)).LT.0.0001.AND.
     +                       ABS(ZCOORD(JAT)).LT.0.0001) GOTO 70
                        W(1)=XCOORD(JAT)*M(1,1)+YCOORD(JAT)*M(1,2)
     +                       +ZCOORD(JAT)*M(1,3)+V(1)
                        W(2)=XCOORD(JAT)*M(2,1)+YCOORD(JAT)*M(2,2)
     +                       +ZCOORD(JAT)*M(2,3)+V(2)
                        W(3)=XCOORD(JAT)*M(3,1)+YCOORD(JAT)*M(3,2)
     +                       +ZCOORD(JAT)*M(3,3)+V(3)
                        XCOORD(JAT)=W(1)
                        YCOORD(JAT)=W(2)
                        ZCOORD(JAT)=W(3)
   70                CONTINUE
                  END IF
               END IF
  200       CONTINUE

   90    CONTINUE
  100 CONTINUE





      CALL MOL200

      RETURN
      END
      SUBROUTINE WIF092D (IFT1,IFT2,M,V)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IFT1, IFT2, IAA, IAT

      REAL          M(3,3), V(3), W(3), GVFDET



      IF (WIFPAR(1012).NE.0) THEN
         IF (ABS(1.0-GVFDET(M)).GT.0.01) THEN
            CALL GVSTTR ('?M3062',GVFDET(M))
            CALL GVSKIL
         END IF
      END IF
      IF (IFT1.LT.1.OR.IFT1.GT.IFT2.OR.IFT2.GT.NUMAAT) THEN
         CALL GVSTTE ('?BUGG10')
         RETURN
      END IF



      DO 100 IAA=IFT1,IFT2
         PREVSHOW(IAA)=-1



         W(1)=SPHRAD(1,IAA)*M(1,1)+SPHRAD(2,IAA)*M(1,2)
     +        +SPHRAD(3,IAA)*M(1,3)+V(1)
         W(2)=SPHRAD(1,IAA)*M(2,1)+SPHRAD(2,IAA)*M(2,2)
     +        +SPHRAD(3,IAA)*M(2,3)+V(2)
         W(3)=SPHRAD(1,IAA)*M(3,1)+SPHRAD(2,IAA)*M(3,2)
     +        +SPHRAD(3,IAA)*M(3,3)+V(3)
         SPHRAD(1,IAA)=W(1)
         SPHRAD(2,IAA)=W(2)
         SPHRAD(3,IAA)=W(3)



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF ((.NOT.ISATOK(IAT)).AND.
     +          ABS(XCOORD(IAT)).LT.0.0001.AND.
     +          ABS(YCOORD(IAT)).LT.0.0001.AND.
     +          ABS(ZCOORD(IAT)).LT.0.0001) GOTO 90
            W(1)=XCOORD(IAT)*M(1,1)+YCOORD(IAT)*M(1,2)
     +           +ZCOORD(IAT)*M(1,3)+V(1)
            W(2)=XCOORD(IAT)*M(2,1)+YCOORD(IAT)*M(2,2)
     +           +ZCOORD(IAT)*M(2,3)+V(2)
            W(3)=XCOORD(IAT)*M(3,1)+YCOORD(IAT)*M(3,2)
     +           +ZCOORD(IAT)*M(3,3)+V(3)
            XCOORD(IAT)=W(1)
            YCOORD(IAT)=W(2)
            ZCOORD(IAT)=W(3)












 90      CONTINUE
 100  CONTINUE



      CALL MOL200

      RETURN
      END
      SUBROUTINE WIF093 (IFT1,IFT2,RMAT,TVEC)

















      IMPLICIT      NONE
      INTEGER       IFT1, IFT2, IERR
      REAL          RMAT(3,3), TVEC(3), RINV(3,3), TINV(3)



      CALL GVSMI2 (RINV,RMAT,3,IERR)



      CALL GVSMV3 (TINV,RINV,TVEC)
      TINV(1)=-TINV(1)
      TINV(2)=-TINV(2)
      TINV(3)=-TINV(3)



      CALL WIF092 (IFT1,IFT2,RINV,TINV)

      RETURN
      END
      SUBROUTINE WIF093A (JAAARR,NUM,RMAT,TVEC)

















      IMPLICIT      NONE
      INTEGER       NUM, JAAARR(NUM),IERR
      REAL          RMAT(3,3), TVEC(3), RINV(3,3), TINV(3)



      CALL GVSMI2 (RINV,RMAT,3,IERR)



      CALL GVSMV3 (TINV,RINV,TVEC)
      TINV(1)=-TINV(1)
      TINV(2)=-TINV(2)
      TINV(3)=-TINV(3)



      CALL WIF092A (JAAARR, NUM, RINV, TINV)

      RETURN
      END
      SUBROUTINE WIF093B (RMAT,TVEC)

















      IMPLICIT      NONE
      INTEGER       IERR
      REAL          RMAT(3,3), TVEC(3), RINV(3,3), TINV(3)



      CALL GVSMI2 (RINV,RMAT,3,IERR)



      CALL GVSMV3 (TINV,RINV,TVEC)
      TINV(1)=-TINV(1)
      TINV(2)=-TINV(2)
      TINV(3)=-TINV(3)



      CALL WIF092B (RINV,TINV)

      RETURN
      END
      SUBROUTINE WIF093D (IFT1,IFT2,RMAT,TVEC)

















      IMPLICIT      NONE
      INTEGER       IFT1, IFT2, IERR
      REAL          RMAT(3,3), TVEC(3), RINV(3,3), TINV(3)



      CALL GVSMI2 (RINV,RMAT,3,IERR)



      CALL GVSMV3 (TINV,RINV,TVEC)
      TINV(1)=-TINV(1)
      TINV(2)=-TINV(2)
      TINV(3)=-TINV(3)



      CALL WIF092D (IFT1,IFT2,RINV,TINV)

      RETURN
      END
      SUBROUTINE WIF094 (IFT1,IFT2,MATRIX,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, IERR, IAT
      REAL          MATRIX(3,3)
      LOGICAL       WIFIRI



      IF (.NOT.WIFIRI(IFT1)) THEN
         IERR=1
         RETURN
      END IF
      IF (.NOT.WIFIRI(IFT2)) THEN
         IERR=1
         RETURN
      END IF



      IERR=0



      DO 10 IAT=PNTAAS(IFT1),PNTAAE(IFT2)



         IF ((.NOT.ISATOK(IAT)).AND.
     +       ABS(XCOORD(IAT)).LT.0.0001.AND.
     +       ABS(YCOORD(IAT)).LT.0.0001.AND.
     +       ABS(ZCOORD(IAT)).LT.0.0001) GOTO 10



         CV(1)=XCOORD(IAT)
         CV(2)=YCOORD(IAT)
         CV(3)=ZCOORD(IAT)
         CALL GVSMVV (CV,MATRIX)
         XCOORD(IAT)=CV(1)
         YCOORD(IAT)=CV(2)
         ZCOORD(IAT)=CV(3)
   10 CONTINUE

      RETURN
      END   
