      subroutine rott(x,y,z,xc,yc,zc,itran)
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      if (itran.eq.1) then
         xc = (x-t(1))*rx(1)+(y-t(2))*rx(2)+(z-t(3))*rx(3)
         yc = (x-t(1))*ry(1)+(y-t(2))*ry(2)+(z-t(3))*ry(3)
         zc = (x-t(1))*rz(1)+(y-t(2))*rz(2)+(z-t(3))*rz(3)
      else
         xc = x*rx(1)+y*rx(2)+z*rx(3)
         yc = x*ry(1)+y*ry(2)+z*ry(3)
         zc = x*rz(1)+y*rz(2)+z*rz(3)
      endif

      return
      end

      subroutine rotts(x,y,z,xc,yc,zc,itran)
      implicit double precision (a-h,o-z)
      real x,y,z
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      if (itran.eq.1) then
         xc = (x-t(1))*rx(1)+(y-t(2))*rx(2)+(z-t(3))*rx(3)
         yc = (x-t(1))*ry(1)+(y-t(2))*ry(2)+(z-t(3))*ry(3)
         zc = (x-t(1))*rz(1)+(y-t(2))*rz(2)+(z-t(3))*rz(3)
      else
         xc = x*rx(1)+y*rx(2)+z*rx(3)
         yc = x*ry(1)+y*ry(2)+z*ry(3)
         zc = x*rz(1)+y*rz(2)+z*rz(3)
      endif

      return
      end

      subroutine mktrn(inct,incp)
      implicit double precision (a-h,o-z)
      parameter (mxel=100)
      common /thephi/theta1,phi1,rroot,rincr,vdwr(mxel),vrad(mxel),
     &               scal,fscal,scali,smag,ipoints,ipnt,icol(mxel)
      common /pers/  xv,yv,zv,c0,pincr,ssincr,xincr,yincr
      common /cllmat/rx(3),ry(3),rz(3),t(3),tz(3),tzorg(3),itz
      common /coars/ icoars
      logical fyesno,backb
      integer dolabs,fancy,persp,shade,atcol
      common /displ/ fancy,shade,atcol,dolabs,persp,irtcel,
     &               ifd,fyesno,backb,logo
      common /align/ vecs(3,3),nscnd,iscst,ialtyp,iocnt
      dimension vec(3)

      celinc = 0.001d0*0.52917706d0

      if (irtcel.ne.0) then
         do i=1,3
            vec(i) = 0.0d0
         end do
      endif

      idir = 0
      if (inct.eq.290) then
         if (irtcel.ne.0) then
            idir = incp
            iax = 3
         else
            if (persp.eq.1) then
               if (incp.eq.1)  zv = zv + pincr
               if (incp.eq.-1) zv = zv - pincr
            else
               if (incp.eq.1)  smag = smag*ssincr
               if (incp.eq.-1) smag = smag/ssincr
               smag = max(smag,0.01d0)
               scal = scali*2.4d0*smag
            endif
         endif
      elseif (inct.eq.415) then
         if (irtcel.ne.0) then
            idir = 1
            if (incp.lt.0) idir = -1
            iax = 2
         else
            yv = yv + yincr*(5**icoars)*incp
         endif
      elseif (inct.eq.416) then
         if (irtcel.ne.0) then
            idir = 1
            if (incp.lt.0) idir = -1
            iax = 1
         else
            xv = xv + xincr*(5**icoars)*incp
         endif
      elseif (inct.eq.417) then
         if (irtcel.ne.0) then
            idir = 1
            if (incp.lt.0) idir = -1
            iax = 3
         else
            if (persp.eq.1) then
               zv = zv + pincr*incp
            else
               ssc = abs(incp)*ssincr
               if (incp.gt.0) smag = smag*ssc
               if (incp.lt.0) smag = smag/ssc
               smag = max(smag,0.01d0)
               smag = min(smag,1000.0d0)
               scal = scali*2.4d0*smag
            endif
         endif
      elseif (inct.eq.420) then
         if (irtcel.ne.0) then
            idir = -1
            iax = 2
         else
            yv = yv - yincr*(5**icoars)
         endif
      elseif (inct.eq.430) then
         if (irtcel.ne.0) then
            idir = 1
            iax = 2
         else
            yv = yv + yincr*(5**icoars)
         endif
      elseif (inct.eq.440) then
         if (irtcel.ne.0) then
            idir = -1
            iax = 1
         else
            xv = xv - xincr*(5**icoars)
         endif
      elseif (inct.eq.450) then
         if (irtcel.ne.0) then
            idir = 1
            iax = 1
         else
            xv = xv + xincr*(5**icoars)
         endif
      else 
         goto 100
      endif

      if (irtcel.ne.0) then
         if (itz.eq.1.and.iax.eq.3) then
            do i=1,3
               vec(i) =  idir*tz(i)*(10**icoars)
            end do
         else
            vec(iax) =  idir*celinc*(10**icoars)
            if ((inct.eq.415.or.inct.eq.416.or.inct.eq.417)
     &          .and.irtcel.eq.2) then
               do i=1,3
                  vec(i) =  celinc*(10**icoars)*incp*vecs(iax,i)
               end do
            endif
         endif
         if (irtcel.eq.1) then
            call cllrot(vec,0,ifd)
         else
            call alnrot(vec,0)
         endif
      endif

      goto 200

