c
c
c     ###################################################
c     ##  COPYRIGHT (C)  1993  by  Jay William Ponder  ##
c     ##              All Rights Reserved              ##
c     ###################################################
c
c     #############################################################
c     ##                                                         ##
c     ##  program correlate  --  time correlation of a property  ##
c     ##                                                         ##
c     #############################################################
c
c
c     "correlate" computes the time correlation function of some
c     property from the individual snapshot coordinate files taken
c     from a molecular dynamics or other trajectory
c
c
      program correlate
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'files.i'
      include 'inform.i'
      include 'iounit.i'
      integer maxblock,maxfile
      parameter (maxblock=100)
      parameter (maxfile=10000)
      integer i,j,k,m,n1,n2,dt
      integer nfile,nblock,blksize,trimtext
      integer first,last,step,start,stop
      integer t1(maxblock),t2(maxblock)
      integer blkdiff,icorr(0:maxfile)
      real*8 x1(maxatm,maxblock),x2(maxatm,maxblock)
      real*8 y1(maxatm,maxblock),y2(maxatm,maxblock)
      real*8 z1(maxatm,maxblock),z2(maxatm,maxblock)
      real*8 value,property,vcorr(0:maxfile)
      character*1 letter
      character*80 string
      logical exist,query
c
c
c     get the base name of user specified input structures
c
      call initial
      call nextarg (filename,exist)
      if (.not. exist) then
         write (iout,10)
   10    format (/,' Enter Cartesian Coordinate File Name :  ',$)
         read (input,20)  filename
   20    format (a60)
      end if
c
c     remove any extension from the filename
c
      leng = trimtext (filename)
      last = leng
      do i = 1, leng
         letter = filename(i:i)
         if (letter .eq. '/')  last = leng
