



      SUBROUTINE CEL001 (A,B,C,ALPH,BETA,GAMMA,RMAT)




















      IMPLICIT      NONE
      REAL          RMAT(3,3), GVFDTR, A,B,C, ALPH,BETA,GAMMA
      REAL          COSA,COSB,COSG, SINB,SING, COSAS, SINAS, GVFSQR







      IF (ABS(ALPH).LT.1.0.OR.
     +    ABS(BETA) .LT.1.0.OR.
     +    ABS(GAMMA).LT.1.0.OR.
     +    ABS(A).LT.1.0.OR.
     +    ABS(B).LT.1.0.OR.
     +    ABS(C).LT.1.0) THEN
         CALL GVSTTE ('?CELL02')
         GOTO 998
      END IF



      COSA = COS(GVFDTR(ALPH))
      COSB = COS(GVFDTR(BETA))
      COSG = COS(GVFDTR(GAMMA))
      SINB = SIN(GVFDTR(BETA))
      SING = SIN(GVFDTR(GAMMA))

      COSAS = (COSB*COSG-COSA)/(SINB*SING)
      SINAS = GVFSQR(1.0-COSAS**2)



      CALL GVSRT0 (RMAT,9)
      RMAT(1,1) = A
      RMAT(1,2) = COSG*B
      RMAT(1,3) = COSB*C
      RMAT(2,2) = SING*B
      RMAT(2,3) = (-SINB)*COSAS*C
      RMAT(3,3) = SINB*SINAS*C



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL002 (A,B,C,ALPH,BETA,GAMMA,RMAT)




















      IMPLICIT      NONE
      REAL          RMAT(3,3), GVFDTR, A,B,C, ALPH,BETA,GAMMA
      REAL          COSA,COSB,COSG, SINB,SING, COSAS, SINAS, GVFSQR







      IF (ABS(ALPH).LT.1.0.OR.ABS(BETA) .LT.1.0.OR.
     +    ABS(GAMMA).LT.1.0.OR.ABS(A).LT.1.0.OR.
     +    ABS(B).LT.1.0.OR.ABS(C).LT.1.0) THEN
         CALL GVSTTE ('?CELL03')
         CALL GVSMTU (RMAT,3)
         GOTO 998
      END IF



      COSA = COS(GVFDTR(ALPH))
      COSB = COS(GVFDTR(BETA))
      COSG = COS(GVFDTR(GAMMA))
      SINB = SIN(GVFDTR(BETA))
      SING = SIN(GVFDTR(GAMMA))

      COSAS = (COSB*COSG-COSA)/(SINB*SING)
      SINAS = GVFSQR(1.0-COSAS**2)



      CALL GVSRT0 (RMAT,9)
      RMAT(1,1) = 1.0/A
      RMAT(1,2) = (-COSG)/(SING*A)
      RMAT(1,3) = (-(COSG*SINB*COSAS+COSB*SING))/(SINB*SINAS*SING*A)
      RMAT(2,2) = 1.0/(SING*B)
      RMAT(2,3) = COSAS/(SINAS*SING*B)
      RMAT(3,3) = 1.0/(SINB*SINAS*C)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL003

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'MAPINC.INC'
      INCLUDE       'SYMINC.INC'
      REAL          GVFRTD, C1, C2, C3, C4, C5, C6
      INTEGER       IMAP, I







      CALL CEL004 (SYMSCL,C1,C2,C3,C4,C5,C6)



      CALL SHOWTEXT ('?CELL08')



      CALL GVSFMT ('?M0132')
      CALL GVSCTB (LINE,80)
      WRITE (LINE,FMT,ERR=999) (CELDIM(I),I=1,3)
      CALL GVSTT6 (LINE)



      CALL GVSFMT ('?M0133')
      CALL GVSCTB (LINE,80)
      WRITE (LINE,FMT,ERR=999) (CELDIM(I),I=4,6)
      CALL GVSTT6 (LINE)



      CALL SHOWTEXT ('?CELL09')



      CALL GVSFMT ('?M0132')
      CALL GVSCTB (LINE,80)
      WRITE (LINE,FMT,ERR=999) C1,C2,C3
      CALL GVSTT6 (LINE)



      CALL GVSFMT ('?M0133')
      CALL GVSCTB (LINE,80)
      WRITE (LINE,FMT,ERR=999) GVFRTD(C4),GVFRTD(C5),GVFRTD(C6)
      CALL GVSTT6 (LINE)



      CALL SHOWTEXT ('?CELL10')
      CALL GVSWM3 (SYMSCL)



      IF (MAPNUM.LT.1) THEN
         CALL GVSTT6 ('?MAPB01')
         GOTO 998
      END IF
      CALL SHOWTEXT ('?CELL06')
      DO 10 IMAP=1,MAPNUM
         CALL GVSTTI ('?CELL07',IMAP)
         CALL GVST6C ('?CELL11',MAPNAM(IMAP),.TRUE.)
         CALL GVST6C ('?CELL12',MAPTXT(IMAP),.TRUE.)



         CALL GVSFMT ('?M0132')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) ACELLM(IMAP),BCELLM(IMAP),
     +    CCELLM(IMAP)
         CALL GVSTT6 (LINE)



         CALL GVSFMT ('?M0133')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) ALPHAM(IMAP),BETAM(IMAP),
     +    GAMMAM(IMAP)
         CALL GVSTT6 (LINE)
   10 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSTTB ('?NEWE477')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL004 (SCALE,A,B,C,ALPH,BETA,GAMMA)
























      IMPLICIT      NONE
      INTEGER       IERR
      REAL          SCALE(3,3), SCLINV(3,3), TEMP(3), AVEC(3),
     +              BVEC(3), CVEC(3), A, B, C, ALPH, BETA, GAMMA,
     +              GVFLDF, GVFLNV, GVFANG







      SCLINV(1,1)=0.0
      SCLINV(1,2)=0.0
      SCLINV(1,3)=0.0
      SCLINV(2,1)=0.0
      SCLINV(2,2)=0.0
      SCLINV(2,3)=0.0
      SCLINV(3,1)=0.0
      SCLINV(3,2)=0.0
      SCLINV(3,3)=0.0
      IF (GVFLDF(SCLINV,SCALE,9).LT.0.0001) THEN
         CALL GVSTTE ('?CELL05')
         CALL GVSWM3 (SCALE)
         GOTO 998
      END IF



      CALL GVSMI2 (SCLINV,SCALE,3,IERR)
      IF (IERR.NE.0) THEN
         CALL GVSWM3 (SCLINV)
         GOTO 998
      END IF



      TEMP(1)=1.0
      TEMP(2)=0.0
      TEMP(3)=0.0
      CALL GVSMV3 (AVEC,SCLINV,TEMP)
      A=GVFLNV(AVEC)
      TEMP(1)=0.0
      TEMP(2)=1.0
      TEMP(3)=0.0
      CALL GVSMV3 (BVEC,SCLINV,TEMP)
      B=GVFLNV(BVEC)
      TEMP(1)=0.0
      TEMP(2)=0.0
      TEMP(3)=1.0
      CALL GVSMV3 (CVEC,SCLINV,TEMP)
      C=GVFLNV(CVEC)



      ALPH =GVFANG(BVEC,CVEC)
      BETA =GVFANG(AVEC,CVEC)
      GAMMA=GVFANG(AVEC,BVEC)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL005 (A,B,C,ALPH,BETA,GAMMA,UVWMAT,UVWORG,
     + RMAT,TVEC)




















      IMPLICIT      NONE
      INTEGER       IERR
      REAL          UVWMAT(3,3), UVWORG(3), RMAT(3,3), TVEC(3), A, B, C,
     +              UVWINV(3,3), ORTFRC(3,3), ALPH, BETA, GAMMA







      CALL GVSMI2 (UVWINV,UVWMAT,3,IERR)
      IF (IERR.NE.0) THEN
         CALL GVSWM3 (UVWINV)
         GOTO 998
      END IF
      CALL CEL002 (A,B,C,ALPH,BETA,GAMMA,ORTFRC)





      CALL GVS3X3 (RMAT,UVWINV,ORTFRC)
      CALL GVSMV3 (TVEC,UVWINV,UVWORG)



      TVEC(1)=1.0-TVEC(1)
      TVEC(2)=1.0-TVEC(2)
      TVEC(3)=1.0-TVEC(3)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL006 (A,B,C,ALPH,BETA,GAMMA,UVWMAT,UVWORG,
     + RMAT,TVEC)



















      IMPLICIT      NONE
      REAL          UVWMAT(3,3), UVWORG(3), RMAT(3,3), TVEC(3),
     +              FRCORT(3,3), A, B, C, ALPH, BETA, GAMMA







      CALL CEL001 (A,B,C,ALPH,BETA,GAMMA,FRCORT)





      CALL GVS3X3 (RMAT,FRCORT,UVWMAT)
      CALL GVSMV3 (TVEC,FRCORT,UVWORG)





      RETURN
      END
      SUBROUTINE CEL007 (A,B,C,ALPH,BETA,GAMMA,RMAT)





















      IMPLICIT      NONE
      REAL          RMAT(3,3), ALPH, BETA, GAMMA, A, B, C, COSA,
     +              COSB, COSG, SINA, SINB, SING, VOLUME, VSTAR,
     +              ASTAR, BSTAR, CSTAR, COSAS, COSBS, COSGS,
     +              SINAS, GVFDTR, GVFSQR







      IF (ABS(ALPH).LT.1.0.OR.
     +    ABS(BETA) .LT.1.0.OR.
     +    ABS(GAMMA).LT.1.0.OR.
     +    ABS(A).LT.1.0.OR.
     +    ABS(B).LT.1.0.OR.
     +    ABS(C).LT.1.0) THEN
         CALL GVSTTE ('?CELL04')
         GOTO 998
      END IF



      COSA = COS(GVFDTR(ALPH))
      COSB = COS(GVFDTR(BETA))
      COSG = COS(GVFDTR(GAMMA))
      SINA = SIN(GVFDTR(ALPH))
      SINB = SIN(GVFDTR(BETA))
      SING = SIN(GVFDTR(GAMMA))



      VOLUME = A*B*C*
     + GVFSQR(1.0+2.0*COSA*COSB*COSG-COSA**2-COSB**2-COSG**2)
      VSTAR = 1.0/VOLUME
      ASTAR = B*C*SINA/VOLUME
      BSTAR = A*C*SINB/VOLUME
      CSTAR = A*B*SING/VOLUME
      COSAS = (COSB*COSG-COSA)/(SINB*SING)
      COSBS = (COSG*COSA-COSB)/(SING*SINA)
      COSGS = (COSA*COSB-COSG)/(SINA*SINB)
      SINAS = GVFSQR(1.0-COSAS**2)



      CALL GVSRT0 (RMAT,9)
      RMAT(1,1) = VSTAR/(BSTAR*CSTAR*SINAS)
      RMAT(2,1) = ASTAR*COSGS
      RMAT(3,1) = ASTAR*(COSBS-COSAS*COSGS)/SINAS
      RMAT(2,2) = BSTAR
      RMAT(2,3) = CSTAR*COSAS
      RMAT(3,3) = CSTAR*SINAS



  998 CONTINUE


      RETURN
      END

      SUBROUTINE CEL008

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'VECTOR.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       CONN(2,12), I
      REAL          CLBOX(3,8), BOXC(3,8), CART(3), FRAC(3)
      EQUIVALENCE   (BOXC(1,1),ESPACE(1))
      EQUIVALENCE   (CART(1),ESPACE(25))
      EQUIVALENCE   (FRAC(1),ESPACE(28))
      SAVE          CONN, CLBOX
      DATA CONN     /1,2,2,3,3,4,4,1,1,5,2,6,3,7,4,8,5,6,6,7,7,8,8,5/
      DATA CLBOX    /0.,0.,0., 1.,0.,0., 1.,1.,0., 0.,1.,0.,
     +               0.,0.,1., 1.,0.,1., 1.,1.,1., 0.,1.,1./







      CALL ESPSET (1,30,19)



      DO 20, I = 1,8
         CALL GVSCPR (FRAC,CLBOX(1,I),3)
         CALL GVSSV3 (FRAC,SYMTRN)
         CALL GVSMV3 (CART,SYMINV,FRAC)
         CALL GVSCPR (BOXC(1,I),CART,3)
   20 CONTINUE




      NUMGRV=12
      DO 40 I=1,12
         XMOL(1,I)=BOXC(1,CONN(1,I))
         XMOL(2,I)=BOXC(2,CONN(1,I))
         XMOL(3,I)=BOXC(3,CONN(1,I))
         YMOL(1,I)=BOXC(1,CONN(2,I))
         YMOL(2,I)=BOXC(2,CONN(2,I))
         YMOL(3,I)=BOXC(3,CONN(2,I))
         HUEVAL(I)=270
   40 CONTINUE



      CALL GRAMOL (' ')



      CALL SETHIS ('?M0481')





      RETURN
      END
      SUBROUTINE CEL009

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'VECTOR.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'SYMINC.INC'
      LOGICAL       GVFIBN
      INTEGER       CONN(2,12), I, MLTFAC, IA, IB, IC, IGRV, J, GVFFFI
      REAL          CLBOX(3,8), BOXC(3,8), CART(3), FRAC(3)
      EQUIVALENCE   (BOXC(1,1),ESPACE(1))
      EQUIVALENCE   (CART(1),ESPACE(25))
      EQUIVALENCE   (FRAC(1),ESPACE(28))
      SAVE          CONN, CLBOX
      DATA CONN     /1,2,2,3,3,4,4,1,1,5,2,6,3,7,4,8,5,6,6,7,7,8,8,5/
      DATA CLBOX    /0.,0.,0., 1.,0.,0., 1.,1.,0., 0.,1.,0.,
     +               0.,0.,1., 1.,0.,1., 1.,1.,1., 0.,1.,1./







      CALL ESPSET (1,30,19)



      CALL GRTVIN



   30 CONTINUE
      CALL IPROMPT ('?NEWP20')
      I=GVFFFI(1,MLTFAC)



      IF (I.EQ.1.AND.MLTFAC.EQ.0) GOTO 998
      IF (I.EQ.0) MLTFAC=2
      IF (MLTFAC.EQ.1) THEN
         CALL GVSTT6 ('?NEWT155')
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(MLTFAC,2,10)) THEN
         CALL GVSTTE ('?NEWE75')
         GOTO 30
      END IF



      DO 100 IA=0,MLTFAC-1
         DO 90 IB=0,MLTFAC-1
            DO 80 IC=0,MLTFAC-1
               DO 70 IGRV=1,12



                  DO 10, I = 1,8
                     CALL GVSCPR (FRAC,CLBOX(1,I),3)
                     FRAC(1)=FRAC(1)+IA
                     FRAC(2)=FRAC(2)+IB
                     FRAC(3)=FRAC(3)+IC
                     CALL GVSMV3 (CART,SYMINV,FRAC)
                     CALL GVSAV3 (CART,SYMTRN)
                     CALL GVSCPR (BOXC(1,I),CART,3)
   10             CONTINUE




                  DO 50 I=1,12



                     DO 40 J=1,NUMGRV
                        IF (ABS(XMOL(1,J)-BOXC(1,CONN(1,I))).LT.0.1.AND.
     +                      ABS(XMOL(2,J)-BOXC(2,CONN(1,I))).LT.0.1.AND.
     +                      ABS(XMOL(3,J)-BOXC(3,CONN(1,I))).LT.0.1.AND.
     +                      ABS(YMOL(1,J)-BOXC(1,CONN(2,I))).LT.0.1.AND.
     +                      ABS(YMOL(2,J)-BOXC(2,CONN(2,I))).LT.0.1.AND.
     +                      ABS(YMOL(3,J)-BOXC(3,CONN(2,I))).LT.0.1)
     +                   GOTO 50
   40                CONTINUE



                     NUMGRV=NUMGRV+1
                     XMOL(1,NUMGRV)=BOXC(1,CONN(1,I))
                     XMOL(2,NUMGRV)=BOXC(2,CONN(1,I))
                     XMOL(3,NUMGRV)=BOXC(3,CONN(1,I))
                     YMOL(1,NUMGRV)=BOXC(1,CONN(2,I))
                     YMOL(2,NUMGRV)=BOXC(2,CONN(2,I))
                     YMOL(3,NUMGRV)=BOXC(3,CONN(2,I))
                     HUEVAL(NUMGRV)=270
   50             CONTINUE
   70          CONTINUE
   80       CONTINUE
   90    CONTINUE
  100 CONTINUE



      CALL GRAMOL (' ')



      CALL SETHIS ('?M0482')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CEL010

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'VECTOR.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'MAPINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       CONN(2,3), I
      REAL          CLBOX(3,4), BOXC(3,4), CART(3), FRAC(3)
      LOGICAL       GVFIBN
      EQUIVALENCE   (BOXC(1,1),ESPACE(1))
      EQUIVALENCE   (CART(1),ESPACE(25))
      EQUIVALENCE   (FRAC(1),ESPACE(28))
      SAVE          CONN, CLBOX
      DATA CONN     /1,2,1,3,1,4/
      DATA CLBOX    /0.,0.,0., 1.,0.,0., 0.,1.,0., 0.,0.,1./







      IF (MAPNUM.LE.0) THEN
         CALL GVSTT6 ('?NEWT375')
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(MAPNOW,1,MAPNUM)) THEN
         CALL GVSTT6 ('?NEWT375')
         GOTO 998
      END IF



      CALL ESPSET (1,30,19)



      DO 20,I=1,4
         CALL GVSCPR (FRAC,CLBOX(1,I),3)
         CALL GVSSV3 (FRAC,SYMTRN)
         CALL GVSMV3 (CART,SYMINV,FRAC)
         CALL GVSCPR (BOXC(1,I),CART,3)
   20 CONTINUE




      NUMGRV=3
      DO 40 I=1,3
         XMOL(1,I)=BOXC(1,CONN(1,I))
         XMOL(2,I)=BOXC(2,CONN(1,I))
         XMOL(3,I)=BOXC(3,CONN(1,I))
         YMOL(1,I)=BOXC(1,CONN(1,I))+(BOXC(1,CONN(2,I))-
     +    BOXC(1,CONN(1,I)))*10.0/ACELLM(MAPNOW)
         YMOL(2,I)=BOXC(2,CONN(2,I))+(BOXC(2,CONN(2,I))-
     +    BOXC(2,CONN(1,I)))*10.0/BCELLM(MAPNOW)
         YMOL(3,I)=BOXC(3,CONN(2,I))+(BOXC(3,CONN(2,I))-
     +    BOXC(3,CONN(1,I)))*10.0/CCELLM(MAPNOW)
         HUEVAL(I)=270
   40 CONTINUE



      CALL GRAMOL (' ')



      CALL SETHIS ('?M0481')



  998 CONTINUE


      RETURN
      END

      SUBROUTINE CEL011 (IAA,ORGX,ORGY,ORGZ,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'MAPINC.INC'
      INTEGER       IAA, ORGX, ORGY, ORGZ, IERR, IAT
      REAL          RMAT(3,3), TVEC(3), TEMP(3), XYZMIN(3), XYZMAX(3),
     +              XYZCEN(3)
      LOGICAL       GVFIBN







      IF (MAPNUM.EQ.0) THEN
         CALL GVSTTE ('?NEWE279')
         CALL GVSKIL
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(MAPNOW,1,MAPNUM)) THEN
         CALL GVSTTE ('?NEWE280')
         CALL GVSKIL
         GOTO 998
      END IF



      IERR=1
      CALL CEL005 (ACELLM(MAPNOW),BCELLM(MAPNOW),CCELLM(MAPNOW),
     + ALPHAM(MAPNOW),BETAM(MAPNOW),GAMMAM(MAPNOW),UVWMAT(1,1,MAPNOW),
     + UVWORG(1,MAPNOW),RMAT,TVEC)



      IF (IAA.NE.0) THEN
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (ISATOK(IAT)) THEN
               TEMP(1)=NINT(XCOORD(IAT))
               TEMP(2)=NINT(YCOORD(IAT))
               TEMP(3)=NINT(ZCOORD(IAT))
               CALL GVSMPV (TEMP,RMAT,TVEC)
               ORGX=TEMP(1)
               ORGY=TEMP(2)
               ORGZ=TEMP(3)
               IERR=0
               GOTO 998
            END IF
 10      CONTINUE
      ELSE
         CALL WIFMMX3 (XYZMIN,XYZMAX,XYZCEN)
         CALL GVSMPV (XYZCEN,RMAT,TVEC)
         ORGX=XYZCEN(1)
         ORGY=XYZCEN(2)
         ORGZ=XYZCEN(3)
      END IF



  998 CONTINUE


      RETURN
      END   