100   continue
      if (abs(incp).eq.1.or.abs(inct).eq.421.or.inct.eq.422) then
         if (abs(inct).eq.421) then
            theinc = -incp
            if (inct.eq.421) then
               inct = -3
            else
               inct = -2
            endif
         elseif(inct.eq.422) then
            theinc = -incp
            inct = -1
         else
            if (icoars.eq.2) then
               theinc = incp*rincr*45.0d0
            elseif (icoars.eq.1) then
               theinc = incp*rincr*5.0d0
            else
               theinc = incp*rincr
            endif
         endif

         if (irtcel.gt.0) then
            if (irtcel.eq.1) then
               call clmat(inct,theinc,1)
               call cllrot(vec,1,ifd)
            else
               if (ialtyp.eq.1) then
                  call clmat(inct,theinc,0)
               else
                  call clmat(inct,theinc,1)
               endif
               call alnrot(vec,1)
            endif
         else
            call xyzrot(inct,theinc)
         endif
      endif

200   if (irtcel.gt.1) then
         if (ialtyp.eq.1) then
            call totpmf(tpmf)
c            print*,'totpmf=',tpmf
            call upsco()
         endif
      endif

      return
      end

      subroutine mtinv3
      implicit double precision (a-h,o-z)
      dimension al(9),alt(9)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)
      common /align/ vecs(3,3),nscnd,iscst,ialtyp,iocnt
   
      do i=1,3
         do j=1,3
            if (i.eq.j) then
               vecs(i,j) = 1.0d0
            else
               vecs(i,j) = 0.0d0
            endif
         end do
      end do

      do j=1,3
         al(j)   = rx(j)
         al(3+j) = ry(j)
         al(6+j) = rz(j)
         alt(j)   = rx(j)
         alt(3+j) = ry(j)
         alt(6+j) = rz(j)
      end do

      call matinv(al,3,det)

      do j=1,3
         rx(j) = al(j)
         ry(j) = al(3+j)
         rz(j) = al(6+j)
      end do

      call rott(vecs(1,1),vecs(1,2),vecs(1,3),xc,yc,zc,0)
      vecs(1,1) = xc
      vecs(1,2) = yc
      vecs(1,3) = zc
      call rott(vecs(2,1),vecs(2,2),vecs(2,3),xc,yc,zc,0)
      vecs(2,1) = xc
      vecs(2,2) = yc
      vecs(2,3) = zc
      call rott(vecs(3,1),vecs(3,2),vecs(3,3),xc,yc,zc,0)
      vecs(3,1) = xc
      vecs(3,2) = yc
      vecs(3,3) = zc

