PROGRAM deapplysym

c	Moves protomers B-F onto protomer A from *.pdb to *.nosym. 
c	Protomer A is NOT written.

	CHARACTER*103	filnam, line
	REAL		mat(3,3,2:6)

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

	OPEN (unit=1, status='OLD', form='FORMATTED', readonly, 
	1	file='/home/ohlen/pcd/AVERINV.MEP')
	READ (1, 1000)
	DO n = 2,6
	  READ (1, 9001) ((mat(i,j,n), i=1,3), j=1,3)
9001	  FORMAT (9f10.5)	
	endDO
	CLOSE (unit=1)

c	Get PDB mnemonic

	WRITE (6, 1000) 'Enter PDB mnemonic:'
1000	FORMAT (a)
	READ (5, 1000) filnam
	len = length(filnam)

c	Open files for input and output

	OPEN (unit=1, form='FORMATTED', status='OLD', readonly,
	1       file=filnam(1:len)//'.pdb')
	OPEN (unit=2, form='FORMATTED', status='UNKNOWN',
	1       file=filnam(1:len)//'.nosym')

c	Loop through file

	DO WHILE (.TRUE.)
11	  READ (1, 1000, end=199) line
	  len = length(line)
	  IF (line(1:4) .NE. 'ATOM' .AND. line(1:6) .NE. 'HETATM') THEN
	    WRITE (2, 1000) line(1:len)
	  ELSE
	    isub = ICHAR(line(73:73))-64
	    line(22:22) = line(73:73)		!Be sure chain ID is okay
	    READ (line(31:54), 1002) xx, yy, zz
1002	    FORMAT (3f8.4)
	    IF (isub .NE. 1) THEN		!Rotate protomers B-F onto A
	      x = xx*mat(1,1,isub) + yy*mat(2,1,isub) + zz*mat(3,1,isub)
	      y = xx*mat(1,2,isub) + yy*mat(2,2,isub) + zz*mat(3,2,isub)
	      z = xx*mat(1,3,isub) + yy*mat(2,3,isub) + zz*mat(3,3,isub)
	      WRITE (line(31:54), 1002) x, y, z
	      WRITE (2, 1000) line(1:len)	!Do not write protomer A
	    endIF
	  endIF
	endDO

199	CLOSE (unit=1)
	CLOSE (unit=2)
	end

	INTEGER FUNCTION length(line)

	CHARACTER*103   line

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

9	length = i

	return
	end