c        if (letter .eq. '\')  last = leng
         if (ichar(letter) .eq. 92)  last = leng
         if (letter .eq. ']')  last = leng
         if (letter .eq. ':')  last = leng
         if (letter .eq. '~')  last = leng
         if (letter .eq. '.')  last = i - 1
      end do
      leng = min(leng,last)
c
c     set first and last coordinate frames and step increment
c
      first = 0
      last = 0
      step = 0
      query = .true.
      call nextarg (string,exist)
      if (exist) then
         read (string,*,err=30,end=30)  first
         query = .false.
      end if
      call nextarg (string,exist)
      if (exist)  read (string,*,err=30,end=30)  last
      call nextarg (string,exist)
      if (exist)  read (string,*,err=30,end=30)  step
   30 continue
      if (query) then
         write (iout,40)
   40    format (/,' Numbers of First & Last File and Step',
     &              ' Increment :  ',$)
         read (input,50)  string
   50    format (a80)
         read (string,*,err=60,end=60)  first,last,step
   60    continue
      end if
      if (last .eq. 0)  last = first
      if (step .eq. 0)  step = 1
c
c     get the number of file blocks from the total files
c
      nfile = 1 + (last-first)/step
      nblock = 1 + (nfile-1)/maxblock
      blksize = maxblock * step
      write (iout,70)  nblock,min(nfile,maxblock)
   70 format (/,' Correlation Function Computed using',i4,
     &           ' Blocks of',i5,' Files',/)
c
c     zero out the time correlation function cumulative values
c
      do i = 0, nfile-1
         icorr(i) = 0
         vcorr(i) = 0.0d0
      end do
c
c     cycle over all pairs of coordinate file blocks
c
      do i = 1, nblock
         start = first + (i-1) * blksize
         stop = start + blksize - step
         stop = min(last,stop)
         call readblk (start,stop,step,n1,t1,x1,y1,z1)
         write (iout,80)  i
   80    format (3x,'Correlation within File Block :    ',i8)
c
c     compute time correlation for files within single block
c
         do k = 1, n1
            do m = k, n1
               dt = t1(m) - t1(k)
               value = property (k,x1,y1,z1,m,x1,y1,z1)
               icorr(dt) = icorr(dt) + 1
               vcorr(dt) = vcorr(dt) + value
            end do
         end do
c
c     compute time correlation for files between two blocks
c
         do j = i+1, nblock
            start = first + (j-1) * blksize
            stop = start + blksize - step
            stop = min(last,stop)
            blkdiff = (j-i) * maxblock
            call readblk (start,stop,step,n2,t2,x2,y2,z2)
            write (iout,90)  i,j
   90       format (3x,'Correlation between File Blocks :  ',2i8)
            do k = 1, n1
               do m = 1, n2
                  dt = t2(m) - t1(k) + blkdiff
                  value = property (k,x1,y1,z1,m,x2,y2,z2)
                  icorr(dt) = icorr(dt) + 1
                  vcorr(dt) = vcorr(dt) + value
               end do
            end do
         end do
      end do
c
c     compute the average time correlation function values
c
      do i = 0, nfile-1
         if (icorr(i) .ne. 0)  vcorr(i) = vcorr(i)/float(icorr(i))
      end do
c
c     print the values of the time correlation function
c
      write (iout,100)
  100 format (/,3x,'Separation',7x,'Samples',8x,'Average Value',/)
      do i = 0, nfile-1
         if (icorr(i) .ne. 0) then
            write (iout,110)  i*step,icorr(i),vcorr(i)
  110       format (i9,6x,i10,6x,f15.6)
         end if
      end do
      end
c
c
c     ################################################################
c     ##                                                            ##
c     ##  subroutine readblk  --  read a block of coordinate files  ##
c     ##                                                            ##
c     ################################################################
c
c
c     "readblk" reads in a set of coordinate files and transfers
c     the coordinates to internal arrays for use in the computation
c     of time correlation functions
c
c
      subroutine readblk (start,stop,step,nb,tb,xb,yb,zb)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      include 'files.i'
      integer maxblock
      parameter (maxblock=100)
      integer i,k,ixyz,start,stop
      integer step,lext,freeunit
      integer nt,nb,tb(maxblock)
c     integer next,label
      real*8 xb(maxatm,maxblock)
      real*8 yb(maxatm,maxblock)
      real*8 zb(maxatm,maxblock)
c     character*4 name
      character*7 ext
      character*60 xyzfile
      character*80 record
c     character*80 string
      logical exist
c
c
c     initialize the number of files and the numeral size
c
      nt = 0
      nb = 0
      lext = 3
c
c     cycle over all coordinate files in the block of files
c
      do i = start, stop, step
         nt = nt + 1
         call numeral (i,ext,lext)
         xyzfile = filename(1:leng)//'.'//ext(1:lext)
         inquire (file=xyzfile,exist=exist)
c
c     add file to the current block and get number of atoms
c
         if (exist) then
            nb = nb + 1
            tb(nb) = nt
            ixyz = freeunit ()
            open (unit=ixyz,file=xyzfile,status='old')
            read (ixyz,10)  record
   10       format (a80)
            read (record,*)  n
c
c     read in the atomic coordinates from a TINKER generated file;
c     this is faster, but assumes the fixed format shown below
c
            do k = 1, n
               read (ixyz,20)  xb(k,nb),yb(k,nb),zb(k,nb)
   20          format (11x,3f12.6)
            end do
c
c     alternatively, get the coordinates from a free formated file;
c     this is slower, but correctly handles any valid TINKER file
c
c           do k = 1, n
c              next = 1
c              read (ixyz,30)  record
c  30          format (a80)
c              read (record,*)  label
c              call getword (record,name,next)
c              string = record(next:80)
c              read (string,*)  xb(k,nb),yb(k,nb),zb(k,nb)
c           end do
            close (unit=ixyz)
         end if
      end do
      return
      end
c
c
c     #################################################################
c     ##                                                             ##
c     ##  function property  --  evaluate time correlation property  ##
c     ##                                                             ##
c     #################################################################
c
c
c     "property" takes two input coordinate sets and computes the
c     value of the property for which the time correlation function
c     is being accumulated
c
c
      function property (i,xi,yi,zi,k,xk,yk,zk)
      implicit none
      include 'sizes.i'
      include 'atoms.i'
      integer maxblock
      parameter (maxblock=100)
      integer i,k
      real*8 property
      real*8 xi(maxatm,maxblock),xk(maxatm,maxblock)
      real*8 yi(maxatm,maxblock),yk(maxatm,maxblock)
      real*8 zi(maxatm,maxblock),zk(maxatm,maxblock)
c
c
c     compute the value of the time correlation function property;
c     the version below finds the rms fit as a function of time
c
      integer ifit,nfit
      real*8 rmsfit
      real*8 x1(maxatm),y1(maxatm),z1(maxatm)
      real*8 x2(maxatm),y2(maxatm),z2(maxatm)
c
c     find the rms coordinate deviation upon superposition
c
      nfit = n
      do ifit = 1, nfit
         x1(ifit) = xi(ifit,i)
         y1(ifit) = yi(ifit,i)
         z1(ifit) = zi(ifit,i)
         x2(ifit) = xk(ifit,k)
         y2(ifit) = yk(ifit,k)
         z2(ifit) = zk(ifit,k)
      end do
      call impose (nfit,x1,y1,z1,nfit,x2,y2,z2,rmsfit)
      property = rmsfit
      return
      end