c restore original rotation

      do j=1,3
         rx(j) = alt(j)
         ry(j) = alt(3+j)
         rz(j) = alt(6+j)
      end do

      return
      end

      subroutine xyzrot(inct,theang)
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      todeg = 45.0d0 / datan(1.0d0)

      sa = dsin(theang/todeg)
      ca = dcos(theang/todeg)

      if (inct.eq.-3) then
         do i=1,3
            y = ry(i)
            z = rz(i)
            ry(i) = ca*y + sa*z
            rz(i) = ca*z - sa*y
         end do
      elseif (inct.eq.-2) then
         do i=1,3
            x = rx(i)
            z = rz(i)
            rx(i) = ca*x + sa*z
            rz(i) = ca*z - sa*x
         end do
      elseif (inct.eq.-1) then
         do i=1,3
            x = rx(i)
            y = ry(i)
            rx(i) = ca*x - sa*y
            ry(i) = ca*y + sa*x
         end do
      endif

      return
      end

      subroutine initr
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      do i=1,3
         t(i)  = 0.0d0
      end do

      return
      end

      subroutine inirot
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      do i=1,3
         rx(i) = 0.0d0
         ry(i) = 0.0d0
         rz(i) = 0.0d0
      end do

      rx(1) = 1.0d0
      ry(2) = 1.0d0
      rz(3) = 1.0d0

      return
      end

      subroutine setrot
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      do i=1,3
         rx(i) = 0.0d0
         ry(i) = 0.0d0
         rz(i) = 0.0d0
      end do

      rx(1) = 1.0d0
      ry(3) = 1.0d0
      rz(2) = -1.0d0

      return
      end

      subroutine setord(iatom,coo)
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)
      common /pers/xv,yv,zv,c0,pincr,ssincr,xincr,yincr
      logical fyesno,backb
      integer dolabs,fancy,persp,shade,atcol
      common /displ/ fancy,shade,atcol,dolabs,persp,irtcel,
     &               ifd,fyesno,backb,logo
      dimension coo(3,*)

      if (irtcel.eq.2) then
         call alnsorg(iatom,coo)
      else
         do i=1,3
            t(i) = coo(i,iatom)
         end do
      endif

c      call doscal

      xv = 0.0d0
      yv = 0.0d0

      return
      end

      subroutine setxyv
      implicit double precision (a-h,o-z)
      common /pers/xv,yv,zv,c0,pincr,ssincr,xincr,yincr

      xv = 0.0d0
      yv = 0.0d0

      return
      end

      subroutine prtrot
      implicit double precision (a-h,o-z)
      common /rotmat/rx(3),ry(3),rz(3),t(3), td(3)

      print*,(rx(i),i=1,3)
      print*,(ry(i),i=1,3)
      print*,(rz(i),i=1,3)

      print*,(t(i),i=1,3)

      return
      end

      subroutine rarbxi
      implicit double precision (a-h,o-z)
      dimension v(3)
      common /rligx/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /align/ vecs(3,3),nscnd,iscst,ialtyp,iocnt

      todeg = 45.0d0 / datan(1.0d0)
      do i=1,3
         v(i) = vecs(1,i)
      end do

c Rotation about an arbitrary axis v (going through the origin)

      pi = 4.d0*datan(1.d0)

