/* ribbon1.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 ischeme, cindex; real color1[3], color2[3], color3[3], rgb[15000] /* was [3][5000] */; } colors_; #define colors_1 colors_ struct { integer natm; real spam[40000] /* was [4][10000] */; integer scam[10000]; } spam_; #define spam_1 spam_ struct { logical mflag, hflag, dflag; } flags_; #define flags_1 flags_ struct matrix_1_ { real matrix[9] /* was [3][3] */, coords[3]; }; #define matrix_1 (*(struct matrix_1_ *) &matrix_) /* Initialized data */ struct { real e_1[9]; integer fill_2[3]; } matrix_ = { 1.f, 0.f, 0.f, 0.f, 1.f, 0.f, 0.f, 0.f, 1.f }; /* Table of constant values */ static integer c__1 = 1; static integer c__9 = 9; static integer c__3 = 3; static real c_b136 = 0.f; static real c_b138 = .4f; static real c_b139 = .5f; static real c_b142 = .6f; static integer c__4 = 4; static integer c__2 = 2; /* PROGRAM RIBBON */ /* Program to set up input for RENDER (RASTER3D package) */ /* to draw ribbon diagram. The RIBBON routine itself is simply */ /* extracted from CCP FRODO. The original invoked a bspline feature */ /* of the ps300; I have replaced this with a spline equation gotten */ /* from Larry Andrews. Conversion from ribbon edges to solid rendering */ /* is my own hacking. */ /* Ethan Merritt - 8-Nov-1988 */ /* Slightly modified code to guarantee output of triangles with */ /* vertices in correct order for triangular mesh algorithms EAM Sep 90 */ /* Usage: ribbon [-h] [-dn] pdbfile > setup.r3d */ /* ribbon [-h] -dn - to take pdb records from stdin */ /* Input: pdbfile */ /* Brookhaven PDB-format file of atomic co-ordinates */ /* only C-alpha and O atoms are needed */ /* setup.matrix or setup.angles */ /* rotation matrix or angles applied to PDB coords */ /* (see writeup for SETUP/RENDER). */ /* Output: stdout (new for DS5000 version) */ /* file suitable for input to RENDER */ /* Interactive parameters: */ /* WIDTH of ribbon in Angstroms */ /* NUMBER of interpolated coordinates between successive C-alphas. */ /* COLOR scheme for ribbon */ /* 0 or 1: solid color (RGB values from color1 below) */ /* 2: shade from color1 at 1st res to color2 at last res */ /* 3: front of ribbon is color1, back of ribbon is color2 */ /* 4: shade front as in scheme 2, back is color 3 */ /* 5: each chain is new color (from successive input */ /* (COLOR cards at start of input file) */ /* 6: use prefixed COLOR cards (as in SETUP/RENDER) */ /* (implemented 4-Aug-1997 EAM) */ /* COLOR1,COLOR2,COLOR3 RGB components (9f8.0) */ /* Main program */ int MAIN__(void) { /* Format strings */ static char fmt_3[] = "(a,a)"; static char fmt_82[] = "(30x,3f8.3)"; static char fmt_120[] = "(\0021 0 0 0 input co-ordinate + radius trans" "formation\002/\0020 1 0 0\002/\0020 0 1 0\002/4f10.3)"; static char fmt_153[] = "(1x,a,3f8.2)"; static char fmt_160[] = "(\002 Coloring schemes available:\002,/,\002 0 " "or 1: solid color (RGB values from color1 below)\002,/,\002 " " 2: shade from color1 at 1st res to color2 at last res\002,/," "\002 3: front of ribbon is color1, back of ribbon is color" "2\002,/,\002 4: shade front as in scheme 2, back is color " "3\002,/,\002 5: new color for each chain (requires COLOUR c" "ards)\002)"; static char fmt_169[] = "(\002 color scheme\002,i3,/,3(3x,3f6.3))"; /* System generated locals */ integer i__1, i__2; real r__1, r__2; olist o__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_rsfi(icilist *), do_fio( integer *, char *, ftnlen), e_rsfi(void), f_open(olist *), s_wsfe( cilist *), e_wsfe(void), s_rsfe(cilist *), e_rsfe(void), s_wsle( cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle( void); /* Subroutine */ int s_stop(char *, ftnlen), s_copy(char *, char *, ftnlen, ftnlen); integer s_rsli(icilist *), e_rsli(void); /* Local variables */ static integer i__; static real x, y, z__, tx, ty, tz, rad; extern /* Subroutine */ int view_matrix__(void); static char card[80]; static integer icol; static char line[80]; static integer narg, iatm; static char mask[24*5000]; static integer ncol; static char atom[80*10000]; static real xmid, ymid, zmid, xmin, ymin, xmax, ymax; static char test[24]; static real zmax, zmin; extern integer iargc_(void); static real scale; static char flags[32]; extern /* Subroutine */ int vload_(real *, real *, real *, real *); static real width, xspan, yspan, zspan; static integer input; static real xroom, yroom, zroom; extern /* Subroutine */ int getarg_(integer *, char *, ftnlen), ribbon_( integer *, real *, integer *, real *, integer *); static integer nchord; extern logical smatch_(char *, char *, ftnlen, ftnlen); static real aspect, offset, radius[5000]; static char in_file__[64]; /* Fortran I/O blocks */ static icilist io___4 = { 0, flags+2, 0, "(I1)", 2, 1 }; static cilist io___9 = { 0, 6, 0, "(A,A)", 0 }; static cilist io___10 = { 0, 6, 0, "(A)", 0 }; static cilist io___11 = { 0, 6, 0, "(A)", 0 }; static cilist io___12 = { 0, 6, 0, "(A)", 0 }; static cilist io___13 = { 0, 6, 0, "(A)", 0 }; static cilist io___14 = { 0, 6, 0, "(A)", 0 }; static cilist io___15 = { 0, 6, 0, "(A)", 0 }; static cilist io___16 = { 0, 6, 0, "(A)", 0 }; static cilist io___17 = { 0, 6, 0, "(A)", 0 }; static cilist io___18 = { 0, 6, 0, "(A)", 0 }; static cilist io___19 = { 0, 6, 0, "(A)", 0 }; static cilist io___20 = { 0, 6, 0, "(A)", 0 }; static cilist io___21 = { 0, 0, 1, "(A80)", 0 }; static cilist io___23 = { 0, 0, 0, 0, 0 }; static icilist io___24 = { 0, card, 0, "(6X,A24,3F8.3,F6.2)", 80, 1 }; static cilist io___27 = { 0, 0, 0, 0, 0 }; static cilist io___29 = { 0, 0, 0, 0, 0 }; static cilist io___30 = { 0, 0, 0, 0, 0 }; static cilist io___31 = { 0, 0, 0, 0, 0 }; static icilist io___40 = { 0, card, 0, fmt_82, 80, 1 }; static cilist io___59 = { 0, 6, 0, fmt_120, 0 }; static cilist io___60 = { 0, 6, 0, "(A)", 0 }; static cilist io___61 = { 0, 6, 0, "(A)", 0 }; static cilist io___62 = { 0, 6, 0, "(A)", 0 }; static cilist io___63 = { 0, 6, 0, "(A)", 0 }; static cilist io___64 = { 0, 6, 0, "(A)", 0 }; static cilist io___65 = { 0, 6, 0, "(A)", 0 }; static cilist io___66 = { 0, 0, 0, "(/)", 0 }; static cilist io___67 = { 0, 0, 0, fmt_153, 0 }; static cilist io___68 = { 0, 0, 0, fmt_153, 0 }; static cilist io___69 = { 0, 0, 0, fmt_153, 0 }; static cilist io___70 = { 0, 0, 0, fmt_153, 0 }; static cilist io___74 = { 0, 0, 0, fmt_3, 0 }; static cilist io___75 = { 0, 5, 0, "(A80)", 0 }; static icilist io___77 = { 1, line, 1, 0, 80, 1 }; static cilist io___78 = { 0, 0, 0, fmt_3, 0 }; static cilist io___79 = { 0, 5, 0, "(A80)", 0 }; static icilist io___80 = { 1, line, 1, 0, 80, 1 }; static cilist io___81 = { 0, 0, 0, fmt_3, 0 }; static cilist io___82 = { 0, 5, 0, "(A80)", 0 }; static icilist io___83 = { 1, line, 1, 0, 80, 1 }; static cilist io___84 = { 0, 0, 0, fmt_160, 0 }; static cilist io___85 = { 0, 0, 0, fmt_3, 0 }; static cilist io___86 = { 0, 5, 0, "(A80)", 0 }; static icilist io___87 = { 1, line, 1, 0, 80, 1 }; static cilist io___88 = { 0, 0, 0, fmt_3, 0 }; static cilist io___89 = { 0, 0, 0, fmt_3, 0 }; static cilist io___90 = { 0, 0, 0, fmt_3, 0 }; static cilist io___91 = { 0, 0, 0, fmt_3, 0 }; static cilist io___92 = { 0, 5, 0, "(A80)", 0 }; static icilist io___93 = { 1, line, 1, 0, 80, 1 }; static cilist io___94 = { 0, 0, 0, fmt_169, 0 }; /* REAL RGB(3,MAXCOL) */ /* Ethan Merritt Oct 1988 */ /* Modified to read in 3x3 view matrix (e.g. from CCP FRODO view command) */ /* from file. Matrix is applied before */ /* finding translation, center, and scale. Afterwards the input matrix */ /* to RENDER is therefore the identity matrix. */ /* EAM Aug 1997 - Honor COLOUR requests */ /* EAM Nov 1999 - remove all (q) formats */ /* -h causes the header records not to be printed */ /* -m [now obsolete because always in force] uses format */ /* mixed object types in output file */ /* -d suppresses interactive input */ flags_1.hflag = FALSE_; flags_1.dflag = FALSE_; flags_1.mflag = TRUE_; narg = iargc_(); i__1 = narg; for (i__ = 1; i__ <= i__1; ++i__) { getarg_(&i__, flags, (ftnlen)32); if (s_cmp(flags, "-h", (ftnlen)2, (ftnlen)2) == 0) { flags_1.hflag = TRUE_; } else if (s_cmp(flags, "-d", (ftnlen)2, (ftnlen)2) == 0) { flags_1.dflag = TRUE_; s_rsfi(&io___4); do_fio(&c__1, (char *)&colors_1.ischeme, (ftnlen)sizeof(integer)); e_rsfi(); } } getarg_(&narg, in_file__, (ftnlen)64); if (*(unsigned char *)in_file__ == '-') { input = 5; } else { input = 1; o__1.oerr = 0; o__1.ounit = input; o__1.ofnmlen = 64; o__1.ofnm = in_file__; o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; f_open(&o__1); } /* L3: */ view_matrix__(); ncol = 0; spam_1.natm = 0; aspect = 1.25f; if (flags_1.hflag) { goto L10; } s_wsfe(&io___9); do_fio(&c__1, "C-alpha ribbon - Raster3D ", (ftnlen)26); do_fio(&c__1, "V2.7d ", (ftnlen)8); e_wsfe(); s_wsfe(&io___10); do_fio(&c__1, "80 64 tiles in x,y", (ftnlen)22); e_wsfe(); s_wsfe(&io___11); do_fio(&c__1, " 8 8 pixels (x,y) per tile", (ftnlen)31); e_wsfe(); s_wsfe(&io___12); do_fio(&c__1, "4 anti-aliasing 3x3 into 2x2 pixels", (ftnlen)43); e_wsfe(); s_wsfe(&io___13); do_fio(&c__1, "0 0 0 black background", (ftnlen)26); e_wsfe(); s_wsfe(&io___14); do_fio(&c__1, "F no, ribbons cast funny shadows", (ftnlen)40); e_wsfe(); s_wsfe(&io___15); do_fio(&c__1, "25 Phong power", (ftnlen)21); e_wsfe(); s_wsfe(&io___16); do_fio(&c__1, "0.15 secondary light contribution", (ftnlen)38); e_wsfe(); s_wsfe(&io___17); do_fio(&c__1, "0.05 ambient light contribution", (ftnlen)36); e_wsfe(); s_wsfe(&io___18); do_fio(&c__1, "0.25 specular reflection component", (ftnlen)39); e_wsfe(); s_wsfe(&io___19); do_fio(&c__1, "4.0 eye position", (ftnlen)22); e_wsfe(); s_wsfe(&io___20); do_fio(&c__1, "1 1 1 main light source position", (ftnlen)36); e_wsfe(); L10: io___21.ciunit = input; i__1 = s_rsfe(&io___21); if (i__1 != 0) { goto L50; } i__1 = do_fio(&c__1, card, (ftnlen)80); if (i__1 != 0) { goto L50; } i__1 = e_rsfe(); if (i__1 != 0) { goto L50; } if (s_cmp(card, "COLO", (ftnlen)4, (ftnlen)4) == 0) { ++ncol; if (ncol > 5000) { s_wsle(&io___23); do_lio(&c__9, &c__1, "Colour table overflow. Increase ", (ftnlen) 33); do_lio(&c__9, &c__1, "MAXCOL and recompile.", (ftnlen)21); e_wsle(); s_stop("10", (ftnlen)2); } s_rsfi(&io___24); do_fio(&c__1, mask + (ncol - 1) * 24, (ftnlen)24); for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&colors_1.rgb[i__ + ncol * 3 - 4], (ftnlen) sizeof(real)); } do_fio(&c__1, (char *)&radius[ncol - 1], (ftnlen)sizeof(real)); e_rsfi(); } else if (s_cmp(card, "ATOM", (ftnlen)4, (ftnlen)4) == 0 && (s_cmp(card + 13, "CA ", (ftnlen)3, (ftnlen)3) == 0 || s_cmp(card + 13, "O ", (ftnlen)3, (ftnlen)3) == 0)) { ++spam_1.natm; if (spam_1.natm > 10000) { s_wsle(&io___27); do_lio(&c__9, &c__1, "Atom array overflow. Increase ", (ftnlen) 31); do_lio(&c__9, &c__1, "MAXATM and recompile.", (ftnlen)21); e_wsle(); s_stop("20", (ftnlen)2); } s_copy(atom + (spam_1.natm - 1) * 80, card, (ftnlen)80, (ftnlen)80); } else if (s_cmp(card, "END", (ftnlen)3, (ftnlen)3) == 0) { goto L50; } goto L10; /* Come here when EOF or 'END' record is reached */ L50: if (spam_1.natm == 0) { s_wsle(&io___29); do_lio(&c__9, &c__1, "No atoms in input.", (ftnlen)18); e_wsle(); s_stop("30", (ftnlen)2); } else { s_wsle(&io___30); do_lio(&c__3, &c__1, (char *)&spam_1.natm, (ftnlen)sizeof(integer)); do_lio(&c__9, &c__1, " atoms accepted from input.", (ftnlen)27); e_wsle(); } if (ncol == 0) { s_wsle(&io___31); do_lio(&c__9, &c__1, "No colours in input.", (ftnlen)20); e_wsle(); /* STOP 40 */ } xmax = -1e20f; xmin = 1e20f; ymax = -1e20f; ymin = 1e20f; zmax = -1e20f; zmin = 1e20f; i__1 = spam_1.natm; for (iatm = 1; iatm <= i__1; ++iatm) { s_copy(card, atom + (iatm - 1) * 80, (ftnlen)80, (ftnlen)80); s_copy(test, card + 6, (ftnlen)24, (ftnlen)24); s_rsfi(&io___40); do_fio(&c__3, (char *)&matrix_1.coords[0], (ftnlen)sizeof(real)); e_rsfi(); x = matrix_1.coords[0] * matrix_1.matrix[0] + matrix_1.coords[1] * matrix_1.matrix[1] + matrix_1.coords[2] * matrix_1.matrix[2]; y = matrix_1.coords[0] * matrix_1.matrix[3] + matrix_1.coords[1] * matrix_1.matrix[4] + matrix_1.coords[2] * matrix_1.matrix[5]; z__ = matrix_1.coords[0] * matrix_1.matrix[6] + matrix_1.coords[1] * matrix_1.matrix[7] + matrix_1.coords[2] * matrix_1.matrix[8]; rad = radius[icol - 1]; spam_1.spam[(iatm << 2) - 4] = x; spam_1.spam[(iatm << 2) - 3] = y; spam_1.spam[(iatm << 2) - 2] = z__; spam_1.spam[(iatm << 2) - 1] = rad; /* EAM Aug 1997 - finally get around to honoring atom colors */ i__2 = ncol; for (icol = 1; icol <= i__2; ++icol) { if (smatch_(test, mask + (icol - 1) * 24, (ftnlen)24, (ftnlen)24)) { spam_1.scam[iatm - 1] = icol; goto L86; } /* L84: */ } L86: /* Computing MAX */ r__1 = xmax, r__2 = x + rad; xmax = dmax(r__1,r__2); /* Computing MIN */ r__1 = xmin, r__2 = x - rad; xmin = dmin(r__1,r__2); /* Computing MAX */ r__1 = ymax, r__2 = y + rad; ymax = dmax(r__1,r__2); /* Computing MIN */ r__1 = ymin, r__2 = y - rad; ymin = dmin(r__1,r__2); /* Computing MAX */ r__1 = zmax, r__2 = z__ + rad; zmax = dmax(r__1,r__2); /* Computing MIN */ r__1 = zmin, r__2 = z__ - rad; zmin = dmin(r__1,r__2); /* L100: */ } xmid = (xmax + xmin) / 2.f; ymid = (ymax + ymin) / 2.f; zmid = (zmax + zmin) / 2.f; tx = -xmid; ty = -ymid; tz = -zmid; if (aspect >= 1.f) { /* The X direction is wider than the Y */ xroom = aspect; yroom = 1.f; zroom = 2.f; } else { xroom = 1.f; yroom = aspect; zroom = 2.f; } xspan = xmax - xmin; yspan = ymax - ymin; zspan = zmax - zmin; /* Computing MAX */ r__1 = xspan / xroom, r__2 = yspan / yroom, r__1 = max(r__1,r__2), r__2 = zspan / zroom; scale = dmax(r__1,r__2); /* Leave a little extra room as a border: */ scale /= .9f; if (flags_1.hflag) { goto L129; } s_wsfe(&io___59); do_fio(&c__1, (char *)&tx, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&ty, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&tz, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&scale, (ftnlen)sizeof(real)); e_wsfe(); if (flags_1.mflag) { s_wsfe(&io___60); do_fio(&c__1, "3 mixed object types", (ftnlen)28); e_wsfe(); s_wsfe(&io___61); do_fio(&c__1, "(9F8.3,2x,3f5.2)", (ftnlen)16); e_wsfe(); s_wsfe(&io___62); do_fio(&c__1, "(11F8.3)", (ftnlen)8); e_wsfe(); s_wsfe(&io___63); do_fio(&c__1, "(11F8.3)", (ftnlen)8); e_wsfe(); } else { s_wsfe(&io___64); do_fio(&c__1, "1 all objects are triangles", (ftnlen)35); e_wsfe(); s_wsfe(&io___65); do_fio(&c__1, "(9F8.3,2x,3f5.2)", (ftnlen)16); e_wsfe(); } L129: s_wsfe(&io___66); e_wsfe(); s_wsfe(&io___67); do_fio(&c__1, "X min max:", (ftnlen)11); do_fio(&c__1, (char *)&xmin, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&xmax, (ftnlen)sizeof(real)); e_wsfe(); s_wsfe(&io___68); do_fio(&c__1, "Y min max:", (ftnlen)11); do_fio(&c__1, (char *)&ymin, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&ymax, (ftnlen)sizeof(real)); e_wsfe(); s_wsfe(&io___69); do_fio(&c__1, "Z min max:", (ftnlen)11); do_fio(&c__1, (char *)&zmin, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&zmax, (ftnlen)sizeof(real)); e_wsfe(); s_wsfe(&io___70); do_fio(&c__1, " scale:", (ftnlen)11); do_fio(&c__1, (char *)&scale, (ftnlen)sizeof(real)); e_wsfe(); if (flags_1.dflag) { width = 1.5f; offset = 1.2f; nchord = 5; if (colors_1.ischeme <= 0 || colors_1.ischeme > 6) { colors_1.ischeme = 2; } vload_(colors_1.color1, &c_b136, &c_b136, &c_b138); vload_(colors_1.color2, &c_b139, &c_b136, &c_b136); vload_(colors_1.color3, &c_b142, &c_b142, &c_b142); } else { width = 0.f; s_wsfe(&io___74); do_fio(&c__1, "Width of ribbon (default 1.5A): ", (ftnlen)32); e_wsfe(); s_rsfe(&io___75); do_fio(&c__1, line, (ftnlen)80); e_rsfe(); i__1 = s_rsli(&io___77); if (i__1 != 0) { goto L154; } i__1 = do_lio(&c__4, &c__1, (char *)&width, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L154; } i__1 = e_rsli(); if (i__1 != 0) { goto L154; } L154: if (width <= 0.f) { width = 1.5f; } /* Original RIBBON used bspline smoothing, which requires "offset" */ /* because smoothed curve doesn't go through guide points. */ s_wsfe(&io___78); do_fio(&c__1, "Offset from CA position (default 1.2A): ", (ftnlen)40); e_wsfe(); s_rsfe(&io___79); do_fio(&c__1, line, (ftnlen)80); e_rsfe(); i__1 = s_rsli(&io___80); if (i__1 != 0) { goto L156; } i__1 = do_lio(&c__4, &c__1, (char *)&offset, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L156; } i__1 = e_rsli(); if (i__1 != 0) { goto L156; } L156: if (offset <= 0.f) { offset = 1.2f; } s_wsfe(&io___81); do_fio(&c__1, "Chords per residue (default = 10): ", (ftnlen)35); e_wsfe(); s_rsfe(&io___82); do_fio(&c__1, line, (ftnlen)80); e_rsfe(); i__1 = s_rsli(&io___83); if (i__1 != 0) { goto L158; } i__1 = do_lio(&c__3, &c__1, (char *)&nchord, (ftnlen)sizeof(integer)); if (i__1 != 0) { goto L158; } i__1 = e_rsli(); if (i__1 != 0) { goto L158; } L158: if (nchord <= 1) { nchord = 10; } /* L159: */ s_wsfe(&io___84); e_wsfe(); s_wsfe(&io___85); do_fio(&c__1, "Coloring scheme: ", (ftnlen)17); e_wsfe(); s_rsfe(&io___86); do_fio(&c__1, line, (ftnlen)80); e_rsfe(); i__1 = s_rsli(&io___87); if (i__1 != 0) { goto L161; } i__1 = do_lio(&c__3, &c__1, (char *)&colors_1.ischeme, (ftnlen)sizeof( integer)); if (i__1 != 0) { goto L161; } i__1 = e_rsli(); if (i__1 != 0) { goto L161; } L161: if (colors_1.ischeme <= 0 || colors_1.ischeme > 6) { colors_1.ischeme = 1; } if (colors_1.ischeme == 1) { s_wsfe(&io___88); do_fio(&c__1, "COLOR1 (RGB values, 3f8.0): ", (ftnlen)28); e_wsfe(); } if (colors_1.ischeme == 2) { s_wsfe(&io___89); do_fio(&c__1, "COLOR1, COLOR2 (RGB values, 6f8.0): ", (ftnlen)36); e_wsfe(); } if (colors_1.ischeme == 3) { s_wsfe(&io___90); do_fio(&c__1, "COLOR1, COLOR2 (RGB values, 6f8.0): ", (ftnlen)36); e_wsfe(); } if (colors_1.ischeme == 4) { s_wsfe(&io___91); do_fio(&c__1, "COLOR1, COLOR2, COLOR3 (RGB values, 9f8.0): ", ( ftnlen)44); e_wsfe(); } if (colors_1.ischeme < 5) { s_rsfe(&io___92); do_fio(&c__1, line, (ftnlen)80); e_rsfe(); if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) == 0) { goto L163; } i__1 = s_rsli(&io___93); if (i__1 != 0) { goto L163; } i__1 = do_lio(&c__4, &c__3, (char *)&colors_1.color1[0], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L163; } i__1 = do_lio(&c__4, &c__3, (char *)&colors_1.color2[0], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L163; } i__1 = do_lio(&c__4, &c__3, (char *)&colors_1.color3[0], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L163; } i__1 = e_rsli(); if (i__1 != 0) { goto L163; } } goto L164; L163: vload_(colors_1.color1, &c_b136, &c_b136, &c_b138); vload_(colors_1.color2, &c_b139, &c_b136, &c_b136); vload_(colors_1.color3, &c_b142, &c_b142, &c_b142); L164: if (colors_1.ischeme == 3) { colors_1.color3[0] = colors_1.color2[0]; colors_1.color3[1] = colors_1.color2[1]; colors_1.color3[2] = colors_1.color2[2]; } /* end of -d suppression */ } s_wsfe(&io___94); do_fio(&c__1, (char *)&colors_1.ischeme, (ftnlen)sizeof(integer)); do_fio(&c__3, (char *)&colors_1.color1[0], (ftnlen)sizeof(real)); do_fio(&c__3, (char *)&colors_1.color2[0], (ftnlen)sizeof(real)); do_fio(&c__3, (char *)&colors_1.color3[0], (ftnlen)sizeof(real)); e_wsfe(); colors_1.cindex = 1; ribbon_(&c__2, &width, &nchord, &offset, &spam_1.natm); return 0; } /* MAIN__ */ logical smatch_(char *subj, char *mask, ftnlen subj_len, ftnlen mask_len) { /* System generated locals */ logical ret_val; /* Local variables */ static integer i__; ret_val = FALSE_; for (i__ = 1; i__ <= 24; ++i__) { if (*(unsigned char *)&subj[i__ - 1] != *(unsigned char *)&mask[i__ - 1] && *(unsigned char *)&mask[i__ - 1] != '#') { return ret_val; } /* L10: */ } ret_val = TRUE_; return ret_val; } /* smatch_ */ /* Subroutine */ int view_matrix__(void) { /* Format strings */ static char fmt_3[] = "(/a,a)"; static char fmt_2[] = "(1x,\002 phiZ =\002,f8.2,\002 phiY =\002,f8" ".2,\002 phiX =\002,f8.2)"; /* System generated locals */ integer i__1; real r__1, r__2, r__3; olist o__1; cllist cl__1; /* Builtin functions */ integer f_open(olist *), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_rsle(void), f_clos(cllist *); double atan2(doublereal, doublereal), cos(doublereal), sin(doublereal); integer s_wsle(cilist *), e_wsle(void); /* Local variables */ static integer i__, j; static real cx, cy, cz, sx, sy, sz, det, phix, phiy, phiz; /* Fortran I/O blocks */ static cilist io___96 = { 0, 0, 0, fmt_3, 0 }; static cilist io___97 = { 0, 3, 0, 0, 0 }; static cilist io___100 = { 0, 0, 0, "(1x,3f9.5)", 0 }; static cilist io___102 = { 0, 0, 0, "(' determinant =',f8.3)", 0 }; static cilist io___106 = { 0, 0, 0, fmt_3, 0 }; static cilist io___107 = { 0, 0, 0, fmt_2, 0 }; static cilist io___108 = { 0, 0, 0, fmt_3, 0 }; static cilist io___109 = { 0, 3, 0, 0, 0 }; static cilist io___110 = { 0, 0, 0, fmt_2, 0 }; static cilist io___117 = { 0, 0, 0, fmt_3, 0 }; static cilist io___118 = { 0, 0, 0, "(1x,3f9.5)", 0 }; static cilist io___119 = { 0, 0, 0, 0, 0 }; o__1.oerr = 1; o__1.ounit = 3; o__1.ofnmlen = 12; o__1.ofnm = "setup.matrix"; o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__1 = f_open(&o__1); if (i__1 != 0) { goto L100; } s_wsfe(&io___96); do_fio(&c__1, " View Matrix from file ", (ftnlen)23); e_wsfe(); s_rsle(&io___97); for (j = 1; j <= 3; ++j) { for (i__ = 1; i__ <= 3; ++i__) { do_lio(&c__4, &c__1, (char *)&matrix_1.matrix[i__ + j * 3 - 4], ( ftnlen)sizeof(real)); } } e_rsle(); s_wsfe(&io___100); for (j = 1; j <= 3; ++j) { for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&matrix_1.matrix[i__ + j * 3 - 4], (ftnlen) sizeof(real)); } } e_wsfe(); cl__1.cerr = 0; cl__1.cunit = 3; cl__1.csta = 0; f_clos(&cl__1); det = matrix_1.matrix[0] * matrix_1.matrix[4] * matrix_1.matrix[8] + matrix_1.matrix[3] * matrix_1.matrix[7] * matrix_1.matrix[2] + matrix_1.matrix[1] * matrix_1.matrix[5] * matrix_1.matrix[6] - matrix_1.matrix[6] * matrix_1.matrix[4] * matrix_1.matrix[2] - matrix_1.matrix[3] * matrix_1.matrix[1] * matrix_1.matrix[8] - matrix_1.matrix[0] * matrix_1.matrix[7] * matrix_1.matrix[5]; s_wsfe(&io___102); do_fio(&c__1, (char *)&det, (ftnlen)sizeof(real)); e_wsfe(); phix = atan2(-matrix_1.matrix[5], matrix_1.matrix[8]); phiy = atan2(matrix_1.matrix[2], matrix_1.matrix[8] / cos(phix)); phiz = atan2(-matrix_1.matrix[1], matrix_1.matrix[0]); s_wsfe(&io___106); do_fio(&c__1, " View Angles from matrix", (ftnlen)24); do_fio(&c__1, " ", (ftnlen)1); e_wsfe(); s_wsfe(&io___107); r__1 = phiz * 57.295778666661661f; do_fio(&c__1, (char *)&r__1, (ftnlen)sizeof(real)); r__2 = phiy * 57.295778666661661f; do_fio(&c__1, (char *)&r__2, (ftnlen)sizeof(real)); r__3 = phix * 57.295778666661661f; do_fio(&c__1, (char *)&r__3, (ftnlen)sizeof(real)); e_wsfe(); return 0; L100: o__1.oerr = 1; o__1.ounit = 3; o__1.ofnmlen = 12; o__1.ofnm = "setup.angles"; o__1.orl = 0; o__1.osta = "OLD"; o__1.oacc = 0; o__1.ofm = 0; o__1.oblnk = 0; i__1 = f_open(&o__1); if (i__1 != 0) { goto L200; } s_wsfe(&io___108); do_fio(&c__1, " View Angles from file ", (ftnlen)23); e_wsfe(); s_rsle(&io___109); do_lio(&c__4, &c__1, (char *)&phiz, (ftnlen)sizeof(real)); do_lio(&c__4, &c__1, (char *)&phiy, (ftnlen)sizeof(real)); do_lio(&c__4, &c__1, (char *)&phix, (ftnlen)sizeof(real)); e_rsle(); cl__1.cerr = 0; cl__1.cunit = 3; cl__1.csta = 0; f_clos(&cl__1); s_wsfe(&io___110); do_fio(&c__1, (char *)&phiz, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&phiy, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&phix, (ftnlen)sizeof(real)); e_wsfe(); cx = cos(phix / 57.295778666661661f); sx = sin(phix / 57.295778666661661f); cy = cos(phiy / 57.295778666661661f); sy = sin(phiy / 57.295778666661661f); cz = cos(phiz / 57.295778666661661f); sz = sin(phiz / 57.295778666661661f); matrix_1.matrix[0] = cz * cy; matrix_1.matrix[3] = sz * cx + cz * sy * sx; matrix_1.matrix[6] = sz * sx - cz * sy * cx; matrix_1.matrix[1] = -sz * cy; matrix_1.matrix[4] = cz * cx - sx * sy * sz; matrix_1.matrix[7] = cz * sx + sz * sy * cx; matrix_1.matrix[2] = sy; matrix_1.matrix[5] = -sx * cy; matrix_1.matrix[8] = cx * cy; s_wsfe(&io___117); do_fio(&c__1, " View Matrix from angles", (ftnlen)24); do_fio(&c__1, " ", (ftnlen)1); e_wsfe(); s_wsfe(&io___118); for (j = 1; j <= 3; ++j) { for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&matrix_1.matrix[i__ + j * 3 - 4], (ftnlen) sizeof(real)); } } e_wsfe(); return 0; L200: s_wsle(&io___119); do_lio(&c__9, &c__1, " No view matrix or angles provided", (ftnlen)34); e_wsle(); return 0; } /* view_matrix__ */ /* Subroutine */ int ribdrw_(real *guide, integer *nrib, integer *maxres, integer *npt, integer *nchord) { /* Format strings */ static char fmt_3[] = "(\0021\002,/,9f8.3,2x,3f5.2)"; static char fmt_2[] = "(9f8.3,2x,3f5.2)"; /* System generated locals */ integer guide_dim2, guide_offset, i__1, i__2; cilist ci__1; /* Builtin functions */ /* Subroutine */ int s_stop(char *, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void); /* Local variables */ static real fraction; static integer i__; static real t, color_inc__; static integer ipt, irib; static real tinc; static integer ires, jres, kres; extern doublereal dist_(real *, real *); static integer iout; static real dist0, dist1, color[3]; static integer inext; static real smooth[40000] /* was [4][5000][2] */; extern /* Subroutine */ int bspline_(real *, real *, real *, real *, real *); static integer iformat; extern /* Subroutine */ int colorit_(real *, real *, real *, real *, real *); /* Assigned format variables */ static char *iformat_fmt; /* number of guide points */ /* 4 dim because E&S wanted it that way */ /* how many interpolations per guide pt */ /* splining from Larry Andrews 7-Nov-1988 */ /* maximum of (npt*nchord) */ /* maximum # guidepoints */ /* npt*nchord points on splined curve */ /* Parameter adjustments */ guide_dim2 = *maxres; guide_offset = 1 + 4 * (1 + guide_dim2); guide -= guide_offset; /* Function Body */ if (*npt > 500) { s_stop("spline - TOO MANY GUIDE POINTS", (ftnlen)30); } if (*npt * *nchord > 5000) { s_stop("spline - NPT*NCHORD > 5000", (ftnlen)26); } /* fill 4th coord with fraction of chain traced */ color_inc__ = 1.f / (real) (*npt); fraction = 0.f; if (colors_1.ischeme <= 5) { i__1 = *npt; for (i__ = 1; i__ <= i__1; ++i__) { guide[(i__ + guide_dim2 << 2) + 4] = fraction; guide[(i__ + (guide_dim2 << 1) << 2) + 4] = fraction; fraction += color_inc__; } } /* calculate spline segments */ tinc = 1.f / (real) (*nchord); for (irib = 1; irib <= 2; ++irib) { iout = 1; i__1 = *npt - 1; for (ipt = 2; ipt <= i__1; ++ipt) { t = 0.f; i__2 = *nchord; for (i__ = 1; i__ <= i__2; ++i__) { ++iout; bspline_(&guide[(ipt - 1 + irib * guide_dim2 << 2) + 1], & guide[(ipt + irib * guide_dim2 << 2) + 1], &guide[( ipt + 1 + irib * guide_dim2 << 2) + 1], &t, &smooth[( iout + irib * 5000 << 2) - 20004]); t += tinc; } /* L900: */ } /* L1000: */ } /* Add end segments (splines go midpoint-to-midpoint) */ ++iout; for (irib = 1; irib <= 2; ++irib) { for (i__ = 1; i__ <= 4; ++i__) { smooth[i__ + (irib * 5000 + 1 << 2) - 20005] = guide[i__ + (irib * guide_dim2 + 1 << 2)]; smooth[i__ + (iout + irib * 5000 << 2) - 20005] = guide[i__ + (* npt + irib * guide_dim2 << 2)]; } /* L1100: */ } if (flags_1.mflag) { iformat = 0; iformat_fmt = fmt_3; } else { iformat = 1; iformat_fmt = fmt_2; } L2: L3: /* Start loop over spline segments */ ires = 1; jres = 1; kres = 2; L2000: /* do 2100 ires = 1, iout-1 */ fraction = smooth[(ires + 5000 << 2) - 20001]; /* Make sure the two sides of the ribbon stay in register */ inext = ires + 1; L55: dist0 = dist_(&smooth[(inext + 5000 << 2) - 20004], &smooth[(kres + 10000 << 2) - 20004]); dist1 = dist_(&smooth[(inext + 5000 << 2) - 20004], &smooth[(kres + 10001 << 2) - 20004]); if (dist1 < dist0 && kres < iout) { ++kres; goto L55; } L56: dist0 = dist_(&smooth[(inext + 5000 << 2) - 20004], &smooth[(kres + 10000 << 2) - 20004]); dist1 = dist_(&smooth[(inext + 5001 << 2) - 20004], &smooth[(kres + 10000 << 2) - 20004]); if (dist1 < dist0 && inext < iout) { ++inext; goto L56; } colorit_(color, &fraction, &smooth[(ires + 5000 << 2) - 20004], &smooth[( jres + 10000 << 2) - 20004], &smooth[(inext + 5000 << 2) - 20004]) ; ci__1.cierr = 0; ci__1.ciunit = 6; ci__1.cifmt = iformat_fmt; s_wsfe(&ci__1); for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (ires + 5000 << 2) - 20005], ( ftnlen)sizeof(real)); } for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (jres + 10000 << 2) - 20005], ( ftnlen)sizeof(real)); } for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (inext + 5000 << 2) - 20005], ( ftnlen)sizeof(real)); } do_fio(&c__3, (char *)&color[0], (ftnlen)sizeof(real)); e_wsfe(); if (jres == kres) { goto L2100; } colorit_(color, &fraction, &smooth[(kres + 10000 << 2) - 20004], &smooth[( inext + 5000 << 2) - 20004], &smooth[(jres + 10000 << 2) - 20004]) ; ci__1.cierr = 0; ci__1.ciunit = 6; ci__1.cifmt = iformat_fmt; s_wsfe(&ci__1); for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (jres + 10000 << 2) - 20005], ( ftnlen)sizeof(real)); } for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (inext + 5000 << 2) - 20005], ( ftnlen)sizeof(real)); } for (i__ = 1; i__ <= 3; ++i__) { do_fio(&c__1, (char *)&smooth[i__ + (kres + 10000 << 2) - 20005], ( ftnlen)sizeof(real)); } do_fio(&c__3, (char *)&color[0], (ftnlen)sizeof(real)); e_wsfe(); jres = kres; if (kres < iout) { ++kres; } L2100: ires = inext; if (ires < iout) { goto L2000; } /* End loop over spline segments */ ++colors_1.cindex; return 0; } /* ribdrw_ */ doublereal dist_(real *v1, real *v2) { /* System generated locals */ real ret_val; /* Local variables */ extern doublereal dot_(real *, real *); static real diff[3]; extern /* Subroutine */ int vdif_(real *, real *, real *); vdif_(diff, v1, v2); ret_val = dot_(diff, diff); return ret_val; } /* dist_ */ /* Subroutine */ int vload_(real *v, real *s1, real *s2, real *s3) { /* Parameter adjustments */ --v; /* Function Body */ v[1] = *s1; v[2] = *s2; v[3] = *s3; return 0; } /* vload_ */ /* Subroutine */ int colorit_(real *color, real *fraction, real *point1, real *point2, real *point3) { static real vec1[3], vec2[3], vec3[3]; extern /* Subroutine */ int vdif_(real *, real *, real *), vload_(real *, real *, real *, real *), cross_(real *, real *, real *); /* scheme 1 solid color (COLOR1) */ /* scheme 2 shade from COLOR1 at 1st residue to COLOR2 at last */ /* scheme 3 COLOR1 on front, COLOR3 (=COLOR2) on back */ /* scheme 4 combination of 2 and 3 above */ /* scheme 5 color each new chain a new color from RGB */ /* Parameter adjustments */ --point3; --point2; --point1; --color; /* Function Body */ if (colors_1.ischeme == 3 || colors_1.ischeme == 4) { vdif_(vec1, &point2[1], &point1[1]); vdif_(vec2, &point3[1], &point1[1]); cross_(vec1, vec2, vec3); if (vec3[2] < 0.f) { color[1] = colors_1.color3[0]; color[2] = colors_1.color3[1]; color[3] = colors_1.color3[2]; } else if (colors_1.ischeme == 4) { color[1] = *fraction * colors_1.color2[0] + (1.f - *fraction) * colors_1.color1[0]; color[2] = *fraction * colors_1.color2[1] + (1.f - *fraction) * colors_1.color1[1]; color[3] = *fraction * colors_1.color2[2] + (1.f - *fraction) * colors_1.color1[2]; } else { color[1] = colors_1.color1[0]; color[2] = colors_1.color1[1]; color[3] = colors_1.color1[2]; } } else if (colors_1.ischeme == 2) { color[1] = *fraction * colors_1.color2[0] + (1.f - *fraction) * colors_1.color1[0]; color[2] = *fraction * colors_1.color2[1] + (1.f - *fraction) * colors_1.color1[1]; color[3] = *fraction * colors_1.color2[2] + (1.f - *fraction) * colors_1.color1[2]; } else if (colors_1.ischeme == 5) { vload_(&color[1], &colors_1.rgb[colors_1.cindex * 3 - 3], & colors_1.rgb[colors_1.cindex * 3 - 2], &colors_1.rgb[ colors_1.cindex * 3 - 1]); /* else if (ischeme .eq. 6) then */ /* ICOL = SCAM(fraction) */ /* color(1) = RGB(1,icol) */ /* color(2) = RGB(2,icol) */ /* color(3) = RGB(3,icol) */ } else { vload_(&color[1], colors_1.color1, &colors_1.color1[1], & colors_1.color1[2]); } return 0; } /* colorit_ */ /* Subroutine */ int bspline_(real *v1, real *v2, real *v3, real *t, real *v4) { static integer i__; static real frac1, frac2, frac3; /* Parameter adjustments */ --v4; --v3; --v2; --v1; /* Function Body */ frac3 = *t * .5f * *t; frac1 = (1.f - *t) * .5f * (1.f - *t); frac2 = 1.f - (frac1 + frac3); for (i__ = 1; i__ <= 4; ++i__) { v4[i__] = frac1 * v1[i__] + frac2 * v2[i__] + frac3 * v3[i__]; } return 0; } /* bspline_ */