C === RIBBON ===
C	(extracted from frodo.tlb in CCP program package)
C
      SUBROUTINE RIBBON(NRIB,RIBWID,NCHORD,OFFSET,NATOM)
C     ==================================================
C
C Generate guide points for protein ribbon, based on ideas on
C Carson & Bugg, J.Molec.Graphics 4,121-122 (1986)
C
C  Guide points for Bspline are generated along a line passing
C through each CA and along the average of the two peptide planes
C
C   NRIB     number of strands in ribbon (maximum=MAXRIB=15)
C   RIBWID   total ribbon width
C   NCHORD   number of chords/residue
C   OFFSET   amount to offset guide points away from CA positions
C   NATOM    number of atoms stored in arrays
C
      PARAMETER (MAXRIB=5,MAXRES=1500)
      PARAMETER (NOISE=0)
      DIMENSION GUIDE(4,MAXRES,MAXRIB)
      DIMENSION XCA(3,2),XO(3,2),A(3),B(3),C(3),D(3),E(3),F(3),
     .   G(3),H(3),P(3)
C
C Maximum CA-CA distance **2
      PARAMETER (DISMAX=6.**2)
C
      IF(NATOM.LE.0) THEN
	    WRITE(NOISE,1005)
1005	    FORMAT(' No atoms selected')
	    RETURN
      ENDIF
C
      IF(NRIB.GT.MAXRIB) THEN
	    WRITE(NOISE,1001) NRIB,MAXRIB
1001	    FORMAT(' Too many ribbon strands',I6,' reset to ',I6)
	    NRIB=MAXRIB
      ENDIF
C
      WRITE(NOISE,1002) NRIB,RIBWID,NCHORD,OFFSET
1002  FORMAT(' Ribbon drawn with',I4,' strands, width ',F6.2,
     . 'A'/'   Number of chords =',I3,', offset = ',F6.2,'A')
C
C Strand separation
      DRIB=0.
      IF(NRIB.GT.1) DRIB=RIBWID/(NRIB-1)
      RIB2=FLOAT(NRIB+1)/2.
C
      NAT=1
C
C Get first CA and O
1     CALL GETCAO(XCA(1,1),XO(1,1),NAT,NATOM,IERR)
CEAM  IF(NAT.LE.0) RETURN
CEAM  IF(IERR.NE.0) GO TO 1
      IF(IERR.NE.0) RETURN
      I=0
C
C  Loop for residues
10    I=I+1
C  Get CA and O for residue I+1
      CALL GETCAO(XCA(1,2),XO(1,2),NAT,NATOM,IERR)
C Set LEND = 1 for end of chain under 3 conditions:
C  (a) all atoms done; (b) one fo CA or O missing; (c) break in chain
      IF(NAT.LT.0.OR.IERR.NE.0) THEN
	    LEND=1
      ELSE
	    LEND=0
      ENDIF
C
      IF(LEND.EQ.0) THEN
C Not last one unless CA-CA distance too large
C   A is vector CAi to Ci+1
	    CALL VDIF(A,XCA(1,2),XCA(1,1))
	    IF(DOT(A,A).GT.DISMAX) LEND=1
      ENDIF
      IF(LEND.EQ.0) THEN
C Not last one
C   B is vector CAi to Oi
	    CALL VDIF(B,XO(1,1),XCA(1,1))
C   C = A x B;  D = C x A
	    CALL CROSS(A,B,C)
	    CALL CROSS(C,A,D)
	    CALL UNIT(D)
C
	    IF(I.EQ.1) THEN
C  First peptide, no previous one to average with
		  CALL VSET(E,D)
C  No offset for first CA
		  CALL ZEROI(P,3)
	    ELSE
C  Not first, ribbon cross vector is average of peptide plane
C  with previous one
		  CALL SCALEV(B,SIGN(1.,DOT(D,G)),D)
		  CALL VSUM(E,G,B)
C  Offset is along bisector of CA-CA-CA vectors A (H is Ai-1)
		  CALL VDIF(P,H,A)
		  CALL UNIT(P)
	    ENDIF
      ELSE
C  Last one, just use last plane
	    CALL VSET(E,G)
C  No offset for last CA
	    CALL ZEROI(P,3)
      ENDIF
C Normalise vector E
      CALL UNIT(E)
C      WRITE(NOISE,1003) I,G,D,B,E
C1003  FORMAT(' I,G,D,B,E',I4,4(3X,3F8.2)/)
C
C
C Generate guide points
      CALL SCALEV(P,OFFSET,P)
      CALL VSUM(P,XCA(1,1),P)
C
      DO 20,J=1,NRIB
      FR=(FLOAT(J)-RIB2)*DRIB
      CALL SCALEV(F,FR,E)
      CALL VSUM(GUIDE(1,I,J),P,F)
C     EAM - Maybe should be NAT-2 ??
      guide(4,i,j) = NAT - 3
20    CONTINUE
C
C Store things for next residue
      CALL VSET(XCA(1,1),XCA(1,2))
      CALL VSET(XO(1,1),XO(1,2))
      CALL VSET(G,E)
      CALL VSET(H,A)
C
      IF(LEND.EQ.0) GO TO 10
C
      NPT=I
      CALL RIBDRW(GUIDE,NRIB,MAXRES,NPT,NCHORD)
C
C Loop chains if required
CEAM  IF(NAT.GT.0) GO TO 1
      IF (IERR.EQ.0) GOTO 1
C
      RETURN
      END
C
C
      SUBROUTINE pdb_GETCAO(XCA,XO,NAT,NATOM,IERR)
C     ========================================
C
C Get coordinates of CA in XCA, O in XO, 
C Modified to read sequential CA and O records in PDB format from file
C
C  On exit: NAT next atom 
C           IERR  =0 if succesfull, else = 1
C
      DIMENSION XCA(3),XO(3)
C
	integer		PDBFILE
	parameter	(PDBFILE = 1)
	character*1	a1, rescode(2)
	character*3	resname(2)
	character*4	reclabel, atname
	integer		resno(2)
C
	ierr=0

	read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(1),
     1		a1, resno(1), rescode(1), xca(1), xca(2), xca(3)
	read (pdbfile,2,end=100) reclabel, nat, atname, a1, resname(2),
     1		a1, resno(2), rescode(2), xo(1), xo(2), xo(3)
    2	format(a4,2x,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,5f8.3,2f6.2,1x,i3)

	if (resname(1) .ne. resname(2)) ierr = 1
	if (resno(1)   .ne. resno(2))   ierr = 1
	if (rescode(1) .ne. rescode(2)) ierr = 1
	return

  100	continue
	ierr = 1
	nat = -1
	return

	end



      SUBROUTINE GETCAO(XCA,XO,NAT,NATOM,IERR)
C     ========================================
C
C Get coordinates of CA in XCA, O in XO, 
C modified to get coords from common /SPAM/
C
C  On exit: NAT next atom 
C           IERR  =0 if succesfull, else = 1
C
      DIMENSION XCA(3),XO(3)
C
	parameter	(MAXATOM=10000)
	common /SPAM/ natm, SPAM(4,MAXATOM), SCAM(MAXATOM)
	integer SCAM
c
	if ((nat .gt. natm) .or. (nat .gt. natom-1)) then
	     ierr = 1
CEAM	     nat = -1
	     return
	end if

	do i=1,3
	    xca(i) = spam(i,nat)
	    xo(i)  = spam(i,nat+1)
	end do
	nat  = nat + 2
	ierr = 0
	return

	end

	subroutine zeroi( a, nwords )
	integer*4 a(nwords)
	do i = 1,nwords
	    a(i) = 0
	end do
	return
	end