c calculate rho, theta, phi (Spherical coordinates)

      rho = vlen(v)

      if (v(1).gt.0.0d0) then
         theta = datan(v(2)/v(1))
      elseif (v(1).lt.0.0d0) then
         theta = pi + datan(v(2)/v(1))
      elseif (v(1).eq.0.0d0) then
         if (v(2).ge.0.0d0) then
            theta = pi / 2.0d0
         else
            theta = 3.0d0 * pi / 2.0d0
         endif
      endif
      
      phi = dacos(v(3)/rho)
      
      cs = dcos(theta)
      si = dsin(theta)

      rz(1,1) = cs
      rz(1,2) = si
      rz(1,3) = 0.0d0

      rz(2,1) = -si
      rz(2,2) = cs
      rz(2,3) = 0.0d0

      rz(3,1) = 0.0d0
      rz(3,2) = 0.0d0
      rz(3,3) = 1.0d0

      rzi(1,1) = cs
      rzi(1,2) = -si
      rzi(1,3) = 0.0d0

      rzi(2,1) = si
      rzi(2,2) = cs
      rzi(2,3) = 0.0d0

      rzi(3,1) = 0.0d0
      rzi(3,2) = 0.0d0
      rzi(3,3) = 1.0d0

      cs1 = dcos(phi)
      si1 = dsin(phi)

      ry(1,1) = cs1
      ry(1,2) = 0.0d0
      ry(1,3) = -si1

      ry(2,1) = 0.0d0
      ry(2,2) = 1.0d0
      ry(2,3) = 0.0d0

      ry(3,1) = si1
      ry(3,2) = 0.0d0
      ry(3,3) = cs1

      ryi(1,1) = cs1
      ryi(1,2) = 0.0d0
      ryi(1,3) = si1

      ryi(2,1) = 0.0d0
      ryi(2,2) = 1.0d0
      ryi(2,3) = 0.0d0

      ryi(3,1) = -si1
      ryi(3,2) = 0.0d0
      ryi(3,3) = cs1

c      print*,'matrix ry'
c      call prtmat(ry)
c      print*,'matrix rz'
c      call prtmat(rz)
c      print*,'matrix ryi'
c      call prtmat(ryi)
c      print*,'matrix rzi'
c      call prtmat(rzi)
c      return

      end

      subroutine rarbx(alfat)
      implicit double precision (a-h,o-z)
      dimension r(3,3),rv(3,3),rout(3,3),rtmp(3,3),rcpy(3,3)
      common /rligx/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /cllmat/rxl(3),ryl(3),rzl(3),t(3),tz(3),tzorg(3),itz

      do i=1,3
         rcpy(i,1) = rxl(i)
         rcpy(i,2) = ryl(i)
         rcpy(i,3) = rzl(i)
      end do

c Rotation about an arbitrary axis v (going through the origin)
c alpha is the angle over which is rotated along axis v

      alfa = -alfat

      ca = dcos(alfa)
      sa = dsin(alfa)

      rv(1,1) = ca
      rv(1,2) = sa
      rv(1,3) = 0.0d0

      rv(2,1) = -sa
      rv(2,2) = ca
      rv(2,3) = 0.0d0

      rv(3,1) = 0.0d0
      rv(3,2) = 0.0d0
      rv(3,3) = 1.0d0

      call matmult(rzi,ryi,rtmp)
      call matmult(rtmp,rv,rout)
      call matmult(rout,ry,rtmp)
      call matmult(rtmp,rz,r)
      call matmult(rcpy,r,rtmp)

      do i=1,3
         rxl(i) = rtmp(i,1)
         ryl(i) = rtmp(i,2)
         rzl(i) = rtmp(i,3)
      end do

      return
      end

      subroutine rarbyi
      implicit double precision (a-h,o-z)
      dimension v(3)
      common /rligy/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /align/ vecs(3,3),nscnd,iscst,ialtyp,iocnt

      do i=1,3
         v(i) = vecs(2,i)
      end do

c Rotation about an arbitrary axis v (going through the origin)

      pi = 4.d0*datan(1.d0)

