/* rods.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 { real matrix[9] /* was [3][3] */, coords[3]; } matrix_; #define matrix_1 matrix_ /* Table of constant values */ static integer c__4 = 4; static integer c__1 = 1; static integer c_n1 = -1; static integer c__9 = 9; static integer c__3 = 3; static integer c__0 = 0; /* Main program */ int MAIN__(void) { /* Initialized data */ static char defcol[60*7] = "COLOUR#######C################ 0.625 0.6" "25 0.625 1.70" "COLOUR#######N################ 0.125 0.12" "5 1.000 1.60" "COLOUR#######O################ 0.750 0.050" " 0.050 1.50" "COLOUR#######S################ 1.000 1.000 " " 0.025 1.85" "COLOUR#######H################ 1.000 1.000 " " 1.000 1.20" "COLOUR#######P################ 0.400 1.000 " "0.400 1.80" "COLOUR######################## 1.000 0.000 1" ".000 2.00"; /* Format strings */ 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_130[] = "(\0022\002,/,7(1x,f8.3))"; static char fmt_140[] = "(\0023\002,/,2(1x,f8.3,1x,f8.3,1x,f8.3,1x,f7.3)" ",3f7.3)"; static char fmt_141[] = "(\00217\002,/3(1x,3f6.3))"; static char fmt_156[] = "(1x,a,3f8.2)"; /* System generated locals */ integer i__1, i__2, i__3; real r__1, r__2; icilist ici__1; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen), s_rsli(icilist *), do_lio( integer *, integer *, char *, ftnlen), e_rsli(void); /* Subroutine */ int s_stop(char *, ftnlen); integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void), s_wsle(cilist *), e_wsle(void), s_rsfe(cilist *), e_rsfe(void), s_rsfi(icilist *), e_rsfi(void); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ static integer i__, j, k; static real x, y, z__, dx, dy, dz, tx, ty, tz, cen[3], rad, rgb[15000] /* was [3][5000] */, red, vdw[5000]; extern /* Subroutine */ int view_matrix__(void); static char card[80]; static real bmin; static integer icol, narg; static real bmax, blue; static integer iatm; static char mask[24*5000]; static integer ncol; static real biso; static integer jatm, natm; static real spam[60000] /* was [6][10000] */; static char atom[80*10000]; static real xmid, ymid, zmid, dist; static integer jcol; extern /* Subroutine */ int exit_(integer *); static real xmin, ymin, xmax, ymax; static char test[24]; static real zmax, zmin; extern /* Subroutine */ int b2rgb_(real *, real *, real *, real *, real *, real *); static logical bflag, hflag; extern integer iargc_(void); static real scale; extern logical match_(char *, char *, ftnlen, ftnlen); static real green, close, xspan, yspan, zspan, xroom, yroom, zroom; static logical bcflag, brflag; extern /* Subroutine */ int getarg_(integer *, char *, ftnlen); static real cylrad, aspect, ballrad; static char options[64]; /* Fortran I/O blocks */ static icilist io___11 = { 1, options, 0, 0, 64, 1 }; static icilist io___13 = { 1, options, 0, 0, 64, 1 }; static icilist io___15 = { 1, options, 0, 0, 64, 1 }; static icilist io___16 = { 1, options, 0, 0, 64, 1 }; static cilist io___17 = { 0, 0, 0, "(A)", 0 }; static cilist io___18 = { 0, 0, 0, 0, 0 }; static cilist io___19 = { 0, 0, 0, 0, 0 }; static cilist io___20 = { 0, 0, 0, 0, 0 }; static cilist io___21 = { 0, 0, 0, 0, 0 }; static cilist io___23 = { 0, 6, 0, "(A,A)", 0 }; static cilist io___24 = { 0, 6, 0, "(A)", 0 }; static cilist io___25 = { 0, 6, 0, "(A)", 0 }; static cilist io___26 = { 0, 6, 0, "(A)", 0 }; static cilist io___27 = { 0, 6, 0, "(A)", 0 }; static cilist io___28 = { 0, 6, 0, "(A)", 0 }; static cilist io___29 = { 0, 6, 0, "(A)", 0 }; static cilist io___30 = { 0, 6, 0, "(A)", 0 }; static cilist io___31 = { 0, 6, 0, "(A)", 0 }; static cilist io___32 = { 0, 6, 0, "(A)", 0 }; static cilist io___33 = { 0, 6, 0, "(A)", 0 }; static cilist io___34 = { 0, 6, 0, "(A)", 0 }; static cilist io___38 = { 0, 5, 1, "(A80)", 0 }; static cilist io___40 = { 0, 0, 0, 0, 0 }; static icilist io___41 = { 1, card, 0, "(6X,A24,3F8.3,F6.2)", 80, 1 }; static cilist io___45 = { 0, 0, 0, 0, 0 }; static cilist io___47 = { 0, 0, 0, 0, 0 }; static cilist io___48 = { 0, 0, 0, 0, 0 }; static cilist io___49 = { 0, 0, 0, 0, 0 }; static icilist io___59 = { 1, card, 0, "(30X,3F8.3,6X,F8.2)", 80, 1 }; static cilist io___66 = { 0, 0, 0, 0, 0 }; static cilist io___67 = { 0, 0, 0, 0, 0 }; static cilist io___81 = { 0, 6, 0, fmt_120, 0 }; static cilist io___82 = { 0, 6, 0, "(A)", 0 }; static cilist io___83 = { 0, 6, 0, "(A)", 0 }; static cilist io___84 = { 0, 6, 0, "(A)", 0 }; static cilist io___85 = { 0, 6, 0, "(A)", 0 }; static cilist io___90 = { 0, 6, 0, fmt_130, 0 }; static cilist io___97 = { 0, 6, 0, fmt_140, 0 }; static cilist io___98 = { 0, 6, 0, fmt_140, 0 }; static cilist io___99 = { 0, 6, 0, fmt_141, 0 }; static cilist io___102 = { 0, 6, 0, fmt_140, 0 }; static cilist io___103 = { 0, 6, 0, fmt_140, 0 }; static cilist io___104 = { 0, 0, 0, "(/)", 0 }; static cilist io___105 = { 0, 0, 0, fmt_156, 0 }; static cilist io___106 = { 0, 0, 0, fmt_156, 0 }; static cilist io___107 = { 0, 0, 0, fmt_156, 0 }; static cilist io___108 = { 0, 0, 0, fmt_156, 0 }; /* ------------------------------------------------------------------------------ */ /* Program to set up input for RENDER with CYLINDERs drawn between */ /* each pair of atoms lying closer than 0.6 * (sum of VanderWaals radii). */ /* This program is the same as SETUP, except for what is generated. */ /* Input matrix or angles are taken from setup.matrix or setup.angles */ /* (NB: same files as setup) */ /* Eric Swanson Oct 1991 */ /* Modified to generate cylinders with half bond colors, where needed. */ /* EAM Feb 1997 */ /* -radius XX to set cylinder radius */ /* EAM Sep 1997 */ /* -default colors; option for coloring by B-value */ /* -more generous output formats (FORMATs 130 and 140) */ /* EAM Jun 1999 */ /* -brad XX to set ball radius as fraction of Van der Waals radius */ /* EAM Jul 1999 */ /* don't draw bonds across alternate chain locations */ /* ------------------------------------------------------------------------------ */ /* I/O units for colour/co-ordinate input, specs output, user output */ /* flags include */ /* -b (ball and stick) */ /* -h (suppress header records in output) */ /* -radius XX (set cylinder radius) */ /* -brad XX (set ball radius as fraction of VdW) */ /* Read in 3x3 view matrix from file setup.matrix. */ /* Matrix is applied before finding translation, center, and scale. */ /* Afterwards the input matrix to RENDER is therefore the identity matrix. */ /* Default to CPK colors and VDW radii */ /* L3: */ bflag = FALSE_; bcflag = FALSE_; hflag = FALSE_; brflag = FALSE_; cylrad = .2f; ballrad = .2f; narg = iargc_(); i__ = 1; L500: getarg_(&i__, options, (ftnlen)64); if (s_cmp(options, "-h", (ftnlen)2, (ftnlen)2) == 0) { hflag = TRUE_; } if (s_cmp(options, "-Bcol", (ftnlen)5, (ftnlen)5) == 0) { bcflag = TRUE_; ++i__; if (i__ > narg) { goto L701; } getarg_(&i__, options, (ftnlen)64); i__1 = s_rsli(&io___11); if (i__1 != 0) { goto L701; } i__1 = do_lio(&c__4, &c__1, (char *)&bmin, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L701; } i__1 = e_rsli(); if (i__1 != 0) { goto L701; } ++i__; if (i__ > narg) { goto L701; } getarg_(&i__, options, (ftnlen)64); i__1 = s_rsli(&io___13); if (i__1 != 0) { goto L701; } i__1 = do_lio(&c__4, &c__1, (char *)&bmax, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L701; } i__1 = e_rsli(); if (i__1 != 0) { goto L701; } } if (s_cmp(options, "-b", (ftnlen)2, (ftnlen)2) == 0) { bflag = TRUE_; } if (s_cmp(options, "-r", (ftnlen)2, (ftnlen)2) == 0) { ++i__; if (i__ > narg) { goto L701; } getarg_(&i__, options, (ftnlen)64); i__1 = s_rsli(&io___15); if (i__1 != 0) { goto L701; } i__1 = do_lio(&c__4, &c__1, (char *)&cylrad, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L701; } i__1 = e_rsli(); if (i__1 != 0) { goto L701; } if (cylrad <= 0.f) { s_stop("illegal radius value", (ftnlen)20); } } if (s_cmp(options, "-br", (ftnlen)3, (ftnlen)3) == 0) { ++i__; if (i__ > narg) { goto L701; } getarg_(&i__, options, (ftnlen)64); i__1 = s_rsli(&io___16); if (i__1 != 0) { goto L701; } i__1 = do_lio(&c__4, &c__1, (char *)&ballrad, (ftnlen)sizeof(real)); if (i__1 != 0) { goto L701; } i__1 = e_rsli(); if (i__1 != 0) { goto L701; } if (ballrad <= 0.f) { s_stop("illegal ball radius value", (ftnlen)25); } bflag = TRUE_; } ++i__; if (i__ <= narg) { goto L500; } goto L799; L701: s_wsfe(&io___17); do_fio(&c__1, "syntax: rods [-h] [-b] [-Bcolor Bmin Bmax] [-radius R]", ( ftnlen)54); e_wsfe(); exit_(&c_n1); L799: s_wsle(&io___18); do_lio(&c__9, &c__1, "Raster3D rods program ", (ftnlen)22); do_lio(&c__9, &c__1, "V2.7d ", (ftnlen)8); e_wsle(); if (bcflag) { s_wsle(&io___19); do_lio(&c__9, &c__1, "Atom colors will be assigned based on Biso", ( ftnlen)42); e_wsle(); s_wsle(&io___20); do_lio(&c__9, &c__1, " from dark blue = Bmin =", (ftnlen)27); do_lio(&c__4, &c__1, (char *)&bmin, (ftnlen)sizeof(real)); e_wsle(); s_wsle(&io___21); do_lio(&c__9, &c__1, " to light red = Bmax =", (ftnlen)27); do_lio(&c__4, &c__1, (char *)&bmax, (ftnlen)sizeof(real)); e_wsle(); } for (i__ = 1; i__ <= 3; ++i__) { for (j = 1; j <= 3; ++j) { matrix_1.matrix[i__ + j * 3 - 4] = 0.f; } matrix_1.matrix[i__ + i__ * 3 - 4] = 1.f; } view_matrix__(); if (! hflag) { s_wsfe(&io___23); do_fio(&c__1, "rods ", (ftnlen)5); do_fio(&c__1, "V2.7d ", (ftnlen)8); e_wsfe(); s_wsfe(&io___24); do_fio(&c__1, "80 64 tiles in x,y", (ftnlen)22); e_wsfe(); s_wsfe(&io___25); do_fio(&c__1, " 8 8 pixels (x,y) per tile", (ftnlen)31); e_wsfe(); s_wsfe(&io___26); do_fio(&c__1, "4 anti-aliasing", (ftnlen)23); e_wsfe(); s_wsfe(&io___27); do_fio(&c__1, "0 0 0 black background", (ftnlen)26); e_wsfe(); s_wsfe(&io___28); do_fio(&c__1, "F no, shadowed rods look funny", (ftnlen)38); e_wsfe(); s_wsfe(&io___29); do_fio(&c__1, "25 Phong power", (ftnlen)21); e_wsfe(); s_wsfe(&io___30); do_fio(&c__1, "0.15 secondary light contribution", (ftnlen)38); e_wsfe(); s_wsfe(&io___31); do_fio(&c__1, "0.05 ambient light contribution", (ftnlen)36); e_wsfe(); s_wsfe(&io___32); do_fio(&c__1, "0.25 specular reflection component", (ftnlen)39); e_wsfe(); s_wsfe(&io___33); do_fio(&c__1, "4.0 eye position", (ftnlen)22); e_wsfe(); s_wsfe(&io___34); do_fio(&c__1, "1 1 1 main light source position", (ftnlen)36); e_wsfe(); } aspect = 1.25f; ncol = 0; natm = 0; L10: i__1 = s_rsfe(&io___38); 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___40); 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); } i__1 = s_rsfi(&io___41); if (i__1 != 0) { goto L49; } i__1 = do_fio(&c__1, mask + (ncol - 1) * 24, (ftnlen)24); if (i__1 != 0) { goto L49; } for (i__ = 1; i__ <= 3; ++i__) { i__1 = do_fio(&c__1, (char *)&rgb[i__ + ncol * 3 - 4], (ftnlen) sizeof(real)); if (i__1 != 0) { goto L49; } } i__1 = do_fio(&c__1, (char *)&vdw[ncol - 1], (ftnlen)sizeof(real)); if (i__1 != 0) { goto L49; } i__1 = e_rsfi(); if (i__1 != 0) { goto L49; } } else if (s_cmp(card, "ATOM", (ftnlen)4, (ftnlen)4) == 0 || s_cmp(card, "HETA", (ftnlen)4, (ftnlen)4) == 0) { ++natm; if (natm > 10000) { s_wsle(&io___45); 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 + (natm - 1) * 80, card, (ftnlen)80, (ftnlen)80); } else if (s_cmp(card, "END", (ftnlen)3, (ftnlen)3) == 0) { goto L50; } goto L10; /* Problems reading input record */ L49: s_wsle(&io___47); do_lio(&c__9, &c__1, "rods: Cannot parse input record ", (ftnlen)32); do_lio(&c__9, &c__1, card, (ftnlen)80); e_wsle(); exit_(&c_n1); /* Come here when EOF or 'END' record is reached */ L50: if (natm == 0) { s_wsle(&io___48); do_lio(&c__9, &c__1, "No atoms in input.", (ftnlen)18); e_wsle(); s_stop("30", (ftnlen)2); } /* Load default colors after any that were read in */ if (ncol < 4992) { for (i__ = 1; i__ <= 7; ++i__) { ++ncol; ici__1.icierr = 0; ici__1.iciend = 0; ici__1.icirnum = 1; ici__1.icirlen = 60; ici__1.iciunit = defcol + (i__ - 1) * 60; ici__1.icifmt = "(6X,A24,3F8.3,F6.2)"; s_rsfi(&ici__1); do_fio(&c__1, mask + (ncol - 1) * 24, (ftnlen)24); for (j = 1; j <= 3; ++j) { do_fio(&c__1, (char *)&rgb[j + ncol * 3 - 4], (ftnlen)sizeof( real)); } do_fio(&c__1, (char *)&vdw[ncol - 1], (ftnlen)sizeof(real)); e_rsfi(); } } if (ncol == 0) { s_wsle(&io___49); do_lio(&c__9, &c__1, "No colours in input.", (ftnlen)20); e_wsle(); s_stop("40", (ftnlen)2); } xmax = -1e20f; xmin = 1e20f; ymax = -1e20f; ymin = 1e20f; zmax = -1e20f; zmin = 1e20f; i__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); i__2 = ncol; for (icol = 1; icol <= i__2; ++icol) { if (match_(test, mask + (icol - 1) * 24, (ftnlen)24, (ftnlen)24)) { /* READ(CARD,'(30X,3F8.3)',err=49) X,Y,Z */ /* EAM Oct88 */ i__3 = s_rsfi(&io___59); if (i__3 != 0) { goto L49; } i__3 = do_fio(&c__3, (char *)&matrix_1.coords[0], (ftnlen) sizeof(real)); if (i__3 != 0) { goto L49; } i__3 = do_fio(&c__1, (char *)&biso, (ftnlen)sizeof(real)); if (i__3 != 0) { goto L49; } i__3 = e_rsfi(); if (i__3 != 0) { goto L49; } 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]; /* EAM Oct88 */ rad = vdw[icol - 1]; spam[iatm * 6 - 6] = x; spam[iatm * 6 - 5] = y; spam[iatm * 6 - 4] = z__; spam[iatm * 6 - 3] = rad; spam[iatm * 6 - 2] = (real) icol; spam[iatm * 6 - 1] = biso; /* 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); goto L100; } /* L80: */ } s_wsle(&io___66); do_lio(&c__9, &c__1, "No colour table mask matches this atom:", ( ftnlen)39); e_wsle(); s_wsle(&io___67); do_lio(&c__9, &c__1, atom + (iatm - 1) * 80, (ftnlen)80); e_wsle(); s_stop("90", (ftnlen)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 (! hflag) { s_wsfe(&io___81); 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(); s_wsfe(&io___82); do_fio(&c__1, "3 mixed object types", (ftnlen)28); e_wsfe(); s_wsfe(&io___83); do_fio(&c__1, "*", (ftnlen)1); e_wsfe(); s_wsfe(&io___84); do_fio(&c__1, "*", (ftnlen)1); e_wsfe(); s_wsfe(&io___85); do_fio(&c__1, "*", (ftnlen)1); e_wsfe(); } /* Here's the real loop. */ /* Look for pairs closer to each other than 0.60 times the */ /* sum of the vanderWaals radii. */ /* Draw all cylinders with 0.2A cylindrical radius. */ /* For ball and stick pictures, shrink vanderWaals radius */ /* of balls by 0.20 */ /* If two atoms of different colors are bonded, make half-bond */ /* cylinders with each color. */ close = 2.5600000000000005f; if (bflag) { i__1 = natm; for (iatm = 1; iatm <= i__1; ++iatm) { rad = spam[iatm * 6 - 3] * ballrad; icol = spam[iatm * 6 - 2]; if (bcflag) { b2rgb_(&spam[iatm * 6 - 1], &bmin, &bmax, &red, &green, &blue) ; red *= red; green *= green; blue *= blue; } else { red = rgb[icol * 3 - 3]; green = rgb[icol * 3 - 2]; blue = rgb[icol * 3 - 1]; } s_wsfe(&io___90); do_fio(&c__1, (char *)&spam[iatm * 6 - 6], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 5], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 4], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&rad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&red, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&green, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&blue, (ftnlen)sizeof(real)); e_wsfe(); /* 130 FORMAT(1H2,/,7f8.3) */ /* L135: */ } } i__1 = natm; for (iatm = 1; iatm <= i__1; ++iatm) { i__2 = natm; for (jatm = iatm + 1; jatm <= i__2; ++jatm) { dx = spam[iatm * 6 - 6] - spam[jatm * 6 - 6]; dy = spam[iatm * 6 - 5] - spam[jatm * 6 - 5]; dz = spam[iatm * 6 - 4] - spam[jatm * 6 - 4]; dist = dx * dx + dy * dy + dz * dz; close = (spam[iatm * 6 - 3] + spam[jatm * 6 - 3]) * .6f; /* Computing 2nd power */ r__1 = close; close = r__1 * r__1; if (*(unsigned char *)&atom[(iatm - 1) * 80 + 16] != ' ' && *( unsigned char *)&atom[(jatm - 1) * 80 + 16] != ' ' && *( unsigned char *)&atom[(iatm - 1) * 80 + 16] != *(unsigned char *)&atom[(jatm - 1) * 80 + 16]) { goto L150; } /* 4-Feb-2000 also force chain ID's to be the same */ if (*(unsigned char *)&atom[(iatm - 1) * 80 + 21] != ' ' && *( unsigned char *)&atom[(jatm - 1) * 80 + 21] != ' ' && *( unsigned char *)&atom[(iatm - 1) * 80 + 21] != *(unsigned char *)&atom[(jatm - 1) * 80 + 21]) { goto L150; } if (dist <= close) { if (bcflag) { icol = 1; jcol = 2; b2rgb_(&spam[iatm * 6 - 1], &bmin, &bmax, &red, &green, & blue); rgb[icol * 3 - 3] = red * red; rgb[icol * 3 - 2] = green * green; rgb[icol * 3 - 1] = blue * blue; b2rgb_(&spam[jatm * 6 - 1], &bmin, &bmax, &red, &green, & blue); rgb[jcol * 3 - 3] = red * red; rgb[jcol * 3 - 2] = green * green; rgb[jcol * 3 - 1] = blue * blue; } else { icol = spam[iatm * 6 - 2]; jcol = spam[jatm * 6 - 2]; } if (icol == jcol) { s_wsfe(&io___97); do_fio(&c__1, (char *)&spam[iatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 1], (ftnlen)sizeof( real)); e_wsfe(); } else if (bcflag) { s_wsfe(&io___98); do_fio(&c__1, (char *)&spam[iatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 1], (ftnlen)sizeof( real)); e_wsfe(); s_wsfe(&io___99); do_fio(&c__1, (char *)&rgb[icol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 1], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 1], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); do_fio(&c__1, (char *)&c__0, (ftnlen)sizeof(integer)); e_wsfe(); } else { for (k = 1; k <= 3; ++k) { /* L136: */ cen[k - 1] = (spam[k + iatm * 6 - 7] + spam[k + jatm * 6 - 7]) / 2; } s_wsfe(&io___102); do_fio(&c__1, (char *)&spam[iatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[iatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cen[0], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cen[1], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cen[2], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[icol * 3 - 1], (ftnlen)sizeof( real)); e_wsfe(); s_wsfe(&io___103); do_fio(&c__1, (char *)&cen[0], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cen[1], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cen[2], (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 6], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 5], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&spam[jatm * 6 - 4], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&cylrad, (ftnlen)sizeof(real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 3], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 2], (ftnlen)sizeof( real)); do_fio(&c__1, (char *)&rgb[jcol * 3 - 1], (ftnlen)sizeof( real)); e_wsfe(); } } /* 140 FORMAT(1H3,/,11f8.3) */ L150: ; } /* L160: */ } s_wsfe(&io___104); e_wsfe(); s_wsfe(&io___105); 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___106); 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___107); 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___108); do_fio(&c__1, " scale:", (ftnlen)11); do_fio(&c__1, (char *)&scale, (ftnlen)sizeof(real)); e_wsfe(); return 0; } /* MAIN__ */ logical match_(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; } /* match_ */ /* 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_rsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), e_rsle(void), s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(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___110 = { 0, 3, 0, 0, 0 }; static cilist io___113 = { 0, 0, 0, "(1x,3f9.5)", 0 }; static cilist io___115 = { 0, 0, 0, "(' determinant =',f8.3)", 0 }; static cilist io___119 = { 0, 0, 0, fmt_3, 0 }; static cilist io___120 = { 0, 0, 0, fmt_2, 0 }; static cilist io___121 = { 0, 3, 0, 0, 0 }; static cilist io___122 = { 0, 0, 0, fmt_2, 0 }; static cilist io___129 = { 0, 0, 0, fmt_3, 0 }; static cilist io___130 = { 0, 0, 0, "(1x,3f9.5)", 0 }; static cilist io___131 = { 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_rsle(&io___110); 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___113); 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___115); 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___119); do_fio(&c__1, " View Angles from matrix", (ftnlen)24); do_fio(&c__1, " ", (ftnlen)1); e_wsfe(); s_wsfe(&io___120); 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_rsle(&io___121); 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___122); 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___129); do_fio(&c__1, " View Matrix from angles", (ftnlen)24); do_fio(&c__1, " ", (ftnlen)1); e_wsfe(); s_wsfe(&io___130); 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___131); do_lio(&c__9, &c__1, " No view matrix or angles provided", (ftnlen)34); e_wsle(); return 0; } /* view_matrix__ */ /* CC Return RGB triple that runs from dark blue at Bmin */ /* C to light red at Bmax */ /* Subroutine */ int b2rgb_(real *biso, real *bmin, real *bmax, real *r__, real *g, real *b) { static real fraction, h__, s, v; extern /* Subroutine */ int hsv2rgb_(real *, real *, real *, real *, real *, real *); fraction = (*biso - *bmin) / (*bmax - *bmin); if (fraction < 0.f) { fraction = 0.f; } if (fraction > 1.f) { fraction = 1.f; } h__ = (1.f - fraction) * 240.f; s = .8f; v = fraction / 2.f + .5f; hsv2rgb_(&h__, &s, &v, r__, g, b); return 0; } /* b2rgb_ */ /* CC Color format conversion from Hue/Saturation/Value to Red/Green/Blue */ /* C minimal (i.e. NO) error checking */ /* Subroutine */ int hsv2rgb_(real *h__, real *s, real *v, real *r__, real *g, real *b) { static real f; static integer i__; static real p, q, t; i__ = *h__ / 60.f; f = *h__ / 60.f - (real) i__; p = *v * (1.f - *s); q = *v * (1.f - *s * f); t = *v * (1.f - *s * (1.f - f)); if (i__ == 5) { *r__ = *v; *g = p; *b = q; } else if (i__ == 4) { *r__ = t; *g = p; *b = *v; } else if (i__ == 3) { *r__ = p; *g = q; *b = *v; } else if (i__ == 2) { *r__ = p; *g = *v; *b = t; } else if (i__ == 1) { *r__ = q; *g = *v; *b = p; } else { *r__ = *v; *g = t; *b = p; } return 0; } /* hsv2rgb_ */ /* Main program alias */ int rods_ () { MAIN__ (); return 0; }