/* srface.f -- translated by f2c (version 19961017).
You must link the resulting object file with the libraries:
-lf2c -lm (in that order)
*/
#include "f2c.h"
/* Common Block Declarations */
struct srfblk_1_ {
integer limu[1024], liml[1024];
real cl[41];
integer ncl, ll;
real fact;
integer irot, ndrz, nupper, nrswt;
real bigd, umin, umax, vmin, vmax, rzero;
integer ioffp, nspval;
real spval, bigest;
};
#define srfblk_1 (*(struct srfblk_1_ *) &srfblk_)
struct {
real xxmin, xxmax, yymin, yymax, zzmin, zzmax, delcrt, eyex, eyey, eyez;
} pwrz1s_;
#define pwrz1s_1 pwrz1s_
struct srfip1_1_ {
integer ifr, istp, irots, idrx, idry, idrz, iupper, iskirt, ncla;
real theta, hskirt, chi, clo, cinc;
integer ispval;
};
#define srfip1_1 (*(struct srfip1_1_ *) &srfip1_)
/* Initialized data */
struct {
integer fill_1[2095];
integer e_2;
integer fill_3[6];
integer e_4;
integer fill_5[1];
real e_6;
integer fill_7[1];
} srfblk_ = { {0}, 0, {0}, 0, {0}, 0.f };
struct {
integer e_1[9];
real e_2[5];
integer e_3;
} srfip1_ = { 1, 0, 0, 1, 1, 0, 0, 0, 6, .02f, 0.f, 0.f, 0.f, 0.f, -999 };
/* Table of constant values */
static real c_b2 = 0.f;
static real c_b3 = 1.f;
static real c_b7 = 1024.f;
static integer c__1 = 1;
static integer c__40 = 40;
static integer c__0 = 0;
static real c_b128 = 10.f;
static integer c__2 = 2;
/* ======================================================================= */
/* Subroutine */ int srface_(real *x, real *y, real *z__, integer *m, integer
*mx, integer *nx, integer *ny, real *s, real *stereo)
{
/* Initialized data */
static integer jf = 1;
static integer if__ = 1;
static integer ly = 2;
static integer lx = 2;
static integer icnst = 0;
/* System generated locals */
integer z_dim1, z_offset, m_dim2, m_offset, i__1, i__2, i__3, i__4, i__5,
i__6, i__7, i__8, i__9, i__10;
/* Local variables */
static integer ipic, npic, ipli, jplj;
static real ster, poix, poiy, poiz, xeye;
static integer mmxx, nnxx;
static real yeye;
static integer nnyy;
static real zeye, ynow, xnow, sign1;
static integer i__, j, k, l;
extern /* Subroutine */ int frame_(void);
static real hight;
extern /* Subroutine */ int clset_(real *, integer *, integer *, integer *
, real *, real *, real *, integer *, integer *, real *, integer *,
integer *, integer *, real *, real *);
static real width;
extern /* Subroutine */ int draws_(integer *, integer *, integer *,
integer *, integer *, integer *);
static integer jpass, ipass;
static real d1, d2;
extern /* Subroutine */ int trn32s_(real *, real *, real *, real *, real *
, real *, integer *);
static real dummy;
static integer nxstp, nystp, ii, jj, li, mi, in, jn, ni, lj;
static real dx, dy;
static integer mj, nj;
extern /* Subroutine */ int srfabd_(void);
static real ctheta, rx, ry, rz, ut, vt, qu, qv, ru, zz, rv;
extern /* Subroutine */ int ctcell_(real *, integer *, integer *, integer
*, integer *, integer *, integer *);
static real stheta;
static integer nxpass, nypass;
static real ux1, vx1, ux2, vx2, uy1, vy1, uy2, vy2, dif, agl;
static integer nla, mxf[2], myf[2];
extern /* Subroutine */ int set_(real *, real *, real *, real *, real *,
real *, real *, real *, integer *);
static integer mxj[2], myj[2], mxs[2], mys[2], nxp1, nyp1;
/* Surface plotting package from NCAR -- the only high level NCAR */
/* routine in this library at present (Aug 17, 1990). */
/*cc DIMENSION X(NX) ,Y(NY) ,Z(MX,NY) ,M(2,NX,NY) ,
*/
/* cc 1 S(6) */
/* Parameter adjustments */
--x;
m_dim2 = *nx;
m_offset = (m_dim2 + 1 << 1) + 1;
m -= m_offset;
z_dim1 = *mx;
z_offset = z_dim1 + 1;
z__ -= z_offset;
--y;
--s;
/* Function Body */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
srfabd_();
set_(&c_b2, &c_b3, &c_b2, &c_b3, &c_b3, &c_b7, &c_b3, &c_b7, &c__1);
srfblk_1.bigest = 1e38f;
/* CC BIGEST = R1MACH(2) */
mmxx = *mx;
nnxx = *nx;
nnyy = *ny;
ster = *stereo;
nxp1 = nnxx + 1;
nyp1 = nnyy + 1;
nla = srfip1_1.ncla;
srfblk_1.nspval = srfip1_1.ispval;
srfblk_1.ndrz = srfip1_1.idrz;
if (srfip1_1.idrz != 0) {
clset_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &srfip1_1.chi, &
srfip1_1.clo, &srfip1_1.cinc, &nla, &c__40, srfblk_1.cl, &
srfblk_1.ncl, &icnst, &srfblk_1.ioffp, &srfblk_1.spval, &
srfblk_1.bigest);
}
if (srfip1_1.idrz != 0) {
srfblk_1.ndrz = 1 - icnst;
}
stheta = sin(ster * srfip1_1.theta);
ctheta = cos(ster * srfip1_1.theta);
rx = s[1] - s[4];
ry = s[2] - s[5];
rz = s[3] - s[6];
d1 = sqrt(rx * rx + ry * ry + rz * rz);
d2 = sqrt(rx * rx + ry * ry);
dx = 0.f;
dy = 0.f;
if (*stereo == 0.f) {
goto L20;
}
d1 = d1 * *stereo * srfip1_1.theta;
if (d2 > 0.f) {
goto L10;
}
dx = d1;
goto L20;
L10:
agl = atan2(rx, -ry);
dx = d1 * cos(agl);
dy = d1 * sin(agl);
L20:
srfblk_1.irot = srfip1_1.irots;
npic = 1;
if (ster != 0.f) {
npic = 2;
}
srfblk_1.fact = 1.f;
if (srfblk_1.nrswt != 0) {
srfblk_1.fact = srfblk_1.rzero / d1;
}
if (srfip1_1.istp == 0 && ster != 0.f) {
srfblk_1.irot = 1;
}
i__1 = npic;
for (ipic = 1; ipic <= i__1; ++ipic) {
srfblk_1.nupper = srfip1_1.iupper;
if (srfip1_1.ifr < 0) {
frame_();
}
/* SET UP MAPING FROM FLOATING POINT 3-SPACE TO CRT SPACE. */
sign1 = (real) ((ipic << 1) - 3);
pwrz1s_1.eyex = s[1] + sign1 * dx;
poix = s[4] + sign1 * dx;
pwrz1s_1.eyey = s[2] + sign1 * dy;
poiy = s[5] + sign1 * dy;
pwrz1s_1.eyez = s[3];
poiz = s[6];
srfblk_1.ll = 0;
xeye = pwrz1s_1.eyex;
yeye = pwrz1s_1.eyey;
zeye = pwrz1s_1.eyez;
trn32s_(&poix, &poiy, &poiz, &xeye, &yeye, &zeye, &c__0);
srfblk_1.ll = ipic + (srfip1_1.istp << 1) + 3;
if (ster == 0.f) {
srfblk_1.ll = 1;
}
if (srfblk_1.nrswt != 0) {
goto L100;
}
pwrz1s_1.xxmin = x[1];
pwrz1s_1.xxmax = x[nnxx];
pwrz1s_1.yymin = y[1];
pwrz1s_1.yymax = y[nnyy];
srfblk_1.umin = srfblk_1.bigest;
srfblk_1.vmin = srfblk_1.bigest;
pwrz1s_1.zzmin = srfblk_1.bigest;
srfblk_1.umax = -srfblk_1.umin;
srfblk_1.vmax = -srfblk_1.vmin;
pwrz1s_1.zzmax = -pwrz1s_1.zzmin;
i__2 = nnyy;
for (j = 1; j <= i__2; ++j) {
i__3 = nnxx;
for (i__ = 1; i__ <= i__3; ++i__) {
zz = z__[i__ + j * z_dim1];
if (srfblk_1.ioffp == 1 && zz == srfblk_1.spval) {
goto L30;
}
pwrz1s_1.zzmax = dmax(pwrz1s_1.zzmax,zz);
pwrz1s_1.zzmin = dmin(pwrz1s_1.zzmin,zz);
trn32s_(&x[i__], &y[j], &z__[i__ + j * z_dim1], &ut, &vt, &
dummy, &c__1);
srfblk_1.umax = dmax(srfblk_1.umax,ut);
srfblk_1.umin = dmin(srfblk_1.umin,ut);
srfblk_1.vmax = dmax(srfblk_1.vmax,vt);
srfblk_1.vmin = dmin(srfblk_1.vmin,vt);
L30:
;
}
/* L40: */
}
if (srfip1_1.iskirt != 1) {
goto L70;
}
nxstp = nnxx - 1;
nystp = nnyy - 1;
i__2 = nnyy;
i__3 = nystp;
for (j = 1; i__3 < 0 ? j >= i__2 : j <= i__2; j += i__3) {
i__4 = nnxx;
i__5 = nxstp;
for (i__ = 1; i__5 < 0 ? i__ >= i__4 : i__ <= i__4; i__ += i__5) {
trn32s_(&x[i__], &y[j], &srfip1_1.hskirt, &ut, &vt, &dummy, &
c__1);
srfblk_1.umax = dmax(srfblk_1.umax,ut);
srfblk_1.umin = dmin(srfblk_1.umin,ut);
srfblk_1.vmax = dmax(srfblk_1.vmax,vt);
srfblk_1.vmin = dmin(srfblk_1.vmin,vt);
/* L50: */
}
/* L60: */
}
L70:
width = srfblk_1.umax - srfblk_1.umin;
hight = srfblk_1.vmax - srfblk_1.vmin;
dif = (width - hight) * .5f;
if (dif < 0.f) {
goto L80;
} else if (dif == 0) {
goto L100;
} else {
goto L90;
}
L80:
srfblk_1.umin += dif;
srfblk_1.umax -= dif;
goto L100;
L90:
srfblk_1.vmin -= dif;
srfblk_1.vmax += dif;
L100:
xeye = pwrz1s_1.eyex;
yeye = pwrz1s_1.eyey;
zeye = pwrz1s_1.eyez;
trn32s_(&poix, &poiy, &poiz, &xeye, &yeye, &zeye, &c__0);
i__3 = nnyy;
for (j = 1; j <= i__3; ++j) {
i__2 = nnxx;
for (i__ = 1; i__ <= i__2; ++i__) {
trn32s_(&x[i__], &y[j], &z__[i__ + j * z_dim1], &ut, &vt, &
dummy, &c__1);
m[(i__ + j * m_dim2 << 1) + 1] = ut;
m[(i__ + j * m_dim2 << 1) + 2] = vt;
/* L110: */
}
/* L120: */
}
/* INITIALIZE UPPER AND LOWER VISIBILITY ARRAYS */
for (k = 1; k <= 1024; ++k) {
srfblk_1.limu[k - 1] = 0;
srfblk_1.liml[k - 1] = 1024;
/* L130: */
}
/* FIND ORDER TO DRAW LINES */
nxpass = 1;
if (s[1] >= x[nnxx]) {
goto L160;
}
if (s[1] <= x[1]) {
goto L170;
}
i__3 = nnxx;
for (i__ = 2; i__ <= i__3; ++i__) {
lx = i__;
if (s[1] <= x[i__]) {
goto L150;
}
/* L140: */
}
L150:
mxs[0] = lx - 1;
mxj[0] = -1;
mxf[0] = 1;
mxs[1] = lx;
mxj[1] = 1;
mxf[1] = nnxx;
nxpass = 2;
goto L180;
L160:
mxs[0] = nnxx;
mxj[0] = -1;
mxf[0] = 1;
goto L180;
L170:
mxs[0] = 1;
mxj[0] = 1;
mxf[0] = nnxx;
L180:
nypass = 1;
if (s[2] >= y[nnyy]) {
goto L210;
}
if (s[2] <= y[1]) {
goto L220;
}
i__3 = nnyy;
for (j = 2; j <= i__3; ++j) {
ly = j;
if (s[2] <= y[j]) {
goto L200;
}
/* L190: */
}
L200:
mys[0] = ly - 1;
myj[0] = -1;
myf[0] = 1;
mys[1] = ly;
myj[1] = 1;
myf[1] = nnyy;
nypass = 2;
goto L230;
L210:
mys[0] = nnyy;
myj[0] = -1;
myf[0] = 1;
goto L230;
L220:
mys[0] = 1;
myj[0] = 1;
myf[0] = nnyy;
/* PUT ON SKIRT ON FRONT SIDE IF WANTED */
L230:
if (nxpass == 2 && nypass == 2) {
goto L490;
}
if (srfip1_1.iskirt == 0) {
goto L290;
}
in = mxs[0];
if__ = mxf[0];
jn = mys[0];
jf = myf[0];
if (nypass != 1) {
goto L260;
}
trn32s_(&x[1], &y[jn], &srfip1_1.hskirt, &ux1, &vx1, &dummy, &c__1);
trn32s_(&x[nnxx], &y[jn], &srfip1_1.hskirt, &ux2, &vx2, &dummy, &c__1)
;
qu = (ux2 - ux1) / (x[nnxx] - x[1]);
qv = (vx2 - vx1) / (x[nnxx] - x[1]);
ynow = y[jn];
i__3 = nnxx;
for (i__ = 1; i__ <= i__3; ++i__) {
trn32s_(&x[i__], &ynow, &srfip1_1.hskirt, &ru, &rv, &dummy, &c__1)
;
i__2 = (integer) ru;
i__5 = (integer) rv;
draws_(&i__2, &i__5, &m[(i__ + jn * m_dim2 << 1) + 1], &m[(i__ +
jn * m_dim2 << 1) + 2], &c__1, &c__0);
/* L240: */
}
i__3 = (integer) ux1;
i__2 = (integer) vx1;
i__5 = (integer) ux2;
i__4 = (integer) vx2;
draws_(&i__3, &i__2, &i__5, &i__4, &c__1, &c__1);
if (srfip1_1.idry != 0) {
goto L260;
}
i__3 = nnxx;
for (i__ = 2; i__ <= i__3; ++i__) {
draws_(&m[(i__ - 1 + jn * m_dim2 << 1) + 1], &m[(i__ - 1 + jn *
m_dim2 << 1) + 2], &m[(i__ + jn * m_dim2 << 1) + 1], &m[(
i__ + jn * m_dim2 << 1) + 2], &c__1, &c__1);
/* L250: */
}
L260:
if (nxpass != 1) {
goto L290;
}
trn32s_(&x[in], &y[1], &srfip1_1.hskirt, &uy1, &vy1, &dummy, &c__1);
trn32s_(&x[in], &y[nnyy], &srfip1_1.hskirt, &uy2, &vy2, &dummy, &c__1)
;
qu = (uy2 - uy1) / (y[nnyy] - y[1]);
qv = (vy2 - vy1) / (y[nnyy] - y[1]);
xnow = x[in];
i__3 = nnyy;
for (j = 1; j <= i__3; ++j) {
trn32s_(&xnow, &y[j], &srfip1_1.hskirt, &ru, &rv, &dummy, &c__1);
i__2 = (integer) ru;
i__5 = (integer) rv;
draws_(&i__2, &i__5, &m[(in + j * m_dim2 << 1) + 1], &m[(in + j *
m_dim2 << 1) + 2], &c__1, &c__0);
/* L270: */
}
i__3 = (integer) uy1;
i__2 = (integer) vy1;
i__5 = (integer) uy2;
i__4 = (integer) vy2;
draws_(&i__3, &i__2, &i__5, &i__4, &c__1, &c__1);
if (srfip1_1.idrx != 0) {
goto L290;
}
i__3 = nnyy;
for (j = 2; j <= i__3; ++j) {
draws_(&m[(in + (j - 1) * m_dim2 << 1) + 1], &m[(in + (j - 1) *
m_dim2 << 1) + 2], &m[(in + j * m_dim2 << 1) + 1], &m[(in
+ j * m_dim2 << 1) + 2], &c__1, &c__1);
/* L280: */
}
/* PICK PROPER ALGORITHM */
L290:
li = mxj[0];
mi = mxs[0] - li;
ni = (i__3 = mi - mxf[0], abs(i__3));
lj = myj[0];
mj = mys[0] - lj;
nj = (i__3 = mj - myf[0], abs(i__3));
/* WHEN LINE OF SIGHT IS NEARER TO PARALLEL TO THE X AXIS, */
/* HAVE J LOOP OUTER-MOST, OTHERWISE HAVE I LOOP OUTER-MOST. */
if (dabs(rx) <= dabs(ry)) {
goto L360;
}
if (srfip1_1.iskirt != 0 || nypass != 1) {
goto L310;
}
i__ = mxs[0];
i__3 = nnyy;
for (j = 2; j <= i__3; ++j) {
draws_(&m[(i__ + (j - 1) * m_dim2 << 1) + 1], &m[(i__ + (j - 1) *
m_dim2 << 1) + 2], &m[(i__ + j * m_dim2 << 1) + 1], &m[(
i__ + j * m_dim2 << 1) + 2], &c__0, &c__1);
/* L300: */
}
L310:
i__3 = nnxx;
for (ii = 1; ii <= i__3; ++ii) {
i__ = mi + ii * li;
ipli = i__ + li;
if (nypass == 1) {
goto L320;
}
k = mys[0];
l = mys[1];
if (srfip1_1.idrx != 0) {
draws_(&m[(i__ + k * m_dim2 << 1) + 1], &m[(i__ + k * m_dim2
<< 1) + 2], &m[(i__ + l * m_dim2 << 1) + 1], &m[(i__
+ l * m_dim2 << 1) + 2], &c__1, &c__1);
}
if (srfblk_1.ndrz != 0 && ii != ni) {
/* Computing MIN */
i__5 = i__, i__4 = i__ + li;
i__2 = min(i__5,i__4);
ctcell_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &m[m_offset], &
i__2, &k);
}
L320:
i__2 = nypass;
for (jpass = 1; jpass <= i__2; ++jpass) {
lj = myj[jpass - 1];
mj = mys[jpass - 1] - lj;
nj = (i__5 = mj - myf[jpass - 1], abs(i__5));
i__5 = nj;
for (jj = 1; jj <= i__5; ++jj) {
j = mj + jj * lj;
jplj = j + lj;
if (srfip1_1.idrx != 0 && jj != nj) {
draws_(&m[(i__ + j * m_dim2 << 1) + 1], &m[(i__ + j *
m_dim2 << 1) + 2], &m[(i__ + jplj * m_dim2 <<
1) + 1], &m[(i__ + jplj * m_dim2 << 1) + 2], &
c__1, &c__1);
}
if (i__ != mxf[0] && srfip1_1.idry != 0) {
draws_(&m[(ipli + j * m_dim2 << 1) + 1], &m[(ipli + j
* m_dim2 << 1) + 2], &m[(i__ + j * m_dim2 <<
1) + 1], &m[(i__ + j * m_dim2 << 1) + 2], &
c__1, &c__1);
}
if (srfblk_1.ndrz != 0 && jj != nj && ii != nnxx) {
/* Computing MIN */
i__6 = i__, i__7 = i__ + li;
i__4 = min(i__6,i__7);
/* Computing MIN */
i__9 = j, i__10 = j + lj;
i__8 = min(i__9,i__10);
ctcell_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &m[
m_offset], &i__4, &i__8);
}
/* L330: */
}
/* L340: */
}
/* L350: */
}
goto L430;
L360:
if (srfip1_1.iskirt != 0 || nxpass != 1) {
goto L380;
}
j = mys[0];
i__3 = nnxx;
for (i__ = 2; i__ <= i__3; ++i__) {
draws_(&m[(i__ - 1 + j * m_dim2 << 1) + 1], &m[(i__ - 1 + j *
m_dim2 << 1) + 2], &m[(i__ + j * m_dim2 << 1) + 1], &m[(
i__ + j * m_dim2 << 1) + 2], &c__0, &c__1);
/* L370: */
}
L380:
i__3 = nnyy;
for (jj = 1; jj <= i__3; ++jj) {
j = mj + jj * lj;
jplj = j + lj;
if (nxpass == 1) {
goto L390;
}
k = mxs[0];
l = mxs[1];
if (srfip1_1.idry != 0) {
draws_(&m[(k + j * m_dim2 << 1) + 1], &m[(k + j * m_dim2 << 1)
+ 2], &m[(l + j * m_dim2 << 1) + 1], &m[(l + j *
m_dim2 << 1) + 2], &c__1, &c__1);
}
if (srfblk_1.ndrz != 0 && jj != nj) {
/* Computing MIN */
i__5 = j, i__4 = j + lj;
i__2 = min(i__5,i__4);
ctcell_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &m[m_offset], &k,
&i__2);
}
L390:
i__2 = nxpass;
for (ipass = 1; ipass <= i__2; ++ipass) {
li = mxj[ipass - 1];
mi = mxs[ipass - 1] - li;
ni = (i__5 = mi - mxf[ipass - 1], abs(i__5));
i__5 = ni;
for (ii = 1; ii <= i__5; ++ii) {
i__ = mi + ii * li;
ipli = i__ + li;
if (srfip1_1.idry != 0 && ii != ni) {
draws_(&m[(i__ + j * m_dim2 << 1) + 1], &m[(i__ + j *
m_dim2 << 1) + 2], &m[(ipli + j * m_dim2 << 1)
+ 1], &m[(ipli + j * m_dim2 << 1) + 2], &
c__1, &c__1);
}
if (j != myf[0] && srfip1_1.idrx != 0) {
draws_(&m[(i__ + jplj * m_dim2 << 1) + 1], &m[(i__ +
jplj * m_dim2 << 1) + 2], &m[(i__ + j *
m_dim2 << 1) + 1], &m[(i__ + j * m_dim2 << 1)
+ 2], &c__1, &c__1);
}
if (srfblk_1.ndrz != 0 && ii != ni && jj != nnyy) {
/* Computing MIN */
i__6 = i__, i__7 = i__ + li;
i__4 = min(i__6,i__7);
/* Computing MIN */
i__9 = j, i__10 = j + lj;
i__8 = min(i__9,i__10);
ctcell_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &m[
m_offset], &i__4, &i__8);
}
/* L400: */
}
/* L410: */
}
/* L420: */
}
L430:
if (srfip1_1.iskirt == 0) {
goto L520;
}
/* FIX UP IF SKIRT IS USED WITH LINES ONE WAY. */
if (srfip1_1.idrx != 0) {
goto L460;
}
i__3 = nxpass;
for (ipass = 1; ipass <= i__3; ++ipass) {
if (nxpass == 2) {
if__ = (ipass - 1) * (nnxx - 1) + 1;
}
i__2 = nnyy;
for (j = 2; j <= i__2; ++j) {
draws_(&m[(if__ + (j - 1) * m_dim2 << 1) + 1], &m[(if__ + (j
- 1) * m_dim2 << 1) + 2], &m[(if__ + j * m_dim2 << 1)
+ 1], &m[(if__ + j * m_dim2 << 1) + 2], &c__1, &c__0);
/* L440: */
}
/* L450: */
}
L460:
if (srfip1_1.idry != 0) {
goto L520;
}
i__3 = nypass;
for (jpass = 1; jpass <= i__3; ++jpass) {
if (nypass == 2) {
jf = (jpass - 1) * (nnyy - 1) + 1;
}
i__2 = nnxx;
for (i__ = 2; i__ <= i__2; ++i__) {
draws_(&m[(i__ - 1 + jf * m_dim2 << 1) + 1], &m[(i__ - 1 + jf
* m_dim2 << 1) + 2], &m[(i__ + jf * m_dim2 << 1) + 1],
&m[(i__ + jf * m_dim2 << 1) + 2], &c__1, &c__0);
/* L470: */
}
/* L480: */
}
goto L520;
/* ALL VISIBLE IF VIEWED FROM DIRECTLY ABOVE OR BELOW. */
L490:
if (srfblk_1.nupper > 0 && s[3] < s[6]) {
goto L520;
}
if (srfblk_1.nupper < 0 && s[3] > s[6]) {
goto L520;
}
srfblk_1.nupper = 1;
if (s[3] < s[6]) {
srfblk_1.nupper = -1;
}
i__3 = nnxx;
for (i__ = 1; i__ <= i__3; ++i__) {
i__2 = nnyy;
for (j = 1; j <= i__2; ++j) {
if (srfip1_1.idrx != 0 && j != nnyy) {
draws_(&m[(i__ + j * m_dim2 << 1) + 1], &m[(i__ + j *
m_dim2 << 1) + 2], &m[(i__ + (j + 1) * m_dim2 <<
1) + 1], &m[(i__ + (j + 1) * m_dim2 << 1) + 2], &
c__1, &c__0);
}
if (srfip1_1.idry != 0 && i__ != nnxx) {
draws_(&m[(i__ + j * m_dim2 << 1) + 1], &m[(i__ + j *
m_dim2 << 1) + 2], &m[(i__ + 1 + j * m_dim2 << 1)
+ 1], &m[(i__ + 1 + j * m_dim2 << 1) + 2], &c__1,
&c__0);
}
if (srfip1_1.idrz != 0 && i__ != nnxx && j != nnyy) {
ctcell_(&z__[z_offset], &mmxx, &nnxx, &nnyy, &m[m_offset],
&i__, &j);
}
/* L500: */
}
/* L510: */
}
L520:
if (ster == 0.f) {
goto L560;
}
if (srfip1_1.istp < 0) {
goto L540;
} else if (srfip1_1.istp == 0) {
goto L530;
} else {
goto L550;
}
L530:
frame_();
L540:
frame_();
goto L570;
L550:
if (ipic != 2) {
goto L570;
}
L560:
if (srfip1_1.ifr > 0) {
frame_();
}
L570:
;
}
return 0;
} /* srface_ */
/* Subroutine */ int srfpl_(integer *n, real *px, real *py)
{
extern /* Subroutine */ int line_(real *, real *, real *, real *);
/* Parameter adjustments */
--py;
--px;
/* Function Body */
line_(&px[1], &py[1], &px[2], &py[2]);
return 0;
} /* srfpl_ */
/* Subroutine */ int clset_(real *z__, integer *mx, integer *nx, integer *ny,
real *chi, real *clo, real *cinc, integer *nla, integer *nlm, real *
cl, integer *ncl, integer *icnst, integer *ioffp, real *spval, real *
bigest)
{
/* Initialized data */
static integer kk = 0;
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double r_lg10(real *), pow_ri(real *, integer *), r_int(real *);
/* Local variables */
static real fanc, crat;
static integer i__, j, k;
static real p, cc, ha, glo;
/* cc DIMENSION Z(MX,NY) ,CL(NLM) */
/* Parameter adjustments */
z_dim1 = *mx;
z_offset = z_dim1 + 1;
z__ -= z_offset;
--cl;
/* Function Body */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* CLSET PUTS THE VALUS OF THE CONTOUR LEVELS IN CL */
*icnst = 0;
glo = *clo;
ha = *chi;
fanc = *cinc;
crat = (real) (*nla);
if ((r__1 = ha - glo) < 0.f) {
goto L10;
} else if (r__1 == 0) {
goto L20;
} else {
goto L50;
}
L10:
glo = ha;
ha = *clo;
goto L50;
L20:
glo = *bigest;
ha = -glo;
i__1 = *ny;
for (j = 1; j <= i__1; ++j) {
i__2 = *nx;
for (i__ = 1; i__ <= i__2; ++i__) {
if (*ioffp == 1 && z__[i__ + j * z_dim1] == *spval) {
goto L30;
}
/* Computing MIN */
r__1 = z__[i__ + j * z_dim1];
glo = dmin(r__1,glo);
/* Computing MAX */
r__1 = z__[i__ + j * z_dim1];
ha = dmax(r__1,ha);
L30:
;
}
/* L40: */
}
L50:
if (fanc < 0.f) {
goto L60;
} else if (fanc == 0) {
goto L70;
} else {
goto L90;
}
L60:
crat = -fanc;
L70:
fanc = (ha - glo) / crat;
if (fanc <= 0.f) {
goto L140;
} else {
goto L80;
}
L80:
i__1 = (integer) (r_lg10(&fanc) + 500.f) - 500;
p = pow_ri(&c_b128, &i__1);
r__1 = fanc / p;
fanc = r_int(&r__1) * p;
L90:
if (*chi - *clo != 0.f) {
goto L110;
} else {
goto L100;
}
L100:
r__1 = glo / fanc;
glo = r_int(&r__1) * fanc;
r__1 = ha / fanc;
ha = r_int(&r__1) * fanc;
L110:
i__1 = *nlm;
for (k = 1; k <= i__1; ++k) {
cc = glo + (real) (k - 1) * fanc;
if (cc > ha) {
goto L130;
}
kk = k;
cl[k] = cc;
/* L120: */
}
L130:
*ncl = kk;
return 0;
L140:
*icnst = 1;
return 0;
} /* clset_ */
/* Subroutine */ int ctcell_(real *z__, integer *mx, integer *nx, integer *ny,
integer *m, integer *i0, integer *j0)
{
/* Initialized data */
static integer idub = 0;
/* System generated locals */
integer z_dim1, z_offset, m_dim2, m_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double r_sign(real *, real *);
/* Local variables */
static integer jump, k;
extern /* Subroutine */ int color_(integer *), draws_(integer *, integer *
, integer *, integer *, integer *, integer *);
static integer i1, j1;
static real h1, h2, h3, h4;
static integer k1, k2, k3, k4;
static real ra, rb, cv;
static logical lcolor;
static integer i1p1, j1p1, mua, mva, mub, mvb;
/* CC DIMENSION Z(MX,NY) ,M(2,NX,NY) */
/* Parameter adjustments */
m_dim2 = *nx;
m_offset = (m_dim2 + 1 << 1) + 1;
m -= m_offset;
z_dim1 = *mx;
z_offset = z_dim1 + 1;
z__ -= z_offset;
/* Function Body */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
i1 = *i0;
i1p1 = i1 + 1;
j1 = *j0;
j1p1 = j1 + 1;
h1 = z__[i1 + j1 * z_dim1];
h2 = z__[i1 + j1p1 * z_dim1];
h3 = z__[i1p1 + j1p1 * z_dim1];
h4 = z__[i1p1 + j1 * z_dim1];
if (srfblk_1.ioffp != 1) {
goto L10;
}
if (h1 == srfblk_1.spval || h2 == srfblk_1.spval || h3 == srfblk_1.spval
|| h4 == srfblk_1.spval) {
return 0;
}
L10:
/* Computing MIN */
r__1 = min(h1,h2), r__1 = min(r__1,h3);
if (dmin(r__1,h4) > srfblk_1.cl[srfblk_1.ncl - 1]) {
return 0;
}
lcolor = FALSE_;
i__1 = srfblk_1.ncl;
for (k = 1; k <= i__1; ++k) {
/* FOR EACH CONTOUR LEVEL, DESIDE WHICH OF THE 16 BASIC SIT- */
/* UATIONS EXISTS, THEN INTERPOLATE IN TWO-SPACE TO FIND THE */
/* END POINTS OF THE CONTOUR LINE SEGMENT WITHIN THIS CELL. */
cv = srfblk_1.cl[k - 1];
r__1 = h1 - cv;
k1 = ((integer) r_sign(&c_b3, &r__1) + 1) / 2;
r__1 = h2 - cv;
k2 = ((integer) r_sign(&c_b3, &r__1) + 1) / 2;
r__1 = h3 - cv;
k3 = ((integer) r_sign(&c_b3, &r__1) + 1) / 2;
r__1 = h4 - cv;
k4 = ((integer) r_sign(&c_b3, &r__1) + 1) / 2;
jump = k1 + 1 + (k2 << 1) + (k3 << 2) + (k4 << 3);
/* 17/Apr/91: plot contours in different colors */
if (jump > 1 && jump < 16) {
i__2 = k % 6 + 2;
color_(&i__2);
}
switch (jump) {
case 1: goto L120;
case 2: goto L30;
case 3: goto L50;
case 4: goto L60;
case 5: goto L70;
case 6: goto L20;
case 7: goto L80;
case 8: goto L90;
case 9: goto L90;
case 10: goto L80;
case 11: goto L40;
case 12: goto L70;
case 13: goto L60;
case 14: goto L50;
case 15: goto L30;
case 16: goto L110;
}
L20:
idub = 1;
L30:
ra = (h1 - cv) / (h1 - h2);
mua = (real) m[(i1 + j1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1 +
j1p1 * m_dim2 << 1) + 1] - m[(i1 + j1 * m_dim2 << 1) + 1]);
mva = (real) m[(i1 + j1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1 +
j1p1 * m_dim2 << 1) + 2] - m[(i1 + j1 * m_dim2 << 1) + 2]);
rb = (h1 - cv) / (h1 - h4);
mub = (real) m[(i1 + j1 * m_dim2 << 1) + 1] + rb * (real) (m[(i1p1 +
j1 * m_dim2 << 1) + 1] - m[(i1 + j1 * m_dim2 << 1) + 1]);
mvb = (real) m[(i1 + j1 * m_dim2 << 1) + 2] + rb * (real) (m[(i1p1 +
j1 * m_dim2 << 1) + 2] - m[(i1 + j1 * m_dim2 << 1) + 2]);
goto L100;
L40:
idub = -1;
L50:
ra = (h2 - cv) / (h2 - h1);
mua = (real) m[(i1 + j1p1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 1] - m[(i1 + j1p1 * m_dim2 << 1) + 1]);
mva = (real) m[(i1 + j1p1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 2] - m[(i1 + j1p1 * m_dim2 << 1) + 2]);
rb = (h2 - cv) / (h2 - h3);
mub = (real) m[(i1 + j1p1 * m_dim2 << 1) + 1] + rb * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 1] - m[(i1 + j1p1 * m_dim2 << 1) + 1])
;
mvb = (real) m[(i1 + j1p1 * m_dim2 << 1) + 2] + rb * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 2] - m[(i1 + j1p1 * m_dim2 << 1) + 2])
;
goto L100;
L60:
ra = (h2 - cv) / (h2 - h3);
mua = (real) m[(i1 + j1p1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 1] - m[(i1 + j1p1 * m_dim2 << 1) + 1])
;
mva = (real) m[(i1 + j1p1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 2] - m[(i1 + j1p1 * m_dim2 << 1) + 2])
;
rb = (h1 - cv) / (h1 - h4);
mub = (real) m[(i1 + j1 * m_dim2 << 1) + 1] + rb * (real) (m[(i1p1 +
j1 * m_dim2 << 1) + 1] - m[(i1 + j1 * m_dim2 << 1) + 1]);
mvb = (real) m[(i1 + j1 * m_dim2 << 1) + 2] + rb * (real) (m[(i1p1 +
j1 * m_dim2 << 1) + 2] - m[(i1 + j1 * m_dim2 << 1) + 2]);
goto L100;
L70:
ra = (h3 - cv) / (h3 - h2);
mua = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1
+ j1p1 * m_dim2 << 1) + 1] - m[(i1p1 + j1p1 * m_dim2 << 1) +
1]);
mva = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1
+ j1p1 * m_dim2 << 1) + 2] - m[(i1p1 + j1p1 * m_dim2 << 1) +
2]);
rb = (h3 - cv) / (h3 - h4);
mub = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 1] + rb * (real) (m[(
i1p1 + j1 * m_dim2 << 1) + 1] - m[(i1p1 + j1p1 * m_dim2 << 1)
+ 1]);
mvb = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 2] + rb * (real) (m[(
i1p1 + j1 * m_dim2 << 1) + 2] - m[(i1p1 + j1p1 * m_dim2 << 1)
+ 2]);
idub = 0;
goto L100;
L80:
ra = (h2 - cv) / (h2 - h1);
mua = (real) m[(i1 + j1p1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 1] - m[(i1 + j1p1 * m_dim2 << 1) + 1]);
mva = (real) m[(i1 + j1p1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 2] - m[(i1 + j1p1 * m_dim2 << 1) + 2]);
rb = (h3 - cv) / (h3 - h4);
mub = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 1] + rb * (real) (m[(
i1p1 + j1 * m_dim2 << 1) + 1] - m[(i1p1 + j1p1 * m_dim2 << 1)
+ 1]);
mvb = (real) m[(i1p1 + j1p1 * m_dim2 << 1) + 2] + rb * (real) (m[(
i1p1 + j1 * m_dim2 << 1) + 2] - m[(i1p1 + j1p1 * m_dim2 << 1)
+ 2]);
goto L100;
L90:
ra = (h4 - cv) / (h4 - h1);
mua = (real) m[(i1p1 + j1 * m_dim2 << 1) + 1] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 1] - m[(i1p1 + j1 * m_dim2 << 1) + 1]);
mva = (real) m[(i1p1 + j1 * m_dim2 << 1) + 2] + ra * (real) (m[(i1 +
j1 * m_dim2 << 1) + 2] - m[(i1p1 + j1 * m_dim2 << 1) + 2]);
rb = (h4 - cv) / (h4 - h3);
mub = (real) m[(i1p1 + j1 * m_dim2 << 1) + 1] + rb * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 1] - m[(i1p1 + j1 * m_dim2 << 1) + 1])
;
mvb = (real) m[(i1p1 + j1 * m_dim2 << 1) + 2] + rb * (real) (m[(i1p1
+ j1p1 * m_dim2 << 1) + 2] - m[(i1p1 + j1 * m_dim2 << 1) + 2])
;
idub = 0;
L100:
draws_(&mua, &mva, &mub, &mvb, &c__1, &c__0);
lcolor = TRUE_;
if (idub < 0) {
goto L90;
} else if (idub == 0) {
goto L110;
} else {
goto L70;
}
L110:
;
}
L120:
if (lcolor) {
color_(&c__1);
}
return 0;
} /* ctcell_ */
/* Subroutine */ int draws_(integer *mx1, integer *my1, integer *mx2, integer
*my2, integer *idraw, integer *imark)
{
/* Initialized data */
static real steep = 5.f;
static integer mx = 0;
static integer my = 0;
/* System generated locals */
integer i__1, i__2;
/* Local variables */
static integer nx1p1, k, ltemp;
extern /* Subroutine */ int srfpl_(integer *, real *, real *);
static real dy;
static integer nx1, ny1, nx2, ny2;
static real pxs[2], pys[2], fny1;
static logical vis1, vis2;
static integer mmx1, mmy1, mmx2, mmy2;
/* THIS ROUTINE DRAWS THE VISIBLE PART OF THE LINE CONNECTING */
/* (MX1,MY1) AND (MX2,MY2). IF IDRAW .NE. 0, THE LINE IS DRAWN. */
/* IF IMARK .NE. 0, THE VISIBILITY ARRAY IS MARKED. */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* MAKE LINE LEFT TO RIGHT. */
mmx1 = *mx1;
mmy1 = *my1;
mmx2 = *mx2;
mmy2 = *my2;
if (mmx1 == srfblk_1.nspval || mmx2 == srfblk_1.nspval) {
return 0;
}
if (mmx1 > mmx2) {
goto L10;
}
nx1 = mmx1;
ny1 = mmy1;
nx2 = mmx2;
ny2 = mmy2;
goto L20;
L10:
nx1 = mmx2;
ny1 = mmy2;
nx2 = mmx1;
ny2 = mmy1;
L20:
if (srfblk_1.nupper < 0) {
goto L180;
}
/* CHECK UPPER VISIBILITY. */
vis1 = ny1 >= srfblk_1.limu[nx1 - 1] - 1;
vis2 = ny2 >= srfblk_1.limu[nx2 - 1] - 1;
/* VIS1 AND VIS2 TRUE MEANS VISIBLE. */
if (vis1 && vis2) {
goto L120;
}
/* VIS1 AND VIS2 FALSE MEANS INVISIBLE. */
if (! (vis1 || vis2)) {
goto L180;
}
/* FIND CHANGE POINT. */
if (nx1 == nx2) {
goto L110;
}
dy = (real) (ny2 - ny1) / (real) (nx2 - nx1);
nx1p1 = nx1 + 1;
fny1 = (real) ny1;
if (vis1) {
goto L60;
}
i__1 = nx2;
for (k = nx1p1; k <= i__1; ++k) {
mx = k;
my = fny1 + (real) (k - nx1) * dy;
if (my > srfblk_1.limu[k - 1]) {
goto L40;
}
/* L30: */
}
L40:
if (dabs(dy) >= steep) {
goto L90;
}
L50:
nx1 = mx;
ny1 = my;
goto L120;
L60:
i__1 = nx2;
for (k = nx1p1; k <= i__1; ++k) {
mx = k;
my = fny1 + (real) (k - nx1) * dy;
if (my <= srfblk_1.limu[k - 1]) {
goto L80;
}
/* L70: */
}
L80:
if (dabs(dy) >= steep) {
goto L100;
}
nx2 = mx - 1;
ny2 = my;
goto L120;
L90:
if (srfblk_1.limu[mx - 1] == 0) {
goto L50;
}
nx1 = mx;
ny1 = srfblk_1.limu[nx1 - 1];
goto L120;
L100:
nx2 = mx - 1;
ny2 = srfblk_1.limu[nx2 - 1];
goto L120;
L110:
if (vis1) {
/* Computing MIN */
i__1 = srfblk_1.limu[nx1 - 1], i__2 = srfblk_1.limu[nx2 - 1];
ny2 = min(i__1,i__2);
}
if (vis2) {
/* Computing MIN */
i__1 = srfblk_1.limu[nx1 - 1], i__2 = srfblk_1.limu[nx2 - 1];
ny1 = min(i__1,i__2);
}
L120:
if (*idraw == 0) {
goto L150;
}
/* DRAW VISIBLE PART OF LINE. */
if (srfblk_1.irot != 0) {
goto L130;
} else {
goto L140;
}
L130:
pxs[0] = (real) ny1;
pxs[1] = (real) ny2;
pys[0] = (real) (1024 - nx1);
pys[1] = (real) (1024 - nx2);
srfpl_(&c__2, pxs, pys);
goto L150;
L140:
pxs[0] = (real) nx1;
pxs[1] = (real) nx2;
pys[0] = (real) ny1;
pys[1] = (real) ny2;
srfpl_(&c__2, pxs, pys);
L150:
if (*imark == 0) {
goto L180;
}
if (nx1 == nx2) {
goto L170;
}
dy = (real) (ny2 - ny1) / (real) (nx2 - nx1);
fny1 = (real) ny1;
i__1 = nx2;
for (k = nx1; k <= i__1; ++k) {
ltemp = fny1 + (real) (k - nx1) * dy;
if (ltemp > srfblk_1.limu[k - 1]) {
srfblk_1.limu[k - 1] = ltemp;
}
/* L160: */
}
goto L180;
L170:
ltemp = max(ny1,ny2);
if (ltemp > srfblk_1.limu[nx1 - 1]) {
srfblk_1.limu[nx1 - 1] = ltemp;
}
L180:
if (srfblk_1.nupper <= 0) {
goto L190;
} else {
goto L370;
}
/* SAME IDEA AS ABOVE, BUT FOR LOWER SIDE. */
L190:
if (mmx1 > mmx2) {
goto L200;
}
nx1 = mmx1;
ny1 = mmy1;
nx2 = mmx2;
ny2 = mmy2;
goto L210;
L200:
nx1 = mmx2;
ny1 = mmy2;
nx2 = mmx1;
ny2 = mmy1;
L210:
vis1 = ny1 <= srfblk_1.liml[nx1 - 1] + 1;
vis2 = ny2 <= srfblk_1.liml[nx2 - 1] + 1;
if (vis1 && vis2) {
goto L310;
}
if (! (vis1 || vis2)) {
goto L370;
}
if (nx1 == nx2) {
goto L300;
}
dy = (real) (ny2 - ny1) / (real) (nx2 - nx1);
nx1p1 = nx1 + 1;
fny1 = (real) ny1;
if (vis1) {
goto L250;
}
i__1 = nx2;
for (k = nx1p1; k <= i__1; ++k) {
mx = k;
my = fny1 + (real) (k - nx1) * dy;
if (my < srfblk_1.liml[k - 1]) {
goto L230;
}
/* L220: */
}
L230:
if (dabs(dy) >= steep) {
goto L280;
}
L240:
nx1 = mx;
ny1 = my;
goto L310;
L250:
i__1 = nx2;
for (k = nx1p1; k <= i__1; ++k) {
mx = k;
my = fny1 + (real) (k - nx1) * dy;
if (my >= srfblk_1.liml[k - 1]) {
goto L270;
}
/* L260: */
}
L270:
if (dabs(dy) >= steep) {
goto L290;
}
nx2 = mx - 1;
ny2 = my;
goto L310;
L280:
if (srfblk_1.liml[mx - 1] == 1024) {
goto L240;
}
nx1 = mx;
ny1 = srfblk_1.liml[nx1 - 1];
goto L310;
L290:
nx2 = mx - 1;
ny2 = srfblk_1.liml[nx2 - 1];
goto L310;
L300:
if (vis1) {
/* Computing MAX */
i__1 = srfblk_1.liml[nx1 - 1], i__2 = srfblk_1.liml[nx2 - 1];
ny2 = max(i__1,i__2);
}
if (vis2) {
/* Computing MAX */
i__1 = srfblk_1.liml[nx1 - 1], i__2 = srfblk_1.liml[nx2 - 1];
ny1 = max(i__1,i__2);
}
L310:
if (*idraw == 0) {
goto L340;
}
if (srfblk_1.irot != 0) {
goto L320;
} else {
goto L330;
}
L320:
pxs[0] = (real) ny1;
pxs[1] = (real) ny2;
pys[0] = (real) (1024 - nx1);
pys[1] = (real) (1024 - nx2);
srfpl_(&c__2, pxs, pys);
goto L340;
L330:
pxs[0] = (real) nx1;
pxs[1] = (real) nx2;
pys[0] = (real) ny1;
pys[1] = (real) ny2;
srfpl_(&c__2, pxs, pys);
L340:
if (*imark == 0) {
goto L370;
}
if (nx1 == nx2) {
goto L360;
}
dy = (real) (ny2 - ny1) / (real) (nx2 - nx1);
fny1 = (real) ny1;
i__1 = nx2;
for (k = nx1; k <= i__1; ++k) {
ltemp = fny1 + (real) (k - nx1) * dy;
if (ltemp < srfblk_1.liml[k - 1]) {
srfblk_1.liml[k - 1] = ltemp;
}
/* L350: */
}
return 0;
L360:
ltemp = min(ny1,ny2);
if (ltemp < srfblk_1.liml[nx1 - 1]) {
srfblk_1.liml[nx1 - 1] = ltemp;
}
L370:
return 0;
} /* draws_ */
/* Subroutine */ int setr_(real *xmin, real *xmax, real *ymin, real *ymax,
real *zmin, real *zmax, real *r0)
{
/* System generated locals */
real r__1, r__2, r__3;
/* Local variables */
static real yeye, xeye, zeye, alpha;
extern /* Subroutine */ int trn32s_(real *, real *, real *, real *, real *
, real *, integer *);
static real dummy, dummie, xat, yat, zat, umn, vmn, xmn, ymn, zmn, umx,
vmx, xmx, ymx, zmx;
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
if (*r0 <= 0.f) {
goto L10;
} else {
goto L20;
}
L10:
srfblk_1.nrswt = 0;
return 0;
L20:
srfblk_1.nrswt = 1;
pwrz1s_1.xxmin = *xmin;
pwrz1s_1.xxmax = *xmax;
pwrz1s_1.yymin = *ymin;
pwrz1s_1.yymax = *ymax;
pwrz1s_1.zzmin = *zmin;
pwrz1s_1.zzmax = *zmax;
srfblk_1.rzero = *r0;
srfblk_1.ll = 0;
xat = (pwrz1s_1.xxmax + pwrz1s_1.xxmin) * .5f;
yat = (pwrz1s_1.yymax + pwrz1s_1.yymin) * .5f;
zat = (pwrz1s_1.zzmax + pwrz1s_1.zzmin) * .5f;
alpha = -(pwrz1s_1.yymin - yat) / (pwrz1s_1.xxmin - xat);
yeye = -srfblk_1.rzero / sqrt(alpha * alpha + 1.f);
xeye = yeye * alpha;
yeye += yat;
xeye += xat;
zeye = zat;
trn32s_(&xat, &yat, &zat, &xeye, &yeye, &zeye, &c__0);
xmn = pwrz1s_1.xxmin;
xmx = pwrz1s_1.xxmax;
ymn = pwrz1s_1.yymin;
ymx = pwrz1s_1.yymax;
zmn = pwrz1s_1.zzmin;
zmx = pwrz1s_1.zzmax;
trn32s_(&xmn, &ymn, &zat, &umn, &dummy, &dummie, &c__1);
trn32s_(&xmx, &ymn, &zmn, &dummy, &vmn, &dummie, &c__1);
trn32s_(&xmx, &ymx, &zat, &umx, &dummy, &dummie, &c__1);
trn32s_(&xmx, &ymn, &zmx, &dummy, &vmx, &dummie, &c__1);
srfblk_1.umin = umn;
srfblk_1.umax = umx;
srfblk_1.vmin = vmn;
srfblk_1.vmax = vmx;
/* Computing 2nd power */
r__1 = pwrz1s_1.xxmax - pwrz1s_1.xxmin;
/* Computing 2nd power */
r__2 = pwrz1s_1.yymax - pwrz1s_1.yymin;
/* Computing 2nd power */
r__3 = pwrz1s_1.zzmax - pwrz1s_1.zzmin;
srfblk_1.bigd = sqrt(r__1 * r__1 + r__2 * r__2 + r__3 * r__3) * .5f;
return 0;
} /* setr_ */
/* Subroutine */ int trn32s_(real *x, real *y, real *z__, real *xt, real *yt,
real *zt, integer *iflag)
{
/* Initialized data */
static integer nlu[7] = { 10,10,100,10,10,10,512 };
static integer nru[7] = { 1014,924,1014,1014,1014,512,1014 };
static integer nbv[7] = { 10,50,50,10,10,256,256 };
static integer ntv[7] = { 1014,964,964,1014,1014,758,758 };
/* Format strings */
static char fmt_60[] = "";
static char fmt_50[] = "";
static char fmt_120[] = "";
static char fmt_100[] = "";
static char fmt_70[] = "";
static char fmt_80[] = "";
/* System generated locals */
real r__1, r__2, r__3, r__4;
/* Local variables */
static integer jump, jump2, jump3;
static real d__, q, r__, cosbe, cosga, sinbe, cosal, singa, u0, v0, u1,
v1, u2, v2, u3, v3, u4, v4, ax, ay, az, dx, ex, ey, ez, dy, dz,
xx, yy, zz;
/* Assigned format variables */
static char *jump3_fmt, *jump2_fmt, *jump_fmt;
/* PICTURE CORNER COORDINATES FOR LL=1 */
/* PICTURE CORNER COORDINATES FOR LL=2 */
/* PICTURE CORNER COORDINATES FOR LL=3 */
/* PICTURE CORNER COORDINATES FOR LL=4 */
/* PICTURE CORNER COORDINATES FOR LL=5 */
/* PICTURE CORNER COORDINATES FOR LL=6 */
/* PICTURE CORNER COORDINATES FOR LL=7 */
/* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
*/
/* STORE THE PARAMETERS OF THE SET32 CALL FOR USE WHEN */
/* TRN32 IS CALLED. */
if (*iflag != 0) {
goto L40;
} else {
goto L10;
}
L10:
jump3 = 0;
jump3_fmt = fmt_60;
if (srfblk_1.ioffp == 1) {
jump3 = 1;
jump3_fmt = fmt_50;
}
ax = *x;
ay = *y;
az = *z__;
ex = *xt;
ey = *yt;
ez = *zt;
/* AS MUCH COMPUTATION AS POSSIBLE IS DONE DURING EXECUTION */
/* THIS ROUTINE WHEN IFLAG=0 BECAUSE CALLS IN THAT MODE ARE INFREQUENT. */
dx = ax - ex;
dy = ay - ey;
dz = az - ez;
d__ = sqrt(dx * dx + dy * dy + dz * dz);
cosal = dx / d__;
cosbe = dy / d__;
cosga = dz / d__;
singa = sqrt(1.f - cosga * cosga);
jump2 = 0;
jump2_fmt = fmt_120;
if (srfblk_1.ll == 0) {
goto L20;
}
jump2 = 1;
jump2_fmt = fmt_100;
pwrz1s_1.delcrt = (real) (nru[srfblk_1.ll - 1] - nlu[srfblk_1.ll - 1]);
u0 = srfblk_1.umin;
v0 = srfblk_1.vmin;
u1 = (real) nlu[srfblk_1.ll - 1];
v1 = (real) nbv[srfblk_1.ll - 1];
u2 = (real) (nru[srfblk_1.ll - 1] - nlu[srfblk_1.ll - 1]);
v2 = (real) (ntv[srfblk_1.ll - 1] - nbv[srfblk_1.ll - 1]);
u3 = u2 / (srfblk_1.umax - srfblk_1.umin);
v3 = v2 / (srfblk_1.vmax - srfblk_1.vmin);
u4 = (real) nru[srfblk_1.ll - 1];
v4 = (real) ntv[srfblk_1.ll - 1];
if (srfblk_1.nrswt == 0) {
goto L20;
}
u0 = -srfblk_1.bigd;
v0 = -srfblk_1.bigd;
u3 = u2 / (srfblk_1.bigd * 2.f);
v3 = v2 / (srfblk_1.bigd * 2.f);
/* THE 3-SPACE POINT LOOKED AT IS TRANSFORMED INTO (0,0) OF */
/* THE 2-SPACE. THE 3-SPACE Z AXIS IS TRANSFORMED INTO THE */
/* 2-SPACE Y AXIS. IF THE LINE OF SIGHT IS CLOSE TO PARALLEL */
/* TO THE 3-SPACE Z AXIS, THE 3-SPACE Y AXIS IS CHOSEN (IN- */
/* STEAD OF THE 3-SPACE Z AXIS) TO BE TRANSFORMED INTO THE */
/* 2-SPACE Y AXIS. */
L20:
if (singa < 1e-4f) {
goto L30;
}
r__ = 1.f / singa;
jump = 0;
jump_fmt = fmt_70;
return 0;
L30:
sinbe = sqrt(1.f - cosbe * cosbe);
r__ = 1.f / sinbe;
jump = 1;
jump_fmt = fmt_80;
return 0;
L40:
xx = *x;
yy = *y;
zz = *z__;
switch (jump3) {
case 0: goto L60;
case 1: goto L50;
}
L50:
if (zz == srfblk_1.spval) {
goto L110;
}
L60:
q = d__ / ((xx - ex) * cosal + (yy - ey) * cosbe + (zz - ez) * cosga);
switch (jump) {
case 0: goto L70;
case 1: goto L80;
}
L70:
xx = ((ex + q * (xx - ex) - ax) * cosbe - (ey + q * (yy - ey) - ay) *
cosal) * r__;
yy = (ez + q * (zz - ez) - az) * r__;
goto L90;
L80:
xx = ((ez + q * (zz - ez) - az) * cosal - (ex + q * (xx - ex) - ax) *
cosga) * r__;
yy = (ey + q * (yy - ey) - ay) * r__;
L90:
switch (jump2) {
case 0: goto L120;
case 1: goto L100;
}
L100:
/* Computing MIN */
/* Computing MAX */
r__3 = u1, r__4 = u1 + u3 * (srfblk_1.fact * xx - u0);
r__1 = u4, r__2 = dmax(r__3,r__4);
xx = dmin(r__1,r__2);
/* Computing MIN */
/* Computing MAX */
r__3 = v1, r__4 = v1 + v3 * (srfblk_1.fact * yy - v0);
r__1 = v4, r__2 = dmax(r__3,r__4);
yy = dmin(r__1,r__2);
goto L120;
L110:
xx = (real) srfblk_1.nspval;
yy = (real) srfblk_1.nspval;
L120:
*xt = xx;
*yt = yy;
return 0;
} /* trn32s_ */
/* cc BLOCKDATA SRFABD */
/* Subroutine */ int srfabd_(void)
{
/* INITIALIZATION OF INTERNAL PARAMETERS */
return 0;
} /* srfabd_ */
syntax highlighted by Code2HTML, v. 0.9.1