c calculate rho, theta, phi (Spherical coordinates)

      rho = vlen(v)

      if (v(1).gt.0.0d0) then
         theta = datan(v(2)/v(1))
      elseif (v(1).lt.0.0d0) then
         theta = pi + datan(v(2)/v(1))
      elseif (v(1).eq.0.0d0) then
         if (v(2).ge.0.0d0) then
            theta = pi / 2.0d0
         else
            theta = 3.0d0 * pi / 2.0d0
         endif
      endif
      
      phi = dacos(v(3)/rho)
      
      cs = dcos(theta)
      si = dsin(theta)

      rz(1,1) = cs
      rz(1,2) = si
      rz(1,3) = 0.0d0

      rz(2,1) = -si
      rz(2,2) = cs
      rz(2,3) = 0.0d0

      rz(3,1) = 0.0d0
      rz(3,2) = 0.0d0
      rz(3,3) = 1.0d0

      rzi(1,1) = cs
      rzi(1,2) = -si
      rzi(1,3) = 0.0d0

      rzi(2,1) = si
      rzi(2,2) = cs
      rzi(2,3) = 0.0d0

      rzi(3,1) = 0.0d0
      rzi(3,2) = 0.0d0
      rzi(3,3) = 1.0d0

      cs1 = dcos(phi)
      si1 = dsin(phi)

      ry(1,1) = cs1
      ry(1,2) = 0.0d0
      ry(1,3) = -si1

      ry(2,1) = 0.0d0
      ry(2,2) = 1.0d0
      ry(2,3) = 0.0d0

      ry(3,1) = si1
      ry(3,2) = 0.0d0
      ry(3,3) = cs1

      ryi(1,1) = cs1
      ryi(1,2) = 0.0d0
      ryi(1,3) = si1

      ryi(2,1) = 0.0d0
      ryi(2,2) = 1.0d0
      ryi(2,3) = 0.0d0

      ryi(3,1) = -si1
      ryi(3,2) = 0.0d0
      ryi(3,3) = cs1

c      print*,'y matrix ry'
c      call prtmat(ry)
c      print*,'y matrix rz'
c      call prtmat(rz)
c      print*,'y matrix ryi'
c      call prtmat(ryi)
c      print*,'y matrix rzi'
c      call prtmat(rzi)

      return
      end

      subroutine rarby(alfa)
      implicit double precision (a-h,o-z)
      dimension r(3,3),rv(3,3),rout(3,3),rtmp(3,3),rcpy(3,3)
      common /rligy/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /cllmat/rxl(3),ryl(3),rzl(3),t(3),tz(3),tzorg(3),itz

      do i=1,3
         rcpy(i,1) = rxl(i)
         rcpy(i,2) = ryl(i)
         rcpy(i,3) = rzl(i)
      end do


c Rotation about an arbitrary axis v (going through the origin)
c alpha is the angle over which is rotated along axis v

      ca = dcos(alfa)
      sa = dsin(alfa)

      rv(1,1) = ca
      rv(1,2) = sa
      rv(1,3) = 0.0d0

      rv(2,1) = -sa
      rv(2,2) = ca
      rv(2,3) = 0.0d0

      rv(3,1) = 0.0d0
      rv(3,2) = 0.0d0
      rv(3,3) = 1.0d0

      call matmult(rzi,ryi,rtmp)
      call matmult(rtmp,rv,rout)
      call matmult(rout,ry,rtmp)
      call matmult(rtmp,rz,r)
      call matmult(rcpy,r,rtmp)

      do i=1,3
         rxl(i) = rtmp(i,1)
         ryl(i) = rtmp(i,2)
         rzl(i) = rtmp(i,3)
      end do

      return
      end

      subroutine matmult(a,b,c)
      implicit double precision (a-h,o-z)
      dimension a(3,3),b(3,3),c(3,3)

      do i=1,3
         do j=1,3
            c(i,j)=0.0d0
            do k=1,3
               c(i,j) = c(i,j)+a(i,k)*b(k,j)
            end do
         end do
      end do

      return
      end

      subroutine rarbzi
      implicit double precision (a-h,o-z)
      dimension v(3)
      common /rligz/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /align/ vecs(3,3),nscnd,iscst,ialtyp,iocnt

      todeg = 45.0d0 / datan(1.0d0)
      do i=1,3
         v(i) = vecs(3,i)
      end do

c Rotation about an arbitrary axis v (going through the origin)

      pi = 4.d0*datan(1.d0)

