/* ribbon.f -- translated by f2c (version 20061008). You must link the resulting object file with libf2c: on Microsoft Windows system, link with libf2c.lib; on Linux or Unix systems, link with .../path/to/libf2c.a -lm or, if you install libf2c.a in a standard place, with -lf2c -lm -- in that order, at the end of the command line, as in cc *.o -lf2c -lm Source for libf2c is in /netlib/f2c/libf2c.zip, e.g., http://www.netlib.org/f2c/libf2c.zip */ #include "f2c.h" /* Common Block Declarations */ struct { integer natm; real spam[40000] /* was [4][10000] */; integer scam[10000]; } spam_; #define spam_1 spam_ /* Table of constant values */ static integer c__1 = 1; static integer c__5 = 5; static integer c__3 = 3; static real c_b18 = 1.f; static integer c__1500 = 1500; /* === RIBBON === */ /* (extracted from frodo.tlb in CCP program package) */ /* Subroutine */ int ribbon_(integer *nrib, real *ribwid, integer *nchord, real *offset, integer *natom) { /* Format strings */ static char fmt_1005[] = "(\002 No atoms selected\002)"; static char fmt_1001[] = "(\002 Too many ribbon strands\002,i6,\002 rese" "t to \002,i6)"; static char fmt_1002[] = "(\002 Ribbon drawn with\002,i4,\002 strands, w" "idth \002,f6.2,\002A\002/\002 Number of chords =\002,i3,\002, " "offset = \002,f6.2,\002A\002)"; /* System generated locals */ integer i__1; real r__1, r__2; /* Builtin functions */ integer s_wsfe(cilist *), e_wsfe(void), do_fio(integer *, char *, ftnlen); double r_sign(real *, real *); /* Local variables */ static real a[3], b[3], c__[3], d__[3], e[3], f[3], g[3], h__[3]; static integer i__, j; static real p[3], fr, xo[6] /* was [3][2] */, xca[6] /* was [3][2] */; static integer nat; extern doublereal dot_(real *, real *); static integer npt; static real rib2, drib; static integer lend; extern /* Subroutine */ int vdif_(real *, real *, real *); static integer ierr; extern /* Subroutine */ int unit_(real *), vset_(real *, real *), vsum_( real *, real *, real *); static real guide[30000] /* was [4][1500][5] */; extern /* Subroutine */ int zeroi_(real *, integer *), cross_(real *, real *, real *), getcao_(real *, real *, integer *, integer *, integer *), scalev_(real *, real *, real *), ribdrw_(real *, integer *, integer *, integer *, integer *); /* Fortran I/O blocks */ static cilist io___1 = { 0, 0, 0, fmt_1005, 0 }; static cilist io___2 = { 0, 0, 0, fmt_1001, 0 }; static cilist io___3 = { 0, 0, 0, fmt_1002, 0 }; /* ================================================== */ /* Generate guide points for protein ribbon, based on ideas on */ /* Carson & Bugg, J.Molec.Graphics 4,121-122 (1986) */ /* Guide points for Bspline are generated along a line passing */ /* through each CA and along the average of the two peptide planes */ /* NRIB number of strands in ribbon (maximum=MAXRIB=15) */ /* RIBWID total ribbon width */ /* NCHORD number of chords/residue */ /* OFFSET amount to offset guide points away from CA positions */ /* NATOM number of atoms stored in arrays */ /* Maximum CA-CA distance **2 */ if (*natom <= 0) { s_wsfe(&io___1); e_wsfe(); return 0; } if (*nrib > 5) { s_wsfe(&io___2); do_fio(&c__1, (char *)&(*nrib), (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer)); e_wsfe(); *nrib = 5; } s_wsfe(&io___3); do_fio(&c__1, (char *)&(*nrib), (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&(*ribwid), (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&(*nchord), (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&(*offset), (ftnlen)sizeof(real)); e_wsfe(); /* Strand separation */ drib = 0.f; if (*nrib > 1) { drib = *ribwid / (*nrib - 1); } rib2 = (real) (*nrib + 1) / 2.f; nat = 1; /* Get first CA and O */ L1: getcao_(xca, xo, &nat, natom, &ierr); /* EAM IF(NAT.LE.0) RETURN */ /* EAM IF(IERR.NE.0) GO TO 1 */ if (ierr != 0) { return 0; } i__ = 0; /* Loop for residues */ L10: ++i__; /* Get CA and O for residue I+1 */ getcao_(&xca[3], &xo[3], &nat, natom, &ierr); /* Set LEND = 1 for end of chain under 3 conditions: */ /* (a) all atoms done; (b) one fo CA or O missing; (c) break in chain */ if (nat < 0 || ierr != 0) { lend = 1; } else { lend = 0; } if (lend == 0) { /* Not last one unless CA-CA distance too large */ /* A is vector CAi to Ci+1 */ vdif_(a, &xca[3], xca); if (dot_(a, a) > 36.f) { lend = 1; } } if (lend == 0) { /* Not last one */ /* B is vector CAi to Oi */ vdif_(b, xo, xca); /* C = A x B; D = C x A */ cross_(a, b, c__); cross_(c__, a, d__); unit_(d__); if (i__ == 1) { /* First peptide, no previous one to average with */ vset_(e, d__); /* No offset for first CA */ zeroi_(p, &c__3); } else { /* Not first, ribbon cross vector is average of peptide plane */ /* with previous one */ r__2 = dot_(d__, g); r__1 = r_sign(&c_b18, &r__2); scalev_(b, &r__1, d__); vsum_(e, g, b); /* Offset is along bisector of CA-CA-CA vectors A (H is Ai-1) */ vdif_(p, h__, a); unit_(p); } } else { /* Last one, just use last plane */ vset_(e, g); /* No offset for last CA */ zeroi_(p, &c__3); } /* Normalise vector E */ unit_(e); /* WRITE(NOISE,1003) I,G,D,B,E */ /* 1003 FORMAT(' I,G,D,B,E',I4,4(3X,3F8.2)/) */ /* Generate guide points */ scalev_(p, offset, p); vsum_(p, xca, p); i__1 = *nrib; for (j = 1; j <= i__1; ++j) { fr = ((real) j - rib2) * drib; scalev_(f, &fr, e); vsum_(&guide[(i__ + j * 1500 << 2) - 6004], p, f); /* EAM - Maybe should be NAT-2 ?? */ guide[(i__ + j * 1500 << 2) - 6001] = (real) (nat - 3); /* L20: */ } /* Store things for next residue */ vset_(xca, &xca[3]); vset_(xo, &xo[3]); vset_(g, e); vset_(h__, a); if (lend == 0) { goto L10; } npt = i__; ribdrw_(guide, nrib, &c__1500, &npt, nchord); /* Loop chains if required */ /* EAM IF(NAT.GT.0) GO TO 1 */ if (ierr == 0) { goto L1; } return 0; } /* ribbon_ */ /* Subroutine */ int pdb_getcao__(real *xca, real *xo, integer *nat, integer * natom, integer *ierr) { /* Format strings */ static char fmt_2[] = "(a4,2x,i5,1x,a4,a1,a3,1x,a1,i4,a1,3x,5f8.3,2f6.2," "1x,i3)"; /* System generated locals */ integer i__1; /* Builtin functions */ integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void), s_cmp(char *, char *, ftnlen, ftnlen); /* Local variables */ static char reclabel[4], a1[1]; static integer resno[2]; static char atname[4], rescode[1*2], resname[3*2]; /* Fortran I/O blocks */ static cilist io___25 = { 0, 1, 1, fmt_2, 0 }; static cilist io___32 = { 0, 1, 1, fmt_2, 0 }; /* ======================================== */ /* Get coordinates of CA in XCA, O in XO, */ /* Modified to read sequential CA and O records in PDB format from file */ /* On exit: NAT next atom */ /* IERR =0 if succesfull, else = 1 */ /* Parameter adjustments */ --xo; --xca; /* Function Body */ *ierr = 0; i__1 = s_rsfe(&io___25); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, reclabel, (ftnlen)4); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&(*nat), (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, atname, (ftnlen)4); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, a1, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, resname, (ftnlen)3); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, a1, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&resno[0], (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, rescode, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xca[1], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xca[2], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xca[3], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = e_rsfe(); if (i__1 != 0) { goto L100; } i__1 = s_rsfe(&io___32); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, reclabel, (ftnlen)4); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&(*nat), (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, atname, (ftnlen)4); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, a1, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, resname + 3, (ftnlen)3); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, a1, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&resno[1], (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, rescode + 1, (ftnlen)1); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xo[1], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xo[2], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = do_fio(&c__1, (char *)&xo[3], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L100; } i__1 = e_rsfe(); if (i__1 != 0) { goto L100; } if (s_cmp(resname, resname + 3, (ftnlen)3, (ftnlen)3) != 0) { *ierr = 1; } if (resno[0] != resno[1]) { *ierr = 1; } if (*(unsigned char *)&rescode[0] != *(unsigned char *)&rescode[1]) { *ierr = 1; } return 0; L100: *ierr = 1; *nat = -1; return 0; } /* pdb_getcao__ */ /* Subroutine */ int getcao_(real *xca, real *xo, integer *nat, integer * natom, integer *ierr) { static integer i__; /* ======================================== */ /* Get coordinates of CA in XCA, O in XO, */ /* modified to get coords from common /SPAM/ */ /* On exit: NAT next atom */ /* IERR =0 if succesfull, else = 1 */ /* Parameter adjustments */ --xo; --xca; /* Function Body */ if (*nat > spam_1.natm || *nat > *natom - 1) { *ierr = 1; /* EAM nat = -1 */ return 0; } for (i__ = 1; i__ <= 3; ++i__) { xca[i__] = spam_1.spam[i__ + (*nat << 2) - 5]; xo[i__] = spam_1.spam[i__ + (*nat + 1 << 2) - 5]; } *nat += 2; *ierr = 0; return 0; } /* getcao_ */ /* Subroutine */ int zeroi_(integer *a, integer *nwords) { /* System generated locals */ integer i__1; /* Local variables */ static integer i__; /* Parameter adjustments */ --a; /* Function Body */ i__1 = *nwords; for (i__ = 1; i__ <= i__1; ++i__) { a[i__] = 0; } return 0; } /* zeroi_ */