PROGRAM applysym

c	Applies symmetry to PDB file (assumes protomer A input)

	PARAMETER	NDIM = 10000 

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

        aa = 197.17
        bb = 127.03
        cc = 134.18
	beta = 97.64
	cosb = COSD(beta-90.)
	sinb = SIND(beta-90.)
	tanb = sinb/cosb

c	Read local symmetry operations

	OPEN (unit=10, status='OLD', form='FORMATTED', readonly,
	1	file='/home/ohlen/pcd/AVER.MEP')
	READ (10, 1000)
1000	FORMAT (a)
	DO n = 1,5
	  READ (10, 1001) ((mat(i,j,n), i=1,3), j=1,3)
1001	  FORMAT (9f10.5)
	  mat(1,2,n) = mat(1,2,n)*aa/bb
	  mat(1,3,n) = mat(1,3,n)*aa/cc
	  mat(2,1,n) = mat(2,1,n)*bb/aa
	  mat(2,3,n) = mat(2,3,n)*bb/cc
	  mat(3,1,n) = mat(3,1,n)*cc/aa
	  mat(3,2,n) = mat(3,2,n)*cc/bb
	endDO
	CLOSE unit=10

	WRITE (6, 1000) 'Enter filename for input PDB file:'
	READ (5, 1000) filnam
	len = length(filnam)
	WRITE (6, 1000) filnam(1:len)
	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)

c	Save coordinates

	DO n = 1, num
	  READ (line(n)(31:54), 1004) xo, yo, zo
1004	  FORMAT (3f8.3)
	  x(n) = xo + tanb*zo
	  y(n) = yo
	  z(n) = zo/cosb
	endDO

c	Apply symmetry to desired atoms

	DO m = 1,5
	  DO n = 1,num

c	Handle natom

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

c	Replace coordinates

	    fx = x(n)*mat(1,1,m) + y(n)*mat(1,2,m) + z(n)*mat(1,3,m)
	    fy = x(n)*mat(2,1,m) + y(n)*mat(2,2,m) + z(n)*mat(2,3,m)
	    fz = x(n)*mat(3,1,m) + y(n)*mat(3,2,m) + z(n)*mat(3,3,m)
	    xo = fx - sinb*fz
	    yo = fy
            zo = cosb*fz
	    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
	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