c calculate rho, theta, phi (Spherical coordinates)

      rho = vlen(v)

      if (v(1).gt.0.0d0) then
         theta = datan(v(2)/v(1))
      elseif (v(1).lt.0.0d0) then
         theta = pi + datan(v(2)/v(1))
      elseif (v(1).eq.0.0d0) then
         if (v(2).ge.0.0d0) then
            theta = pi / 2.0d0
         else
            theta = 3.0d0 * pi / 2.0d0
         endif
      endif
      
      phi = dacos(v(3)/rho)
      
      cs = dcos(theta)
      si = dsin(theta)

      rz(1,1) = cs
      rz(1,2) = si
      rz(1,3) = 0.0d0

      rz(2,1) = -si
      rz(2,2) = cs
      rz(2,3) = 0.0d0

      rz(3,1) = 0.0d0
      rz(3,2) = 0.0d0
      rz(3,3) = 1.0d0

      rzi(1,1) = cs
      rzi(1,2) = -si
      rzi(1,3) = 0.0d0

      rzi(2,1) = si
      rzi(2,2) = cs
      rzi(2,3) = 0.0d0

      rzi(3,1) = 0.0d0
      rzi(3,2) = 0.0d0
      rzi(3,3) = 1.0d0

      cs1 = dcos(phi)
      si1 = dsin(phi)

      ry(1,1) = cs1
      ry(1,2) = 0.0d0
      ry(1,3) = -si1

      ry(2,1) = 0.0d0
      ry(2,2) = 1.0d0
      ry(2,3) = 0.0d0

      ry(3,1) = si1
      ry(3,2) = 0.0d0
      ry(3,3) = cs1

      ryi(1,1) = cs1
      ryi(1,2) = 0.0d0
      ryi(1,3) = si1

      ryi(2,1) = 0.0d0
      ryi(2,2) = 1.0d0
      ryi(2,3) = 0.0d0

      ryi(3,1) = -si1
      ryi(3,2) = 0.0d0
      ryi(3,3) = cs1

c      print*,'matrix ry'
c      call prtmat(ry)
c      print*,'matrix rz'
c      call prtmat(rz)
c      print*,'matrix ryi'
c      call prtmat(ryi)
c      print*,'matrix rzi'
c      call prtmat(rzi)
c      return

      end

      subroutine rarbz(alfa)
      implicit double precision (a-h,o-z)
      dimension r(3,3),rv(3,3),rout(3,3),rtmp(3,3),rcpy(3,3)
      common /rligz/ ry(3,3),rz(3,3),rzi(3,3),ryi(3,3)
      common /cllmat/rxl(3),ryl(3),rzl(3),t(3),tz(3),tzorg(3),itz

      do i=1,3
         rcpy(i,1) = rxl(i)
         rcpy(i,2) = ryl(i)
         rcpy(i,3) = rzl(i)
      end do

c Rotation about an arbitrary axis v (going through the origin)
c alpha is the angle over which is rotated along axis v


      ca = dcos(alfa)
      sa = dsin(alfa)

      rv(1,1) = ca
      rv(1,2) = sa
      rv(1,3) = 0.0d0

      rv(2,1) = -sa
      rv(2,2) = ca
      rv(2,3) = 0.0d0

      rv(3,1) = 0.0d0
      rv(3,2) = 0.0d0
      rv(3,3) = 1.0d0

      call matmult(rzi,ryi,rtmp)
      call matmult(rtmp,rv,rout)
      call matmult(rout,ry,rtmp)
      call matmult(rtmp,rz,r)
      call matmult(rcpy,r,rtmp)

      do i=1,3
         rxl(i) = rtmp(i,1)
         ryl(i) = rtmp(i,2)
         rzl(i) = rtmp(i,3)
      end do

      return
      end

      subroutine prtmat(a)
      implicit double precision (a-h,o-z)
      dimension a(3,3)

      do i=1,3
         write(6,'(3f12.4)') (a(i,j),j=1,3)
      end do

      return
      end

