1c
2c
3c     ###################################################
4c     ##  COPYRIGHT (C)  2014  by  Jay William Ponder  ##
5c     ##              All Rights Reserved              ##
6c     ###################################################
7c
8c     ##################################################################
9c     ##                                                              ##
10c     ##  program xyzavg  --  average structure from an archive file  ##
11c     ##                                                              ##
12c     ##################################################################
13c
14c
15c     "xyzavg" compute the coordiantes of the average strurcture from
16c     an archive file; assumes the files in the archive have already
17c     been superimposed
18c
19c
20      program xyzavg
21      use atoms
22      use inform
23      use iounit
24      implicit none
25      integer i,ixyz
26      integer natom
27      integer nframe
28      integer freeunit
29      real*8 denom
30      real*8, allocatable :: xave(:)
31      real*8, allocatable :: yave(:)
32      real*8, allocatable :: zave(:)
33      logical exist
34      character*240 xyzfile
35c
36c
37c     try to get a filename from the command line arguments
38c
39      call initial
40      call nextarg (xyzfile,exist)
41      if (exist) then
42         call basefile (xyzfile)
43         call suffix (xyzfile,'xyz','old')
44         inquire (file=xyzfile,exist=exist)
45      end if
46c
47c     ask for the user specified input structure filename
48c
49      do while (.not. exist)
50         write (iout,10)
51   10    format (/,' Enter Coordinate Archive File Name :  ',$)
52         read (input,20)  xyzfile
53   20    format (a240)
54         call basefile (xyzfile)
55         call suffix (xyzfile,'xyz','old')
56         inquire (file=xyzfile,exist=exist)
57      end do
58c
59c     open the input file and read the first coordinate set
60c
61      ixyz = freeunit ()
62      open (unit=ixyz,file=xyzfile,status='old')
63      call readxyz (ixyz)
64      allocate (xave(n))
65      allocate (yave(n))
66      allocate (zave(n))
67      natom = n
68      nframe = 1
69      do i = 1, n
70         xave(i) = x(i)
71         yave(i) = y(i)
72         zave(i) = z(i)
73      end do
74c
75c     get the remaining coordinate sets from the archive file
76c
77      dowhile (.true.)
78         call readxyz (ixyz)
79         if (abort)  goto 30
80         natom = n
81         nframe = nframe + 1
82         do i = 1, n
83            xave(i) = xave(i) + x(i)
84            yave(i) = yave(i) + y(i)
85            zave(i) = zave(i) + z(i)
86         end do
87      end do
88   30 continue
89      close (unit=ixyz)
90c
91c     compute the average coordinates over all structures
92c
93      n = natom
94      denom = dble(nframe)
95      do i = 1, n
96         x(i) = xave(i) / denom
97         y(i) = yave(i) / denom
98         z(i) = zave(i) / denom
99      end do
100c
101c     write the average coordinates to a file
102c
103      call suffix (xyzfile,'xyz','new')
104      open (unit=ixyz,file=xyzfile,status='new')
105      call prtxyz (ixyz)
106      close (unit=ixyz)
107c
108c     perform any final tasks before program exit
109c
110      call final
111      end
112