PROGRAM applysym

c	Applies symmetry to PDB file (assumes protomer A input)
c	Uses output from LSQMAN 

	PARAMETER	NDIM = 10000 

	CHARACTER*80	line(NDIM)
	CHARACTER*80	filnam
        CHARACTER*1     letter(6)/'A', 'B','C','D','E','F'/
	REAL		mat(3,4,2:6), x(NDIM), y(NDIM), z(NDIM)

c	Read in matrices to rotate protomer A onto B-F 

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='atob.odb')
	READ (1, 1000)
	READ (1, 1000)
	READ (1, 9001) ((mat(i,j,2), i=1,3), j=1,4)
9001	FORMAT (3f15.7)
	CLOSE (unit=1)

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='atoc.odb')
	READ (1, 1000)
	READ (1, 1000)
	READ (1, 9001) ((mat(i,j,3), i=1,3), j=1,4)
	CLOSE (unit=1)

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='atod.odb')
	READ (1, 1000)
	READ (1, 1000)
	READ (1, 9001) ((mat(i,j,4), i=1,3), j=1,4)
	CLOSE (unit=1)

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='atoe.odb')
	READ (1, 1000)
	READ (1, 1000)
	READ (1, 9001) ((mat(i,j,5), i=1,3), j=1,4)
	CLOSE (unit=1)

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='atof.odb')
	READ (1, 1000)
	READ (1, 1000)
	READ (1, 9001) ((mat(i,j,6), i=1,3), j=1,4)
	CLOSE (unit=1)

c	Open input and output files

	WRITE (6, 1000) 'Enter filename for input PDB file:'
	READ (5, 1000) filnam
	len = length(filnam)
	WRITE (6, 1000) filnam(1:len)
1000	FORMAT (a)
	OPEN (unit=1, file=filnam(1:len), status='OLD', readonly, 
	1	form='FORMATTED')

	WRITE (6, 1000) 'Enter filename for output PDB file:'
	READ (5, 1000) filnam
	len = length(filnam)
	WRITE (6, 1000) filnam(1:len)	
	OPEN (unit=2, file=filnam(1:len), status='UNKNOWN', 
	1	form='FORMATTED') 

c	Store input PDB file

	natom = 0
	DO n = 1,NDIM

c	Enforce protomer A

12	  READ (1, 1000, end=10) line(n)
          IF (line(n)(1:6) .EQ. 'REMARK' .OR. 
	1	line(n)(1:5) .EQ. 'SCALE' .OR.
	2	line(n)(1:5) .EQ. 'CRYST' .OR.
	3	line(n)(1:4) .EQ. 'ORIG') THEN
	    WRITE (2, 1000) line(n)
            goto 12
          ELSE IF (line(n)(1:6) .EQ. 'HETATM' .OR.
	1	line(n)(1:6) .EQ. 'ATOM  ') THEN
	    line(n)(73:73) = 'A'
	    READ (line(n)(23:26), 1002) nres
1002	    FORMAT (i4)
	    IF (nres .LT. 300) THEN
	      line(n)(74:76) = 'ALP'
	    ELSE IF (nres .LT. 540) THEN
	      line(n)(74:76) = 'BET'
	    ELSE IF (nres .EQ. 600) THEN
	      line(n)(74:76) = 'FE '
	    ELSE IF (nres .GT. 600) THEN
	      line(n)(74:76) = 'WAT'
	    ELSE
	      line(n)(74:76) = 'SUB'
	    endIF	

c	Set up natom 

	    natom = natom + 1
	    WRITE (line(n)(7:11), 1003) natom
1003	    FORMAT (i5)

	    ll = length(line(n))
	    WRITE (2, 1000) line(n)(1:ll)
	  ELSE
	  goto 12
	  endIF
	endDO

10	num = n - 1
	CLOSE (unit=1)
	WRITE (2, 1000) 'TER'

c	Save original coordinates

	DO n = 1, num
	  READ (line(n)(31:54), 1004) x(n), y(n), z(n)
1004	  FORMAT (3f8.3)
	endDO

c	Apply symmetry to desired atoms

	DO m = 2,6
	  DO n = 1,num

c	Handle natom

	    natom = natom + 1
	    WRITE (line(n)(7:11), 1003) natom

c	Replace coordinates

	    xo = x(n)*mat(1,1,m) + y(n)*mat(1,2,m) + z(n)*mat(1,3,m) 
	1	+ mat(1,4,m)
	    yo = x(n)*mat(2,1,m) + y(n)*mat(2,2,m) + z(n)*mat(2,3,m)
	1	+ mat(2,4,m)
	    zo = x(n)*mat(3,1,m) + y(n)*mat(3,2,m) + z(n)*mat(3,3,m)
	1	+ mat(3,4,m)
	    WRITE (line(n)(31:54), 1004) xo, yo, zo

c	Handle protomer label

	    line(n)(73:73) = letter(m)
	    IF (line(n)(22:22) .NE. ' ') line(n)(22:22) = letter(m)

c	Write it

	    ll = length(line(n))
	    WRITE (2, 1000) line(n)(1:ll)
	  endDO
	  WRITE (2, 1000) 'TER'
	endDO

	CLOSE (unit=2)
	end

        INTEGER FUNCTION length(line)

        CHARACTER*80   line

        DO i = 80,1,-1
          IF (line(i:i) .NE. ' ') goto 9
        endDO

9       length = i

        return
        end