#include <cstring>
#include <ctime>
#include <iostream>
#include <cstdio>
#include <cstdlib>
#include <boost/format.hpp>
#include "emdata.h"
#include "util.h"
#include "fundamentals.h"
#include "lapackblas.h"
#include "lbfgsb.h"
#include "steepest.h"
#include "emassert.h"
#include "randnum.h"
#include <gsl/gsl_sf_bessel.h>
#include <cmath>
Include dependency graph for util_sparx.cpp:
Go to the source code of this file.
Classes | |
struct | ori_t |
struct | cmpang |
struct | tmpstruct |
struct | stcom_ |
struct | ccf_point |
struct | ccf_value |
struct | point3d_t |
Defines | |
#define | fdata(i, j) fdata[ i-1 + (j-1)*nxdata ] |
#define | fdata(i, j) fdata[ i-1 + (j-1)*nxdata ] |
#define | circ(i) circ[i-1] |
#define | numr(i, j) numr[(j-1)*3 + i-1] |
#define | xim(i, j) xim[(j-1)*nsam + i-1] |
#define | tab1(i) tab1[i-1] |
#define | xcmplx(i, j) xcmplx [(j-1)*2 + i-1] |
#define | br(i) br[i-1] |
#define | bi(i) bi[i-1] |
#define | b(i) b[i-1] |
#define | circ1(i) circ1[i-1] |
#define | circ2(i) circ2[i-1] |
#define | t(i) t[i-1] |
#define | q(i) q[i-1] |
#define | b(i) b[i-1] |
#define | t7(i) t7[i-1] |
#define | dout(i, j) dout[i+maxrin*j] |
#define | circ1b(i) circ1b[i-1] |
#define | circ2b(i) circ2b[i-1] |
#define | dout(i, j) dout[i+maxrin*j] |
#define | circ1b(i) circ1b[i-1] |
#define | circ2b(i) circ2b[i-1] |
#define | QUADPI 3.141592653589793238462643383279502884197 |
#define | PI2 2*QUADPI |
#define | QUADPI 3.141592653589793238462643383279502884197 |
#define | PI2 QUADPI*2 |
#define | deg_rad QUADPI/180.0 |
#define | rad_deg 180.0/QUADPI |
#define | old_ptr(i, j, k) old_ptr[i+(j+(k*ny))*nx] |
#define | new_ptr(iptr, jptr, kptr) new_ptr[iptr+(jptr+(kptr*new_ny))*new_nx] |
#define | inp(i, j, k) inp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*ny))*nx] |
#define | outp(i, j, k) outp[i+(j+(k*new_ny))*new_nx] |
#define | inp(i, j, k) inp[i+(j+(k*ny))*nx] |
#define | outp(i, j, k) outp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*new_ny))*new_nx] |
#define | QUADPI 3.141592653589793238462643383279502884197 |
#define | DGR_TO_RAD QUADPI/180 |
#define | DM(I) DM [I-1] |
#define | SS(I) SS [I-1] |
#define | DM(I) DM[I-1] |
#define | B(i, j) Bptr[i-1+((j-1)*NSAM)] |
#define | CUBE(i, j, k) CUBEptr[(i-1)+((j-1)+((k-1)*NY3D))*NX3D] |
#define | W(i, j) Wptr [i-1+((j-1)*Wnx)] |
#define | PROJ(i, j) PROJptr [i-1+((j-1)*NNNN)] |
#define | SS(I, J) SS [I-1 + (J-1)*6] |
#define | W(i, j) Wptr [i-1+((j-1)*Wnx)] |
#define | PROJ(i, j) PROJptr [i-1+((j-1)*NNNN)] |
#define | SS(I, J) SS [I-1 + (J-1)*6] |
#define | RI(i, j) RI [(i-1) + ((j-1)*3)] |
#define | CC(i) CC [i-1] |
#define | CP(i) CP [i-1] |
#define | VP(i) VP [i-1] |
#define | VV(i) VV [i-1] |
#define | AMAX1(i, j) i>j?i:j |
#define | AMIN1(i, j) i<j?i:j |
#define | mymax(x, y) (((x)>(y))?(x):(y)) |
#define | mymin(x, y) (((x)<(y))?(x):(y)) |
#define | sign(x, y) (((((y)>0)?(1):(-1))*(y!=0))*(x)) |
#define | quadpi 3.141592653589793238462643383279502884197 |
#define | dgr_to_rad quadpi/180 |
#define | deg_to_rad quadpi/180 |
#define | rad_to_deg 180/quadpi |
#define | rad_to_dgr 180/quadpi |
#define | TRUE 1 |
#define | FALSE 0 |
#define | theta(i) theta [i-1] |
#define | phi(i) phi [i-1] |
#define | weight(i) weight [i-1] |
#define | lband(i) lband [i-1] |
#define | ts(i) ts [i-1] |
#define | thetast(i) thetast [i-1] |
#define | key(i) key [i-1] |
#define | TRUE_ (1) |
#define | FALSE_ (0) |
#define | abs(x) ((x) >= 0 ? (x) : -(x)) |
#define | img_ptr(i, j, k) img_ptr[2*(i-1)+((j-1)+((k-1)*ny))*nxo] |
#define | img_ptr(i, j, k) img_ptr[i+(j+(k*ny))*nx] |
#define | img2_ptr(i, j, k) img2_ptr[i+(j+(k*ny))*nx] |
#define | cent(i) out[i+N] |
#define | assign(i) out[i] |
#define | data(i, j) group[i*ny+j] |
Functions | |
int | i_dnnt (double *x) |
int | addnod_ (int *nst, int *k, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *lnew, int *ier) |
double | angle_ (double *v1, double *v2, double *v3) |
double | areas_ (double *v1, double *v2, double *v3) |
double | areav_new__ (int *k, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *ier) |
int | bdyadd_ (int *kk, int *i1, int *i2, int *list, int *lptr, int *lend, int *lnew) |
int | bnodes_ (int *n, int *list, int *lptr, int *lend, int *nodes, int *nb, int *na, int *nt) |
int | circle_ (int *k, double *xc, double *yc, int *ier) |
int | circum_ (double *v1, double *v2, double *v3, double *c__, int *ier) |
int | covsph_ (int *kk, int *n0, int *list, int *lptr, int *lend, int *lnew) |
int | crlist_ (int *n, int *ncol, double *x, double *y, double *z__, int *list, int *lend, int *lptr, int *lnew, int *ltri, int *listc, int *nb, double *xc, double *yc, double *zc, double *rc, int *ier) |
int | delarc_ (int *n, int *io1, int *io2, int *list, int *lptr, int *lend, int *lnew, int *ier) |
int | delnb_ (int *n0, int *nb, int *n, int *list, int *lptr, int *lend, int *lnew, int *lph) |
int | delnod_ (int *k, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *lnew, int *lwk, int *iwk, int *ier) |
int | drwarc_ (int *, double *p, double *q, double *tol, int *nseg) |
int | edge_ (int *in1, int *in2, double *x, double *y, double *z__, int *lwk, int *iwk, int *list, int *lptr, int *lend, int *ier) |
int | getnp_ (double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *l, int *npts, double *df, int *ier) |
int | insert_ (int *k, int *lp, int *list, int *lptr, int *lnew) |
long int | inside_ (double *p, int *lv, double *xv, double *yv, double *zv, int *nv, int *listv, int *ier) |
int | intadd_ (int *kk, int *i1, int *i2, int *i3, int *list, int *lptr, int *lend, int *lnew) |
int | intrsc_ (double *p1, double *p2, double *cn, double *p, int *ier) |
int | jrand_ (int *n, int *ix, int *iy, int *iz) |
long int | left_ (double *x1, double *y1, double *z1, double *x2, double *y2, double *z2, double *x0, double *y0, double *z0) |
int | lstptr_ (int *lpl, int *nb, int *list, int *lptr) |
int | nbcnt_ (int *lpl, int *lptr) |
int | nearnd_ (double *p, int *ist, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, double *al) |
int | optim_ (double *x, double *y, double *z__, int *na, int *list, int *lptr, int *lend, int *nit, int *iwk, int *ier) |
int | projct_ (double *px, double *py, double *pz, double *ox, double *oy, double *oz, double *ex, double *ey, double *ez, double *vx, double *vy, double *vz, long int *init, double *x, double *y, double *z__, int *ier) |
int | scoord_ (double *px, double *py, double *pz, double *plat, double *plon, double *pnrm) |
double | store_ (double *x) |
int | swap_ (int *in1, int *in2, int *io1, int *io2, int *list, int *lptr, int *lend, int *lp21) |
long int | swptst_ (int *n1, int *n2, int *n3, int *n4, double *x, double *y, double *z__) |
int | trans_ (int *n, double *rlat, double *rlon, double *x, double *y, double *z__) |
int | trfind_ (int *nst, double *p, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, double *b1, double *b2, double *b3, int *i1, int *i2, int *i3) |
int | trlist_ (int *n, int *list, int *lptr, int *lend, int *nrow, int *nt, int *ltri, int *ier) |
int | trlprt_ (int *n, double *x, double *y, double *z__, int *iflag, int *nrow, int *nt, int *ltri, int *lout) |
int | trmesh_ (int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *lnew, int *near__, int *next, double *dist, int *ier) |
int | trplot_ (int *lun, double *pltsiz, double *elat, double *elon, double *a, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, char *, long int *numbr, int *ier, short) |
int | trprnt_ (int *n, double *x, double *y, double *z__, int *iflag, int *list, int *lptr, int *lend, int *lout) |
int | vrplot_ (int *lun, double *pltsiz, double *elat, double *elon, double *a, int *n, double *x, double *y, double *z__, int *nt, int *listc, int *lptr, int *lend, double *xc, double *yc, double *zc, char *, long int *numbr, int *ier, short) |
int | random_ (int *ix, int *iy, int *iz, double *rannum) |
int | find_group (int ix, int iy, int iz, int grpid, EMData *mg, EMData *visited) |
Variables | |
stcom_ | stcom_1 |
|
Definition at line 7678 of file util_sparx.cpp. |
|
Definition at line 5795 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 5796 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 19211 of file util_sparx.cpp. Referenced by EMAN::Util::cluster_pairwise(). |
|
Definition at line 5641 of file util_sparx.cpp. Referenced by EMAN::Util::BPCQ(), EMAN::LowpassAutoBProcessor::create_radial_func(), EMAN::Util::histc(), EMAN::Util::im_diff(), and submatrix(). |
|
Definition at line 3163 of file util_sparx.cpp. |
|
|
Definition at line 2616 of file util_sparx.cpp. Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), and EMAN::TestImageEllipse::process_inplace(). |
|
Definition at line 2615 of file util_sparx.cpp. Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::EMData::render_amp24(), and EMAN::EMData::render_ap24(). |
|
Definition at line 5791 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 19210 of file util_sparx.cpp. Referenced by EMAN::Util::cluster_pairwise(). |
|
Definition at line 2133 of file util_sparx.cpp. Referenced by EMAN::Util::alrl_ms(), alrq(), alrq_ms(), applyws(), EMAN::Util::Frngs(), frngs(), EMAN::Util::Frngs_inv(), EMAN::Util::Polar2D(), EMAN::Util::Polar2Dm(), and EMAN::Util::Polar2Dmi(). |
|
Definition at line 3159 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi_0_180(), and EMAN::Util::Crosrng_sm_psi(). |
|
Definition at line 4179 of file util_sparx.cpp. |
|
Definition at line 4179 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), and EMAN::Util::Crosrng_msg_vec(). |
|
Definition at line 3160 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi_0_180(), and EMAN::Util::Crosrng_sm_psi(). |
|
Definition at line 4180 of file util_sparx.cpp. |
|
Definition at line 4180 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), and EMAN::Util::Crosrng_msg_vec(). |
|
Definition at line 5792 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 5642 of file util_sparx.cpp. Referenced by EMAN::Util::BPCQ(). |
|
|
Definition at line 4560 of file util_sparx.cpp. Referenced by EMAN::Util::cml_init_rot(), EMAN::Util::cml_line_in3d(), and EMAN::Util::cml_update_rot(). |
|
Definition at line 6969 of file util_sparx.cpp. |
|
Definition at line 6968 of file util_sparx.cpp. Referenced by EMAN::Util::ang_to_xyz(), apmq(), aprq2d(), EMAN::Util::even_angles(), and EMAN::ChaoProjector::setdm(). |
|
Definition at line 5593 of file util_sparx.cpp. |
|
Definition at line 5640 of file util_sparx.cpp. |
|
Definition at line 5640 of file util_sparx.cpp. Referenced by EMAN::Util::BPCQ(), and EMAN::Util::CANG(). |
|
Definition at line 4178 of file util_sparx.cpp. |
|
Definition at line 4178 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), and EMAN::Util::Crosrng_msg_s(). |
|
Definition at line 6973 of file util_sparx.cpp. |
|
Definition at line 7677 of file util_sparx.cpp. |
|
Definition at line 709 of file util_sparx.cpp. |
|
Definition at line 709 of file util_sparx.cpp. Referenced by EMAN::Util::quadri(), quadri(), and EMAN::Util::quadri_background(). |
|
Definition at line 18835 of file util_sparx.cpp. Referenced by EMAN::Util::addn_img(), EMAN::Util::divn_filter(), EMAN::Util::divn_img(), EMAN::Util::madn_scalar(), EMAN::Util::move_points(), EMAN::Util::muln_img(), EMAN::Util::mult_scalar(), and EMAN::Util::subn_img(). |
|
Definition at line 18834 of file util_sparx.cpp. |
|
|
Definition at line 5263 of file util_sparx.cpp. |
|
Definition at line 5263 of file util_sparx.cpp. Referenced by EMAN::Util::pad(), and EMAN::Util::window(). |
|
Definition at line 6982 of file util_sparx.cpp. Referenced by EMAN::Util::hsortd(), mpi_comm_split(), EMAN::Log::vlog(), EMAN::Util::voronoi(), and EMAN::Util::vrdg(). |
|
Definition at line 6979 of file util_sparx.cpp. |
|
Definition at line 6962 of file util_sparx.cpp. |
|
Definition at line 6963 of file util_sparx.cpp. |
|
Definition at line 5159 of file util_sparx.cpp. Referenced by EMAN::Util::compress_image_mask(), EMAN::Util::decimate(), and EMAN::Util::reconstitute_image_mask(). |
|
|
Definition at line 5158 of file util_sparx.cpp. Referenced by EMAN::Util::decimate(). |
|
Definition at line 5264 of file util_sparx.cpp. |
|
Definition at line 5264 of file util_sparx.cpp. Referenced by EMAN::Util::pad(), and EMAN::Util::window(). |
|
|
Definition at line 4559 of file util_sparx.cpp. |
|
Definition at line 4559 of file util_sparx.cpp. Referenced by EMAN::Util::cml_weights(), EMAN::Util::ener(), EMAN::Util::ener_tot(), EMAN::Util::sub_fav(), and EMAN::Util::update_fav(). |
|
Definition at line 5788 of file util_sparx.cpp. |
|
Definition at line 5788 of file util_sparx.cpp. Referenced by EMAN::Util::WTF(), and EMAN::Util::WTM(). |
|
|
Definition at line 6967 of file util_sparx.cpp. |
|
Definition at line 5592 of file util_sparx.cpp. |
|
Definition at line 5592 of file util_sparx.cpp. |
|
Definition at line 5592 of file util_sparx.cpp. |
|
Definition at line 4561 of file util_sparx.cpp. Referenced by EMAN::Util::cml_line_in3d(), EMAN::Util::cml_line_insino(), and EMAN::Util::cml_line_insino_all(). |
|
Definition at line 6970 of file util_sparx.cpp. |
|
Definition at line 6971 of file util_sparx.cpp. |
|
Definition at line 5790 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 6964 of file util_sparx.cpp. Referenced by EMAN::Processor::EMFourierFilterFunc(), EMAN::nnSSNR_ctfReconstructor::setup(), and EMAN::nn4_ctfReconstructor::setup(). |
|
Definition at line 5789 of file util_sparx.cpp. |
|
Definition at line 5789 of file util_sparx.cpp. |
|
Definition at line 5789 of file util_sparx.cpp. Referenced by EMAN::Util::CANG(), EMAN::Util::WTF(), and EMAN::Util::WTM(). |
|
|
Definition at line 3164 of file util_sparx.cpp. Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi_0_180(), and EMAN::Util::Crosrng_sm_psi(). |
|
Definition at line 2613 of file util_sparx.cpp. Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), and fftr_q(). |
|
|
Definition at line 6981 of file util_sparx.cpp. |
|
Definition at line 6972 of file util_sparx.cpp. |
|
Definition at line 7676 of file util_sparx.cpp. |
|
Definition at line 6980 of file util_sparx.cpp. |
|
Definition at line 5793 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 5794 of file util_sparx.cpp. Referenced by EMAN::Util::WTM(). |
|
Definition at line 5787 of file util_sparx.cpp. |
|
Definition at line 5787 of file util_sparx.cpp. Referenced by EMAN::Util::getBaldwinGridWeights(), EMAN::Util::WTF(), and EMAN::Util::WTM(). |
|
Definition at line 6978 of file util_sparx.cpp. Referenced by ali3d_d(), EMAN::FRCCmp::cmp(), EMAN::BackProjectionReconstructor::insert_slice(), and EMAN::Util::vrdg(). |
|
Definition at line 2614 of file util_sparx.cpp. Referenced by EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), and fftr_q(). |
|
Definition at line 2135 of file util_sparx.cpp. Referenced by EMAN::Util::bilinear(), EMAN::Util::Polar2D(), and EMAN::Util::Polar2Dm(). |
|
Definition at line 8130 of file util_sparx.cpp. References abs, bdyadd_(), covsph_(), intadd_(), lstptr_(), swap_(), swptst_(), and trfind_(). Referenced by trmesh_(), and EMAN::Util::trmsh3_(). 08133 { 08134 /* Initialized data */ 08135 08136 static double tol = 0.; 08137 08138 /* System generated locals */ 08139 int i__1; 08140 08141 /* Local variables */ 08142 static int l; 08143 static double p[3], b1, b2, b3; 08144 static int i1, i2, i3, kk, lp, in1, io1, io2, km1, lpf, ist, lpo1; 08145 extern /* Subroutine */ int swap_(int *, int *, int *, 08146 int *, int *, int *, int *, int *); 08147 static int lpo1s; 08148 extern /* Subroutine */ int bdyadd_(int *, int *, int *, 08149 int *, int *, int *, int *), intadd_(int *, 08150 int *, int *, int *, int *, int *, int *, 08151 int *), trfind_(int *, double *, int *, 08152 double *, double *, double *, int *, int *, 08153 int *, double *, double *, double *, int *, 08154 int *, int *), covsph_(int *, int *, int *, 08155 int *, int *, int *); 08156 extern int lstptr_(int *, int *, int *, int *); 08157 extern long int swptst_(int *, int *, int *, int *, 08158 double *, double *, double *); 08159 08160 08161 /* *********************************************************** */ 08162 08163 /* From STRIPACK */ 08164 /* Robert J. Renka */ 08165 /* Dept. of Computer Science */ 08166 /* Univ. of North Texas */ 08167 /* renka@cs.unt.edu */ 08168 /* 01/08/03 */ 08169 08170 /* This subroutine adds node K to a triangulation of the */ 08171 /* convex hull of nodes 1,...,K-1, producing a triangulation */ 08172 /* of the convex hull of nodes 1,...,K. */ 08173 08174 /* The algorithm consists of the following steps: node K */ 08175 /* is located relative to the triangulation (TRFIND), its */ 08176 /* index is added to the data structure (INTADD or BDYADD), */ 08177 /* and a sequence of swaps (SWPTST and SWAP) are applied to */ 08178 /* the arcs opposite K so that all arcs incident on node K */ 08179 /* and opposite node K are locally optimal (satisfy the cir- */ 08180 /* cumcircle test). Thus, if a Delaunay triangulation is */ 08181 /* input, a Delaunay triangulation will result. */ 08182 08183 08184 /* On input: */ 08185 08186 /* NST = Index of a node at which TRFIND begins its */ 08187 /* search. Search time depends on the proximity */ 08188 /* of this node to K. If NST < 1, the search is */ 08189 /* begun at node K-1. */ 08190 08191 /* K = Nodal index (index for X, Y, Z, and LEND) of the */ 08192 /* new node to be added. K .GE. 4. */ 08193 08194 /* X,Y,Z = Arrays of length .GE. K containing Car- */ 08195 /* tesian coordinates of the nodes. */ 08196 /* (X(I),Y(I),Z(I)) defines node I for */ 08197 /* I = 1,...,K. */ 08198 08199 /* The above parameters are not altered by this routine. */ 08200 08201 /* LIST,LPTR,LEND,LNEW = Data structure associated with */ 08202 /* the triangulation of nodes 1 */ 08203 /* to K-1. The array lengths are */ 08204 /* assumed to be large enough to */ 08205 /* add node K. Refer to Subrou- */ 08206 /* tine TRMESH. */ 08207 08208 /* On output: */ 08209 08210 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 08211 /* the addition of node K as the */ 08212 /* last entry unless IER .NE. 0 */ 08213 /* and IER .NE. -3, in which case */ 08214 /* the arrays are not altered. */ 08215 08216 /* IER = Error indicator: */ 08217 /* IER = 0 if no errors were encountered. */ 08218 /* IER = -1 if K is outside its valid range */ 08219 /* on input. */ 08220 /* IER = -2 if all nodes (including K) are col- */ 08221 /* linear (lie on a common geodesic). */ 08222 /* IER = L if nodes L and K coincide for some */ 08223 /* L < K. Refer to TOL below. */ 08224 08225 /* Modules required by ADDNOD: BDYADD, COVSPH, INSERT, */ 08226 /* INTADD, JRAND, LSTPTR, */ 08227 /* STORE, SWAP, SWPTST, */ 08228 /* TRFIND */ 08229 08230 /* Intrinsic function called by ADDNOD: ABS */ 08231 08232 /* *********************************************************** */ 08233 08234 08235 /* Local parameters: */ 08236 08237 /* B1,B2,B3 = Unnormalized barycentric coordinates returned */ 08238 /* by TRFIND. */ 08239 /* I1,I2,I3 = Vertex indexes of a triangle containing K */ 08240 /* IN1 = Vertex opposite K: first neighbor of IO2 */ 08241 /* that precedes IO1. IN1,IO1,IO2 are in */ 08242 /* counterclockwise order. */ 08243 /* IO1,IO2 = Adjacent neighbors of K defining an arc to */ 08244 /* be tested for a swap */ 08245 /* IST = Index of node at which TRFIND begins its search */ 08246 /* KK = Local copy of K */ 08247 /* KM1 = K-1 */ 08248 /* L = Vertex index (I1, I2, or I3) returned in IER */ 08249 /* if node K coincides with a vertex */ 08250 /* LP = LIST pointer */ 08251 /* LPF = LIST pointer to the first neighbor of K */ 08252 /* LPO1 = LIST pointer to IO1 */ 08253 /* LPO1S = Saved value of LPO1 */ 08254 /* P = Cartesian coordinates of node K */ 08255 /* TOL = Tolerance defining coincident nodes: bound on */ 08256 /* the deviation from 1 of the cosine of the */ 08257 /* angle between the nodes. */ 08258 /* Note that |1-cos(A)| is approximately A*A/2. */ 08259 08260 /* Parameter adjustments */ 08261 --lend; 08262 --z__; 08263 --y; 08264 --x; 08265 --list; 08266 --lptr; 08267 08268 /* Function Body */ 08269 08270 kk = *k; 08271 if (kk < 4) { 08272 goto L3; 08273 } 08274 08275 /* Initialization: */ 08276 km1 = kk - 1; 08277 ist = *nst; 08278 if (ist < 1) { 08279 ist = km1; 08280 } 08281 p[0] = x[kk]; 08282 p[1] = y[kk]; 08283 p[2] = z__[kk]; 08284 08285 /* Find a triangle (I1,I2,I3) containing K or the rightmost */ 08286 /* (I1) and leftmost (I2) visible boundary nodes as viewed */ 08287 /* from node K. */ 08288 trfind_(&ist, p, &km1, &x[1], &y[1], &z__[1], &list[1], &lptr[1], &lend[1] 08289 , &b1, &b2, &b3, &i1, &i2, &i3); 08290 08291 /* Test for collinear or (nearly) duplicate nodes. */ 08292 08293 if (i1 == 0) { 08294 goto L4; 08295 } 08296 l = i1; 08297 if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) { 08298 goto L5; 08299 } 08300 l = i2; 08301 if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) { 08302 goto L5; 08303 } 08304 if (i3 != 0) { 08305 l = i3; 08306 if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) { 08307 goto L5; 08308 } 08309 intadd_(&kk, &i1, &i2, &i3, &list[1], &lptr[1], &lend[1], lnew); 08310 } else { 08311 if (i1 != i2) { 08312 bdyadd_(&kk, &i1, &i2, &list[1], &lptr[1], &lend[1], lnew); 08313 } else { 08314 covsph_(&kk, &i1, &list[1], &lptr[1], &lend[1], lnew); 08315 } 08316 } 08317 *ier = 0; 08318 08319 /* Initialize variables for optimization of the */ 08320 /* triangulation. */ 08321 lp = lend[kk]; 08322 lpf = lptr[lp]; 08323 io2 = list[lpf]; 08324 lpo1 = lptr[lpf]; 08325 io1 = (i__1 = list[lpo1], abs(i__1)); 08326 08327 /* Begin loop: find the node opposite K. */ 08328 08329 L1: 08330 lp = lstptr_(&lend[io1], &io2, &list[1], &lptr[1]); 08331 if (list[lp] < 0) { 08332 goto L2; 08333 } 08334 lp = lptr[lp]; 08335 in1 = (i__1 = list[lp], abs(i__1)); 08336 08337 /* Swap test: if a swap occurs, two new arcs are */ 08338 /* opposite K and must be tested. */ 08339 08340 lpo1s = lpo1; 08341 if (! swptst_(&in1, &kk, &io1, &io2, &x[1], &y[1], &z__[1])) { 08342 goto L2; 08343 } 08344 swap_(&in1, &kk, &io1, &io2, &list[1], &lptr[1], &lend[1], &lpo1); 08345 if (lpo1 == 0) { 08346 08347 /* A swap is not possible because KK and IN1 are already */ 08348 /* adjacent. This error in SWPTST only occurs in the */ 08349 /* neutral case and when there are nearly duplicate */ 08350 /* nodes. */ 08351 08352 lpo1 = lpo1s; 08353 goto L2; 08354 } 08355 io1 = in1; 08356 goto L1; 08357 08358 /* No swap occurred. Test for termination and reset */ 08359 /* IO2 and IO1. */ 08360 08361 L2: 08362 if (lpo1 == lpf || list[lpo1] < 0) { 08363 return 0; 08364 } 08365 io2 = io1; 08366 lpo1 = lptr[lpo1]; 08367 io1 = (i__1 = list[lpo1], abs(i__1)); 08368 goto L1; 08369 08370 /* KK < 4. */ 08371 08372 L3: 08373 *ier = -1; 08374 return 0; 08375 08376 /* All nodes are collinear. */ 08377 08378 L4: 08379 *ier = -2; 08380 return 0; 08381 08382 /* Nodes L and K coincide. */ 08383 08384 L5: 08385 *ier = l; 08386 return 0; 08387 } /* addnod_ */
|
|
Definition at line 8389 of file util_sparx.cpp. References left_(), and sqrt(). Referenced by areav_new__(). 08390 { 08391 /* System generated locals */ 08392 double ret_val; 08393 08394 /* Builtin functions */ 08395 //double sqrt(double), acos(double); 08396 08397 /* Local variables */ 08398 static double a; 08399 static int i__; 08400 static double ca, s21, s23, u21[3], u23[3]; 08401 extern long int left_(double *, double *, double *, double 08402 *, double *, double *, double *, double *, 08403 double *); 08404 08405 08406 /* *********************************************************** */ 08407 08408 /* From STRIPACK */ 08409 /* Robert J. Renka */ 08410 /* Dept. of Computer Science */ 08411 /* Univ. of North Texas */ 08412 /* renka@cs.unt.edu */ 08413 /* 06/03/03 */ 08414 08415 /* Given a sequence of three nodes (V1,V2,V3) on the sur- */ 08416 /* face of the unit sphere, this function returns the */ 08417 /* interior angle at V2 -- the dihedral angle between the */ 08418 /* plane defined by V2 and V3 (and the origin) and the plane */ 08419 /* defined by V2 and V1 or, equivalently, the angle between */ 08420 /* the normals V2 X V3 and V2 X V1. Note that the angle is */ 08421 /* in the range 0 to Pi if V3 Left V1->V2, Pi to 2*Pi other- */ 08422 /* wise. The surface area of a spherical polygon with CCW- */ 08423 /* ordered vertices V1, V2, ..., Vm is Asum - (m-2)*Pi, where */ 08424 /* Asum is the sum of the m interior angles computed from the */ 08425 /* sequences (Vm,V1,V2), (V1,V2,V3), (V2,V3,V4), ..., */ 08426 /* (Vm-1,Vm,V1). */ 08427 08428 08429 /* On input: */ 08430 08431 /* V1,V2,V3 = Arrays of length 3 containing the Carte- */ 08432 /* sian coordinates of unit vectors. These */ 08433 /* vectors, if nonzero, are implicitly */ 08434 /* scaled to have length 1. */ 08435 08436 /* Input parameters are not altered by this function. */ 08437 08438 /* On output: */ 08439 08440 /* ANGLE = Angle defined above, or 0 if V2 X V1 = 0 or */ 08441 /* V2 X V3 = 0. */ 08442 08443 /* Module required by ANGLE: LEFT */ 08444 08445 /* Intrinsic functions called by ANGLE: ACOS, SQRT */ 08446 08447 /* *********************************************************** */ 08448 08449 08450 /* Local parameters: */ 08451 08452 /* A = Interior angle at V2 */ 08453 /* CA = cos(A) */ 08454 /* I = DO-loop index and index for U21 and U23 */ 08455 /* S21,S23 = Sum of squared components of U21 and U23 */ 08456 /* U21,U23 = Unit normal vectors to the planes defined by */ 08457 /* pairs of triangle vertices */ 08458 08459 08460 /* Compute cross products U21 = V2 X V1 and U23 = V2 X V3. */ 08461 08462 /* Parameter adjustments */ 08463 --v3; 08464 --v2; 08465 --v1; 08466 08467 /* Function Body */ 08468 u21[0] = v2[2] * v1[3] - v2[3] * v1[2]; 08469 u21[1] = v2[3] * v1[1] - v2[1] * v1[3]; 08470 u21[2] = v2[1] * v1[2] - v2[2] * v1[1]; 08471 08472 u23[0] = v2[2] * v3[3] - v2[3] * v3[2]; 08473 u23[1] = v2[3] * v3[1] - v2[1] * v3[3]; 08474 u23[2] = v2[1] * v3[2] - v2[2] * v3[1]; 08475 08476 /* Normalize U21 and U23 to unit vectors. */ 08477 08478 s21 = 0.; 08479 s23 = 0.; 08480 for (i__ = 1; i__ <= 3; ++i__) { 08481 s21 += u21[i__ - 1] * u21[i__ - 1]; 08482 s23 += u23[i__ - 1] * u23[i__ - 1]; 08483 /* L1: */ 08484 } 08485 08486 /* Test for a degenerate triangle associated with collinear */ 08487 /* vertices. */ 08488 08489 if (s21 == 0. || s23 == 0.) { 08490 ret_val = 0.; 08491 return ret_val; 08492 } 08493 s21 = sqrt(s21); 08494 s23 = sqrt(s23); 08495 for (i__ = 1; i__ <= 3; ++i__) { 08496 u21[i__ - 1] /= s21; 08497 u23[i__ - 1] /= s23; 08498 /* L2: */ 08499 } 08500 08501 /* Compute the angle A between normals: */ 08502 08503 /* CA = cos(A) = <U21,U23> */ 08504 08505 ca = u21[0] * u23[0] + u21[1] * u23[1] + u21[2] * u23[2]; 08506 if (ca < -1.) { 08507 ca = -1.; 08508 } 08509 if (ca > 1.) { 08510 ca = 1.; 08511 } 08512 a = acos(ca); 08513 08514 /* Adjust A to the interior angle: A > Pi iff */ 08515 /* V3 Right V1->V2. */ 08516 08517 if (! left_(&v1[1], &v1[2], &v1[3], &v2[1], &v2[2], &v2[3], &v3[1], &v3[2] 08518 , &v3[3])) { 08519 a = acos(-1.) * 2. - a; 08520 } 08521 ret_val = a; 08522 return ret_val; 08523 } /* angle_ */
|
|
Definition at line 8525 of file util_sparx.cpp. References sqrt(). Referenced by EMAN::Util::areav_(). 08526 { 08527 /* System generated locals */ 08528 double ret_val; 08529 08530 /* Builtin functions */ 08531 //double sqrt(double), acos(double); 08532 08533 /* Local variables */ 08534 static int i__; 08535 static double a1, a2, a3, s12, s31, s23, u12[3], u23[3], u31[3], ca1, 08536 ca2, ca3; 08537 08538 08539 /* *********************************************************** */ 08540 08541 /* From STRIPACK */ 08542 /* Robert J. Renka */ 08543 /* Dept. of Computer Science */ 08544 /* Univ. of North Texas */ 08545 /* renka@cs.unt.edu */ 08546 /* 06/22/98 */ 08547 08548 /* This function returns the area of a spherical triangle */ 08549 /* on the unit sphere. */ 08550 08551 08552 /* On input: */ 08553 08554 /* V1,V2,V3 = Arrays of length 3 containing the Carte- */ 08555 /* sian coordinates of unit vectors (the */ 08556 /* three triangle vertices in any order). */ 08557 /* These vectors, if nonzero, are implicitly */ 08558 /* scaled to have length 1. */ 08559 08560 /* Input parameters are not altered by this function. */ 08561 08562 /* On output: */ 08563 08564 /* AREAS = Area of the spherical triangle defined by */ 08565 /* V1, V2, and V3 in the range 0 to 2*PI (the */ 08566 /* area of a hemisphere). AREAS = 0 (or 2*PI) */ 08567 /* if and only if V1, V2, and V3 lie in (or */ 08568 /* close to) a plane containing the origin. */ 08569 08570 /* Modules required by AREAS: None */ 08571 08572 /* Intrinsic functions called by AREAS: ACOS, SQRT */ 08573 08574 /* *********************************************************** */ 08575 08576 08577 /* Local parameters: */ 08578 08579 /* A1,A2,A3 = Interior angles of the spherical triangle */ 08580 /* CA1,CA2,CA3 = cos(A1), cos(A2), and cos(A3), respectively */ 08581 /* I = DO-loop index and index for Uij */ 08582 /* S12,S23,S31 = Sum of squared components of U12, U23, U31 */ 08583 /* U12,U23,U31 = Unit normal vectors to the planes defined by */ 08584 /* pairs of triangle vertices */ 08585 08586 08587 /* Compute cross products Uij = Vi X Vj. */ 08588 08589 /* Parameter adjustments */ 08590 --v3; 08591 --v2; 08592 --v1; 08593 08594 /* Function Body */ 08595 u12[0] = v1[2] * v2[3] - v1[3] * v2[2]; 08596 u12[1] = v1[3] * v2[1] - v1[1] * v2[3]; 08597 u12[2] = v1[1] * v2[2] - v1[2] * v2[1]; 08598 08599 u23[0] = v2[2] * v3[3] - v2[3] * v3[2]; 08600 u23[1] = v2[3] * v3[1] - v2[1] * v3[3]; 08601 u23[2] = v2[1] * v3[2] - v2[2] * v3[1]; 08602 08603 u31[0] = v3[2] * v1[3] - v3[3] * v1[2]; 08604 u31[1] = v3[3] * v1[1] - v3[1] * v1[3]; 08605 u31[2] = v3[1] * v1[2] - v3[2] * v1[1]; 08606 08607 /* Normalize Uij to unit vectors. */ 08608 08609 s12 = 0.; 08610 s23 = 0.; 08611 s31 = 0.; 08612 for (i__ = 1; i__ <= 3; ++i__) { 08613 s12 += u12[i__ - 1] * u12[i__ - 1]; 08614 s23 += u23[i__ - 1] * u23[i__ - 1]; 08615 s31 += u31[i__ - 1] * u31[i__ - 1]; 08616 /* L2: */ 08617 } 08618 08619 /* Test for a degenerate triangle associated with collinear */ 08620 /* vertices. */ 08621 08622 if (s12 == 0. || s23 == 0. || s31 == 0.) { 08623 ret_val = 0.; 08624 return ret_val; 08625 } 08626 s12 = sqrt(s12); 08627 s23 = sqrt(s23); 08628 s31 = sqrt(s31); 08629 for (i__ = 1; i__ <= 3; ++i__) { 08630 u12[i__ - 1] /= s12; 08631 u23[i__ - 1] /= s23; 08632 u31[i__ - 1] /= s31; 08633 /* L3: */ 08634 } 08635 08636 /* Compute interior angles Ai as the dihedral angles between */ 08637 /* planes: */ 08638 /* CA1 = cos(A1) = -<U12,U31> */ 08639 /* CA2 = cos(A2) = -<U23,U12> */ 08640 /* CA3 = cos(A3) = -<U31,U23> */ 08641 08642 ca1 = -u12[0] * u31[0] - u12[1] * u31[1] - u12[2] * u31[2]; 08643 ca2 = -u23[0] * u12[0] - u23[1] * u12[1] - u23[2] * u12[2]; 08644 ca3 = -u31[0] * u23[0] - u31[1] * u23[1] - u31[2] * u23[2]; 08645 if (ca1 < -1.) { 08646 ca1 = -1.; 08647 } 08648 if (ca1 > 1.) { 08649 ca1 = 1.; 08650 } 08651 if (ca2 < -1.) { 08652 ca2 = -1.; 08653 } 08654 if (ca2 > 1.) { 08655 ca2 = 1.; 08656 } 08657 if (ca3 < -1.) { 08658 ca3 = -1.; 08659 } 08660 if (ca3 > 1.) { 08661 ca3 = 1.; 08662 } 08663 a1 = acos(ca1); 08664 a2 = acos(ca2); 08665 a3 = acos(ca3); 08666 08667 /* Compute AREAS = A1 + A2 + A3 - PI. */ 08668 08669 ret_val = a1 + a2 + a3 - acos(-1.); 08670 if (ret_val < 0.) { 08671 ret_val = 0.; 08672 } 08673 return ret_val; 08674 } /* areas_ */
|
|
Definition at line 8880 of file util_sparx.cpp. References angle_(), circum_(), and ierr. 08883 { 08884 /* System generated locals */ 08885 double ret_val = 0; 08886 08887 /* Builtin functions */ 08888 //double acos(double); 08889 08890 /* Local variables */ 08891 static int m; 08892 static double c1[3], c2[3], c3[3]; 08893 static int n1, n2, n3; 08894 static double v1[3], v2[3], v3[3]; 08895 static int lp; 08896 static double c1s[3], c2s[3]; 08897 static int lpl, ierr; 08898 static double asum; 08899 extern double angle_(double *, double *, double *); 08900 static float areav; 08901 extern /* Subroutine */ int circum_(double *, double *, 08902 double *, double *, int *); 08903 08904 08905 /* *********************************************************** */ 08906 08907 /* Robert J. Renka */ 08908 /* Dept. of Computer Science */ 08909 /* Univ. of North Texas */ 08910 /* renka@cs.unt.edu */ 08911 /* 06/03/03 */ 08912 08913 /* Given a Delaunay triangulation and the index K of an */ 08914 /* interior node, this subroutine returns the (surface) area */ 08915 /* of the Voronoi region associated with node K. The Voronoi */ 08916 /* region is the polygon whose vertices are the circumcenters */ 08917 /* of the triangles that contain node K, where a triangle */ 08918 /* circumcenter is the point (unit vector) lying at the same */ 08919 /* angular distance from the three vertices and contained in */ 08920 /* the same hemisphere as the vertices. The Voronoi region */ 08921 /* area is computed as Asum-(m-2)*Pi, where m is the number */ 08922 /* of Voronoi vertices (neighbors of K) and Asum is the sum */ 08923 /* of interior angles at the vertices. */ 08924 08925 08926 /* On input: */ 08927 08928 /* K = Nodal index in the range 1 to N. */ 08929 08930 /* N = Number of nodes in the triangulation. N > 3. */ 08931 08932 /* X,Y,Z = Arrays of length N containing the Cartesian */ 08933 /* coordinates of the nodes (unit vectors). */ 08934 08935 /* LIST,LPTR,LEND = Data structure defining the trian- */ 08936 /* gulation. Refer to Subroutine */ 08937 /* TRMESH. */ 08938 08939 /* Input parameters are not altered by this function. */ 08940 08941 /* On output: */ 08942 08943 /* AREAV = Area of Voronoi region K unless IER > 0, */ 08944 /* in which case AREAV = 0. */ 08945 08946 /* IER = Error indicator: */ 08947 /* IER = 0 if no errors were encountered. */ 08948 /* IER = 1 if K or N is outside its valid range */ 08949 /* on input. */ 08950 /* IER = 2 if K indexes a boundary node. */ 08951 /* IER = 3 if an error flag is returned by CIRCUM */ 08952 /* (null triangle). */ 08953 08954 /* Modules required by AREAV: ANGLE, CIRCUM */ 08955 08956 /* Intrinsic functions called by AREAV: ACOS, DBLE */ 08957 08958 /* *********************************************************** */ 08959 08960 08961 /* Test for invalid input. */ 08962 08963 /* Parameter adjustments */ 08964 --lend; 08965 --z__; 08966 --y; 08967 --x; 08968 --list; 08969 --lptr; 08970 08971 /* Function Body */ 08972 if (*k < 1 || *k > *n || *n <= 3) { 08973 goto L11; 08974 } 08975 08976 /* Initialization: Set N3 to the last neighbor of N1 = K. */ 08977 /* The number of neighbors and the sum of interior angles */ 08978 /* are accumulated in M and ASUM, respectively. */ 08979 08980 n1 = *k; 08981 v1[0] = x[n1]; 08982 v1[1] = y[n1]; 08983 v1[2] = z__[n1]; 08984 lpl = lend[n1]; 08985 n3 = list[lpl]; 08986 if (n3 < 0) { 08987 goto L12; 08988 } 08989 lp = lpl; 08990 m = 0; 08991 asum = 0.; 08992 08993 /* Loop on triangles (N1,N2,N3) containing N1 = K. */ 08994 08995 L1: 08996 ++m; 08997 n2 = n3; 08998 lp = lptr[lp]; 08999 n3 = list[lp]; 09000 v2[0] = x[n2]; 09001 v2[1] = y[n2]; 09002 v2[2] = z__[n2]; 09003 v3[0] = x[n3]; 09004 v3[1] = y[n3]; 09005 v3[2] = z__[n3]; 09006 if (m == 1) { 09007 09008 /* First triangle: compute the circumcenter C2 and save a */ 09009 /* copy in C1S. */ 09010 09011 circum_(v1, v2, v3, c2, &ierr); 09012 if (ierr != 0) { 09013 goto L13; 09014 } 09015 c1s[0] = c2[0]; 09016 c1s[1] = c2[1]; 09017 c1s[2] = c2[2]; 09018 } else if (m == 2) { 09019 09020 /* Second triangle: compute the circumcenter C3 and save a */ 09021 /* copy in C2S. */ 09022 09023 circum_(v1, v2, v3, c3, &ierr); 09024 if (ierr != 0) { 09025 goto L13; 09026 } 09027 c2s[0] = c3[0]; 09028 c2s[1] = c3[1]; 09029 c2s[2] = c3[2]; 09030 } else { 09031 09032 /* Set C1 to C2, set C2 to C3, compute the new circumcenter */ 09033 /* C3, and compute the interior angle at C2 from the */ 09034 /* sequence of vertices (C1,C2,C3). */ 09035 09036 c1[0] = c2[0]; 09037 c1[1] = c2[1]; 09038 c1[2] = c2[2]; 09039 c2[0] = c3[0]; 09040 c2[1] = c3[1]; 09041 c2[2] = c3[2]; 09042 circum_(v1, v2, v3, c3, &ierr); 09043 if (ierr != 0) { 09044 goto L13; 09045 } 09046 asum += angle_(c1, c2, c3); 09047 } 09048 09049 /* Bottom on loop on neighbors of K. */ 09050 09051 if (lp != lpl) { 09052 goto L1; 09053 } 09054 09055 /* C3 is the last vertex. Compute its interior angle from */ 09056 /* the sequence (C2,C3,C1S). */ 09057 09058 asum += angle_(c2, c3, c1s); 09059 09060 /* Compute the interior angle at C1S from */ 09061 /* the sequence (C3,C1S,C2S). */ 09062 09063 asum += angle_(c3, c1s, c2s); 09064 09065 /* No error encountered. */ 09066 09067 *ier = 0; 09068 ret_val = asum - (double) (m - 2) * acos(-1.); 09069 return ret_val; 09070 09071 /* Invalid input. */ 09072 09073 L11: 09074 *ier = 1; 09075 areav = 0.f; 09076 return ret_val; 09077 09078 /* K indexes a boundary node. */ 09079 09080 L12: 09081 *ier = 2; 09082 areav = 0.f; 09083 return ret_val; 09084 09085 /* Error in CIRCUM. */ 09086 09087 L13: 09088 *ier = 3; 09089 areav = 0.f; 09090 return ret_val; 09091 } /* areav_new__ */
|
|
Definition at line 9093 of file util_sparx.cpp. References insert_(). Referenced by addnod_(). 09095 { 09096 static int k, n1, n2, lp, lsav, nsav, next; 09097 extern /* Subroutine */ int insert_(int *, int *, int *, 09098 int *, int *); 09099 09100 09101 /* *********************************************************** */ 09102 09103 /* From STRIPACK */ 09104 /* Robert J. Renka */ 09105 /* Dept. of Computer Science */ 09106 /* Univ. of North Texas */ 09107 /* renka@cs.unt.edu */ 09108 /* 07/11/96 */ 09109 09110 /* This subroutine adds a boundary node to a triangulation */ 09111 /* of a set of KK-1 points on the unit sphere. The data */ 09112 /* structure is updated with the insertion of node KK, but no */ 09113 /* optimization is performed. */ 09114 09115 /* This routine is identical to the similarly named routine */ 09116 /* in TRIPACK. */ 09117 09118 09119 /* On input: */ 09120 09121 /* KK = Index of a node to be connected to the sequence */ 09122 /* of all visible boundary nodes. KK .GE. 1 and */ 09123 /* KK must not be equal to I1 or I2. */ 09124 09125 /* I1 = First (rightmost as viewed from KK) boundary */ 09126 /* node in the triangulation that is visible from */ 09127 /* node KK (the line segment KK-I1 intersects no */ 09128 /* arcs. */ 09129 09130 /* I2 = Last (leftmost) boundary node that is visible */ 09131 /* from node KK. I1 and I2 may be determined by */ 09132 /* Subroutine TRFIND. */ 09133 09134 /* The above parameters are not altered by this routine. */ 09135 09136 /* LIST,LPTR,LEND,LNEW = Triangulation data structure */ 09137 /* created by Subroutine TRMESH. */ 09138 /* Nodes I1 and I2 must be in- */ 09139 /* cluded in the triangulation. */ 09140 09141 /* On output: */ 09142 09143 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 09144 /* the addition of node KK. Node */ 09145 /* KK is connected to I1, I2, and */ 09146 /* all boundary nodes in between. */ 09147 09148 /* Module required by BDYADD: INSERT */ 09149 09150 /* *********************************************************** */ 09151 09152 09153 /* Local parameters: */ 09154 09155 /* K = Local copy of KK */ 09156 /* LP = LIST pointer */ 09157 /* LSAV = LIST pointer */ 09158 /* N1,N2 = Local copies of I1 and I2, respectively */ 09159 /* NEXT = Boundary node visible from K */ 09160 /* NSAV = Boundary node visible from K */ 09161 09162 /* Parameter adjustments */ 09163 --lend; 09164 --lptr; 09165 --list; 09166 09167 /* Function Body */ 09168 k = *kk; 09169 n1 = *i1; 09170 n2 = *i2; 09171 09172 /* Add K as the last neighbor of N1. */ 09173 09174 lp = lend[n1]; 09175 lsav = lptr[lp]; 09176 lptr[lp] = *lnew; 09177 list[*lnew] = -k; 09178 lptr[*lnew] = lsav; 09179 lend[n1] = *lnew; 09180 ++(*lnew); 09181 next = -list[lp]; 09182 list[lp] = next; 09183 nsav = next; 09184 09185 /* Loop on the remaining boundary nodes between N1 and N2, */ 09186 /* adding K as the first neighbor. */ 09187 09188 L1: 09189 lp = lend[next]; 09190 insert_(&k, &lp, &list[1], &lptr[1], lnew); 09191 if (next == n2) { 09192 goto L2; 09193 } 09194 next = -list[lp]; 09195 list[lp] = next; 09196 goto L1; 09197 09198 /* Add the boundary nodes between N1 and N2 as neighbors */ 09199 /* of node K. */ 09200 09201 L2: 09202 lsav = *lnew; 09203 list[*lnew] = n1; 09204 lptr[*lnew] = *lnew + 1; 09205 ++(*lnew); 09206 next = nsav; 09207 09208 L3: 09209 if (next == n2) { 09210 goto L4; 09211 } 09212 list[*lnew] = next; 09213 lptr[*lnew] = *lnew + 1; 09214 ++(*lnew); 09215 lp = lend[next]; 09216 next = list[lp]; 09217 goto L3; 09218 09219 L4: 09220 list[*lnew] = -n2; 09221 lptr[*lnew] = lsav; 09222 lend[k] = *lnew; 09223 ++(*lnew); 09224 return 0; 09225 } /* bdyadd_ */
|
|
Definition at line 9227 of file util_sparx.cpp. References nn(). 09229 { 09230 /* System generated locals */ 09231 int i__1; 09232 09233 /* Local variables */ 09234 static int k, n0, lp, nn, nst; 09235 09236 09237 /* *********************************************************** */ 09238 09239 /* From STRIPACK */ 09240 /* Robert J. Renka */ 09241 /* Dept. of Computer Science */ 09242 /* Univ. of North Texas */ 09243 /* renka@cs.unt.edu */ 09244 /* 06/26/96 */ 09245 09246 /* Given a triangulation of N nodes on the unit sphere */ 09247 /* created by Subroutine TRMESH, this subroutine returns an */ 09248 /* array containing the indexes (if any) of the counterclock- */ 09249 /* wise-ordered sequence of boundary nodes -- the nodes on */ 09250 /* the boundary of the convex hull of the set of nodes. (The */ 09251 /* boundary is empty if the nodes do not lie in a single */ 09252 /* hemisphere.) The numbers of boundary nodes, arcs, and */ 09253 /* triangles are also returned. */ 09254 09255 09256 /* On input: */ 09257 09258 /* N = Number of nodes in the triangulation. N .GE. 3. */ 09259 09260 /* LIST,LPTR,LEND = Data structure defining the trian- */ 09261 /* gulation. Refer to Subroutine */ 09262 /* TRMESH. */ 09263 09264 /* The above parameters are not altered by this routine. */ 09265 09266 /* NODES = int array of length at least NB */ 09267 /* (NB .LE. N). */ 09268 09269 /* On output: */ 09270 09271 /* NODES = Ordered sequence of boundary node indexes */ 09272 /* in the range 1 to N (in the first NB loca- */ 09273 /* tions). */ 09274 09275 /* NB = Number of boundary nodes. */ 09276 09277 /* NA,NT = Number of arcs and triangles, respectively, */ 09278 /* in the triangulation. */ 09279 09280 /* Modules required by BNODES: None */ 09281 09282 /* *********************************************************** */ 09283 09284 09285 /* Local parameters: */ 09286 09287 /* K = NODES index */ 09288 /* LP = LIST pointer */ 09289 /* N0 = Boundary node to be added to NODES */ 09290 /* NN = Local copy of N */ 09291 /* NST = First element of nodes (arbitrarily chosen to be */ 09292 /* the one with smallest index) */ 09293 09294 /* Parameter adjustments */ 09295 --lend; 09296 --list; 09297 --lptr; 09298 --nodes; 09299 09300 /* Function Body */ 09301 nn = *n; 09302 09303 /* Search for a boundary node. */ 09304 09305 i__1 = nn; 09306 for (nst = 1; nst <= i__1; ++nst) { 09307 lp = lend[nst]; 09308 if (list[lp] < 0) { 09309 goto L2; 09310 } 09311 /* L1: */ 09312 } 09313 09314 /* The triangulation contains no boundary nodes. */ 09315 09316 *nb = 0; 09317 *na = (nn - 2) * 3; 09318 *nt = nn - (2<<1); 09319 return 0; 09320 09321 /* NST is the first boundary node encountered. Initialize */ 09322 /* for traversal of the boundary. */ 09323 09324 L2: 09325 nodes[1] = nst; 09326 k = 1; 09327 n0 = nst; 09328 09329 /* Traverse the boundary in counterclockwise order. */ 09330 09331 L3: 09332 lp = lend[n0]; 09333 lp = lptr[lp]; 09334 n0 = list[lp]; 09335 if (n0 == nst) { 09336 goto L4; 09337 } 09338 ++k; 09339 nodes[k] = n0; 09340 goto L3; 09341 09342 /* Store the counts. */ 09343 09344 L4: 09345 *nb = k; 09346 *nt = (*n << 1) - *nb - 2; 09347 *na = *nt + *n - 1; 09348 return 0; 09349 } /* bnodes_ */
|
|
Definition at line 9351 of file util_sparx.cpp. 09353 { 09354 /* System generated locals */ 09355 int i__1; 09356 09357 /* Builtin functions */ 09358 //double atan(double), cos(double), sin(double); 09359 09360 /* Local variables */ 09361 static double a, c__; 09362 static int i__; 09363 static double s; 09364 static int k2, k3; 09365 static double x0, y0; 09366 static int kk, np1; 09367 09368 09369 /* *********************************************************** */ 09370 09371 /* From STRIPACK */ 09372 /* Robert J. Renka */ 09373 /* Dept. of Computer Science */ 09374 /* Univ. of North Texas */ 09375 /* renka@cs.unt.edu */ 09376 /* 04/06/90 */ 09377 09378 /* This subroutine computes the coordinates of a sequence */ 09379 /* of N equally spaced points on the unit circle centered at */ 09380 /* (0,0). An N-sided polygonal approximation to the circle */ 09381 /* may be plotted by connecting (XC(I),YC(I)) to (XC(I+1), */ 09382 /* YC(I+1)) for I = 1,...,N, where XC(N+1) = XC(1) and */ 09383 /* YC(N+1) = YC(1). A reasonable value for N in this case */ 09384 /* is 2*PI*R, where R is the radius of the circle in device */ 09385 /* coordinates. */ 09386 09387 09388 /* On input: */ 09389 09390 /* K = Number of points in each quadrant, defining N as */ 09391 /* 4K. K .GE. 1. */ 09392 09393 /* XC,YC = Arrays of length at least N+1 = 4K+1. */ 09394 09395 /* K is not altered by this routine. */ 09396 09397 /* On output: */ 09398 09399 /* XC,YC = Cartesian coordinates of the points on the */ 09400 /* unit circle in the first N+1 locations. */ 09401 /* XC(I) = cos(A*(I-1)), YC(I) = sin(A*(I-1)), */ 09402 /* where A = 2*PI/N. Note that XC(N+1) = XC(1) */ 09403 /* and YC(N+1) = YC(1). */ 09404 09405 /* IER = Error indicator: */ 09406 /* IER = 0 if no errors were encountered. */ 09407 /* IER = 1 if K < 1 on input. */ 09408 09409 /* Modules required by CIRCLE: None */ 09410 09411 /* Intrinsic functions called by CIRCLE: ATAN, COS, DBLE, */ 09412 /* SIN */ 09413 09414 /* *********************************************************** */ 09415 09416 09417 /* Local parameters: */ 09418 09419 /* I = DO-loop index and index for XC and YC */ 09420 /* KK = Local copy of K */ 09421 /* K2 = K*2 */ 09422 /* K3 = K*3 */ 09423 /* NP1 = N+1 = 4*K + 1 */ 09424 /* A = Angular separation between adjacent points */ 09425 /* C,S = Cos(A) and sin(A), respectively, defining a */ 09426 /* rotation through angle A */ 09427 /* X0,Y0 = Cartesian coordinates of a point on the unit */ 09428 /* circle in the first quadrant */ 09429 09430 /* Parameter adjustments */ 09431 --yc; 09432 --xc; 09433 09434 /* Function Body */ 09435 kk = *k; 09436 k2 = kk << 1; 09437 k3 = kk * 3; 09438 np1 = (kk << 2) + 1; 09439 09440 /* Test for invalid input, compute A, C, and S, and */ 09441 /* initialize (X0,Y0) to (1,0). */ 09442 09443 if (kk < 1) { 09444 goto L2; 09445 } 09446 a = atan(1.) * 2. / (double) kk; 09447 c__ = cos(a); 09448 s = sin(a); 09449 x0 = 1.; 09450 y0 = 0.; 09451 09452 /* Loop on points (X0,Y0) in the first quadrant, storing */ 09453 /* the point and its reflections about the x axis, the */ 09454 /* y axis, and the line y = -x. */ 09455 09456 i__1 = kk; 09457 for (i__ = 1; i__ <= i__1; ++i__) { 09458 xc[i__] = x0; 09459 yc[i__] = y0; 09460 xc[i__ + kk] = -y0; 09461 yc[i__ + kk] = x0; 09462 xc[i__ + k2] = -x0; 09463 yc[i__ + k2] = -y0; 09464 xc[i__ + k3] = y0; 09465 yc[i__ + k3] = -x0; 09466 09467 /* Rotate (X0,Y0) counterclockwise through angle A. */ 09468 09469 x0 = c__ * x0 - s * y0; 09470 y0 = s * x0 + c__ * y0; 09471 /* L1: */ 09472 } 09473 09474 /* Store the coordinates of the first point as the last */ 09475 /* point. */ 09476 09477 xc[np1] = xc[1]; 09478 yc[np1] = yc[1]; 09479 *ier = 0; 09480 return 0; 09481 09482 /* K < 1. */ 09483 09484 L2: 09485 *ier = 1; 09486 return 0; 09487 } /* circle_ */
|
|
Definition at line 9489 of file util_sparx.cpp. References sqrt(). Referenced by EMAN::Util::areav_(), areav_new__(), and crlist_(). 09491 { 09492 /* Builtin functions */ 09493 //double sqrt(double); 09494 09495 /* Local variables */ 09496 static int i__; 09497 static double e1[3], e2[3], cu[3], cnorm; 09498 09499 09500 /* *********************************************************** */ 09501 09502 /* From STRIPACK */ 09503 /* Robert J. Renka */ 09504 /* Dept. of Computer Science */ 09505 /* Univ. of North Texas */ 09506 /* renka@cs.unt.edu */ 09507 /* 10/27/02 */ 09508 09509 /* This subroutine returns the circumcenter of a spherical */ 09510 /* triangle on the unit sphere: the point on the sphere sur- */ 09511 /* face that is equally distant from the three triangle */ 09512 /* vertices and lies in the same hemisphere, where distance */ 09513 /* is taken to be arc-length on the sphere surface. */ 09514 09515 09516 /* On input: */ 09517 09518 /* V1,V2,V3 = Arrays of length 3 containing the Carte- */ 09519 /* sian coordinates of the three triangle */ 09520 /* vertices (unit vectors) in CCW order. */ 09521 09522 /* The above parameters are not altered by this routine. */ 09523 09524 /* C = Array of length 3. */ 09525 09526 /* On output: */ 09527 09528 /* C = Cartesian coordinates of the circumcenter unless */ 09529 /* IER > 0, in which case C is not defined. C = */ 09530 /* (V2-V1) X (V3-V1) normalized to a unit vector. */ 09531 09532 /* IER = Error indicator: */ 09533 /* IER = 0 if no errors were encountered. */ 09534 /* IER = 1 if V1, V2, and V3 lie on a common */ 09535 /* line: (V2-V1) X (V3-V1) = 0. */ 09536 /* (The vertices are not tested for validity.) */ 09537 09538 /* Modules required by CIRCUM: None */ 09539 09540 /* Intrinsic function called by CIRCUM: SQRT */ 09541 09542 /* *********************************************************** */ 09543 09544 09545 /* Local parameters: */ 09546 09547 /* CNORM = Norm of CU: used to compute C */ 09548 /* CU = Scalar multiple of C: E1 X E2 */ 09549 /* E1,E2 = Edges of the underlying planar triangle: */ 09550 /* V2-V1 and V3-V1, respectively */ 09551 /* I = DO-loop index */ 09552 09553 /* Parameter adjustments */ 09554 --c__; 09555 --v3; 09556 --v2; 09557 --v1; 09558 09559 /* Function Body */ 09560 for (i__ = 1; i__ <= 3; ++i__) { 09561 e1[i__ - 1] = v2[i__] - v1[i__]; 09562 e2[i__ - 1] = v3[i__] - v1[i__]; 09563 /* L1: */ 09564 } 09565 09566 /* Compute CU = E1 X E2 and CNORM**2. */ 09567 09568 cu[0] = e1[1] * e2[2] - e1[2] * e2[1]; 09569 cu[1] = e1[2] * e2[0] - e1[0] * e2[2]; 09570 cu[2] = e1[0] * e2[1] - e1[1] * e2[0]; 09571 cnorm = cu[0] * cu[0] + cu[1] * cu[1] + cu[2] * cu[2]; 09572 09573 /* The vertices lie on a common line if and only if CU is */ 09574 /* the zero vector. */ 09575 09576 if (cnorm != 0.) { 09577 09578 /* No error: compute C. */ 09579 09580 cnorm = sqrt(cnorm); 09581 for (i__ = 1; i__ <= 3; ++i__) { 09582 c__[i__] = cu[i__ - 1] / cnorm; 09583 /* L2: */ 09584 } 09585 09586 /* If the vertices are nearly identical, the problem is */ 09587 /* ill-conditioned and it is possible for the computed */ 09588 /* value of C to be 180 degrees off: <C,V1> near -1 */ 09589 /* when it should be positive. */ 09590 09591 if (c__[1] * v1[1] + c__[2] * v1[2] + c__[3] * v1[3] < -.5) { 09592 c__[1] = -c__[1]; 09593 c__[2] = -c__[2]; 09594 c__[3] = -c__[3]; 09595 } 09596 *ier = 0; 09597 } else { 09598 09599 /* CU = 0. */ 09600 09601 *ier = 1; 09602 } 09603 return 0; 09604 } /* circum_ */
|
|
Definition at line 9606 of file util_sparx.cpp. References insert_(). Referenced by addnod_(). 09608 { 09609 static int k, lp, nst, lsav, next; 09610 extern /* Subroutine */ int insert_(int *, int *, int *, 09611 int *, int *); 09612 09613 09614 /* *********************************************************** */ 09615 09616 /* From STRIPACK */ 09617 /* Robert J. Renka */ 09618 /* Dept. of Computer Science */ 09619 /* Univ. of North Texas */ 09620 /* renka@cs.unt.edu */ 09621 /* 07/17/96 */ 09622 09623 /* This subroutine connects an exterior node KK to all */ 09624 /* boundary nodes of a triangulation of KK-1 points on the */ 09625 /* unit sphere, producing a triangulation that covers the */ 09626 /* sphere. The data structure is updated with the addition */ 09627 /* of node KK, but no optimization is performed. All boun- */ 09628 /* dary nodes must be visible from node KK. */ 09629 09630 09631 /* On input: */ 09632 09633 /* KK = Index of the node to be connected to the set of */ 09634 /* all boundary nodes. KK .GE. 4. */ 09635 09636 /* N0 = Index of a boundary node (in the range 1 to */ 09637 /* KK-1). N0 may be determined by Subroutine */ 09638 /* TRFIND. */ 09639 09640 /* The above parameters are not altered by this routine. */ 09641 09642 /* LIST,LPTR,LEND,LNEW = Triangulation data structure */ 09643 /* created by Subroutine TRMESH. */ 09644 /* Node N0 must be included in */ 09645 /* the triangulation. */ 09646 09647 /* On output: */ 09648 09649 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 09650 /* the addition of node KK as the */ 09651 /* last entry. The updated */ 09652 /* triangulation contains no */ 09653 /* boundary nodes. */ 09654 09655 /* Module required by COVSPH: INSERT */ 09656 09657 /* *********************************************************** */ 09658 09659 09660 /* Local parameters: */ 09661 09662 /* K = Local copy of KK */ 09663 /* LP = LIST pointer */ 09664 /* LSAV = LIST pointer */ 09665 /* NEXT = Boundary node visible from K */ 09666 /* NST = Local copy of N0 */ 09667 09668 /* Parameter adjustments */ 09669 --lend; 09670 --lptr; 09671 --list; 09672 09673 /* Function Body */ 09674 k = *kk; 09675 nst = *n0; 09676 09677 /* Traverse the boundary in clockwise order, inserting K as */ 09678 /* the first neighbor of each boundary node, and converting */ 09679 /* the boundary node to an interior node. */ 09680 09681 next = nst; 09682 L1: 09683 lp = lend[next]; 09684 insert_(&k, &lp, &list[1], &lptr[1], lnew); 09685 next = -list[lp]; 09686 list[lp] = next; 09687 if (next != nst) { 09688 goto L1; 09689 } 09690 09691 /* Traverse the boundary again, adding each node to K's */ 09692 /* adjacency list. */ 09693 09694 lsav = *lnew; 09695 L2: 09696 lp = lend[next]; 09697 list[*lnew] = next; 09698 lptr[*lnew] = *lnew + 1; 09699 ++(*lnew); 09700 next = list[lp]; 09701 if (next != nst) { 09702 goto L2; 09703 } 09704 09705 lptr[*lnew - 1] = lsav; 09706 lend[k] = *lnew - 1; 09707 return 0; 09708 } /* covsph_ */
|
|
Definition at line 9710 of file util_sparx.cpp. References abs, circum_(), FALSE_, ierr, lstptr_(), nn(), swptst_(), t, and TRUE_. 09715 { 09716 /* System generated locals */ 09717 int i__1, i__2; 09718 09719 /* Builtin functions */ 09720 //double acos(double); 09721 09722 /* Local variables */ 09723 static double c__[3], t; 09724 static int i1, i2, i3, i4, n0, n1, n2, n3, n4; 09725 static double v1[3], v2[3], v3[3]; 09726 static int lp, kt, nn, nt, nm2, kt1, kt2, kt11, kt12, kt21, kt22, lpl, 09727 lpn; 09728 static long int swp; 09729 static int ierr; 09730 extern /* Subroutine */ int circum_(double *, double *, 09731 double *, double *, int *); 09732 extern int lstptr_(int *, int *, int *, int *); 09733 extern long int swptst_(int *, int *, int *, int *, 09734 double *, double *, double *); 09735 09736 09737 /* *********************************************************** */ 09738 09739 /* From STRIPACK */ 09740 /* Robert J. Renka */ 09741 /* Dept. of Computer Science */ 09742 /* Univ. of North Texas */ 09743 /* renka@cs.unt.edu */ 09744 /* 03/05/03 */ 09745 09746 /* Given a Delaunay triangulation of nodes on the surface */ 09747 /* of the unit sphere, this subroutine returns the set of */ 09748 /* triangle circumcenters corresponding to Voronoi vertices, */ 09749 /* along with the circumradii and a list of triangle indexes */ 09750 /* LISTC stored in one-to-one correspondence with LIST/LPTR */ 09751 /* entries. */ 09752 09753 /* A triangle circumcenter is the point (unit vector) lying */ 09754 /* at the same angular distance from the three vertices and */ 09755 /* contained in the same hemisphere as the vertices. (Note */ 09756 /* that the negative of a circumcenter is also equidistant */ 09757 /* from the vertices.) If the triangulation covers the sur- */ 09758 /* face, the Voronoi vertices are the circumcenters of the */ 09759 /* triangles in the Delaunay triangulation. LPTR, LEND, and */ 09760 /* LNEW are not altered in this case. */ 09761 09762 /* On the other hand, if the nodes are contained in a sin- */ 09763 /* gle hemisphere, the triangulation is implicitly extended */ 09764 /* to the entire surface by adding pseudo-arcs (of length */ 09765 /* greater than 180 degrees) between boundary nodes forming */ 09766 /* pseudo-triangles whose 'circumcenters' are included in the */ 09767 /* list. This extension to the triangulation actually con- */ 09768 /* sists of a triangulation of the set of boundary nodes in */ 09769 /* which the swap test is reversed (a non-empty circumcircle */ 09770 /* test). The negative circumcenters are stored as the */ 09771 /* pseudo-triangle 'circumcenters'. LISTC, LPTR, LEND, and */ 09772 /* LNEW contain a data structure corresponding to the ex- */ 09773 /* tended triangulation (Voronoi diagram), but LIST is not */ 09774 /* altered in this case. Thus, if it is necessary to retain */ 09775 /* the original (unextended) triangulation data structure, */ 09776 /* copies of LPTR and LNEW must be saved before calling this */ 09777 /* routine. */ 09778 09779 09780 /* On input: */ 09781 09782 /* N = Number of nodes in the triangulation. N .GE. 3. */ 09783 /* Note that, if N = 3, there are only two Voronoi */ 09784 /* vertices separated by 180 degrees, and the */ 09785 /* Voronoi regions are not well defined. */ 09786 09787 /* NCOL = Number of columns reserved for LTRI. This */ 09788 /* must be at least NB-2, where NB is the number */ 09789 /* of boundary nodes. */ 09790 09791 /* X,Y,Z = Arrays of length N containing the Cartesian */ 09792 /* coordinates of the nodes (unit vectors). */ 09793 09794 /* LIST = int array containing the set of adjacency */ 09795 /* lists. Refer to Subroutine TRMESH. */ 09796 09797 /* LEND = Set of pointers to ends of adjacency lists. */ 09798 /* Refer to Subroutine TRMESH. */ 09799 09800 /* The above parameters are not altered by this routine. */ 09801 09802 /* LPTR = Array of pointers associated with LIST. Re- */ 09803 /* fer to Subroutine TRMESH. */ 09804 09805 /* LNEW = Pointer to the first empty location in LIST */ 09806 /* and LPTR (list length plus one). */ 09807 09808 /* LTRI = int work space array dimensioned 6 by */ 09809 /* NCOL, or unused dummy parameter if NB = 0. */ 09810 09811 /* LISTC = int array of length at least 3*NT, where */ 09812 /* NT = 2*N-4 is the number of triangles in the */ 09813 /* triangulation (after extending it to cover */ 09814 /* the entire surface if necessary). */ 09815 09816 /* XC,YC,ZC,RC = Arrays of length NT = 2*N-4. */ 09817 09818 /* On output: */ 09819 09820 /* LPTR = Array of pointers associated with LISTC: */ 09821 /* updated for the addition of pseudo-triangles */ 09822 /* if the original triangulation contains */ 09823 /* boundary nodes (NB > 0). */ 09824 09825 /* LNEW = Pointer to the first empty location in LISTC */ 09826 /* and LPTR (list length plus one). LNEW is not */ 09827 /* altered if NB = 0. */ 09828 09829 /* LTRI = Triangle list whose first NB-2 columns con- */ 09830 /* tain the indexes of a clockwise-ordered */ 09831 /* sequence of vertices (first three rows) */ 09832 /* followed by the LTRI column indexes of the */ 09833 /* triangles opposite the vertices (or 0 */ 09834 /* denoting the exterior region) in the last */ 09835 /* three rows. This array is not generally of */ 09836 /* any use. */ 09837 09838 /* LISTC = Array containing triangle indexes (indexes */ 09839 /* to XC, YC, ZC, and RC) stored in 1-1 corres- */ 09840 /* pondence with LIST/LPTR entries (or entries */ 09841 /* that would be stored in LIST for the */ 09842 /* extended triangulation): the index of tri- */ 09843 /* angle (N1,N2,N3) is stored in LISTC(K), */ 09844 /* LISTC(L), and LISTC(M), where LIST(K), */ 09845 /* LIST(L), and LIST(M) are the indexes of N2 */ 09846 /* as a neighbor of N1, N3 as a neighbor of N2, */ 09847 /* and N1 as a neighbor of N3. The Voronoi */ 09848 /* region associated with a node is defined by */ 09849 /* the CCW-ordered sequence of circumcenters in */ 09850 /* one-to-one correspondence with its adjacency */ 09851 /* list (in the extended triangulation). */ 09852 09853 /* NB = Number of boundary nodes unless IER = 1. */ 09854 09855 /* XC,YC,ZC = Arrays containing the Cartesian coordi- */ 09856 /* nates of the triangle circumcenters */ 09857 /* (Voronoi vertices). XC(I)**2 + YC(I)**2 */ 09858 /* + ZC(I)**2 = 1. The first NB-2 entries */ 09859 /* correspond to pseudo-triangles if NB > 0. */ 09860 09861 /* RC = Array containing circumradii (the arc lengths */ 09862 /* or angles between the circumcenters and associ- */ 09863 /* ated triangle vertices) in 1-1 correspondence */ 09864 /* with circumcenters. */ 09865 09866 /* IER = Error indicator: */ 09867 /* IER = 0 if no errors were encountered. */ 09868 /* IER = 1 if N < 3. */ 09869 /* IER = 2 if NCOL < NB-2. */ 09870 /* IER = 3 if a triangle is degenerate (has ver- */ 09871 /* tices lying on a common geodesic). */ 09872 09873 /* Modules required by CRLIST: CIRCUM, LSTPTR, SWPTST */ 09874 09875 /* Intrinsic functions called by CRLIST: ABS, ACOS */ 09876 09877 /* *********************************************************** */ 09878 09879 09880 /* Local parameters: */ 09881 09882 /* C = Circumcenter returned by Subroutine CIRCUM */ 09883 /* I1,I2,I3 = Permutation of (1,2,3): LTRI row indexes */ 09884 /* I4 = LTRI row index in the range 1 to 3 */ 09885 /* IERR = Error flag for calls to CIRCUM */ 09886 /* KT = Triangle index */ 09887 /* KT1,KT2 = Indexes of a pair of adjacent pseudo-triangles */ 09888 /* KT11,KT12 = Indexes of the pseudo-triangles opposite N1 */ 09889 /* and N2 as vertices of KT1 */ 09890 /* KT21,KT22 = Indexes of the pseudo-triangles opposite N1 */ 09891 /* and N2 as vertices of KT2 */ 09892 /* LP,LPN = LIST pointers */ 09893 /* LPL = LIST pointer of the last neighbor of N1 */ 09894 /* N0 = Index of the first boundary node (initial */ 09895 /* value of N1) in the loop on boundary nodes */ 09896 /* used to store the pseudo-triangle indexes */ 09897 /* in LISTC */ 09898 /* N1,N2,N3 = Nodal indexes defining a triangle (CCW order) */ 09899 /* or pseudo-triangle (clockwise order) */ 09900 /* N4 = Index of the node opposite N2 -> N1 */ 09901 /* NM2 = N-2 */ 09902 /* NN = Local copy of N */ 09903 /* NT = Number of pseudo-triangles: NB-2 */ 09904 /* SWP = long int variable set to TRUE in each optimiza- */ 09905 /* tion loop (loop on pseudo-arcs) iff a swap */ 09906 /* is performed */ 09907 /* V1,V2,V3 = Vertices of triangle KT = (N1,N2,N3) sent to */ 09908 /* Subroutine CIRCUM */ 09909 09910 /* Parameter adjustments */ 09911 --lend; 09912 --z__; 09913 --y; 09914 --x; 09915 ltri -= 7; 09916 --list; 09917 --lptr; 09918 --listc; 09919 --xc; 09920 --yc; 09921 --zc; 09922 --rc; 09923 09924 /* Function Body */ 09925 nn = *n; 09926 *nb = 0; 09927 nt = 0; 09928 if (nn < 3) { 09929 goto L21; 09930 } 09931 09932 /* Search for a boundary node N1. */ 09933 09934 i__1 = nn; 09935 for (n1 = 1; n1 <= i__1; ++n1) { 09936 lp = lend[n1]; 09937 if (list[lp] < 0) { 09938 goto L2; 09939 } 09940 /* L1: */ 09941 } 09942 09943 /* The triangulation already covers the sphere. */ 09944 09945 goto L9; 09946 09947 /* There are NB .GE. 3 boundary nodes. Add NB-2 pseudo- */ 09948 /* triangles (N1,N2,N3) by connecting N3 to the NB-3 */ 09949 /* boundary nodes to which it is not already adjacent. */ 09950 09951 /* Set N3 and N2 to the first and last neighbors, */ 09952 /* respectively, of N1. */ 09953 09954 L2: 09955 n2 = -list[lp]; 09956 lp = lptr[lp]; 09957 n3 = list[lp]; 09958 09959 /* Loop on boundary arcs N1 -> N2 in clockwise order, */ 09960 /* storing triangles (N1,N2,N3) in column NT of LTRI */ 09961 /* along with the indexes of the triangles opposite */ 09962 /* the vertices. */ 09963 09964 L3: 09965 ++nt; 09966 if (nt <= *ncol) { 09967 ltri[nt * 6 + 1] = n1; 09968 ltri[nt * 6 + 2] = n2; 09969 ltri[nt * 6 + 3] = n3; 09970 ltri[nt * 6 + 4] = nt + 1; 09971 ltri[nt * 6 + 5] = nt - 1; 09972 ltri[nt * 6 + 6] = 0; 09973 } 09974 n1 = n2; 09975 lp = lend[n1]; 09976 n2 = -list[lp]; 09977 if (n2 != n3) { 09978 goto L3; 09979 } 09980 09981 *nb = nt + 2; 09982 if (*ncol < nt) { 09983 goto L22; 09984 } 09985 ltri[nt * 6 + 4] = 0; 09986 if (nt == 1) { 09987 goto L7; 09988 } 09989 09990 /* Optimize the exterior triangulation (set of pseudo- */ 09991 /* triangles) by applying swaps to the pseudo-arcs N1-N2 */ 09992 /* (pairs of adjacent pseudo-triangles KT1 and KT2 > KT1). */ 09993 /* The loop on pseudo-arcs is repeated until no swaps are */ 09994 /* performed. */ 09995 09996 L4: 09997 swp = FALSE_; 09998 i__1 = nt - 1; 09999 for (kt1 = 1; kt1 <= i__1; ++kt1) { 10000 for (i3 = 1; i3 <= 3; ++i3) { 10001 kt2 = ltri[i3 + 3 + kt1 * 6]; 10002 if (kt2 <= kt1) { 10003 goto L5; 10004 } 10005 10006 /* The LTRI row indexes (I1,I2,I3) of triangle KT1 = */ 10007 /* (N1,N2,N3) are a cyclical permutation of (1,2,3). */ 10008 10009 if (i3 == 1) { 10010 i1 = 2; 10011 i2 = 3; 10012 } else if (i3 == 2) { 10013 i1 = 3; 10014 i2 = 1; 10015 } else { 10016 i1 = 1; 10017 i2 = 2; 10018 } 10019 n1 = ltri[i1 + kt1 * 6]; 10020 n2 = ltri[i2 + kt1 * 6]; 10021 n3 = ltri[i3 + kt1 * 6]; 10022 10023 /* KT2 = (N2,N1,N4) for N4 = LTRI(I,KT2), where */ 10024 /* LTRI(I+3,KT2) = KT1. */ 10025 10026 if (ltri[kt2 * 6 + 4] == kt1) { 10027 i4 = 1; 10028 } else if (ltri[kt2 * 6 + 5] == kt1) { 10029 i4 = 2; 10030 } else { 10031 i4 = 3; 10032 } 10033 n4 = ltri[i4 + kt2 * 6]; 10034 10035 /* The empty circumcircle test is reversed for the pseudo- */ 10036 /* triangles. The reversal is implicit in the clockwise */ 10037 /* ordering of the vertices. */ 10038 10039 if (! swptst_(&n1, &n2, &n3, &n4, &x[1], &y[1], &z__[1])) { 10040 goto L5; 10041 } 10042 10043 /* Swap arc N1-N2 for N3-N4. KTij is the triangle opposite */ 10044 /* Nj as a vertex of KTi. */ 10045 10046 swp = TRUE_; 10047 kt11 = ltri[i1 + 3 + kt1 * 6]; 10048 kt12 = ltri[i2 + 3 + kt1 * 6]; 10049 if (i4 == 1) { 10050 i2 = 2; 10051 i1 = 3; 10052 } else if (i4 == 2) { 10053 i2 = 3; 10054 i1 = 1; 10055 } else { 10056 i2 = 1; 10057 i1 = 2; 10058 } 10059 kt21 = ltri[i1 + 3 + kt2 * 6]; 10060 kt22 = ltri[i2 + 3 + kt2 * 6]; 10061 ltri[kt1 * 6 + 1] = n4; 10062 ltri[kt1 * 6 + 2] = n3; 10063 ltri[kt1 * 6 + 3] = n1; 10064 ltri[kt1 * 6 + 4] = kt12; 10065 ltri[kt1 * 6 + 5] = kt22; 10066 ltri[kt1 * 6 + 6] = kt2; 10067 ltri[kt2 * 6 + 1] = n3; 10068 ltri[kt2 * 6 + 2] = n4; 10069 ltri[kt2 * 6 + 3] = n2; 10070 ltri[kt2 * 6 + 4] = kt21; 10071 ltri[kt2 * 6 + 5] = kt11; 10072 ltri[kt2 * 6 + 6] = kt1; 10073 10074 /* Correct the KT11 and KT22 entries that changed. */ 10075 10076 if (kt11 != 0) { 10077 i4 = 4; 10078 if (ltri[kt11 * 6 + 4] != kt1) { 10079 i4 = 5; 10080 if (ltri[kt11 * 6 + 5] != kt1) { 10081 i4 = 6; 10082 } 10083 } 10084 ltri[i4 + kt11 * 6] = kt2; 10085 } 10086 if (kt22 != 0) { 10087 i4 = 4; 10088 if (ltri[kt22 * 6 + 4] != kt2) { 10089 i4 = 5; 10090 if (ltri[kt22 * 6 + 5] != kt2) { 10091 i4 = 6; 10092 } 10093 } 10094 ltri[i4 + kt22 * 6] = kt1; 10095 } 10096 L5: 10097 ; 10098 } 10099 /* L6: */ 10100 } 10101 if (swp) { 10102 goto L4; 10103 } 10104 10105 /* Compute and store the negative circumcenters and radii of */ 10106 /* the pseudo-triangles in the first NT positions. */ 10107 10108 L7: 10109 i__1 = nt; 10110 for (kt = 1; kt <= i__1; ++kt) { 10111 n1 = ltri[kt * 6 + 1]; 10112 n2 = ltri[kt * 6 + 2]; 10113 n3 = ltri[kt * 6 + 3]; 10114 v1[0] = x[n1]; 10115 v1[1] = y[n1]; 10116 v1[2] = z__[n1]; 10117 v2[0] = x[n2]; 10118 v2[1] = y[n2]; 10119 v2[2] = z__[n2]; 10120 v3[0] = x[n3]; 10121 v3[1] = y[n3]; 10122 v3[2] = z__[n3]; 10123 circum_(v2, v1, v3, c__, &ierr); 10124 if (ierr != 0) { 10125 goto L23; 10126 } 10127 10128 /* Store the negative circumcenter and radius (computed */ 10129 /* from <V1,C>). */ 10130 10131 xc[kt] = -c__[0]; 10132 yc[kt] = -c__[1]; 10133 zc[kt] = -c__[2]; 10134 t = -(v1[0] * c__[0] + v1[1] * c__[1] + v1[2] * c__[2]); 10135 if (t < -1.) { 10136 t = -1.; 10137 } 10138 if (t > 1.) { 10139 t = 1.; 10140 } 10141 rc[kt] = acos(t); 10142 /* L8: */ 10143 } 10144 10145 /* Compute and store the circumcenters and radii of the */ 10146 /* actual triangles in positions KT = NT+1, NT+2, ... */ 10147 /* Also, store the triangle indexes KT in the appropriate */ 10148 /* LISTC positions. */ 10149 10150 L9: 10151 kt = nt; 10152 10153 /* Loop on nodes N1. */ 10154 10155 nm2 = nn - 2; 10156 i__1 = nm2; 10157 for (n1 = 1; n1 <= i__1; ++n1) { 10158 lpl = lend[n1]; 10159 lp = lpl; 10160 n3 = list[lp]; 10161 10162 /* Loop on adjacent neighbors N2,N3 of N1 for which N2 > N1 */ 10163 /* and N3 > N1. */ 10164 10165 L10: 10166 lp = lptr[lp]; 10167 n2 = n3; 10168 n3 = (i__2 = list[lp], abs(i__2)); 10169 if (n2 <= n1 || n3 <= n1) { 10170 goto L11; 10171 } 10172 ++kt; 10173 10174 /* Compute the circumcenter C of triangle KT = (N1,N2,N3). */ 10175 10176 v1[0] = x[n1]; 10177 v1[1] = y[n1]; 10178 v1[2] = z__[n1]; 10179 v2[0] = x[n2]; 10180 v2[1] = y[n2]; 10181 v2[2] = z__[n2]; 10182 v3[0] = x[n3]; 10183 v3[1] = y[n3]; 10184 v3[2] = z__[n3]; 10185 circum_(v1, v2, v3, c__, &ierr); 10186 if (ierr != 0) { 10187 goto L23; 10188 } 10189 10190 /* Store the circumcenter, radius and triangle index. */ 10191 10192 xc[kt] = c__[0]; 10193 yc[kt] = c__[1]; 10194 zc[kt] = c__[2]; 10195 t = v1[0] * c__[0] + v1[1] * c__[1] + v1[2] * c__[2]; 10196 if (t < -1.) { 10197 t = -1.; 10198 } 10199 if (t > 1.) { 10200 t = 1.; 10201 } 10202 rc[kt] = acos(t); 10203 10204 /* Store KT in LISTC(LPN), where Abs(LIST(LPN)) is the */ 10205 /* index of N2 as a neighbor of N1, N3 as a neighbor */ 10206 /* of N2, and N1 as a neighbor of N3. */ 10207 10208 lpn = lstptr_(&lpl, &n2, &list[1], &lptr[1]); 10209 listc[lpn] = kt; 10210 lpn = lstptr_(&lend[n2], &n3, &list[1], &lptr[1]); 10211 listc[lpn] = kt; 10212 lpn = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]); 10213 listc[lpn] = kt; 10214 L11: 10215 if (lp != lpl) { 10216 goto L10; 10217 } 10218 /* L12: */ 10219 } 10220 if (nt == 0) { 10221 goto L20; 10222 } 10223 10224 /* Store the first NT triangle indexes in LISTC. */ 10225 10226 /* Find a boundary triangle KT1 = (N1,N2,N3) with a */ 10227 /* boundary arc opposite N3. */ 10228 10229 kt1 = 0; 10230 L13: 10231 ++kt1; 10232 if (ltri[kt1 * 6 + 4] == 0) { 10233 i1 = 2; 10234 i2 = 3; 10235 i3 = 1; 10236 goto L14; 10237 } else if (ltri[kt1 * 6 + 5] == 0) { 10238 i1 = 3; 10239 i2 = 1; 10240 i3 = 2; 10241 goto L14; 10242 } else if (ltri[kt1 * 6 + 6] == 0) { 10243 i1 = 1; 10244 i2 = 2; 10245 i3 = 3; 10246 goto L14; 10247 } 10248 goto L13; 10249 L14: 10250 n1 = ltri[i1 + kt1 * 6]; 10251 n0 = n1; 10252 10253 /* Loop on boundary nodes N1 in CCW order, storing the */ 10254 /* indexes of the clockwise-ordered sequence of triangles */ 10255 /* that contain N1. The first triangle overwrites the */ 10256 /* last neighbor position, and the remaining triangles, */ 10257 /* if any, are appended to N1's adjacency list. */ 10258 10259 /* A pointer to the first neighbor of N1 is saved in LPN. */ 10260 10261 L15: 10262 lp = lend[n1]; 10263 lpn = lptr[lp]; 10264 listc[lp] = kt1; 10265 10266 /* Loop on triangles KT2 containing N1. */ 10267 10268 L16: 10269 kt2 = ltri[i2 + 3 + kt1 * 6]; 10270 if (kt2 != 0) { 10271 10272 /* Append KT2 to N1's triangle list. */ 10273 10274 lptr[lp] = *lnew; 10275 lp = *lnew; 10276 listc[lp] = kt2; 10277 ++(*lnew); 10278 10279 /* Set KT1 to KT2 and update (I1,I2,I3) such that */ 10280 /* LTRI(I1,KT1) = N1. */ 10281 10282 kt1 = kt2; 10283 if (ltri[kt1 * 6 + 1] == n1) { 10284 i1 = 1; 10285 i2 = 2; 10286 i3 = 3; 10287 } else if (ltri[kt1 * 6 + 2] == n1) { 10288 i1 = 2; 10289 i2 = 3; 10290 i3 = 1; 10291 } else { 10292 i1 = 3; 10293 i2 = 1; 10294 i3 = 2; 10295 } 10296 goto L16; 10297 } 10298 10299 /* Store the saved first-triangle pointer in LPTR(LP), set */ 10300 /* N1 to the next boundary node, test for termination, */ 10301 /* and permute the indexes: the last triangle containing */ 10302 /* a boundary node is the first triangle containing the */ 10303 /* next boundary node. */ 10304 10305 lptr[lp] = lpn; 10306 n1 = ltri[i3 + kt1 * 6]; 10307 if (n1 != n0) { 10308 i4 = i3; 10309 i3 = i2; 10310 i2 = i1; 10311 i1 = i4; 10312 goto L15; 10313 } 10314 10315 /* No errors encountered. */ 10316 10317 L20: 10318 *ier = 0; 10319 return 0; 10320 10321 /* N < 3. */ 10322 10323 L21: 10324 *ier = 1; 10325 return 0; 10326 10327 /* Insufficient space reserved for LTRI. */ 10328 10329 L22: 10330 *ier = 2; 10331 return 0; 10332 10333 /* Error flag returned by CIRCUM: KT indexes a null triangle. */ 10334 10335 L23: 10336 *ier = 3; 10337 return 0; 10338 } /* crlist_ */
|
|
Definition at line 10340 of file util_sparx.cpp. References abs, delnb_(), and lstptr_(). 10342 { 10343 /* System generated locals */ 10344 int i__1; 10345 10346 /* Local variables */ 10347 static int n1, n2, n3, lp, lph, lpl; 10348 extern /* Subroutine */ int delnb_(int *, int *, int *, 10349 int *, int *, int *, int *, int *); 10350 extern int lstptr_(int *, int *, int *, int *); 10351 10352 10353 /* *********************************************************** */ 10354 10355 /* From STRIPACK */ 10356 /* Robert J. Renka */ 10357 /* Dept. of Computer Science */ 10358 /* Univ. of North Texas */ 10359 /* renka@cs.unt.edu */ 10360 /* 07/17/96 */ 10361 10362 /* This subroutine deletes a boundary arc from a triangula- */ 10363 /* tion. It may be used to remove a null triangle from the */ 10364 /* convex hull boundary. Note, however, that if the union of */ 10365 /* triangles is rendered nonconvex, Subroutines DELNOD, EDGE, */ 10366 /* and TRFIND (and hence ADDNOD) may fail. Also, Function */ 10367 /* NEARND should not be called following an arc deletion. */ 10368 10369 /* This routine is identical to the similarly named routine */ 10370 /* in TRIPACK. */ 10371 10372 10373 /* On input: */ 10374 10375 /* N = Number of nodes in the triangulation. N .GE. 4. */ 10376 10377 /* IO1,IO2 = Indexes (in the range 1 to N) of a pair of */ 10378 /* adjacent boundary nodes defining the arc */ 10379 /* to be removed. */ 10380 10381 /* The above parameters are not altered by this routine. */ 10382 10383 /* LIST,LPTR,LEND,LNEW = Triangulation data structure */ 10384 /* created by Subroutine TRMESH. */ 10385 10386 /* On output: */ 10387 10388 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 10389 /* the removal of arc IO1-IO2 */ 10390 /* unless IER > 0. */ 10391 10392 /* IER = Error indicator: */ 10393 /* IER = 0 if no errors were encountered. */ 10394 /* IER = 1 if N, IO1, or IO2 is outside its valid */ 10395 /* range, or IO1 = IO2. */ 10396 /* IER = 2 if IO1-IO2 is not a boundary arc. */ 10397 /* IER = 3 if the node opposite IO1-IO2 is al- */ 10398 /* ready a boundary node, and thus IO1 */ 10399 /* or IO2 has only two neighbors or a */ 10400 /* deletion would result in two triangu- */ 10401 /* lations sharing a single node. */ 10402 /* IER = 4 if one of the nodes is a neighbor of */ 10403 /* the other, but not vice versa, imply- */ 10404 /* ing an invalid triangulation data */ 10405 /* structure. */ 10406 10407 /* Module required by DELARC: DELNB, LSTPTR */ 10408 10409 /* Intrinsic function called by DELARC: ABS */ 10410 10411 /* *********************************************************** */ 10412 10413 10414 /* Local parameters: */ 10415 10416 /* LP = LIST pointer */ 10417 /* LPH = LIST pointer or flag returned by DELNB */ 10418 /* LPL = Pointer to the last neighbor of N1, N2, or N3 */ 10419 /* N1,N2,N3 = Nodal indexes of a triangle such that N1->N2 */ 10420 /* is the directed boundary edge associated */ 10421 /* with IO1-IO2 */ 10422 10423 /* Parameter adjustments */ 10424 --lend; 10425 --list; 10426 --lptr; 10427 10428 /* Function Body */ 10429 n1 = *io1; 10430 n2 = *io2; 10431 10432 /* Test for errors, and set N1->N2 to the directed boundary */ 10433 /* edge associated with IO1-IO2: (N1,N2,N3) is a triangle */ 10434 /* for some N3. */ 10435 10436 if (*n < 4 || n1 < 1 || n1 > *n || n2 < 1 || n2 > *n || n1 == n2) { 10437 *ier = 1; 10438 return 0; 10439 } 10440 10441 lpl = lend[n2]; 10442 if (-list[lpl] != n1) { 10443 n1 = n2; 10444 n2 = *io1; 10445 lpl = lend[n2]; 10446 if (-list[lpl] != n1) { 10447 *ier = 2; 10448 return 0; 10449 } 10450 } 10451 10452 /* Set N3 to the node opposite N1->N2 (the second neighbor */ 10453 /* of N1), and test for error 3 (N3 already a boundary */ 10454 /* node). */ 10455 10456 lpl = lend[n1]; 10457 lp = lptr[lpl]; 10458 lp = lptr[lp]; 10459 n3 = (i__1 = list[lp], abs(i__1)); 10460 lpl = lend[n3]; 10461 if (list[lpl] <= 0) { 10462 *ier = 3; 10463 return 0; 10464 } 10465 10466 /* Delete N2 as a neighbor of N1, making N3 the first */ 10467 /* neighbor, and test for error 4 (N2 not a neighbor */ 10468 /* of N1). Note that previously computed pointers may */ 10469 /* no longer be valid following the call to DELNB. */ 10470 10471 delnb_(&n1, &n2, n, &list[1], &lptr[1], &lend[1], lnew, &lph); 10472 if (lph < 0) { 10473 *ier = 4; 10474 return 0; 10475 } 10476 10477 /* Delete N1 as a neighbor of N2, making N3 the new last */ 10478 /* neighbor. */ 10479 10480 delnb_(&n2, &n1, n, &list[1], &lptr[1], &lend[1], lnew, &lph); 10481 10482 /* Make N3 a boundary node with first neighbor N2 and last */ 10483 /* neighbor N1. */ 10484 10485 lp = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]); 10486 lend[n3] = lp; 10487 list[lp] = -n1; 10488 10489 /* No errors encountered. */ 10490 10491 *ier = 0; 10492 return 0; 10493 } /* delarc_ */
|
|
Definition at line 10495 of file util_sparx.cpp. Referenced by delarc_(), and delnod_(). 10497 { 10498 /* System generated locals */ 10499 int i__1; 10500 10501 /* Local variables */ 10502 static int i__, lp, nn, lpb, lpl, lpp, lnw; 10503 10504 10505 /* *********************************************************** */ 10506 10507 /* From STRIPACK */ 10508 /* Robert J. Renka */ 10509 /* Dept. of Computer Science */ 10510 /* Univ. of North Texas */ 10511 /* renka@cs.unt.edu */ 10512 /* 07/29/98 */ 10513 10514 /* This subroutine deletes a neighbor NB from the adjacency */ 10515 /* list of node N0 (but N0 is not deleted from the adjacency */ 10516 /* list of NB) and, if NB is a boundary node, makes N0 a */ 10517 /* boundary node. For pointer (LIST index) LPH to NB as a */ 10518 /* neighbor of N0, the empty LIST,LPTR location LPH is filled */ 10519 /* in with the values at LNEW-1, pointer LNEW-1 (in LPTR and */ 10520 /* possibly in LEND) is changed to LPH, and LNEW is decremen- */ 10521 /* ted. This requires a search of LEND and LPTR entailing an */ 10522 /* expected operation count of O(N). */ 10523 10524 /* This routine is identical to the similarly named routine */ 10525 /* in TRIPACK. */ 10526 10527 10528 /* On input: */ 10529 10530 /* N0,NB = Indexes, in the range 1 to N, of a pair of */ 10531 /* nodes such that NB is a neighbor of N0. */ 10532 /* (N0 need not be a neighbor of NB.) */ 10533 10534 /* N = Number of nodes in the triangulation. N .GE. 3. */ 10535 10536 /* The above parameters are not altered by this routine. */ 10537 10538 /* LIST,LPTR,LEND,LNEW = Data structure defining the */ 10539 /* triangulation. */ 10540 10541 /* On output: */ 10542 10543 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 10544 /* the removal of NB from the ad- */ 10545 /* jacency list of N0 unless */ 10546 /* LPH < 0. */ 10547 10548 /* LPH = List pointer to the hole (NB as a neighbor of */ 10549 /* N0) filled in by the values at LNEW-1 or error */ 10550 /* indicator: */ 10551 /* LPH > 0 if no errors were encountered. */ 10552 /* LPH = -1 if N0, NB, or N is outside its valid */ 10553 /* range. */ 10554 /* LPH = -2 if NB is not a neighbor of N0. */ 10555 10556 /* Modules required by DELNB: None */ 10557 10558 /* Intrinsic function called by DELNB: ABS */ 10559 10560 /* *********************************************************** */ 10561 10562 10563 /* Local parameters: */ 10564 10565 /* I = DO-loop index */ 10566 /* LNW = LNEW-1 (output value of LNEW) */ 10567 /* LP = LIST pointer of the last neighbor of NB */ 10568 /* LPB = Pointer to NB as a neighbor of N0 */ 10569 /* LPL = Pointer to the last neighbor of N0 */ 10570 /* LPP = Pointer to the neighbor of N0 that precedes NB */ 10571 /* NN = Local copy of N */ 10572 10573 /* Parameter adjustments */ 10574 --lend; 10575 --list; 10576 --lptr; 10577 10578 /* Function Body */ 10579 nn = *n; 10580 10581 /* Test for error 1. */ 10582 10583 if (*n0 < 1 || *n0 > nn || *nb < 1 || *nb > nn || nn < 3) { 10584 *lph = -1; 10585 return 0; 10586 } 10587 10588 /* Find pointers to neighbors of N0: */ 10589 10590 /* LPL points to the last neighbor, */ 10591 /* LPP points to the neighbor NP preceding NB, and */ 10592 /* LPB points to NB. */ 10593 10594 lpl = lend[*n0]; 10595 lpp = lpl; 10596 lpb = lptr[lpp]; 10597 L1: 10598 if (list[lpb] == *nb) { 10599 goto L2; 10600 } 10601 lpp = lpb; 10602 lpb = lptr[lpp]; 10603 if (lpb != lpl) { 10604 goto L1; 10605 } 10606 10607 /* Test for error 2 (NB not found). */ 10608 10609 if ((i__1 = list[lpb], abs(i__1)) != *nb) { 10610 *lph = -2; 10611 return 0; 10612 } 10613 10614 /* NB is the last neighbor of N0. Make NP the new last */ 10615 /* neighbor and, if NB is a boundary node, then make N0 */ 10616 /* a boundary node. */ 10617 10618 lend[*n0] = lpp; 10619 lp = lend[*nb]; 10620 if (list[lp] < 0) { 10621 list[lpp] = -list[lpp]; 10622 } 10623 goto L3; 10624 10625 /* NB is not the last neighbor of N0. If NB is a boundary */ 10626 /* node and N0 is not, then make N0 a boundary node with */ 10627 /* last neighbor NP. */ 10628 10629 L2: 10630 lp = lend[*nb]; 10631 if (list[lp] < 0 && list[lpl] > 0) { 10632 lend[*n0] = lpp; 10633 list[lpp] = -list[lpp]; 10634 } 10635 10636 /* Update LPTR so that the neighbor following NB now fol- */ 10637 /* lows NP, and fill in the hole at location LPB. */ 10638 10639 L3: 10640 lptr[lpp] = lptr[lpb]; 10641 lnw = *lnew - 1; 10642 list[lpb] = list[lnw]; 10643 lptr[lpb] = lptr[lnw]; 10644 for (i__ = nn; i__ >= 1; --i__) { 10645 if (lend[i__] == lnw) { 10646 lend[i__] = lpb; 10647 goto L5; 10648 } 10649 /* L4: */ 10650 } 10651 10652 L5: 10653 i__1 = lnw - 1; 10654 for (i__ = 1; i__ <= i__1; ++i__) { 10655 if (lptr[i__] == lnw) { 10656 lptr[i__] = lpb; 10657 } 10658 /* L6: */ 10659 } 10660 10661 /* No errors encountered. */ 10662 10663 *lnew = lnw; 10664 *lph = lpb; 10665 return 0; 10666 } /* delnb_ */
|
|
Definition at line 10668 of file util_sparx.cpp. References abs, delnb_(), FALSE_, ierr, left_(), lstptr_(), nbcnt_(), nn(), optim_(), swap_(), and TRUE_. 10671 { 10672 /* System generated locals */ 10673 int i__1; 10674 10675 /* Local variables */ 10676 static int i__, j, n1, n2; 10677 static double x1, x2, y1, y2, z1, z2; 10678 static int nl, lp, nn, nr; 10679 static double xl, yl, zl, xr, yr, zr; 10680 static int nnb, lp21, lpf, lph, lpl, lpn, iwl, nit, lnw, lpl2; 10681 extern long int left_(double *, double *, double *, double 10682 *, double *, double *, double *, double *, 10683 double *); 10684 static long int bdry; 10685 static int ierr, lwkl; 10686 extern /* Subroutine */ int swap_(int *, int *, int *, 10687 int *, int *, int *, int *, int *), delnb_( 10688 int *, int *, int *, int *, int *, int *, 10689 int *, int *); 10690 extern int nbcnt_(int *, int *); 10691 extern /* Subroutine */ int optim_(double *, double *, double 10692 *, int *, int *, int *, int *, int *, int 10693 *, int *); 10694 static int nfrst; 10695 extern int lstptr_(int *, int *, int *, int *); 10696 10697 10698 /* *********************************************************** */ 10699 10700 /* From STRIPACK */ 10701 /* Robert J. Renka */ 10702 /* Dept. of Computer Science */ 10703 /* Univ. of North Texas */ 10704 /* renka@cs.unt.edu */ 10705 /* 11/30/99 */ 10706 10707 /* This subroutine deletes node K (along with all arcs */ 10708 /* incident on node K) from a triangulation of N nodes on the */ 10709 /* unit sphere, and inserts arcs as necessary to produce a */ 10710 /* triangulation of the remaining N-1 nodes. If a Delaunay */ 10711 /* triangulation is input, a Delaunay triangulation will */ 10712 /* result, and thus, DELNOD reverses the effect of a call to */ 10713 /* Subroutine ADDNOD. */ 10714 10715 10716 /* On input: */ 10717 10718 /* K = Index (for X, Y, and Z) of the node to be */ 10719 /* deleted. 1 .LE. K .LE. N. */ 10720 10721 /* K is not altered by this routine. */ 10722 10723 /* N = Number of nodes in the triangulation on input. */ 10724 /* N .GE. 4. Note that N will be decremented */ 10725 /* following the deletion. */ 10726 10727 /* X,Y,Z = Arrays of length N containing the Cartesian */ 10728 /* coordinates of the nodes in the triangula- */ 10729 /* tion. */ 10730 10731 /* LIST,LPTR,LEND,LNEW = Data structure defining the */ 10732 /* triangulation. Refer to Sub- */ 10733 /* routine TRMESH. */ 10734 10735 /* LWK = Number of columns reserved for IWK. LWK must */ 10736 /* be at least NNB-3, where NNB is the number of */ 10737 /* neighbors of node K, including an extra */ 10738 /* pseudo-node if K is a boundary node. */ 10739 10740 /* IWK = int work array dimensioned 2 by LWK (or */ 10741 /* array of length .GE. 2*LWK). */ 10742 10743 /* On output: */ 10744 10745 /* N = Number of nodes in the triangulation on output. */ 10746 /* The input value is decremented unless 1 .LE. IER */ 10747 /* .LE. 4. */ 10748 10749 /* X,Y,Z = Updated arrays containing nodal coordinates */ 10750 /* (with elements K+1,...,N+1 shifted up one */ 10751 /* position, thus overwriting element K) unless */ 10752 /* 1 .LE. IER .LE. 4. */ 10753 10754 /* LIST,LPTR,LEND,LNEW = Updated triangulation data */ 10755 /* structure reflecting the dele- */ 10756 /* tion unless 1 .LE. IER .LE. 4. */ 10757 /* Note that the data structure */ 10758 /* may have been altered if IER > */ 10759 /* 3. */ 10760 10761 /* LWK = Number of IWK columns required unless IER = 1 */ 10762 /* or IER = 3. */ 10763 10764 /* IWK = Indexes of the endpoints of the new arcs added */ 10765 /* unless LWK = 0 or 1 .LE. IER .LE. 4. (Arcs */ 10766 /* are associated with columns, or pairs of */ 10767 /* adjacent elements if IWK is declared as a */ 10768 /* singly-subscripted array.) */ 10769 10770 /* IER = Error indicator: */ 10771 /* IER = 0 if no errors were encountered. */ 10772 /* IER = 1 if K or N is outside its valid range */ 10773 /* or LWK < 0 on input. */ 10774 /* IER = 2 if more space is required in IWK. */ 10775 /* Refer to LWK. */ 10776 /* IER = 3 if the triangulation data structure is */ 10777 /* invalid on input. */ 10778 /* IER = 4 if K indexes an interior node with */ 10779 /* four or more neighbors, none of which */ 10780 /* can be swapped out due to collineari- */ 10781 /* ty, and K cannot therefore be deleted. */ 10782 /* IER = 5 if an error flag (other than IER = 1) */ 10783 /* was returned by OPTIM. An error */ 10784 /* message is written to the standard */ 10785 /* output unit in this case. */ 10786 /* IER = 6 if error flag 1 was returned by OPTIM. */ 10787 /* This is not necessarily an error, but */ 10788 /* the arcs may not be optimal. */ 10789 10790 /* Note that the deletion may result in all remaining nodes */ 10791 /* being collinear. This situation is not flagged. */ 10792 10793 /* Modules required by DELNOD: DELNB, LEFT, LSTPTR, NBCNT, */ 10794 /* OPTIM, SWAP, SWPTST */ 10795 10796 /* Intrinsic function called by DELNOD: ABS */ 10797 10798 /* *********************************************************** */ 10799 10800 10801 /* Local parameters: */ 10802 10803 /* BDRY = long int variable with value TRUE iff N1 is a */ 10804 /* boundary node */ 10805 /* I,J = DO-loop indexes */ 10806 /* IERR = Error flag returned by OPTIM */ 10807 /* IWL = Number of IWK columns containing arcs */ 10808 /* LNW = Local copy of LNEW */ 10809 /* LP = LIST pointer */ 10810 /* LP21 = LIST pointer returned by SWAP */ 10811 /* LPF,LPL = Pointers to the first and last neighbors of N1 */ 10812 /* LPH = Pointer (or flag) returned by DELNB */ 10813 /* LPL2 = Pointer to the last neighbor of N2 */ 10814 /* LPN = Pointer to a neighbor of N1 */ 10815 /* LWKL = Input value of LWK */ 10816 /* N1 = Local copy of K */ 10817 /* N2 = Neighbor of N1 */ 10818 /* NFRST = First neighbor of N1: LIST(LPF) */ 10819 /* NIT = Number of iterations in OPTIM */ 10820 /* NR,NL = Neighbors of N1 preceding (to the right of) and */ 10821 /* following (to the left of) N2, respectively */ 10822 /* NN = Number of nodes in the triangulation */ 10823 /* NNB = Number of neighbors of N1 (including a pseudo- */ 10824 /* node representing the boundary if N1 is a */ 10825 /* boundary node) */ 10826 /* X1,Y1,Z1 = Coordinates of N1 */ 10827 /* X2,Y2,Z2 = Coordinates of N2 */ 10828 /* XL,YL,ZL = Coordinates of NL */ 10829 /* XR,YR,ZR = Coordinates of NR */ 10830 10831 10832 /* Set N1 to K and NNB to the number of neighbors of N1 (plus */ 10833 /* one if N1 is a boundary node), and test for errors. LPF */ 10834 /* and LPL are LIST indexes of the first and last neighbors */ 10835 /* of N1, IWL is the number of IWK columns containing arcs, */ 10836 /* and BDRY is TRUE iff N1 is a boundary node. */ 10837 10838 /* Parameter adjustments */ 10839 iwk -= 3; 10840 --lend; 10841 --lptr; 10842 --list; 10843 --z__; 10844 --y; 10845 --x; 10846 10847 /* Function Body */ 10848 n1 = *k; 10849 nn = *n; 10850 if (n1 < 1 || n1 > nn || nn < 4 || *lwk < 0) { 10851 goto L21; 10852 } 10853 lpl = lend[n1]; 10854 lpf = lptr[lpl]; 10855 nnb = nbcnt_(&lpl, &lptr[1]); 10856 bdry = list[lpl] < 0; 10857 if (bdry) { 10858 ++nnb; 10859 } 10860 if (nnb < 3) { 10861 goto L23; 10862 } 10863 lwkl = *lwk; 10864 *lwk = nnb - 3; 10865 if (lwkl < *lwk) { 10866 goto L22; 10867 } 10868 iwl = 0; 10869 if (nnb == 3) { 10870 goto L3; 10871 } 10872 10873 /* Initialize for loop on arcs N1-N2 for neighbors N2 of N1, */ 10874 /* beginning with the second neighbor. NR and NL are the */ 10875 /* neighbors preceding and following N2, respectively, and */ 10876 /* LP indexes NL. The loop is exited when all possible */ 10877 /* swaps have been applied to arcs incident on N1. */ 10878 10879 x1 = x[n1]; 10880 y1 = y[n1]; 10881 z1 = z__[n1]; 10882 nfrst = list[lpf]; 10883 nr = nfrst; 10884 xr = x[nr]; 10885 yr = y[nr]; 10886 zr = z__[nr]; 10887 lp = lptr[lpf]; 10888 n2 = list[lp]; 10889 x2 = x[n2]; 10890 y2 = y[n2]; 10891 z2 = z__[n2]; 10892 lp = lptr[lp]; 10893 10894 /* Top of loop: set NL to the neighbor following N2. */ 10895 10896 L1: 10897 nl = (i__1 = list[lp], abs(i__1)); 10898 if (nl == nfrst && bdry) { 10899 goto L3; 10900 } 10901 xl = x[nl]; 10902 yl = y[nl]; 10903 zl = z__[nl]; 10904 10905 /* Test for a convex quadrilateral. To avoid an incorrect */ 10906 /* test caused by collinearity, use the fact that if N1 */ 10907 /* is a boundary node, then N1 LEFT NR->NL and if N2 is */ 10908 /* a boundary node, then N2 LEFT NL->NR. */ 10909 10910 lpl2 = lend[n2]; 10911 if (! ((bdry || left_(&xr, &yr, &zr, &xl, &yl, &zl, &x1, &y1, &z1)) && ( 10912 list[lpl2] < 0 || left_(&xl, &yl, &zl, &xr, &yr, &zr, &x2, &y2, & 10913 z2)))) { 10914 10915 /* Nonconvex quadrilateral -- no swap is possible. */ 10916 10917 nr = n2; 10918 xr = x2; 10919 yr = y2; 10920 zr = z2; 10921 goto L2; 10922 } 10923 10924 /* The quadrilateral defined by adjacent triangles */ 10925 /* (N1,N2,NL) and (N2,N1,NR) is convex. Swap in */ 10926 /* NL-NR and store it in IWK unless NL and NR are */ 10927 /* already adjacent, in which case the swap is not */ 10928 /* possible. Indexes larger than N1 must be decremented */ 10929 /* since N1 will be deleted from X, Y, and Z. */ 10930 10931 swap_(&nl, &nr, &n1, &n2, &list[1], &lptr[1], &lend[1], &lp21); 10932 if (lp21 == 0) { 10933 nr = n2; 10934 xr = x2; 10935 yr = y2; 10936 zr = z2; 10937 goto L2; 10938 } 10939 ++iwl; 10940 if (nl <= n1) { 10941 iwk[(iwl << 1) + 1] = nl; 10942 } else { 10943 iwk[(iwl << 1) + 1] = nl - 1; 10944 } 10945 if (nr <= n1) { 10946 iwk[(iwl << 1) + 2] = nr; 10947 } else { 10948 iwk[(iwl << 1) + 2] = nr - 1; 10949 } 10950 10951 /* Recompute the LIST indexes and NFRST, and decrement NNB. */ 10952 10953 lpl = lend[n1]; 10954 --nnb; 10955 if (nnb == 3) { 10956 goto L3; 10957 } 10958 lpf = lptr[lpl]; 10959 nfrst = list[lpf]; 10960 lp = lstptr_(&lpl, &nl, &list[1], &lptr[1]); 10961 if (nr == nfrst) { 10962 goto L2; 10963 } 10964 10965 /* NR is not the first neighbor of N1. */ 10966 /* Back up and test N1-NR for a swap again: Set N2 to */ 10967 /* NR and NR to the previous neighbor of N1 -- the */ 10968 /* neighbor of NR which follows N1. LP21 points to NL */ 10969 /* as a neighbor of NR. */ 10970 10971 n2 = nr; 10972 x2 = xr; 10973 y2 = yr; 10974 z2 = zr; 10975 lp21 = lptr[lp21]; 10976 lp21 = lptr[lp21]; 10977 nr = (i__1 = list[lp21], abs(i__1)); 10978 xr = x[nr]; 10979 yr = y[nr]; 10980 zr = z__[nr]; 10981 goto L1; 10982 10983 /* Bottom of loop -- test for termination of loop. */ 10984 10985 L2: 10986 if (n2 == nfrst) { 10987 goto L3; 10988 } 10989 n2 = nl; 10990 x2 = xl; 10991 y2 = yl; 10992 z2 = zl; 10993 lp = lptr[lp]; 10994 goto L1; 10995 10996 /* Delete N1 and all its incident arcs. If N1 is an interior */ 10997 /* node and either NNB > 3 or NNB = 3 and N2 LEFT NR->NL, */ 10998 /* then N1 must be separated from its neighbors by a plane */ 10999 /* containing the origin -- its removal reverses the effect */ 11000 /* of a call to COVSPH, and all its neighbors become */ 11001 /* boundary nodes. This is achieved by treating it as if */ 11002 /* it were a boundary node (setting BDRY to TRUE, changing */ 11003 /* a sign in LIST, and incrementing NNB). */ 11004 11005 L3: 11006 if (! bdry) { 11007 if (nnb > 3) { 11008 bdry = TRUE_; 11009 } else { 11010 lpf = lptr[lpl]; 11011 nr = list[lpf]; 11012 lp = lptr[lpf]; 11013 n2 = list[lp]; 11014 nl = list[lpl]; 11015 bdry = left_(&x[nr], &y[nr], &z__[nr], &x[nl], &y[nl], &z__[nl], & 11016 x[n2], &y[n2], &z__[n2]); 11017 } 11018 if (bdry) { 11019 11020 /* IF a boundary node already exists, then N1 and its */ 11021 /* neighbors cannot be converted to boundary nodes. */ 11022 /* (They must be collinear.) This is a problem if */ 11023 /* NNB > 3. */ 11024 11025 i__1 = nn; 11026 for (i__ = 1; i__ <= i__1; ++i__) { 11027 if (list[lend[i__]] < 0) { 11028 bdry = FALSE_; 11029 goto L5; 11030 } 11031 /* L4: */ 11032 } 11033 list[lpl] = -list[lpl]; 11034 ++nnb; 11035 } 11036 } 11037 L5: 11038 if (! bdry && nnb > 3) { 11039 goto L24; 11040 } 11041 11042 /* Initialize for loop on neighbors. LPL points to the last */ 11043 /* neighbor of N1. LNEW is stored in local variable LNW. */ 11044 11045 lp = lpl; 11046 lnw = *lnew; 11047 11048 /* Loop on neighbors N2 of N1, beginning with the first. */ 11049 11050 L6: 11051 lp = lptr[lp]; 11052 n2 = (i__1 = list[lp], abs(i__1)); 11053 delnb_(&n2, &n1, n, &list[1], &lptr[1], &lend[1], &lnw, &lph); 11054 if (lph < 0) { 11055 goto L23; 11056 } 11057 11058 /* LP and LPL may require alteration. */ 11059 11060 if (lpl == lnw) { 11061 lpl = lph; 11062 } 11063 if (lp == lnw) { 11064 lp = lph; 11065 } 11066 if (lp != lpl) { 11067 goto L6; 11068 } 11069 11070 /* Delete N1 from X, Y, Z, and LEND, and remove its adjacency */ 11071 /* list from LIST and LPTR. LIST entries (nodal indexes) */ 11072 /* which are larger than N1 must be decremented. */ 11073 11074 --nn; 11075 if (n1 > nn) { 11076 goto L9; 11077 } 11078 i__1 = nn; 11079 for (i__ = n1; i__ <= i__1; ++i__) { 11080 x[i__] = x[i__ + 1]; 11081 y[i__] = y[i__ + 1]; 11082 z__[i__] = z__[i__ + 1]; 11083 lend[i__] = lend[i__ + 1]; 11084 /* L7: */ 11085 } 11086 11087 i__1 = lnw - 1; 11088 for (i__ = 1; i__ <= i__1; ++i__) { 11089 if (list[i__] > n1) { 11090 --list[i__]; 11091 } 11092 if (list[i__] < -n1) { 11093 ++list[i__]; 11094 } 11095 /* L8: */ 11096 } 11097 11098 /* For LPN = first to last neighbors of N1, delete the */ 11099 /* preceding neighbor (indexed by LP). */ 11100 11101 /* Each empty LIST,LPTR location LP is filled in with the */ 11102 /* values at LNW-1, and LNW is decremented. All pointers */ 11103 /* (including those in LPTR and LEND) with value LNW-1 */ 11104 /* must be changed to LP. */ 11105 11106 /* LPL points to the last neighbor of N1. */ 11107 11108 L9: 11109 if (bdry) { 11110 --nnb; 11111 } 11112 lpn = lpl; 11113 i__1 = nnb; 11114 for (j = 1; j <= i__1; ++j) { 11115 --lnw; 11116 lp = lpn; 11117 lpn = lptr[lp]; 11118 list[lp] = list[lnw]; 11119 lptr[lp] = lptr[lnw]; 11120 if (lptr[lpn] == lnw) { 11121 lptr[lpn] = lp; 11122 } 11123 if (lpn == lnw) { 11124 lpn = lp; 11125 } 11126 for (i__ = nn; i__ >= 1; --i__) { 11127 if (lend[i__] == lnw) { 11128 lend[i__] = lp; 11129 goto L11; 11130 } 11131 /* L10: */ 11132 } 11133 11134 L11: 11135 for (i__ = lnw - 1; i__ >= 1; --i__) { 11136 if (lptr[i__] == lnw) { 11137 lptr[i__] = lp; 11138 } 11139 /* L12: */ 11140 } 11141 /* L13: */ 11142 } 11143 11144 /* Update N and LNEW, and optimize the patch of triangles */ 11145 /* containing K (on input) by applying swaps to the arcs */ 11146 /* in IWK. */ 11147 11148 *n = nn; 11149 *lnew = lnw; 11150 if (iwl > 0) { 11151 nit = iwl << 2; 11152 optim_(&x[1], &y[1], &z__[1], &iwl, &list[1], &lptr[1], &lend[1], & 11153 nit, &iwk[3], &ierr); 11154 if (ierr != 0 && ierr != 1) { 11155 goto L25; 11156 } 11157 if (ierr == 1) { 11158 goto L26; 11159 } 11160 } 11161 11162 /* Successful termination. */ 11163 11164 *ier = 0; 11165 return 0; 11166 11167 /* Invalid input parameter. */ 11168 11169 L21: 11170 *ier = 1; 11171 return 0; 11172 11173 /* Insufficient space reserved for IWK. */ 11174 11175 L22: 11176 *ier = 2; 11177 return 0; 11178 11179 /* Invalid triangulation data structure. NNB < 3 on input or */ 11180 /* N2 is a neighbor of N1 but N1 is not a neighbor of N2. */ 11181 11182 L23: 11183 *ier = 3; 11184 return 0; 11185 11186 /* N1 is interior but NNB could not be reduced to 3. */ 11187 11188 L24: 11189 *ier = 4; 11190 return 0; 11191 11192 /* Error flag (other than 1) returned by OPTIM. */ 11193 11194 L25: 11195 *ier = 5; 11196 /* WRITE (*,100) NIT, IERR */ 11197 /* 100 FORMAT (//5X,'*** Error in OPTIM (called from ', */ 11198 /* . 'DELNOD): NIT = ',I4,', IER = ',I1,' ***'/) */ 11199 return 0; 11200 11201 /* Error flag 1 returned by OPTIM. */ 11202 11203 L26: 11204 *ier = 6; 11205 return 0; 11206 } /* delnod_ */
|
|
Definition at line 11208 of file util_sparx.cpp. Referenced by trplot_(), and vrplot_(). 11210 { 11211 /* System generated locals */ 11212 int i__1; 11213 double d__1; 11214 11215 /* Builtin functions */ 11216 //double sqrt(double); 11217 11218 /* Local variables */ 11219 static int i__, k; 11220 static double s, p1[3], p2[3], u1, u2, v1, v2; 11221 static int na; 11222 static double dp[3], du, dv, pm[3], um, vm, err, enrm; 11223 11224 11225 /* *********************************************************** */ 11226 11227 /* From STRIPACK */ 11228 /* Robert J. Renka */ 11229 /* Dept. of Computer Science */ 11230 /* Univ. of North Texas */ 11231 /* renka@cs.unt.edu */ 11232 /* 03/04/03 */ 11233 11234 /* Given unit vectors P and Q corresponding to northern */ 11235 /* hemisphere points (with positive third components), this */ 11236 /* subroutine draws a polygonal line which approximates the */ 11237 /* projection of arc P-Q onto the plane containing the */ 11238 /* equator. */ 11239 11240 /* The line segment is drawn by writing a sequence of */ 11241 /* 'moveto' and 'lineto' Postscript commands to unit LUN. It */ 11242 /* is assumed that an open file is attached to the unit, */ 11243 /* header comments have been written to the file, a window- */ 11244 /* to-viewport mapping has been established, etc. */ 11245 11246 /* On input: */ 11247 11248 /* LUN = long int unit number in the range 0 to 99. */ 11249 11250 /* P,Q = Arrays of length 3 containing the endpoints of */ 11251 /* the arc to be drawn. */ 11252 11253 /* TOL = Maximum distance in world coordinates between */ 11254 /* the projected arc and polygonal line. */ 11255 11256 /* Input parameters are not altered by this routine. */ 11257 11258 /* On output: */ 11259 11260 /* NSEG = Number of line segments in the polygonal */ 11261 /* approximation to the projected arc. This is */ 11262 /* a decreasing function of TOL. NSEG = 0 and */ 11263 /* no drawing is performed if P = Q or P = -Q */ 11264 /* or an error is encountered in writing to unit */ 11265 /* LUN. */ 11266 11267 /* STRIPACK modules required by DRWARC: None */ 11268 11269 /* Intrinsic functions called by DRWARC: ABS, DBLE, SQRT */ 11270 11271 /* *********************************************************** */ 11272 11273 11274 /* Local parameters: */ 11275 11276 /* DP = (Q-P)/NSEG */ 11277 /* DU,DV = Components of the projection Q'-P' of arc P->Q */ 11278 /* onto the projection plane */ 11279 /* ENRM = Euclidean norm (or squared norm) of Q'-P' or PM */ 11280 /* ERR = Orthogonal distance from the projected midpoint */ 11281 /* PM' to the line defined by P' and Q': */ 11282 /* |Q'-P' X PM'-P'|/|Q'-P'| */ 11283 /* I,K = DO-loop indexes */ 11284 /* NA = Number of arcs (segments) in the partition of P-Q */ 11285 /* P1,P2 = Pairs of adjacent points in a uniform partition of */ 11286 /* arc P-Q into NSEG segments; obtained by normal- */ 11287 /* izing PM values */ 11288 /* PM = Midpoint of arc P-Q or a point P + k*DP in a */ 11289 /* uniform partition of the line segment P-Q into */ 11290 /* NSEG segments */ 11291 /* S = Scale factor 1/NA */ 11292 /* U1,V1 = Components of P' */ 11293 /* U2,V2 = Components of Q' */ 11294 /* UM,VM = Components of the midpoint PM' */ 11295 11296 11297 /* Compute the midpoint PM of arc P-Q. */ 11298 11299 /* Parameter adjustments */ 11300 --q; 11301 --p; 11302 11303 /* Function Body */ 11304 enrm = 0.; 11305 for (i__ = 1; i__ <= 3; ++i__) { 11306 pm[i__ - 1] = p[i__] + q[i__]; 11307 enrm += pm[i__ - 1] * pm[i__ - 1]; 11308 /* L1: */ 11309 } 11310 if (enrm == 0.) { 11311 goto L5; 11312 } 11313 enrm = sqrt(enrm); 11314 pm[0] /= enrm; 11315 pm[1] /= enrm; 11316 pm[2] /= enrm; 11317 11318 /* Project P, Q, and PM to P' = (U1,V1), Q' = (U2,V2), and */ 11319 /* PM' = (UM,VM), respectively. */ 11320 11321 u1 = p[1]; 11322 v1 = p[2]; 11323 u2 = q[1]; 11324 v2 = q[2]; 11325 um = pm[0]; 11326 vm = pm[1]; 11327 11328 /* Compute the orthogonal distance ERR from PM' to the line */ 11329 /* defined by P' and Q'. This is the maximum deviation */ 11330 /* between the projected arc and the line segment. It is */ 11331 /* undefined if P' = Q'. */ 11332 11333 du = u2 - u1; 11334 dv = v2 - v1; 11335 enrm = du * du + dv * dv; 11336 if (enrm == 0.) { 11337 goto L5; 11338 } 11339 err = (d__1 = du * (vm - v1) - (um - u1) * dv, abs(d__1)) / sqrt(enrm); 11340 11341 /* Compute the number of arcs into which P-Q will be parti- */ 11342 /* tioned (the number of line segments to be drawn): */ 11343 /* NA = ERR/TOL. */ 11344 11345 na = (int) (err / *tol + 1.); 11346 11347 /* Initialize for loop on arcs P1-P2, where the intermediate */ 11348 /* points are obtained by normalizing PM = P + k*DP for */ 11349 /* DP = (Q-P)/NA */ 11350 11351 s = 1. / (double) na; 11352 for (i__ = 1; i__ <= 3; ++i__) { 11353 dp[i__ - 1] = s * (q[i__] - p[i__]); 11354 pm[i__ - 1] = p[i__]; 11355 p1[i__ - 1] = p[i__]; 11356 /* L2: */ 11357 } 11358 11359 /* Loop on arcs P1-P2, drawing the line segments associated */ 11360 /* with the projected endpoints. */ 11361 11362 i__1 = na - 1; 11363 for (k = 1; k <= i__1; ++k) { 11364 enrm = 0.; 11365 for (i__ = 1; i__ <= 3; ++i__) { 11366 pm[i__ - 1] += dp[i__ - 1]; 11367 enrm += pm[i__ - 1] * pm[i__ - 1]; 11368 /* L3: */ 11369 } 11370 if (enrm == 0.) { 11371 goto L5; 11372 } 11373 enrm = sqrt(enrm); 11374 p2[0] = pm[0] / enrm; 11375 p2[1] = pm[1] / enrm; 11376 p2[2] = pm[2] / enrm; 11377 /* WRITE (LUN,100,ERR=5) P1(1), P1(2), P2(1), P2(2) */ 11378 /* 100 FORMAT (2F12.6,' moveto',2F12.6,' lineto') */ 11379 p1[0] = p2[0]; 11380 p1[1] = p2[1]; 11381 p1[2] = p2[2]; 11382 /* L4: */ 11383 } 11384 /* WRITE (LUN,100,ERR=5) P1(1), P1(2), Q(1), Q(2) */ 11385 11386 /* No error encountered. */ 11387 11388 *nseg = na; 11389 return 0; 11390 11391 /* Invalid input value of P or Q. */ 11392 11393 L5: 11394 *nseg = 0; 11395 return 0; 11396 } /* drwarc_ */
|
|
Definition at line 11398 of file util_sparx.cpp. References abs, ierr, left_(), optim_(), and swap_(). 11401 { 11402 /* System generated locals */ 11403 int i__1; 11404 11405 /* Local variables */ 11406 static int i__, n0, n1, n2; 11407 static double x0, x1, x2, y0, y1, y2, z0, z1, z2; 11408 static int nl, lp, nr; 11409 static double dp12; 11410 static int lp21, iwc, iwf, lft, lpl, iwl, nit; 11411 static double dp1l, dp2l, dp1r, dp2r; 11412 extern long int left_(double *, double *, double *, double 11413 *, double *, double *, double *, double *, 11414 double *); 11415 static int ierr; 11416 extern /* Subroutine */ int swap_(int *, int *, int *, 11417 int *, int *, int *, int *, int *); 11418 static int next, iwcp1, n1lst, iwend; 11419 extern /* Subroutine */ int optim_(double *, double *, double 11420 *, int *, int *, int *, int *, int *, int 11421 *, int *); 11422 static int n1frst; 11423 11424 11425 /* *********************************************************** */ 11426 11427 /* From STRIPACK */ 11428 /* Robert J. Renka */ 11429 /* Dept. of Computer Science */ 11430 /* Univ. of North Texas */ 11431 /* renka@cs.unt.edu */ 11432 /* 07/30/98 */ 11433 11434 /* Given a triangulation of N nodes and a pair of nodal */ 11435 /* indexes IN1 and IN2, this routine swaps arcs as necessary */ 11436 /* to force IN1 and IN2 to be adjacent. Only arcs which */ 11437 /* intersect IN1-IN2 are swapped out. If a Delaunay triangu- */ 11438 /* lation is input, the resulting triangulation is as close */ 11439 /* as possible to a Delaunay triangulation in the sense that */ 11440 /* all arcs other than IN1-IN2 are locally optimal. */ 11441 11442 /* A sequence of calls to EDGE may be used to force the */ 11443 /* presence of a set of edges defining the boundary of a non- */ 11444 /* convex and/or multiply connected region, or to introduce */ 11445 /* barriers into the triangulation. Note that Subroutine */ 11446 /* GETNP will not necessarily return closest nodes if the */ 11447 /* triangulation has been constrained by a call to EDGE. */ 11448 /* However, this is appropriate in some applications, such */ 11449 /* as triangle-based interpolation on a nonconvex domain. */ 11450 11451 11452 /* On input: */ 11453 11454 /* IN1,IN2 = Indexes (of X, Y, and Z) in the range 1 to */ 11455 /* N defining a pair of nodes to be connected */ 11456 /* by an arc. */ 11457 11458 /* X,Y,Z = Arrays of length N containing the Cartesian */ 11459 /* coordinates of the nodes. */ 11460 11461 /* The above parameters are not altered by this routine. */ 11462 11463 /* LWK = Number of columns reserved for IWK. This must */ 11464 /* be at least NI -- the number of arcs that */ 11465 /* intersect IN1-IN2. (NI is bounded by N-3.) */ 11466 11467 /* IWK = int work array of length at least 2*LWK. */ 11468 11469 /* LIST,LPTR,LEND = Data structure defining the trian- */ 11470 /* gulation. Refer to Subroutine */ 11471 /* TRMESH. */ 11472 11473 /* On output: */ 11474 11475 /* LWK = Number of arcs which intersect IN1-IN2 (but */ 11476 /* not more than the input value of LWK) unless */ 11477 /* IER = 1 or IER = 3. LWK = 0 if and only if */ 11478 /* IN1 and IN2 were adjacent (or LWK=0) on input. */ 11479 11480 /* IWK = Array containing the indexes of the endpoints */ 11481 /* of the new arcs other than IN1-IN2 unless */ 11482 /* IER > 0 or LWK = 0. New arcs to the left of */ 11483 /* IN1->IN2 are stored in the first K-1 columns */ 11484 /* (left portion of IWK), column K contains */ 11485 /* zeros, and new arcs to the right of IN1->IN2 */ 11486 /* occupy columns K+1,...,LWK. (K can be deter- */ 11487 /* mined by searching IWK for the zeros.) */ 11488 11489 /* LIST,LPTR,LEND = Data structure updated if necessary */ 11490 /* to reflect the presence of an arc */ 11491 /* connecting IN1 and IN2 unless IER > */ 11492 /* 0. The data structure has been */ 11493 /* altered if IER >= 4. */ 11494 11495 /* IER = Error indicator: */ 11496 /* IER = 0 if no errors were encountered. */ 11497 /* IER = 1 if IN1 < 1, IN2 < 1, IN1 = IN2, */ 11498 /* or LWK < 0 on input. */ 11499 /* IER = 2 if more space is required in IWK. */ 11500 /* Refer to LWK. */ 11501 /* IER = 3 if IN1 and IN2 could not be connected */ 11502 /* due to either an invalid data struc- */ 11503 /* ture or collinear nodes (and floating */ 11504 /* point error). */ 11505 /* IER = 4 if an error flag other than IER = 1 */ 11506 /* was returned by OPTIM. */ 11507 /* IER = 5 if error flag 1 was returned by OPTIM. */ 11508 /* This is not necessarily an error, but */ 11509 /* the arcs other than IN1-IN2 may not */ 11510 /* be optimal. */ 11511 11512 /* An error message is written to the standard output unit */ 11513 /* in the case of IER = 3 or IER = 4. */ 11514 11515 /* Modules required by EDGE: LEFT, LSTPTR, OPTIM, SWAP, */ 11516 /* SWPTST */ 11517 11518 /* Intrinsic function called by EDGE: ABS */ 11519 11520 /* *********************************************************** */ 11521 11522 11523 /* Local parameters: */ 11524 11525 /* DPij = Dot product <Ni,Nj> */ 11526 /* I = DO-loop index and column index for IWK */ 11527 /* IERR = Error flag returned by Subroutine OPTIM */ 11528 /* IWC = IWK index between IWF and IWL -- NL->NR is */ 11529 /* stored in IWK(1,IWC)->IWK(2,IWC) */ 11530 /* IWCP1 = IWC + 1 */ 11531 /* IWEND = Input or output value of LWK */ 11532 /* IWF = IWK (column) index of the first (leftmost) arc */ 11533 /* which intersects IN1->IN2 */ 11534 /* IWL = IWK (column) index of the last (rightmost) are */ 11535 /* which intersects IN1->IN2 */ 11536 /* LFT = Flag used to determine if a swap results in the */ 11537 /* new arc intersecting IN1-IN2 -- LFT = 0 iff */ 11538 /* N0 = IN1, LFT = -1 implies N0 LEFT IN1->IN2, */ 11539 /* and LFT = 1 implies N0 LEFT IN2->IN1 */ 11540 /* LP = List pointer (index for LIST and LPTR) */ 11541 /* LP21 = Unused parameter returned by SWAP */ 11542 /* LPL = Pointer to the last neighbor of IN1 or NL */ 11543 /* N0 = Neighbor of N1 or node opposite NR->NL */ 11544 /* N1,N2 = Local copies of IN1 and IN2 */ 11545 /* N1FRST = First neighbor of IN1 */ 11546 /* N1LST = (Signed) last neighbor of IN1 */ 11547 /* NEXT = Node opposite NL->NR */ 11548 /* NIT = Flag or number of iterations employed by OPTIM */ 11549 /* NL,NR = Endpoints of an arc which intersects IN1-IN2 */ 11550 /* with NL LEFT IN1->IN2 */ 11551 /* X0,Y0,Z0 = Coordinates of N0 */ 11552 /* X1,Y1,Z1 = Coordinates of IN1 */ 11553 /* X2,Y2,Z2 = Coordinates of IN2 */ 11554 11555 11556 /* Store IN1, IN2, and LWK in local variables and test for */ 11557 /* errors. */ 11558 11559 /* Parameter adjustments */ 11560 --lend; 11561 --lptr; 11562 --list; 11563 iwk -= 3; 11564 --z__; 11565 --y; 11566 --x; 11567 11568 /* Function Body */ 11569 n1 = *in1; 11570 n2 = *in2; 11571 iwend = *lwk; 11572 if (n1 < 1 || n2 < 1 || n1 == n2 || iwend < 0) { 11573 goto L31; 11574 } 11575 11576 /* Test for N2 as a neighbor of N1. LPL points to the last */ 11577 /* neighbor of N1. */ 11578 11579 lpl = lend[n1]; 11580 n0 = (i__1 = list[lpl], abs(i__1)); 11581 lp = lpl; 11582 L1: 11583 if (n0 == n2) { 11584 goto L30; 11585 } 11586 lp = lptr[lp]; 11587 n0 = list[lp]; 11588 if (lp != lpl) { 11589 goto L1; 11590 } 11591 11592 /* Initialize parameters. */ 11593 11594 iwl = 0; 11595 nit = 0; 11596 11597 /* Store the coordinates of N1 and N2. */ 11598 11599 L2: 11600 x1 = x[n1]; 11601 y1 = y[n1]; 11602 z1 = z__[n1]; 11603 x2 = x[n2]; 11604 y2 = y[n2]; 11605 z2 = z__[n2]; 11606 11607 /* Set NR and NL to adjacent neighbors of N1 such that */ 11608 /* NR LEFT N2->N1 and NL LEFT N1->N2, */ 11609 /* (NR Forward N1->N2 or NL Forward N1->N2), and */ 11610 /* (NR Forward N2->N1 or NL Forward N2->N1). */ 11611 11612 /* Initialization: Set N1FRST and N1LST to the first and */ 11613 /* (signed) last neighbors of N1, respectively, and */ 11614 /* initialize NL to N1FRST. */ 11615 11616 lpl = lend[n1]; 11617 n1lst = list[lpl]; 11618 lp = lptr[lpl]; 11619 n1frst = list[lp]; 11620 nl = n1frst; 11621 if (n1lst < 0) { 11622 goto L4; 11623 } 11624 11625 /* N1 is an interior node. Set NL to the first candidate */ 11626 /* for NR (NL LEFT N2->N1). */ 11627 11628 L3: 11629 if (left_(&x2, &y2, &z2, &x1, &y1, &z1, &x[nl], &y[nl], &z__[nl])) { 11630 goto L4; 11631 } 11632 lp = lptr[lp]; 11633 nl = list[lp]; 11634 if (nl != n1frst) { 11635 goto L3; 11636 } 11637 11638 /* All neighbors of N1 are strictly left of N1->N2. */ 11639 11640 goto L5; 11641 11642 /* NL = LIST(LP) LEFT N2->N1. Set NR to NL and NL to the */ 11643 /* following neighbor of N1. */ 11644 11645 L4: 11646 nr = nl; 11647 lp = lptr[lp]; 11648 nl = (i__1 = list[lp], abs(i__1)); 11649 if (left_(&x1, &y1, &z1, &x2, &y2, &z2, &x[nl], &y[nl], &z__[nl])) { 11650 11651 /* NL LEFT N1->N2 and NR LEFT N2->N1. The Forward tests */ 11652 /* are employed to avoid an error associated with */ 11653 /* collinear nodes. */ 11654 11655 dp12 = x1 * x2 + y1 * y2 + z1 * z2; 11656 dp1l = x1 * x[nl] + y1 * y[nl] + z1 * z__[nl]; 11657 dp2l = x2 * x[nl] + y2 * y[nl] + z2 * z__[nl]; 11658 dp1r = x1 * x[nr] + y1 * y[nr] + z1 * z__[nr]; 11659 dp2r = x2 * x[nr] + y2 * y[nr] + z2 * z__[nr]; 11660 if ((dp2l - dp12 * dp1l >= 0. || dp2r - dp12 * dp1r >= 0.) && (dp1l - 11661 dp12 * dp2l >= 0. || dp1r - dp12 * dp2r >= 0.)) { 11662 goto L6; 11663 } 11664 11665 /* NL-NR does not intersect N1-N2. However, there is */ 11666 /* another candidate for the first arc if NL lies on */ 11667 /* the line N1-N2. */ 11668 11669 if (! left_(&x2, &y2, &z2, &x1, &y1, &z1, &x[nl], &y[nl], &z__[nl])) { 11670 goto L5; 11671 } 11672 } 11673 11674 /* Bottom of loop. */ 11675 11676 if (nl != n1frst) { 11677 goto L4; 11678 } 11679 11680 /* Either the triangulation is invalid or N1-N2 lies on the */ 11681 /* convex hull boundary and an edge NR->NL (opposite N1 and */ 11682 /* intersecting N1-N2) was not found due to floating point */ 11683 /* error. Try interchanging N1 and N2 -- NIT > 0 iff this */ 11684 /* has already been done. */ 11685 11686 L5: 11687 if (nit > 0) { 11688 goto L33; 11689 } 11690 nit = 1; 11691 n1 = n2; 11692 n2 = *in1; 11693 goto L2; 11694 11695 /* Store the ordered sequence of intersecting edges NL->NR in */ 11696 /* IWK(1,IWL)->IWK(2,IWL). */ 11697 11698 L6: 11699 ++iwl; 11700 if (iwl > iwend) { 11701 goto L32; 11702 } 11703 iwk[(iwl << 1) + 1] = nl; 11704 iwk[(iwl << 1) + 2] = nr; 11705 11706 /* Set NEXT to the neighbor of NL which follows NR. */ 11707 11708 lpl = lend[nl]; 11709 lp = lptr[lpl]; 11710 11711 /* Find NR as a neighbor of NL. The search begins with */ 11712 /* the first neighbor. */ 11713 11714 L7: 11715 if (list[lp] == nr) { 11716 goto L8; 11717 } 11718 lp = lptr[lp]; 11719 if (lp != lpl) { 11720 goto L7; 11721 } 11722 11723 /* NR must be the last neighbor, and NL->NR cannot be a */ 11724 /* boundary edge. */ 11725 11726 if (list[lp] != nr) { 11727 goto L33; 11728 } 11729 11730 /* Set NEXT to the neighbor following NR, and test for */ 11731 /* termination of the store loop. */ 11732 11733 L8: 11734 lp = lptr[lp]; 11735 next = (i__1 = list[lp], abs(i__1)); 11736 if (next == n2) { 11737 goto L9; 11738 } 11739 11740 /* Set NL or NR to NEXT. */ 11741 11742 if (left_(&x1, &y1, &z1, &x2, &y2, &z2, &x[next], &y[next], &z__[next])) { 11743 nl = next; 11744 } else { 11745 nr = next; 11746 } 11747 goto L6; 11748 11749 /* IWL is the number of arcs which intersect N1-N2. */ 11750 /* Store LWK. */ 11751 11752 L9: 11753 *lwk = iwl; 11754 iwend = iwl; 11755 11756 /* Initialize for edge swapping loop -- all possible swaps */ 11757 /* are applied (even if the new arc again intersects */ 11758 /* N1-N2), arcs to the left of N1->N2 are stored in the */ 11759 /* left portion of IWK, and arcs to the right are stored in */ 11760 /* the right portion. IWF and IWL index the first and last */ 11761 /* intersecting arcs. */ 11762 11763 iwf = 1; 11764 11765 /* Top of loop -- set N0 to N1 and NL->NR to the first edge. */ 11766 /* IWC points to the arc currently being processed. LFT */ 11767 /* .LE. 0 iff N0 LEFT N1->N2. */ 11768 11769 L10: 11770 lft = 0; 11771 n0 = n1; 11772 x0 = x1; 11773 y0 = y1; 11774 z0 = z1; 11775 nl = iwk[(iwf << 1) + 1]; 11776 nr = iwk[(iwf << 1) + 2]; 11777 iwc = iwf; 11778 11779 /* Set NEXT to the node opposite NL->NR unless IWC is the */ 11780 /* last arc. */ 11781 11782 L11: 11783 if (iwc == iwl) { 11784 goto L21; 11785 } 11786 iwcp1 = iwc + 1; 11787 next = iwk[(iwcp1 << 1) + 1]; 11788 if (next != nl) { 11789 goto L16; 11790 } 11791 next = iwk[(iwcp1 << 1) + 2]; 11792 11793 /* NEXT RIGHT N1->N2 and IWC .LT. IWL. Test for a possible */ 11794 /* swap. */ 11795 11796 if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x[next], &y[next], & 11797 z__[next])) { 11798 goto L14; 11799 } 11800 if (lft >= 0) { 11801 goto L12; 11802 } 11803 if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x[next], &y[next], & 11804 z__[next])) { 11805 goto L14; 11806 } 11807 11808 /* Replace NL->NR with N0->NEXT. */ 11809 11810 swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11811 iwk[(iwc << 1) + 1] = n0; 11812 iwk[(iwc << 1) + 2] = next; 11813 goto L15; 11814 11815 /* Swap NL-NR for N0-NEXT, shift columns IWC+1,...,IWL to */ 11816 /* the left, and store N0-NEXT in the right portion of */ 11817 /* IWK. */ 11818 11819 L12: 11820 swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11821 i__1 = iwl; 11822 for (i__ = iwcp1; i__ <= i__1; ++i__) { 11823 iwk[(i__ - (1<<1)) + 1] = iwk[(i__ << 1) + 1]; 11824 iwk[(i__ - (1<<1)) + 2] = iwk[(i__ << 1) + 2]; 11825 /* L13: */ 11826 } 11827 iwk[(iwl << 1) + 1] = n0; 11828 iwk[(iwl << 1) + 2] = next; 11829 --iwl; 11830 nr = next; 11831 goto L11; 11832 11833 /* A swap is not possible. Set N0 to NR. */ 11834 11835 L14: 11836 n0 = nr; 11837 x0 = x[n0]; 11838 y0 = y[n0]; 11839 z0 = z__[n0]; 11840 lft = 1; 11841 11842 /* Advance to the next arc. */ 11843 11844 L15: 11845 nr = next; 11846 ++iwc; 11847 goto L11; 11848 11849 /* NEXT LEFT N1->N2, NEXT .NE. N2, and IWC .LT. IWL. */ 11850 /* Test for a possible swap. */ 11851 11852 L16: 11853 if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x[next], &y[next], & 11854 z__[next])) { 11855 goto L19; 11856 } 11857 if (lft <= 0) { 11858 goto L17; 11859 } 11860 if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x[next], &y[next], & 11861 z__[next])) { 11862 goto L19; 11863 } 11864 11865 /* Replace NL->NR with NEXT->N0. */ 11866 11867 swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11868 iwk[(iwc << 1) + 1] = next; 11869 iwk[(iwc << 1) + 2] = n0; 11870 goto L20; 11871 11872 /* Swap NL-NR for N0-NEXT, shift columns IWF,...,IWC-1 to */ 11873 /* the right, and store N0-NEXT in the left portion of */ 11874 /* IWK. */ 11875 11876 L17: 11877 swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11878 i__1 = iwf; 11879 for (i__ = iwc - 1; i__ >= i__1; --i__) { 11880 iwk[(i__ + (1<<1)) + 1] = iwk[(i__ << 1) + 1]; 11881 iwk[(i__ + (1<<1)) + 2] = iwk[(i__ << 1) + 2]; 11882 /* L18: */ 11883 } 11884 iwk[(iwf << 1) + 1] = n0; 11885 iwk[(iwf << 1) + 2] = next; 11886 ++iwf; 11887 goto L20; 11888 11889 /* A swap is not possible. Set N0 to NL. */ 11890 11891 L19: 11892 n0 = nl; 11893 x0 = x[n0]; 11894 y0 = y[n0]; 11895 z0 = z__[n0]; 11896 lft = -1; 11897 11898 /* Advance to the next arc. */ 11899 11900 L20: 11901 nl = next; 11902 ++iwc; 11903 goto L11; 11904 11905 /* N2 is opposite NL->NR (IWC = IWL). */ 11906 11907 L21: 11908 if (n0 == n1) { 11909 goto L24; 11910 } 11911 if (lft < 0) { 11912 goto L22; 11913 } 11914 11915 /* N0 RIGHT N1->N2. Test for a possible swap. */ 11916 11917 if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x2, &y2, &z2)) { 11918 goto L10; 11919 } 11920 11921 /* Swap NL-NR for N0-N2 and store N0-N2 in the right */ 11922 /* portion of IWK. */ 11923 11924 swap_(&n2, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11925 iwk[(iwl << 1) + 1] = n0; 11926 iwk[(iwl << 1) + 2] = n2; 11927 --iwl; 11928 goto L10; 11929 11930 /* N0 LEFT N1->N2. Test for a possible swap. */ 11931 11932 L22: 11933 if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x2, &y2, &z2)) { 11934 goto L10; 11935 } 11936 11937 /* Swap NL-NR for N0-N2, shift columns IWF,...,IWL-1 to the */ 11938 /* right, and store N0-N2 in the left portion of IWK. */ 11939 11940 swap_(&n2, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11941 i__ = iwl; 11942 L23: 11943 iwk[(i__ << 1) + 1] = iwk[(i__ - (1<<1)) + 1]; 11944 iwk[(i__ << 1) + 2] = iwk[(i__ - (1<<1)) + 2]; 11945 --i__; 11946 if (i__ > iwf) { 11947 goto L23; 11948 } 11949 iwk[(iwf << 1) + 1] = n0; 11950 iwk[(iwf << 1) + 2] = n2; 11951 ++iwf; 11952 goto L10; 11953 11954 /* IWF = IWC = IWL. Swap out the last arc for N1-N2 and */ 11955 /* store zeros in IWK. */ 11956 11957 L24: 11958 swap_(&n2, &n1, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21); 11959 iwk[(iwc << 1) + 1] = 0; 11960 iwk[(iwc << 1) + 2] = 0; 11961 11962 /* Optimization procedure -- */ 11963 11964 *ier = 0; 11965 if (iwc > 1) { 11966 11967 /* Optimize the set of new arcs to the left of IN1->IN2. */ 11968 11969 nit = iwc - (1<<2); 11970 i__1 = iwc - 1; 11971 optim_(&x[1], &y[1], &z__[1], &i__1, &list[1], &lptr[1], &lend[1], & 11972 nit, &iwk[3], &ierr); 11973 if (ierr != 0 && ierr != 1) { 11974 goto L34; 11975 } 11976 if (ierr == 1) { 11977 *ier = 5; 11978 } 11979 } 11980 if (iwc < iwend) { 11981 11982 /* Optimize the set of new arcs to the right of IN1->IN2. */ 11983 11984 nit = iwend - (iwc<<2); 11985 i__1 = iwend - iwc; 11986 optim_(&x[1], &y[1], &z__[1], &i__1, &list[1], &lptr[1], &lend[1], & 11987 nit, &iwk[(iwc + (1<<1)) + 1], &ierr); 11988 if (ierr != 0 && ierr != 1) { 11989 goto L34; 11990 } 11991 if (ierr == 1) { 11992 goto L35; 11993 } 11994 } 11995 if (*ier == 5) { 11996 goto L35; 11997 } 11998 11999 /* Successful termination (IER = 0). */ 12000 12001 return 0; 12002 12003 /* IN1 and IN2 were adjacent on input. */ 12004 12005 L30: 12006 *ier = 0; 12007 return 0; 12008 12009 /* Invalid input parameter. */ 12010 12011 L31: 12012 *ier = 1; 12013 return 0; 12014 12015 /* Insufficient space reserved for IWK. */ 12016 12017 L32: 12018 *ier = 2; 12019 return 0; 12020 12021 /* Invalid triangulation data structure or collinear nodes */ 12022 /* on convex hull boundary. */ 12023 12024 L33: 12025 *ier = 3; 12026 /* WRITE (*,130) IN1, IN2 */ 12027 /* 130 FORMAT (//5X,'*** Error in EDGE: Invalid triangula', */ 12028 /* . 'tion or null triangles on boundary'/ */ 12029 /* . 9X,'IN1 =',I4,', IN2=',I4/) */ 12030 return 0; 12031 12032 /* Error flag (other than 1) returned by OPTIM. */ 12033 12034 L34: 12035 *ier = 4; 12036 /* WRITE (*,140) NIT, IERR */ 12037 /* 140 FORMAT (//5X,'*** Error in OPTIM (called from EDGE):', */ 12038 /* . ' NIT = ',I4,', IER = ',I1,' ***'/) */ 12039 return 0; 12040 12041 /* Error flag 1 returned by OPTIM. */ 12042 12043 L35: 12044 *ier = 5; 12045 return 0; 12046 } /* edge_ */
|
|
Definition at line 18981 of file util_sparx.cpp. References EMAN::EMData::get_xsize(), EMAN::EMData::get_ysize(), EMAN::EMData::get_zsize(), nx, ny, and EMAN::EMData::set_value_at(). Referenced by EMAN::Util::get_biggest_cluster(). 18982 { 18983 int offs[][3] = { {-1, 0, 0}, {1, 0, 0}, {0, -1, 0}, {0, 1, 0}, {0, 0, -1}, {0, 0, 1} }; 18984 int noff = 6; 18985 18986 int nx = visited->get_xsize(); 18987 int ny = visited->get_ysize(); 18988 int nz = visited->get_zsize(); 18989 18990 vector< point3d_t > pts; 18991 pts.push_back( point3d_t(ix, iy, iz) ); 18992 visited->set_value_at( ix, iy, iz, (float)grpid ); 18993 18994 int start = 0; 18995 int end = pts.size(); 18996 18997 while( end > start ) { 18998 for(int i=start; i < end; ++i ) { 18999 int ix = pts[i].x; 19000 int iy = pts[i].y; 19001 int iz = pts[i].z; 19002 19003 for( int j=0; j < noff; ++j ) { 19004 int jx = ix + offs[j][0]; 19005 int jy = iy + offs[j][1]; 19006 int jz = iz + offs[j][2]; 19007 19008 if( jx < 0 || jx >= nx ) continue; 19009 if( jy < 0 || jy >= ny ) continue; 19010 if( jz < 0 || jz >= nz ) continue; 19011 19012 19013 if( (*mg)(jx, jy, jz)>0 && (*visited)(jx, jy, jz)==0.0 ) { 19014 pts.push_back( point3d_t(jx, jy, jz) ); 19015 visited->set_value_at( jx, jy, jz, (float)grpid ); 19016 } 19017 19018 } 19019 } 19020 19021 start = end; 19022 end = pts.size(); 19023 } 19024 return pts.size(); 19025 }
|
|
Definition at line 12048 of file util_sparx.cpp. References abs. 12051 { 12052 /* System generated locals */ 12053 int i__1, i__2; 12054 12055 /* Local variables */ 12056 static int i__, n1; 12057 static double x1, y1, z1; 12058 static int nb, ni, lp, np, lm1; 12059 static double dnb, dnp; 12060 static int lpl; 12061 12062 12063 /* *********************************************************** */ 12064 12065 /* From STRIPACK */ 12066 /* Robert J. Renka */ 12067 /* Dept. of Computer Science */ 12068 /* Univ. of North Texas */ 12069 /* renka@cs.unt.edu */ 12070 /* 07/28/98 */ 12071 12072 /* Given a Delaunay triangulation of N nodes on the unit */ 12073 /* sphere and an array NPTS containing the indexes of L-1 */ 12074 /* nodes ordered by angular distance from NPTS(1), this sub- */ 12075 /* routine sets NPTS(L) to the index of the next node in the */ 12076 /* sequence -- the node, other than NPTS(1),...,NPTS(L-1), */ 12077 /* that is closest to NPTS(1). Thus, the ordered sequence */ 12078 /* of K closest nodes to N1 (including N1) may be determined */ 12079 /* by K-1 calls to GETNP with NPTS(1) = N1 and L = 2,3,...,K */ 12080 /* for K .GE. 2. */ 12081 12082 /* The algorithm uses the property of a Delaunay triangula- */ 12083 /* tion that the K-th closest node to N1 is a neighbor of one */ 12084 /* of the K-1 closest nodes to N1. */ 12085 12086 12087 /* On input: */ 12088 12089 /* X,Y,Z = Arrays of length N containing the Cartesian */ 12090 /* coordinates of the nodes. */ 12091 12092 /* LIST,LPTR,LEND = Triangulation data structure. Re- */ 12093 /* fer to Subroutine TRMESH. */ 12094 12095 /* L = Number of nodes in the sequence on output. 2 */ 12096 /* .LE. L .LE. N. */ 12097 12098 /* The above parameters are not altered by this routine. */ 12099 12100 /* NPTS = Array of length .GE. L containing the indexes */ 12101 /* of the L-1 closest nodes to NPTS(1) in the */ 12102 /* first L-1 locations. */ 12103 12104 /* On output: */ 12105 12106 /* NPTS = Array updated with the index of the L-th */ 12107 /* closest node to NPTS(1) in position L unless */ 12108 /* IER = 1. */ 12109 12110 /* DF = Value of an increasing function (negative cos- */ 12111 /* ine) of the angular distance between NPTS(1) */ 12112 /* and NPTS(L) unless IER = 1. */ 12113 12114 /* IER = Error indicator: */ 12115 /* IER = 0 if no errors were encountered. */ 12116 /* IER = 1 if L < 2. */ 12117 12118 /* Modules required by GETNP: None */ 12119 12120 /* Intrinsic function called by GETNP: ABS */ 12121 12122 /* *********************************************************** */ 12123 12124 12125 /* Local parameters: */ 12126 12127 /* DNB,DNP = Negative cosines of the angular distances from */ 12128 /* N1 to NB and to NP, respectively */ 12129 /* I = NPTS index and DO-loop index */ 12130 /* LM1 = L-1 */ 12131 /* LP = LIST pointer of a neighbor of NI */ 12132 /* LPL = Pointer to the last neighbor of NI */ 12133 /* N1 = NPTS(1) */ 12134 /* NB = Neighbor of NI and candidate for NP */ 12135 /* NI = NPTS(I) */ 12136 /* NP = Candidate for NPTS(L) */ 12137 /* X1,Y1,Z1 = Coordinates of N1 */ 12138 12139 /* Parameter adjustments */ 12140 --x; 12141 --y; 12142 --z__; 12143 --list; 12144 --lptr; 12145 --lend; 12146 --npts; 12147 12148 /* Function Body */ 12149 lm1 = *l - 1; 12150 if (lm1 < 1) { 12151 goto L6; 12152 } 12153 *ier = 0; 12154 12155 /* Store N1 = NPTS(1) and mark the elements of NPTS. */ 12156 12157 n1 = npts[1]; 12158 x1 = x[n1]; 12159 y1 = y[n1]; 12160 z1 = z__[n1]; 12161 i__1 = lm1; 12162 for (i__ = 1; i__ <= i__1; ++i__) { 12163 ni = npts[i__]; 12164 lend[ni] = -lend[ni]; 12165 /* L1: */ 12166 } 12167 12168 /* Candidates for NP = NPTS(L) are the unmarked neighbors */ 12169 /* of nodes in NPTS. DNP is initially greater than -cos(PI) */ 12170 /* (the maximum distance). */ 12171 12172 dnp = 2.; 12173 12174 /* Loop on nodes NI in NPTS. */ 12175 12176 i__1 = lm1; 12177 for (i__ = 1; i__ <= i__1; ++i__) { 12178 ni = npts[i__]; 12179 lpl = -lend[ni]; 12180 lp = lpl; 12181 12182 /* Loop on neighbors NB of NI. */ 12183 12184 L2: 12185 nb = (i__2 = list[lp], abs(i__2)); 12186 if (lend[nb] < 0) { 12187 goto L3; 12188 } 12189 12190 /* NB is an unmarked neighbor of NI. Replace NP if NB is */ 12191 /* closer to N1. */ 12192 12193 dnb = -(x[nb] * x1 + y[nb] * y1 + z__[nb] * z1); 12194 if (dnb >= dnp) { 12195 goto L3; 12196 } 12197 np = nb; 12198 dnp = dnb; 12199 L3: 12200 lp = lptr[lp]; 12201 if (lp != lpl) { 12202 goto L2; 12203 } 12204 /* L4: */ 12205 } 12206 npts[*l] = np; 12207 *df = dnp; 12208 12209 /* Unmark the elements of NPTS. */ 12210 12211 i__1 = lm1; 12212 for (i__ = 1; i__ <= i__1; ++i__) { 12213 ni = npts[i__]; 12214 lend[ni] = -lend[ni]; 12215 /* L5: */ 12216 } 12217 return 0; 12218 12219 /* L is outside its valid range. */ 12220 12221 L6: 12222 *ier = 1; 12223 return 0; 12224 } /* getnp_ */
|
|
Definition at line 7688 of file util_sparx.cpp. Referenced by trplot_(), and vrplot_().
|
|
Definition at line 12226 of file util_sparx.cpp. Referenced by bdyadd_(), covsph_(), and intadd_(). 12228 { 12229 static int lsav; 12230 12231 12232 /* *********************************************************** */ 12233 12234 /* From STRIPACK */ 12235 /* Robert J. Renka */ 12236 /* Dept. of Computer Science */ 12237 /* Univ. of North Texas */ 12238 /* renka@cs.unt.edu */ 12239 /* 07/17/96 */ 12240 12241 /* This subroutine inserts K as a neighbor of N1 following */ 12242 /* N2, where LP is the LIST pointer of N2 as a neighbor of */ 12243 /* N1. Note that, if N2 is the last neighbor of N1, K will */ 12244 /* become the first neighbor (even if N1 is a boundary node). */ 12245 12246 /* This routine is identical to the similarly named routine */ 12247 /* in TRIPACK. */ 12248 12249 12250 /* On input: */ 12251 12252 /* K = Index of the node to be inserted. */ 12253 12254 /* LP = LIST pointer of N2 as a neighbor of N1. */ 12255 12256 /* The above parameters are not altered by this routine. */ 12257 12258 /* LIST,LPTR,LNEW = Data structure defining the trian- */ 12259 /* gulation. Refer to Subroutine */ 12260 /* TRMESH. */ 12261 12262 /* On output: */ 12263 12264 /* LIST,LPTR,LNEW = Data structure updated with the */ 12265 /* addition of node K. */ 12266 12267 /* Modules required by INSERT: None */ 12268 12269 /* *********************************************************** */ 12270 12271 12272 /* Parameter adjustments */ 12273 --lptr; 12274 --list; 12275 12276 /* Function Body */ 12277 lsav = lptr[*lp]; 12278 lptr[*lp] = *lnew; 12279 list[*lnew] = *k; 12280 lptr[*lnew] = lsav; 12281 ++(*lnew); 12282 return 0; 12283 } /* insert_ */
|
|
Definition at line 12285 of file util_sparx.cpp. References b, ierr, intrsc_(), q, sqrt(), and TRUE_. 12287 { 12288 /* Initialized data */ 12289 12290 static double eps = .001; 12291 12292 /* System generated locals */ 12293 int i__1; 12294 long int ret_val = 0; 12295 12296 /* Builtin functions */ 12297 //double sqrt(double); 12298 12299 /* Local variables */ 12300 static double b[3], d__; 12301 static int k, n; 12302 static double q[3]; 12303 static int i1, i2, k0; 12304 static double v1[3], v2[3], cn[3], bp, bq; 12305 static int ni; 12306 static double pn[3], qn[3], vn[3]; 12307 static int imx; 12308 static long int lft1, lft2, even; 12309 static int ierr; 12310 static long int pinr, qinr; 12311 static double qnrm, vnrm; 12312 extern /* Subroutine */ int intrsc_(double *, double *, 12313 double *, double *, int *); 12314 12315 12316 /* *********************************************************** */ 12317 12318 /* From STRIPACK */ 12319 /* Robert J. Renka */ 12320 /* Dept. of Computer Science */ 12321 /* Univ. of North Texas */ 12322 /* renka@cs.unt.edu */ 12323 /* 12/27/93 */ 12324 12325 /* This function locates a point P relative to a polygonal */ 12326 /* region R on the surface of the unit sphere, returning */ 12327 /* INSIDE = TRUE if and only if P is contained in R. R is */ 12328 /* defined by a cyclically ordered sequence of vertices which */ 12329 /* form a positively-oriented simple closed curve. Adjacent */ 12330 /* vertices need not be distinct but the curve must not be */ 12331 /* self-intersecting. Also, while polygon edges are by defi- */ 12332 /* nition restricted to a single hemisphere, R is not so */ 12333 /* restricted. Its interior is the region to the left as the */ 12334 /* vertices are traversed in order. */ 12335 12336 /* The algorithm consists of selecting a point Q in R and */ 12337 /* then finding all points at which the great circle defined */ 12338 /* by P and Q intersects the boundary of R. P lies inside R */ 12339 /* if and only if there is an even number of intersection */ 12340 /* points between Q and P. Q is taken to be a point immedi- */ 12341 /* ately to the left of a directed boundary edge -- the first */ 12342 /* one that results in no consistency-check failures. */ 12343 12344 /* If P is close to the polygon boundary, the problem is */ 12345 /* ill-conditioned and the decision may be incorrect. Also, */ 12346 /* an incorrect decision may result from a poor choice of Q */ 12347 /* (if, for example, a boundary edge lies on the great cir- */ 12348 /* cle defined by P and Q). A more reliable result could be */ 12349 /* obtained by a sequence of calls to INSIDE with the ver- */ 12350 /* tices cyclically permuted before each call (to alter the */ 12351 /* choice of Q). */ 12352 12353 12354 /* On input: */ 12355 12356 /* P = Array of length 3 containing the Cartesian */ 12357 /* coordinates of the point (unit vector) to be */ 12358 /* located. */ 12359 12360 /* LV = Length of arrays XV, YV, and ZV. */ 12361 12362 /* XV,YV,ZV = Arrays of length LV containing the Carte- */ 12363 /* sian coordinates of unit vectors (points */ 12364 /* on the unit sphere). These values are */ 12365 /* not tested for validity. */ 12366 12367 /* NV = Number of vertices in the polygon. 3 .LE. NV */ 12368 /* .LE. LV. */ 12369 12370 /* LISTV = Array of length NV containing the indexes */ 12371 /* (for XV, YV, and ZV) of a cyclically-ordered */ 12372 /* (and CCW-ordered) sequence of vertices that */ 12373 /* define R. The last vertex (indexed by */ 12374 /* LISTV(NV)) is followed by the first (indexed */ 12375 /* by LISTV(1)). LISTV entries must be in the */ 12376 /* range 1 to LV. */ 12377 12378 /* Input parameters are not altered by this function. */ 12379 12380 /* On output: */ 12381 12382 /* INSIDE = TRUE if and only if P lies inside R unless */ 12383 /* IER .NE. 0, in which case the value is not */ 12384 /* altered. */ 12385 12386 /* IER = Error indicator: */ 12387 /* IER = 0 if no errors were encountered. */ 12388 /* IER = 1 if LV or NV is outside its valid */ 12389 /* range. */ 12390 /* IER = 2 if a LISTV entry is outside its valid */ 12391 /* range. */ 12392 /* IER = 3 if the polygon boundary was found to */ 12393 /* be self-intersecting. This error will */ 12394 /* not necessarily be detected. */ 12395 /* IER = 4 if every choice of Q (one for each */ 12396 /* boundary edge) led to failure of some */ 12397 /* internal consistency check. The most */ 12398 /* likely cause of this error is invalid */ 12399 /* input: P = (0,0,0), a null or self- */ 12400 /* intersecting polygon, etc. */ 12401 12402 /* Module required by INSIDE: INTRSC */ 12403 12404 /* Intrinsic function called by INSIDE: SQRT */ 12405 12406 /* *********************************************************** */ 12407 12408 12409 /* Local parameters: */ 12410 12411 /* B = Intersection point between the boundary and */ 12412 /* the great circle defined by P and Q */ 12413 /* BP,BQ = <B,P> and <B,Q>, respectively, maximized over */ 12414 /* intersection points B that lie between P and */ 12415 /* Q (on the shorter arc) -- used to find the */ 12416 /* closest intersection points to P and Q */ 12417 /* CN = Q X P = normal to the plane of P and Q */ 12418 /* D = Dot product <B,P> or <B,Q> */ 12419 /* EPS = Parameter used to define Q as the point whose */ 12420 /* orthogonal distance to (the midpoint of) */ 12421 /* boundary edge V1->V2 is approximately EPS/ */ 12422 /* (2*Cos(A/2)), where <V1,V2> = Cos(A). */ 12423 /* EVEN = TRUE iff an even number of intersection points */ 12424 /* lie between P and Q (on the shorter arc) */ 12425 /* I1,I2 = Indexes (LISTV elements) of a pair of adjacent */ 12426 /* boundary vertices (endpoints of a boundary */ 12427 /* edge) */ 12428 /* IERR = Error flag for calls to INTRSC (not tested) */ 12429 /* IMX = Local copy of LV and maximum value of I1 and */ 12430 /* I2 */ 12431 /* K = DO-loop index and LISTV index */ 12432 /* K0 = LISTV index of the first endpoint of the */ 12433 /* boundary edge used to compute Q */ 12434 /* LFT1,LFT2 = long int variables associated with I1 and I2 in */ 12435 /* the boundary traversal: TRUE iff the vertex */ 12436 /* is strictly to the left of Q->P (<V,CN> > 0) */ 12437 /* N = Local copy of NV */ 12438 /* NI = Number of intersections (between the boundary */ 12439 /* curve and the great circle P-Q) encountered */ 12440 /* PINR = TRUE iff P is to the left of the directed */ 12441 /* boundary edge associated with the closest */ 12442 /* intersection point to P that lies between P */ 12443 /* and Q (a left-to-right intersection as */ 12444 /* viewed from Q), or there is no intersection */ 12445 /* between P and Q (on the shorter arc) */ 12446 /* PN,QN = P X CN and CN X Q, respectively: used to */ 12447 /* locate intersections B relative to arc Q->P */ 12448 /* Q = (V1 + V2 + EPS*VN/VNRM)/QNRM, where V1->V2 is */ 12449 /* the boundary edge indexed by LISTV(K0) -> */ 12450 /* LISTV(K0+1) */ 12451 /* QINR = TRUE iff Q is to the left of the directed */ 12452 /* boundary edge associated with the closest */ 12453 /* intersection point to Q that lies between P */ 12454 /* and Q (a right-to-left intersection as */ 12455 /* viewed from Q), or there is no intersection */ 12456 /* between P and Q (on the shorter arc) */ 12457 /* QNRM = Euclidean norm of V1+V2+EPS*VN/VNRM used to */ 12458 /* compute (normalize) Q */ 12459 /* V1,V2 = Vertices indexed by I1 and I2 in the boundary */ 12460 /* traversal */ 12461 /* VN = V1 X V2, where V1->V2 is the boundary edge */ 12462 /* indexed by LISTV(K0) -> LISTV(K0+1) */ 12463 /* VNRM = Euclidean norm of VN */ 12464 12465 /* Parameter adjustments */ 12466 --p; 12467 --zv; 12468 --yv; 12469 --xv; 12470 --listv; 12471 12472 /* Function Body */ 12473 12474 /* Store local parameters, test for error 1, and initialize */ 12475 /* K0. */ 12476 12477 imx = *lv; 12478 n = *nv; 12479 if (n < 3 || n > imx) { 12480 goto L11; 12481 } 12482 k0 = 0; 12483 i1 = listv[1]; 12484 if (i1 < 1 || i1 > imx) { 12485 goto L12; 12486 } 12487 12488 /* Increment K0 and set Q to a point immediately to the left */ 12489 /* of the midpoint of edge V1->V2 = LISTV(K0)->LISTV(K0+1): */ 12490 /* Q = (V1 + V2 + EPS*VN/VNRM)/QNRM, where VN = V1 X V2. */ 12491 12492 L1: 12493 ++k0; 12494 if (k0 > n) { 12495 goto L14; 12496 } 12497 i1 = listv[k0]; 12498 if (k0 < n) { 12499 i2 = listv[k0 + 1]; 12500 } else { 12501 i2 = listv[1]; 12502 } 12503 if (i2 < 1 || i2 > imx) { 12504 goto L12; 12505 } 12506 vn[0] = yv[i1] * zv[i2] - zv[i1] * yv[i2]; 12507 vn[1] = zv[i1] * xv[i2] - xv[i1] * zv[i2]; 12508 vn[2] = xv[i1] * yv[i2] - yv[i1] * xv[i2]; 12509 vnrm = sqrt(vn[0] * vn[0] + vn[1] * vn[1] + vn[2] * vn[2]); 12510 if (vnrm == 0.) { 12511 goto L1; 12512 } 12513 q[0] = xv[i1] + xv[i2] + eps * vn[0] / vnrm; 12514 q[1] = yv[i1] + yv[i2] + eps * vn[1] / vnrm; 12515 q[2] = zv[i1] + zv[i2] + eps * vn[2] / vnrm; 12516 qnrm = sqrt(q[0] * q[0] + q[1] * q[1] + q[2] * q[2]); 12517 q[0] /= qnrm; 12518 q[1] /= qnrm; 12519 q[2] /= qnrm; 12520 12521 /* Compute CN = Q X P, PN = P X CN, and QN = CN X Q. */ 12522 12523 cn[0] = q[1] * p[3] - q[2] * p[2]; 12524 cn[1] = q[2] * p[1] - q[0] * p[3]; 12525 cn[2] = q[0] * p[2] - q[1] * p[1]; 12526 if (cn[0] == 0. && cn[1] == 0. && cn[2] == 0.) { 12527 goto L1; 12528 } 12529 pn[0] = p[2] * cn[2] - p[3] * cn[1]; 12530 pn[1] = p[3] * cn[0] - p[1] * cn[2]; 12531 pn[2] = p[1] * cn[1] - p[2] * cn[0]; 12532 qn[0] = cn[1] * q[2] - cn[2] * q[1]; 12533 qn[1] = cn[2] * q[0] - cn[0] * q[2]; 12534 qn[2] = cn[0] * q[1] - cn[1] * q[0]; 12535 12536 /* Initialize parameters for the boundary traversal. */ 12537 12538 ni = 0; 12539 even = TRUE_; 12540 bp = -2.; 12541 bq = -2.; 12542 pinr = TRUE_; 12543 qinr = TRUE_; 12544 i2 = listv[n]; 12545 if (i2 < 1 || i2 > imx) { 12546 goto L12; 12547 } 12548 lft2 = cn[0] * xv[i2] + cn[1] * yv[i2] + cn[2] * zv[i2] > 0.; 12549 12550 /* Loop on boundary arcs I1->I2. */ 12551 12552 i__1 = n; 12553 for (k = 1; k <= i__1; ++k) { 12554 i1 = i2; 12555 lft1 = lft2; 12556 i2 = listv[k]; 12557 if (i2 < 1 || i2 > imx) { 12558 goto L12; 12559 } 12560 lft2 = cn[0] * xv[i2] + cn[1] * yv[i2] + cn[2] * zv[i2] > 0.; 12561 if (lft1 == lft2) { 12562 goto L2; 12563 } 12564 12565 /* I1 and I2 are on opposite sides of Q->P. Compute the */ 12566 /* point of intersection B. */ 12567 12568 ++ni; 12569 v1[0] = xv[i1]; 12570 v1[1] = yv[i1]; 12571 v1[2] = zv[i1]; 12572 v2[0] = xv[i2]; 12573 v2[1] = yv[i2]; 12574 v2[2] = zv[i2]; 12575 intrsc_(v1, v2, cn, b, &ierr); 12576 12577 /* B is between Q and P (on the shorter arc) iff */ 12578 /* B Forward Q->P and B Forward P->Q iff */ 12579 /* <B,QN> > 0 and <B,PN> > 0. */ 12580 12581 if (b[0] * qn[0] + b[1] * qn[1] + b[2] * qn[2] > 0. && b[0] * pn[0] + 12582 b[1] * pn[1] + b[2] * pn[2] > 0.) { 12583 12584 /* Update EVEN, BQ, QINR, BP, and PINR. */ 12585 12586 even = ! even; 12587 d__ = b[0] * q[0] + b[1] * q[1] + b[2] * q[2]; 12588 if (d__ > bq) { 12589 bq = d__; 12590 qinr = lft2; 12591 } 12592 d__ = b[0] * p[1] + b[1] * p[2] + b[2] * p[3]; 12593 if (d__ > bp) { 12594 bp = d__; 12595 pinr = lft1; 12596 } 12597 } 12598 L2: 12599 ; 12600 } 12601 12602 /* Test for consistency: NI must be even and QINR must be */ 12603 /* TRUE. */ 12604 12605 if (ni != ni / 2 << 1 || ! qinr) { 12606 goto L1; 12607 } 12608 12609 /* Test for error 3: different values of PINR and EVEN. */ 12610 12611 if (pinr != even) { 12612 goto L13; 12613 } 12614 12615 /* No error encountered. */ 12616 12617 *ier = 0; 12618 ret_val = even; 12619 return ret_val; 12620 12621 /* LV or NV is outside its valid range. */ 12622 12623 L11: 12624 *ier = 1; 12625 return ret_val; 12626 12627 /* A LISTV entry is outside its valid range. */ 12628 12629 L12: 12630 *ier = 2; 12631 return ret_val; 12632 12633 /* The polygon boundary is self-intersecting. */ 12634 12635 L13: 12636 *ier = 3; 12637 return ret_val; 12638 12639 /* Consistency tests failed for all values of Q. */ 12640 12641 L14: 12642 *ier = 4; 12643 return ret_val; 12644 } /* inside_ */
|
|
Definition at line 12646 of file util_sparx.cpp. References insert_(), and lstptr_(). Referenced by addnod_(). 12648 { 12649 static int k, n1, n2, n3, lp; 12650 extern /* Subroutine */ int insert_(int *, int *, int *, 12651 int *, int *); 12652 extern int lstptr_(int *, int *, int *, int *); 12653 12654 12655 /* *********************************************************** */ 12656 12657 /* From STRIPACK */ 12658 /* Robert J. Renka */ 12659 /* Dept. of Computer Science */ 12660 /* Univ. of North Texas */ 12661 /* renka@cs.unt.edu */ 12662 /* 07/17/96 */ 12663 12664 /* This subroutine adds an interior node to a triangulation */ 12665 /* of a set of points on the unit sphere. The data structure */ 12666 /* is updated with the insertion of node KK into the triangle */ 12667 /* whose vertices are I1, I2, and I3. No optimization of the */ 12668 /* triangulation is performed. */ 12669 12670 /* This routine is identical to the similarly named routine */ 12671 /* in TRIPACK. */ 12672 12673 12674 /* On input: */ 12675 12676 /* KK = Index of the node to be inserted. KK .GE. 1 */ 12677 /* and KK must not be equal to I1, I2, or I3. */ 12678 12679 /* I1,I2,I3 = Indexes of the counterclockwise-ordered */ 12680 /* sequence of vertices of a triangle which */ 12681 /* contains node KK. */ 12682 12683 /* The above parameters are not altered by this routine. */ 12684 12685 /* LIST,LPTR,LEND,LNEW = Data structure defining the */ 12686 /* triangulation. Refer to Sub- */ 12687 /* routine TRMESH. Triangle */ 12688 /* (I1,I2,I3) must be included */ 12689 /* in the triangulation. */ 12690 12691 /* On output: */ 12692 12693 /* LIST,LPTR,LEND,LNEW = Data structure updated with */ 12694 /* the addition of node KK. KK */ 12695 /* will be connected to nodes I1, */ 12696 /* I2, and I3. */ 12697 12698 /* Modules required by INTADD: INSERT, LSTPTR */ 12699 12700 /* *********************************************************** */ 12701 12702 12703 /* Local parameters: */ 12704 12705 /* K = Local copy of KK */ 12706 /* LP = LIST pointer */ 12707 /* N1,N2,N3 = Local copies of I1, I2, and I3 */ 12708 12709 /* Parameter adjustments */ 12710 --lend; 12711 --lptr; 12712 --list; 12713 12714 /* Function Body */ 12715 k = *kk; 12716 12717 /* Initialization. */ 12718 12719 n1 = *i1; 12720 n2 = *i2; 12721 n3 = *i3; 12722 12723 /* Add K as a neighbor of I1, I2, and I3. */ 12724 12725 lp = lstptr_(&lend[n1], &n2, &list[1], &lptr[1]); 12726 insert_(&k, &lp, &list[1], &lptr[1], lnew); 12727 lp = lstptr_(&lend[n2], &n3, &list[1], &lptr[1]); 12728 insert_(&k, &lp, &list[1], &lptr[1], lnew); 12729 lp = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]); 12730 insert_(&k, &lp, &list[1], &lptr[1], lnew); 12731 12732 /* Add I1, I2, and I3 as neighbors of K. */ 12733 12734 list[*lnew] = n1; 12735 list[*lnew + 1] = n2; 12736 list[*lnew + 2] = n3; 12737 lptr[*lnew] = *lnew + 1; 12738 lptr[*lnew + 1] = *lnew + 2; 12739 lptr[*lnew + 2] = *lnew; 12740 lend[k] = *lnew + 2; 12741 *lnew += 3; 12742 return 0; 12743 } /* intadd_ */
|
|
Definition at line 12745 of file util_sparx.cpp. Referenced by inside_(). 12747 { 12748 /* Builtin functions */ 12749 //double sqrt(double); 12750 12751 /* Local variables */ 12752 static int i__; 12753 static double t, d1, d2, pp[3], ppn; 12754 12755 12756 /* *********************************************************** */ 12757 12758 /* From STRIPACK */ 12759 /* Robert J. Renka */ 12760 /* Dept. of Computer Science */ 12761 /* Univ. of North Texas */ 12762 /* renka@cs.unt.edu */ 12763 /* 07/19/90 */ 12764 12765 /* Given a great circle C and points P1 and P2 defining an */ 12766 /* arc A on the surface of the unit sphere, where A is the */ 12767 /* shorter of the two portions of the great circle C12 assoc- */ 12768 /* iated with P1 and P2, this subroutine returns the point */ 12769 /* of intersection P between C and C12 that is closer to A. */ 12770 /* Thus, if P1 and P2 lie in opposite hemispheres defined by */ 12771 /* C, P is the point of intersection of C with A. */ 12772 12773 12774 /* On input: */ 12775 12776 /* P1,P2 = Arrays of length 3 containing the Cartesian */ 12777 /* coordinates of unit vectors. */ 12778 12779 /* CN = Array of length 3 containing the Cartesian */ 12780 /* coordinates of a nonzero vector which defines C */ 12781 /* as the intersection of the plane whose normal */ 12782 /* is CN with the unit sphere. Thus, if C is to */ 12783 /* be the great circle defined by P and Q, CN */ 12784 /* should be P X Q. */ 12785 12786 /* The above parameters are not altered by this routine. */ 12787 12788 /* P = Array of length 3. */ 12789 12790 /* On output: */ 12791 12792 /* P = Point of intersection defined above unless IER */ 12793 /* .NE. 0, in which case P is not altered. */ 12794 12795 /* IER = Error indicator. */ 12796 /* IER = 0 if no errors were encountered. */ 12797 /* IER = 1 if <CN,P1> = <CN,P2>. This occurs */ 12798 /* iff P1 = P2 or CN = 0 or there are */ 12799 /* two intersection points at the same */ 12800 /* distance from A. */ 12801 /* IER = 2 if P2 = -P1 and the definition of A is */ 12802 /* therefore ambiguous. */ 12803 12804 /* Modules required by INTRSC: None */ 12805 12806 /* Intrinsic function called by INTRSC: SQRT */ 12807 12808 /* *********************************************************** */ 12809 12810 12811 /* Local parameters: */ 12812 12813 /* D1 = <CN,P1> */ 12814 /* D2 = <CN,P2> */ 12815 /* I = DO-loop index */ 12816 /* PP = P1 + T*(P2-P1) = Parametric representation of the */ 12817 /* line defined by P1 and P2 */ 12818 /* PPN = Norm of PP */ 12819 /* T = D1/(D1-D2) = Parameter value chosen so that PP lies */ 12820 /* in the plane of C */ 12821 12822 /* Parameter adjustments */ 12823 --p; 12824 --cn; 12825 --p2; 12826 --p1; 12827 12828 /* Function Body */ 12829 d1 = cn[1] * p1[1] + cn[2] * p1[2] + cn[3] * p1[3]; 12830 d2 = cn[1] * p2[1] + cn[2] * p2[2] + cn[3] * p2[3]; 12831 12832 if (d1 == d2) { 12833 *ier = 1; 12834 return 0; 12835 } 12836 12837 /* Solve for T such that <PP,CN> = 0 and compute PP and PPN. */ 12838 12839 t = d1 / (d1 - d2); 12840 ppn = 0.; 12841 for (i__ = 1; i__ <= 3; ++i__) { 12842 pp[i__ - 1] = p1[i__] + t * (p2[i__] - p1[i__]); 12843 ppn += pp[i__ - 1] * pp[i__ - 1]; 12844 /* L1: */ 12845 } 12846 12847 /* PPN = 0 iff PP = 0 iff P2 = -P1 (and T = .5). */ 12848 12849 if (ppn == 0.) { 12850 *ier = 2; 12851 return 0; 12852 } 12853 ppn = sqrt(ppn); 12854 12855 /* Compute P = PP/PPN. */ 12856 12857 for (i__ = 1; i__ <= 3; ++i__) { 12858 p[i__] = pp[i__ - 1] / ppn; 12859 /* L2: */ 12860 } 12861 *ier = 0; 12862 return 0; 12863 } /* intrsc_ */
|
|
Definition at line 12865 of file util_sparx.cpp. Referenced by trfind_(). 12866 { 12867 /* System generated locals */ 12868 int ret_val; 12869 12870 /* Local variables */ 12871 static float u, x; 12872 12873 12874 /* *********************************************************** */ 12875 12876 /* From STRIPACK */ 12877 /* Robert J. Renka */ 12878 /* Dept. of Computer Science */ 12879 /* Univ. of North Texas */ 12880 /* renka@cs.unt.edu */ 12881 /* 07/28/98 */ 12882 12883 /* This function returns a uniformly distributed pseudo- */ 12884 /* random int in the range 1 to N. */ 12885 12886 12887 /* On input: */ 12888 12889 /* N = Maximum value to be returned. */ 12890 12891 /* N is not altered by this function. */ 12892 12893 /* IX,IY,IZ = int seeds initialized to values in */ 12894 /* the range 1 to 30,000 before the first */ 12895 /* call to JRAND, and not altered between */ 12896 /* subsequent calls (unless a sequence of */ 12897 /* random numbers is to be repeated by */ 12898 /* reinitializing the seeds). */ 12899 12900 /* On output: */ 12901 12902 /* IX,IY,IZ = Updated int seeds. */ 12903 12904 /* JRAND = Random int in the range 1 to N. */ 12905 12906 /* Reference: B. A. Wichmann and I. D. Hill, "An Efficient */ 12907 /* and Portable Pseudo-random Number Generator", */ 12908 /* Applied Statistics, Vol. 31, No. 2, 1982, */ 12909 /* pp. 188-190. */ 12910 12911 /* Modules required by JRAND: None */ 12912 12913 /* Intrinsic functions called by JRAND: INT, MOD, float */ 12914 12915 /* *********************************************************** */ 12916 12917 12918 /* Local parameters: */ 12919 12920 /* U = Pseudo-random number uniformly distributed in the */ 12921 /* interval (0,1). */ 12922 /* X = Pseudo-random number in the range 0 to 3 whose frac- */ 12923 /* tional part is U. */ 12924 12925 *ix = *ix * 171 % 30269; 12926 *iy = *iy * 172 % 30307; 12927 *iz = *iz * 170 % 30323; 12928 x = (float) (*ix) / 30269.f + (float) (*iy) / 30307.f + (float) (*iz) / 12929 30323.f; 12930 u = x - (int) x; 12931 ret_val = (int) ((float) (*n) * u + 1.f); 12932 return ret_val; 12933 } /* jrand_ */
|
|
Definition at line 12935 of file util_sparx.cpp. Referenced by angle_(), delnod_(), edge_(), trmesh_(), and EMAN::Util::trmsh3_(). 12938 { 12939 /* System generated locals */ 12940 long int ret_val; 12941 12942 12943 /* *********************************************************** */ 12944 12945 /* From STRIPACK */ 12946 /* Robert J. Renka */ 12947 /* Dept. of Computer Science */ 12948 /* Univ. of North Texas */ 12949 /* renka@cs.unt.edu */ 12950 /* 07/15/96 */ 12951 12952 /* This function determines whether node N0 is in the */ 12953 /* (closed) left hemisphere defined by the plane containing */ 12954 /* N1, N2, and the origin, where left is defined relative to */ 12955 /* an observer at N1 facing N2. */ 12956 12957 12958 /* On input: */ 12959 12960 /* X1,Y1,Z1 = Coordinates of N1. */ 12961 12962 /* X2,Y2,Z2 = Coordinates of N2. */ 12963 12964 /* X0,Y0,Z0 = Coordinates of N0. */ 12965 12966 /* Input parameters are not altered by this function. */ 12967 12968 /* On output: */ 12969 12970 /* LEFT = TRUE if and only if N0 is in the closed */ 12971 /* left hemisphere. */ 12972 12973 /* Modules required by LEFT: None */ 12974 12975 /* *********************************************************** */ 12976 12977 /* LEFT = TRUE iff <N0,N1 X N2> = det(N0,N1,N2) .GE. 0. */ 12978 12979 ret_val = *x0 * (*y1 * *z2 - *y2 * *z1) - *y0 * (*x1 * *z2 - *x2 * *z1) + 12980 *z0 * (*x1 * *y2 - *x2 * *y1) >= -0.000001; 12981 12982 12983 return ret_val; 12984 } /* left_ */
|
|
Definition at line 12986 of file util_sparx.cpp. Referenced by addnod_(), crlist_(), delarc_(), delnod_(), intadd_(), nearnd_(), swap_(), and trfind_(). 12987 { 12988 /* System generated locals */ 12989 int ret_val; 12990 12991 /* Local variables */ 12992 static int nd, lp; 12993 12994 12995 /* *********************************************************** */ 12996 12997 /* From STRIPACK */ 12998 /* Robert J. Renka */ 12999 /* Dept. of Computer Science */ 13000 /* Univ. of North Texas */ 13001 /* renka@cs.unt.edu */ 13002 /* 07/15/96 */ 13003 13004 /* This function returns the index (LIST pointer) of NB in */ 13005 /* the adjacency list for N0, where LPL = LEND(N0). */ 13006 13007 /* This function is identical to the similarly named */ 13008 /* function in TRIPACK. */ 13009 13010 13011 /* On input: */ 13012 13013 /* LPL = LEND(N0) */ 13014 13015 /* NB = Index of the node whose pointer is to be re- */ 13016 /* turned. NB must be connected to N0. */ 13017 13018 /* LIST,LPTR = Data structure defining the triangula- */ 13019 /* tion. Refer to Subroutine TRMESH. */ 13020 13021 /* Input parameters are not altered by this function. */ 13022 13023 /* On output: */ 13024 13025 /* LSTPTR = Pointer such that LIST(LSTPTR) = NB or */ 13026 /* LIST(LSTPTR) = -NB, unless NB is not a */ 13027 /* neighbor of N0, in which case LSTPTR = LPL. */ 13028 13029 /* Modules required by LSTPTR: None */ 13030 13031 /* *********************************************************** */ 13032 13033 13034 /* Local parameters: */ 13035 13036 /* LP = LIST pointer */ 13037 /* ND = Nodal index */ 13038 13039 /* Parameter adjustments */ 13040 --lptr; 13041 --list; 13042 13043 /* Function Body */ 13044 lp = lptr[*lpl]; 13045 L1: 13046 nd = list[lp]; 13047 if (nd == *nb) { 13048 goto L2; 13049 } 13050 lp = lptr[lp]; 13051 if (lp != *lpl) { 13052 goto L1; 13053 } 13054 13055 L2: 13056 ret_val = lp; 13057 return ret_val; 13058 } /* lstptr_ */
|
|
Definition at line 13060 of file util_sparx.cpp. Referenced by delnod_(). 13061 { 13062 /* System generated locals */ 13063 int ret_val; 13064 13065 /* Local variables */ 13066 static int k, lp; 13067 13068 13069 /* *********************************************************** */ 13070 13071 /* From STRIPACK */ 13072 /* Robert J. Renka */ 13073 /* Dept. of Computer Science */ 13074 /* Univ. of North Texas */ 13075 /* renka@cs.unt.edu */ 13076 /* 07/15/96 */ 13077 13078 /* This function returns the number of neighbors of a node */ 13079 /* N0 in a triangulation created by Subroutine TRMESH. */ 13080 13081 /* This function is identical to the similarly named */ 13082 /* function in TRIPACK. */ 13083 13084 13085 /* On input: */ 13086 13087 /* LPL = LIST pointer to the last neighbor of N0 -- */ 13088 /* LPL = LEND(N0). */ 13089 13090 /* LPTR = Array of pointers associated with LIST. */ 13091 13092 /* Input parameters are not altered by this function. */ 13093 13094 /* On output: */ 13095 13096 /* NBCNT = Number of neighbors of N0. */ 13097 13098 /* Modules required by NBCNT: None */ 13099 13100 /* *********************************************************** */ 13101 13102 13103 /* Local parameters: */ 13104 13105 /* K = Counter for computing the number of neighbors */ 13106 /* LP = LIST pointer */ 13107 13108 /* Parameter adjustments */ 13109 --lptr; 13110 13111 /* Function Body */ 13112 lp = *lpl; 13113 k = 1; 13114 13115 L1: 13116 lp = lptr[lp]; 13117 if (lp == *lpl) { 13118 goto L2; 13119 } 13120 ++k; 13121 goto L1; 13122 13123 L2: 13124 ret_val = k; 13125 return ret_val; 13126 } /* nbcnt_ */
|
|
Definition at line 13128 of file util_sparx.cpp. References abs, lstptr_(), nn(), and trfind_(). 13131 { 13132 /* System generated locals */ 13133 int ret_val, i__1; 13134 13135 /* Builtin functions */ 13136 //double acos(double); 13137 13138 /* Local variables */ 13139 static int l; 13140 static double b1, b2, b3; 13141 static int i1, i2, i3, n1, n2, n3, lp, nn, nr; 13142 static double ds1; 13143 static int lp1, lp2; 13144 static double dx1, dx2, dx3, dy1, dy2, dy3, dz1, dz2, dz3; 13145 static int lpl; 13146 static double dsr; 13147 static int nst, listp[25], lptrp[25]; 13148 extern /* Subroutine */ int trfind_(int *, double *, int *, 13149 double *, double *, double *, int *, int *, 13150 int *, double *, double *, double *, int *, 13151 int *, int *); 13152 extern int lstptr_(int *, int *, int *, int *); 13153 13154 13155 /* *********************************************************** */ 13156 13157 /* From STRIPACK */ 13158 /* Robert J. Renka */ 13159 /* Dept. of Computer Science */ 13160 /* Univ. of North Texas */ 13161 /* renka@cs.unt.edu */ 13162 /* 07/28/98 */ 13163 13164 /* Given a point P on the surface of the unit sphere and a */ 13165 /* Delaunay triangulation created by Subroutine TRMESH, this */ 13166 /* function returns the index of the nearest triangulation */ 13167 /* node to P. */ 13168 13169 /* The algorithm consists of implicitly adding P to the */ 13170 /* triangulation, finding the nearest neighbor to P, and */ 13171 /* implicitly deleting P from the triangulation. Thus, it */ 13172 /* is based on the fact that, if P is a node in a Delaunay */ 13173 /* triangulation, the nearest node to P is a neighbor of P. */ 13174 13175 13176 /* On input: */ 13177 13178 /* P = Array of length 3 containing the Cartesian coor- */ 13179 /* dinates of the point P to be located relative to */ 13180 /* the triangulation. It is assumed without a test */ 13181 /* that P(1)**2 + P(2)**2 + P(3)**2 = 1. */ 13182 13183 /* IST = Index of a node at which TRFIND begins the */ 13184 /* search. Search time depends on the proximity */ 13185 /* of this node to P. */ 13186 13187 /* N = Number of nodes in the triangulation. N .GE. 3. */ 13188 13189 /* X,Y,Z = Arrays of length N containing the Cartesian */ 13190 /* coordinates of the nodes. */ 13191 13192 /* LIST,LPTR,LEND = Data structure defining the trian- */ 13193 /* gulation. Refer to TRMESH. */ 13194 13195 /* Input parameters are not altered by this function. */ 13196 13197 /* On output: */ 13198 13199 /* NEARND = Nodal index of the nearest node to P, or 0 */ 13200 /* if N < 3 or the triangulation data struc- */ 13201 /* ture is invalid. */ 13202 13203 /* AL = Arc length (angular distance in radians) be- */ 13204 /* tween P and NEARND unless NEARND = 0. */ 13205 13206 /* Note that the number of candidates for NEARND */ 13207 /* (neighbors of P) is limited to LMAX defined in */ 13208 /* the PARAMETER statement below. */ 13209 13210 /* Modules required by NEARND: JRAND, LSTPTR, TRFIND, STORE */ 13211 13212 /* Intrinsic functions called by NEARND: ABS, ACOS */ 13213 13214 /* *********************************************************** */ 13215 13216 13217 /* Local parameters: */ 13218 13219 /* B1,B2,B3 = Unnormalized barycentric coordinates returned */ 13220 /* by TRFIND */ 13221 /* DS1 = (Negative cosine of the) distance from P to N1 */ 13222 /* DSR = (Negative cosine of the) distance from P to NR */ 13223 /* DX1,..DZ3 = Components of vectors used by the swap test */ 13224 /* I1,I2,I3 = Nodal indexes of a triangle containing P, or */ 13225 /* the rightmost (I1) and leftmost (I2) visible */ 13226 /* boundary nodes as viewed from P */ 13227 /* L = Length of LISTP/LPTRP and number of neighbors */ 13228 /* of P */ 13229 /* LMAX = Maximum value of L */ 13230 /* LISTP = Indexes of the neighbors of P */ 13231 /* LPTRP = Array of pointers in 1-1 correspondence with */ 13232 /* LISTP elements */ 13233 /* LP = LIST pointer to a neighbor of N1 and LISTP */ 13234 /* pointer */ 13235 /* LP1,LP2 = LISTP indexes (pointers) */ 13236 /* LPL = Pointer to the last neighbor of N1 */ 13237 /* N1 = Index of a node visible from P */ 13238 /* N2 = Index of an endpoint of an arc opposite P */ 13239 /* N3 = Index of the node opposite N1->N2 */ 13240 /* NN = Local copy of N */ 13241 /* NR = Index of a candidate for the nearest node to P */ 13242 /* NST = Index of the node at which TRFIND begins the */ 13243 /* search */ 13244 13245 13246 /* Store local parameters and test for N invalid. */ 13247 13248 /* Parameter adjustments */ 13249 --p; 13250 --lend; 13251 --z__; 13252 --y; 13253 --x; 13254 --list; 13255 --lptr; 13256 13257 /* Function Body */ 13258 nn = *n; 13259 if (nn < 3) { 13260 goto L6; 13261 } 13262 nst = *ist; 13263 if (nst < 1 || nst > nn) { 13264 nst = 1; 13265 } 13266 13267 /* Find a triangle (I1,I2,I3) containing P, or the rightmost */ 13268 /* (I1) and leftmost (I2) visible boundary nodes as viewed */ 13269 /* from P. */ 13270 13271 trfind_(&nst, &p[1], n, &x[1], &y[1], &z__[1], &list[1], &lptr[1], &lend[ 13272 1], &b1, &b2, &b3, &i1, &i2, &i3); 13273 13274 /* Test for collinear nodes. */ 13275 13276 if (i1 == 0) { 13277 goto L6; 13278 } 13279 13280 /* Store the linked list of 'neighbors' of P in LISTP and */ 13281 /* LPTRP. I1 is the first neighbor, and 0 is stored as */ 13282 /* the last neighbor if P is not contained in a triangle. */ 13283 /* L is the length of LISTP and LPTRP, and is limited to */ 13284 /* LMAX. */ 13285 13286 if (i3 != 0) { 13287 listp[0] = i1; 13288 lptrp[0] = 2; 13289 listp[1] = i2; 13290 lptrp[1] = 3; 13291 listp[2] = i3; 13292 lptrp[2] = 1; 13293 l = 3; 13294 } else { 13295 n1 = i1; 13296 l = 1; 13297 lp1 = 2; 13298 listp[l - 1] = n1; 13299 lptrp[l - 1] = lp1; 13300 13301 /* Loop on the ordered sequence of visible boundary nodes */ 13302 /* N1 from I1 to I2. */ 13303 13304 L1: 13305 lpl = lend[n1]; 13306 n1 = -list[lpl]; 13307 l = lp1; 13308 lp1 = l + 1; 13309 listp[l - 1] = n1; 13310 lptrp[l - 1] = lp1; 13311 if (n1 != i2 && lp1 < 25) { 13312 goto L1; 13313 } 13314 l = lp1; 13315 listp[l - 1] = 0; 13316 lptrp[l - 1] = 1; 13317 } 13318 13319 /* Initialize variables for a loop on arcs N1-N2 opposite P */ 13320 /* in which new 'neighbors' are 'swapped' in. N1 follows */ 13321 /* N2 as a neighbor of P, and LP1 and LP2 are the LISTP */ 13322 /* indexes of N1 and N2. */ 13323 13324 lp2 = 1; 13325 n2 = i1; 13326 lp1 = lptrp[0]; 13327 n1 = listp[lp1 - 1]; 13328 13329 /* Begin loop: find the node N3 opposite N1->N2. */ 13330 13331 L2: 13332 lp = lstptr_(&lend[n1], &n2, &list[1], &lptr[1]); 13333 if (list[lp] < 0) { 13334 goto L3; 13335 } 13336 lp = lptr[lp]; 13337 n3 = (i__1 = list[lp], abs(i__1)); 13338 13339 /* Swap test: Exit the loop if L = LMAX. */ 13340 13341 if (l == 25) { 13342 goto L4; 13343 } 13344 dx1 = x[n1] - p[1]; 13345 dy1 = y[n1] - p[2]; 13346 dz1 = z__[n1] - p[3]; 13347 13348 dx2 = x[n2] - p[1]; 13349 dy2 = y[n2] - p[2]; 13350 dz2 = z__[n2] - p[3]; 13351 13352 dx3 = x[n3] - p[1]; 13353 dy3 = y[n3] - p[2]; 13354 dz3 = z__[n3] - p[3]; 13355 if (dx3 * (dy2 * dz1 - dy1 * dz2) - dy3 * (dx2 * dz1 - dx1 * dz2) + dz3 * 13356 (dx2 * dy1 - dx1 * dy2) <= 0.) { 13357 goto L3; 13358 } 13359 13360 /* Swap: Insert N3 following N2 in the adjacency list for P. */ 13361 /* The two new arcs opposite P must be tested. */ 13362 13363 ++l; 13364 lptrp[lp2 - 1] = l; 13365 listp[l - 1] = n3; 13366 lptrp[l - 1] = lp1; 13367 lp1 = l; 13368 n1 = n3; 13369 goto L2; 13370 13371 /* No swap: Advance to the next arc and test for termination */ 13372 /* on N1 = I1 (LP1 = 1) or N1 followed by 0. */ 13373 13374 L3: 13375 if (lp1 == 1) { 13376 goto L4; 13377 } 13378 lp2 = lp1; 13379 n2 = n1; 13380 lp1 = lptrp[lp1 - 1]; 13381 n1 = listp[lp1 - 1]; 13382 if (n1 == 0) { 13383 goto L4; 13384 } 13385 goto L2; 13386 13387 /* Set NR and DSR to the index of the nearest node to P and */ 13388 /* an increasing function (negative cosine) of its distance */ 13389 /* from P, respectively. */ 13390 13391 L4: 13392 nr = i1; 13393 dsr = -(x[nr] * p[1] + y[nr] * p[2] + z__[nr] * p[3]); 13394 i__1 = l; 13395 for (lp = 2; lp <= i__1; ++lp) { 13396 n1 = listp[lp - 1]; 13397 if (n1 == 0) { 13398 goto L5; 13399 } 13400 ds1 = -(x[n1] * p[1] + y[n1] * p[2] + z__[n1] * p[3]); 13401 if (ds1 < dsr) { 13402 nr = n1; 13403 dsr = ds1; 13404 } 13405 L5: 13406 ; 13407 } 13408 dsr = -dsr; 13409 if (dsr > 1.) { 13410 dsr = 1.; 13411 } 13412 *al = acos(dsr); 13413 ret_val = nr; 13414 return ret_val; 13415 13416 /* Invalid input. */ 13417 13418 L6: 13419 ret_val = 0; 13420 return ret_val; 13421 } /* nearnd_ */
|
|
Definition at line 13423 of file util_sparx.cpp. References abs, FALSE_, swap_(), swptst_(), and TRUE_. Referenced by delnod_(), and edge_(). 13426 { 13427 /* System generated locals */ 13428 int i__1, i__2; 13429 13430 /* Local variables */ 13431 static int i__, n1, n2, lp, io1, io2, nna, lp21, lpl, lpp; 13432 static long int swp; 13433 static int iter; 13434 extern /* Subroutine */ int swap_(int *, int *, int *, 13435 int *, int *, int *, int *, int *); 13436 static int maxit; 13437 extern long int swptst_(int *, int *, int *, int *, 13438 double *, double *, double *); 13439 13440 13441 /* *********************************************************** */ 13442 13443 /* From STRIPACK */ 13444 /* Robert J. Renka */ 13445 /* Dept. of Computer Science */ 13446 /* Univ. of North Texas */ 13447 /* renka@cs.unt.edu */ 13448 /* 07/30/98 */ 13449 13450 /* Given a set of NA triangulation arcs, this subroutine */ 13451 /* optimizes the portion of the triangulation consisting of */ 13452 /* the quadrilaterals (pairs of adjacent triangles) which */ 13453 /* have the arcs as diagonals by applying the circumcircle */ 13454 /* test and appropriate swaps to the arcs. */ 13455 13456 /* An iteration consists of applying the swap test and */ 13457 /* swaps to all NA arcs in the order in which they are */ 13458 /* stored. The iteration is repeated until no swap occurs */ 13459 /* or NIT iterations have been performed. The bound on the */ 13460 /* number of iterations may be necessary to prevent an */ 13461 /* infinite loop caused by cycling (reversing the effect of a */ 13462 /* previous swap) due to floating point inaccuracy when four */ 13463 /* or more nodes are nearly cocircular. */ 13464 13465 13466 /* On input: */ 13467 13468 /* X,Y,Z = Arrays containing the nodal coordinates. */ 13469 13470 /* NA = Number of arcs in the set. NA .GE. 0. */ 13471 13472 /* The above parameters are not altered by this routine. */ 13473 13474 /* LIST,LPTR,LEND = Data structure defining the trian- */ 13475 /* gulation. Refer to Subroutine */ 13476 /* TRMESH. */ 13477 13478 /* NIT = Maximum number of iterations to be performed. */ 13479 /* NIT = 4*NA should be sufficient. NIT .GE. 1. */ 13480 13481 /* IWK = int array dimensioned 2 by NA containing */ 13482 /* the nodal indexes of the arc endpoints (pairs */ 13483 /* of endpoints are stored in columns). */ 13484 13485 /* On output: */ 13486 13487 /* LIST,LPTR,LEND = Updated triangulation data struc- */ 13488 /* ture reflecting the swaps. */ 13489 13490 /* NIT = Number of iterations performed. */ 13491 13492 /* IWK = Endpoint indexes of the new set of arcs */ 13493 /* reflecting the swaps. */ 13494 13495 /* IER = Error indicator: */ 13496 /* IER = 0 if no errors were encountered. */ 13497 /* IER = 1 if a swap occurred on the last of */ 13498 /* MAXIT iterations, where MAXIT is the */ 13499 /* value of NIT on input. The new set */ 13500 /* of arcs is not necessarily optimal */ 13501 /* in this case. */ 13502 /* IER = 2 if NA < 0 or NIT < 1 on input. */ 13503 /* IER = 3 if IWK(2,I) is not a neighbor of */ 13504 /* IWK(1,I) for some I in the range 1 */ 13505 /* to NA. A swap may have occurred in */ 13506 /* this case. */ 13507 /* IER = 4 if a zero pointer was returned by */ 13508 /* Subroutine SWAP. */ 13509 13510 /* Modules required by OPTIM: LSTPTR, SWAP, SWPTST */ 13511 13512 /* Intrinsic function called by OPTIM: ABS */ 13513 13514 /* *********************************************************** */ 13515 13516 13517 /* Local parameters: */ 13518 13519 /* I = Column index for IWK */ 13520 /* IO1,IO2 = Nodal indexes of the endpoints of an arc in IWK */ 13521 /* ITER = Iteration count */ 13522 /* LP = LIST pointer */ 13523 /* LP21 = Parameter returned by SWAP (not used) */ 13524 /* LPL = Pointer to the last neighbor of IO1 */ 13525 /* LPP = Pointer to the node preceding IO2 as a neighbor */ 13526 /* of IO1 */ 13527 /* MAXIT = Input value of NIT */ 13528 /* N1,N2 = Nodes opposite IO1->IO2 and IO2->IO1, */ 13529 /* respectively */ 13530 /* NNA = Local copy of NA */ 13531 /* SWP = Flag set to TRUE iff a swap occurs in the */ 13532 /* optimization loop */ 13533 13534 /* Parameter adjustments */ 13535 --x; 13536 --y; 13537 --z__; 13538 iwk -= 3; 13539 --list; 13540 --lptr; 13541 --lend; 13542 13543 /* Function Body */ 13544 nna = *na; 13545 maxit = *nit; 13546 if (nna < 0 || maxit < 1) { 13547 goto L7; 13548 } 13549 13550 /* Initialize iteration count ITER and test for NA = 0. */ 13551 13552 iter = 0; 13553 if (nna == 0) { 13554 goto L5; 13555 } 13556 13557 /* Top of loop -- */ 13558 /* SWP = TRUE iff a swap occurred in the current iteration. */ 13559 13560 L1: 13561 if (iter == maxit) { 13562 goto L6; 13563 } 13564 ++iter; 13565 swp = FALSE_; 13566 13567 /* Inner loop on arcs IO1-IO2 -- */ 13568 13569 i__1 = nna; 13570 for (i__ = 1; i__ <= i__1; ++i__) { 13571 io1 = iwk[(i__ << 1) + 1]; 13572 io2 = iwk[(i__ << 1) + 2]; 13573 13574 /* Set N1 and N2 to the nodes opposite IO1->IO2 and */ 13575 /* IO2->IO1, respectively. Determine the following: */ 13576 13577 /* LPL = pointer to the last neighbor of IO1, */ 13578 /* LP = pointer to IO2 as a neighbor of IO1, and */ 13579 /* LPP = pointer to the node N2 preceding IO2. */ 13580 13581 lpl = lend[io1]; 13582 lpp = lpl; 13583 lp = lptr[lpp]; 13584 L2: 13585 if (list[lp] == io2) { 13586 goto L3; 13587 } 13588 lpp = lp; 13589 lp = lptr[lpp]; 13590 if (lp != lpl) { 13591 goto L2; 13592 } 13593 13594 /* IO2 should be the last neighbor of IO1. Test for no */ 13595 /* arc and bypass the swap test if IO1 is a boundary */ 13596 /* node. */ 13597 13598 if ((i__2 = list[lp], abs(i__2)) != io2) { 13599 goto L8; 13600 } 13601 if (list[lp] < 0) { 13602 goto L4; 13603 } 13604 13605 /* Store N1 and N2, or bypass the swap test if IO1 is a */ 13606 /* boundary node and IO2 is its first neighbor. */ 13607 13608 L3: 13609 n2 = list[lpp]; 13610 if (n2 < 0) { 13611 goto L4; 13612 } 13613 lp = lptr[lp]; 13614 n1 = (i__2 = list[lp], abs(i__2)); 13615 13616 /* Test IO1-IO2 for a swap, and update IWK if necessary. */ 13617 13618 if (! swptst_(&n1, &n2, &io1, &io2, &x[1], &y[1], &z__[1])) { 13619 goto L4; 13620 } 13621 swap_(&n1, &n2, &io1, &io2, &list[1], &lptr[1], &lend[1], &lp21); 13622 if (lp21 == 0) { 13623 goto L9; 13624 } 13625 swp = TRUE_; 13626 iwk[(i__ << 1) + 1] = n1; 13627 iwk[(i__ << 1) + 2] = n2; 13628 L4: 13629 ; 13630 } 13631 if (swp) { 13632 goto L1; 13633 } 13634 13635 /* Successful termination. */ 13636 13637 L5: 13638 *nit = iter; 13639 *ier = 0; 13640 return 0; 13641 13642 /* MAXIT iterations performed without convergence. */ 13643 13644 L6: 13645 *nit = maxit; 13646 *ier = 1; 13647 return 0; 13648 13649 /* Invalid input parameter. */ 13650 13651 L7: 13652 *nit = 0; 13653 *ier = 2; 13654 return 0; 13655 13656 /* IO2 is not a neighbor of IO1. */ 13657 13658 L8: 13659 *nit = iter; 13660 *ier = 3; 13661 return 0; 13662 13663 /* Zero pointer returned by SWAP. */ 13664 13665 L9: 13666 *nit = iter; 13667 *ier = 4; 13668 return 0; 13669 } /* optim_ */
|
|
Definition at line 13671 of file util_sparx.cpp. References FALSE_, and sqrt(). 13676 { 13677 /* Builtin functions */ 13678 //double sqrt(double); 13679 13680 /* Local variables */ 13681 static double s, sc, xe, ye, ze, xh, yh, zh, xv, yv, zv, xw, yw, zw, 13682 oes, xoe, yoe, zoe, xep, yep, zep; 13683 13684 13685 /* *********************************************************** */ 13686 13687 /* From PLTPACK, SCRPLOT, and STRIPACK */ 13688 /* Robert J. Renka */ 13689 /* Dept. of Computer Science */ 13690 /* Univ. of North Texas */ 13691 /* renka@cs.unt.edu */ 13692 /* 07/18/90 */ 13693 13694 /* Given a projection plane and associated coordinate sys- */ 13695 /* tem defined by an origin O, eye position E, and up-vector */ 13696 /* V, this subroutine applies a perspective depth transform- */ 13697 /* ation T to a point P = (PX,PY,PZ), returning the point */ 13698 /* T(P) = (X,Y,Z), where X and Y are the projection plane */ 13699 /* coordinates of the point that lies in the projection */ 13700 /* plane and on the line defined by P and E, and Z is the */ 13701 /* depth associated with P. */ 13702 13703 /* The projection plane is defined to be the plane that */ 13704 /* contains O and has normal defined by O and E. */ 13705 13706 /* The depth Z is defined in such a way that Z < 1, T maps */ 13707 /* lines to lines (and planes to planes), and if two distinct */ 13708 /* points have the same projection plane coordinates, then */ 13709 /* the one closer to E has a smaller depth. (Z increases */ 13710 /* monotonically with orthogonal distance from P to the plane */ 13711 /* that is parallel to the projection plane and contains E.) */ 13712 /* This depth value facilitates depth sorting and depth buf- */ 13713 /* fer methods. */ 13714 13715 13716 /* On input: */ 13717 13718 /* PX,PY,PZ = Cartesian coordinates of the point P to */ 13719 /* be mapped onto the projection plane. The */ 13720 /* half line that contains P and has end- */ 13721 /* point at E must intersect the plane. */ 13722 13723 /* OX,OY,OZ = Coordinates of O (the origin of a coordi- */ 13724 /* nate system in the projection plane). A */ 13725 /* reasonable value for O is a point near */ 13726 /* the center of an object or scene to be */ 13727 /* viewed. */ 13728 13729 /* EX,EY,EZ = Coordinates of the eye-position E defin- */ 13730 /* ing the normal to the plane and the line */ 13731 /* of sight for the projection. E must not */ 13732 /* coincide with O or P, and the angle be- */ 13733 /* tween the vectors O-E and P-E must be */ 13734 /* less than 90 degrees. Note that E and P */ 13735 /* may lie on opposite sides of the projec- */ 13736 /* tion plane. */ 13737 13738 /* VX,VY,VZ = Coordinates of a point V which defines */ 13739 /* the positive Y axis of an X-Y coordinate */ 13740 /* system in the projection plane as the */ 13741 /* half-line containing O and the projection */ 13742 /* of O+V onto the plane. The positive X */ 13743 /* axis has direction defined by the cross */ 13744 /* product V X (E-O). */ 13745 13746 /* The above parameters are not altered by this routine. */ 13747 13748 /* INIT = long int switch which must be set to TRUE on */ 13749 /* the first call and when the values of O, E, */ 13750 /* or V have been altered since a previous call. */ 13751 /* If INIT = FALSE, it is assumed that only the */ 13752 /* coordinates of P have changed since a previ- */ 13753 /* ous call. Previously stored quantities are */ 13754 /* used for increased efficiency in this case. */ 13755 13756 /* On output: */ 13757 13758 /* INIT = Switch with value reset to FALSE if IER = 0. */ 13759 13760 /* X,Y = Projection plane coordinates of the point */ 13761 /* that lies in the projection plane and on the */ 13762 /* line defined by E and P. X and Y are not */ 13763 /* altered if IER .NE. 0. */ 13764 13765 /* Z = Depth value defined above unless IER .NE. 0. */ 13766 13767 /* IER = Error indicator. */ 13768 /* IER = 0 if no errors were encountered. */ 13769 /* IER = 1 if the inner product of O-E with P-E */ 13770 /* is not positive, implying that E is */ 13771 /* too close to the plane. */ 13772 /* IER = 2 if O, E, and O+V are collinear. See */ 13773 /* the description of VX,VY,VZ. */ 13774 13775 /* Modules required by PROJCT: None */ 13776 13777 /* Intrinsic function called by PROJCT: SQRT */ 13778 13779 /* *********************************************************** */ 13780 13781 13782 /* Local parameters: */ 13783 13784 /* OES = Norm squared of OE -- inner product (OE,OE) */ 13785 /* S = Scale factor for computing projections */ 13786 /* SC = Scale factor for normalizing VN and HN */ 13787 /* XE,YE,ZE = Local copies of EX, EY, EZ */ 13788 /* XEP,YEP,ZEP = Components of the vector EP from E to P */ 13789 /* XH,YH,ZH = Components of a unit vector HN defining the */ 13790 /* positive X-axis in the plane */ 13791 /* XOE,YOE,ZOE = Components of the vector OE from O to E */ 13792 /* XV,YV,ZV = Components of a unit vector VN defining the */ 13793 /* positive Y-axis in the plane */ 13794 /* XW,YW,ZW = Components of the vector W from O to the */ 13795 /* projection of P onto the plane */ 13796 13797 if (*init) { 13798 13799 /* Compute parameters defining the transformation: */ 13800 /* 17 adds, 27 multiplies, 3 divides, 2 compares, and */ 13801 /* 2 square roots. */ 13802 13803 /* Set the coordinates of E to local variables, compute */ 13804 /* OE = E-O and OES, and test for OE = 0. */ 13805 13806 xe = *ex; 13807 ye = *ey; 13808 ze = *ez; 13809 xoe = xe - *ox; 13810 yoe = ye - *oy; 13811 zoe = ze - *oz; 13812 oes = xoe * xoe + yoe * yoe + zoe * zoe; 13813 if (oes == 0.) { 13814 goto L1; 13815 } 13816 13817 /* Compute S = (OE,V)/OES and VN = V - S*OE. */ 13818 13819 s = (xoe * *vx + yoe * *vy + zoe * *vz) / oes; 13820 xv = *vx - s * xoe; 13821 yv = *vy - s * yoe; 13822 zv = *vz - s * zoe; 13823 13824 /* Normalize VN to a unit vector. */ 13825 13826 sc = xv * xv + yv * yv + zv * zv; 13827 if (sc == 0.) { 13828 goto L2; 13829 } 13830 sc = 1. / sqrt(sc); 13831 xv = sc * xv; 13832 yv = sc * yv; 13833 zv = sc * zv; 13834 13835 /* Compute HN = VN X OE (normalized). */ 13836 13837 xh = yv * zoe - yoe * zv; 13838 yh = xoe * zv - xv * zoe; 13839 zh = xv * yoe - xoe * yv; 13840 sc = sqrt(xh * xh + yh * yh + zh * zh); 13841 if (sc == 0.) { 13842 goto L2; 13843 } 13844 sc = 1. / sc; 13845 xh = sc * xh; 13846 yh = sc * yh; 13847 zh = sc * zh; 13848 } 13849 13850 /* Apply the transformation: 13 adds, 12 multiplies, */ 13851 /* 1 divide, and 1 compare. */ 13852 13853 /* Compute EP = P-E, S = OES/(OE,EP), and W = OE - S*EP. */ 13854 13855 xep = *px - xe; 13856 yep = *py - ye; 13857 zep = *pz - ze; 13858 s = xoe * xep + yoe * yep + zoe * zep; 13859 if (s >= 0.) { 13860 goto L1; 13861 } 13862 s = oes / s; 13863 xw = xoe - s * xep; 13864 yw = yoe - s * yep; 13865 zw = zoe - s * zep; 13866 13867 /* Map W into X = (W,HN), Y = (W,VN), compute Z = 1+S, and */ 13868 /* reset INIT. */ 13869 13870 *x = xw * xh + yw * yh + zw * zh; 13871 *y = xw * xv + yw * yv + zw * zv; 13872 *z__ = s + 1.; 13873 *init = FALSE_; 13874 *ier = 0; 13875 return 0; 13876 13877 /* (OE,EP) .GE. 0. */ 13878 13879 L1: 13880 *ier = 1; 13881 return 0; 13882 13883 /* O, E, and O+V are collinear. */ 13884 13885 L2: 13886 *ier = 2; 13887 return 0; 13888 } /* projct_ */
|
|
Definition at line 17144 of file util_sparx.cpp. 17146 { 17147 static double x; 17148 17149 17150 /* This routine returns pseudo-random numbers uniformly */ 17151 /* distributed in the interval (0,1). int seeds IX, IY, */ 17152 /* and IZ should be initialized to values in the range 1 to */ 17153 /* 30,000 before the first call to RANDOM, and should not */ 17154 /* be altered between subsequent calls (unless a sequence */ 17155 /* of random numbers is to be repeated by reinitializing the */ 17156 /* seeds). */ 17157 17158 /* Reference: B. A. Wichmann and I. D. Hill, An Efficient */ 17159 /* and Portable Pseudo-random Number Generator, */ 17160 /* Applied Statistics, Vol. 31, No. 2, 1982, */ 17161 /* pp. 188-190. */ 17162 17163 *ix = *ix * 171 % 30269; 17164 *iy = *iy * 172 % 30307; 17165 *iz = *iz * 170 % 30323; 17166 x = (double) (*ix) / 30269. + (double) (*iy) / 30307. + ( 17167 double) (*iz) / 30323.; 17168 *rannum = x - (int) x; 17169 return 0; 17170 } /* random_ */
|
|
Definition at line 13890 of file util_sparx.cpp. References sqrt(). 13892 { 13893 /* Builtin functions */ 13894 //double sqrt(double), atan2(double, double), asin(double); 13895 13896 13897 /* *********************************************************** */ 13898 13899 /* From STRIPACK */ 13900 /* Robert J. Renka */ 13901 /* Dept. of Computer Science */ 13902 /* Univ. of North Texas */ 13903 /* renka@cs.unt.edu */ 13904 /* 08/27/90 */ 13905 13906 /* This subroutine converts a point P from Cartesian coor- */ 13907 /* dinates to spherical coordinates. */ 13908 13909 13910 /* On input: */ 13911 13912 /* PX,PY,PZ = Cartesian coordinates of P. */ 13913 13914 /* Input parameters are not altered by this routine. */ 13915 13916 /* On output: */ 13917 13918 /* PLAT = Latitude of P in the range -PI/2 to PI/2, or */ 13919 /* 0 if PNRM = 0. PLAT should be scaled by */ 13920 /* 180/PI to obtain the value in degrees. */ 13921 13922 /* PLON = Longitude of P in the range -PI to PI, or 0 */ 13923 /* if P lies on the Z-axis. PLON should be */ 13924 /* scaled by 180/PI to obtain the value in */ 13925 /* degrees. */ 13926 13927 /* PNRM = Magnitude (Euclidean norm) of P. */ 13928 13929 /* Modules required by SCOORD: None */ 13930 13931 /* Intrinsic functions called by SCOORD: ASIN, ATAN2, SQRT */ 13932 13933 /* *********************************************************** */ 13934 13935 *pnrm = sqrt(*px * *px + *py * *py + *pz * *pz); 13936 if (*px != 0. || *py != 0.) { 13937 *plon = atan2(*py, *px); 13938 } else { 13939 *plon = 0.; 13940 } 13941 if (*pnrm != 0.) { 13942 *plat = asin(*pz / *pnrm); 13943 } else { 13944 *plat = 0.; 13945 } 13946 return 0; 13947 } /* scoord_ */
|
|
Definition at line 13949 of file util_sparx.cpp. References stcom_::y. Referenced by trfind_(). 13950 { 13951 /* System generated locals */ 13952 double ret_val; 13953 13954 13955 /* *********************************************************** */ 13956 13957 /* From STRIPACK */ 13958 /* Robert J. Renka */ 13959 /* Dept. of Computer Science */ 13960 /* Univ. of North Texas */ 13961 /* renka@cs.unt.edu */ 13962 /* 05/09/92 */ 13963 13964 /* This function forces its argument X to be stored in a */ 13965 /* memory location, thus providing a means of determining */ 13966 /* floating point number characteristics (such as the machine */ 13967 /* precision) when it is necessary to avoid computation in */ 13968 /* high precision registers. */ 13969 13970 13971 /* On input: */ 13972 13973 /* X = Value to be stored. */ 13974 13975 /* X is not altered by this function. */ 13976 13977 /* On output: */ 13978 13979 /* STORE = Value of X after it has been stored and */ 13980 /* possibly truncated or rounded to the single */ 13981 /* precision word length. */ 13982 13983 /* Modules required by STORE: None */ 13984 13985 /* *********************************************************** */ 13986 13987 stcom_1.y = *x; 13988 ret_val = stcom_1.y; 13989 return ret_val; 13990 } /* store_ */
|
|
Definition at line 13992 of file util_sparx.cpp. References abs, and lstptr_(). Referenced by addnod_(), delnod_(), edge_(), and optim_(). 13994 { 13995 /* System generated locals */ 13996 int i__1; 13997 13998 /* Local variables */ 13999 static int lp, lph, lpsav; 14000 extern int lstptr_(int *, int *, int *, int *); 14001 14002 14003 /* *********************************************************** */ 14004 14005 /* From STRIPACK */ 14006 /* Robert J. Renka */ 14007 /* Dept. of Computer Science */ 14008 /* Univ. of North Texas */ 14009 /* renka@cs.unt.edu */ 14010 /* 06/22/98 */ 14011 14012 /* Given a triangulation of a set of points on the unit */ 14013 /* sphere, this subroutine replaces a diagonal arc in a */ 14014 /* strictly convex quadrilateral (defined by a pair of adja- */ 14015 /* cent triangles) with the other diagonal. Equivalently, a */ 14016 /* pair of adjacent triangles is replaced by another pair */ 14017 /* having the same union. */ 14018 14019 14020 /* On input: */ 14021 14022 /* IN1,IN2,IO1,IO2 = Nodal indexes of the vertices of */ 14023 /* the quadrilateral. IO1-IO2 is re- */ 14024 /* placed by IN1-IN2. (IO1,IO2,IN1) */ 14025 /* and (IO2,IO1,IN2) must be trian- */ 14026 /* gles on input. */ 14027 14028 /* The above parameters are not altered by this routine. */ 14029 14030 /* LIST,LPTR,LEND = Data structure defining the trian- */ 14031 /* gulation. Refer to Subroutine */ 14032 /* TRMESH. */ 14033 14034 /* On output: */ 14035 14036 /* LIST,LPTR,LEND = Data structure updated with the */ 14037 /* swap -- triangles (IO1,IO2,IN1) and */ 14038 /* (IO2,IO1,IN2) are replaced by */ 14039 /* (IN1,IN2,IO2) and (IN2,IN1,IO1) */ 14040 /* unless LP21 = 0. */ 14041 14042 /* LP21 = Index of IN1 as a neighbor of IN2 after the */ 14043 /* swap is performed unless IN1 and IN2 are */ 14044 /* adjacent on input, in which case LP21 = 0. */ 14045 14046 /* Module required by SWAP: LSTPTR */ 14047 14048 /* Intrinsic function called by SWAP: ABS */ 14049 14050 /* *********************************************************** */ 14051 14052 14053 /* Local parameters: */ 14054 14055 /* LP,LPH,LPSAV = LIST pointers */ 14056 14057 14058 /* Test for IN1 and IN2 adjacent. */ 14059 14060 /* Parameter adjustments */ 14061 --lend; 14062 --lptr; 14063 --list; 14064 14065 /* Function Body */ 14066 lp = lstptr_(&lend[*in1], in2, &list[1], &lptr[1]); 14067 if ((i__1 = list[lp], abs(i__1)) == *in2) { 14068 *lp21 = 0; 14069 return 0; 14070 } 14071 14072 /* Delete IO2 as a neighbor of IO1. */ 14073 14074 lp = lstptr_(&lend[*io1], in2, &list[1], &lptr[1]); 14075 lph = lptr[lp]; 14076 lptr[lp] = lptr[lph]; 14077 14078 /* If IO2 is the last neighbor of IO1, make IN2 the */ 14079 /* last neighbor. */ 14080 14081 if (lend[*io1] == lph) { 14082 lend[*io1] = lp; 14083 } 14084 14085 /* Insert IN2 as a neighbor of IN1 following IO1 */ 14086 /* using the hole created above. */ 14087 14088 lp = lstptr_(&lend[*in1], io1, &list[1], &lptr[1]); 14089 lpsav = lptr[lp]; 14090 lptr[lp] = lph; 14091 list[lph] = *in2; 14092 lptr[lph] = lpsav; 14093 14094 /* Delete IO1 as a neighbor of IO2. */ 14095 14096 lp = lstptr_(&lend[*io2], in1, &list[1], &lptr[1]); 14097 lph = lptr[lp]; 14098 lptr[lp] = lptr[lph]; 14099 14100 /* If IO1 is the last neighbor of IO2, make IN1 the */ 14101 /* last neighbor. */ 14102 14103 if (lend[*io2] == lph) { 14104 lend[*io2] = lp; 14105 } 14106 14107 /* Insert IN1 as a neighbor of IN2 following IO2. */ 14108 14109 lp = lstptr_(&lend[*in2], io2, &list[1], &lptr[1]); 14110 lpsav = lptr[lp]; 14111 lptr[lp] = lph; 14112 list[lph] = *in1; 14113 lptr[lph] = lpsav; 14114 *lp21 = lph; 14115 return 0; 14116 } /* swap_ */
|
|
Definition at line 14118 of file util_sparx.cpp. Referenced by addnod_(), crlist_(), and optim_(). 14120 { 14121 /* System generated locals */ 14122 long int ret_val; 14123 14124 /* Local variables */ 14125 static double x4, y4, z4, dx1, dx2, dx3, dy1, dy2, dy3, dz1, dz2, dz3; 14126 14127 14128 /* *********************************************************** */ 14129 14130 /* From STRIPACK */ 14131 /* Robert J. Renka */ 14132 /* Dept. of Computer Science */ 14133 /* Univ. of North Texas */ 14134 /* renka@cs.unt.edu */ 14135 /* 03/29/91 */ 14136 14137 /* This function decides whether or not to replace a */ 14138 /* diagonal arc in a quadrilateral with the other diagonal. */ 14139 /* The decision will be to swap (SWPTST = TRUE) if and only */ 14140 /* if N4 lies above the plane (in the half-space not contain- */ 14141 /* ing the origin) defined by (N1,N2,N3), or equivalently, if */ 14142 /* the projection of N4 onto this plane is interior to the */ 14143 /* circumcircle of (N1,N2,N3). The decision will be for no */ 14144 /* swap if the quadrilateral is not strictly convex. */ 14145 14146 14147 /* On input: */ 14148 14149 /* N1,N2,N3,N4 = Indexes of the four nodes defining the */ 14150 /* quadrilateral with N1 adjacent to N2, */ 14151 /* and (N1,N2,N3) in counterclockwise */ 14152 /* order. The arc connecting N1 to N2 */ 14153 /* should be replaced by an arc connec- */ 14154 /* ting N3 to N4 if SWPTST = TRUE. Refer */ 14155 /* to Subroutine SWAP. */ 14156 14157 /* X,Y,Z = Arrays of length N containing the Cartesian */ 14158 /* coordinates of the nodes. (X(I),Y(I),Z(I)) */ 14159 /* define node I for I = N1, N2, N3, and N4. */ 14160 14161 /* Input parameters are not altered by this routine. */ 14162 14163 /* On output: */ 14164 14165 /* SWPTST = TRUE if and only if the arc connecting N1 */ 14166 /* and N2 should be swapped for an arc con- */ 14167 /* necting N3 and N4. */ 14168 14169 /* Modules required by SWPTST: None */ 14170 14171 /* *********************************************************** */ 14172 14173 14174 /* Local parameters: */ 14175 14176 /* DX1,DY1,DZ1 = Coordinates of N4->N1 */ 14177 /* DX2,DY2,DZ2 = Coordinates of N4->N2 */ 14178 /* DX3,DY3,DZ3 = Coordinates of N4->N3 */ 14179 /* X4,Y4,Z4 = Coordinates of N4 */ 14180 14181 /* Parameter adjustments */ 14182 --z__; 14183 --y; 14184 --x; 14185 14186 /* Function Body */ 14187 x4 = x[*n4]; 14188 y4 = y[*n4]; 14189 z4 = z__[*n4]; 14190 dx1 = x[*n1] - x4; 14191 dx2 = x[*n2] - x4; 14192 dx3 = x[*n3] - x4; 14193 dy1 = y[*n1] - y4; 14194 dy2 = y[*n2] - y4; 14195 dy3 = y[*n3] - y4; 14196 dz1 = z__[*n1] - z4; 14197 dz2 = z__[*n2] - z4; 14198 dz3 = z__[*n3] - z4; 14199 14200 /* N4 lies above the plane of (N1,N2,N3) iff N3 lies above */ 14201 /* the plane of (N2,N1,N4) iff Det(N3-N4,N2-N4,N1-N4) = */ 14202 /* (N3-N4,N2-N4 X N1-N4) > 0. */ 14203 14204 ret_val = dx3 * (dy2 * dz1 - dy1 * dz2) - dy3 * (dx2 * dz1 - dx1 * dz2) + 14205 dz3 * (dx2 * dy1 - dx1 * dy2) > 0.; 14206 return ret_val; 14207 } /* swptst_ */
|
|
Definition at line 14209 of file util_sparx.cpp. References nn(), phi, and theta. 14211 { 14212 /* System generated locals */ 14213 int i__1; 14214 14215 /* Builtin functions */ 14216 //double cos(double), sin(double); 14217 14218 /* Local variables */ 14219 static int i__, nn; 14220 static double phi, theta, cosphi; 14221 14222 14223 /* *********************************************************** */ 14224 14225 /* From STRIPACK */ 14226 /* Robert J. Renka */ 14227 /* Dept. of Computer Science */ 14228 /* Univ. of North Texas */ 14229 /* renka@cs.unt.edu */ 14230 /* 04/08/90 */ 14231 14232 /* This subroutine transforms spherical coordinates into */ 14233 /* Cartesian coordinates on the unit sphere for input to */ 14234 /* Subroutine TRMESH. Storage for X and Y may coincide with */ 14235 /* storage for RLAT and RLON if the latter need not be saved. */ 14236 14237 14238 /* On input: */ 14239 14240 /* N = Number of nodes (points on the unit sphere) */ 14241 /* whose coordinates are to be transformed. */ 14242 14243 /* RLAT = Array of length N containing latitudinal */ 14244 /* coordinates of the nodes in radians. */ 14245 14246 /* RLON = Array of length N containing longitudinal */ 14247 /* coordinates of the nodes in radians. */ 14248 14249 /* The above parameters are not altered by this routine. */ 14250 14251 /* X,Y,Z = Arrays of length at least N. */ 14252 14253 /* On output: */ 14254 14255 /* X,Y,Z = Cartesian coordinates in the range -1 to 1. */ 14256 /* X(I)**2 + Y(I)**2 + Z(I)**2 = 1 for I = 1 */ 14257 /* to N. */ 14258 14259 /* Modules required by TRANS: None */ 14260 14261 /* Intrinsic functions called by TRANS: COS, SIN */ 14262 14263 /* *********************************************************** */ 14264 14265 14266 /* Local parameters: */ 14267 14268 /* COSPHI = cos(PHI) */ 14269 /* I = DO-loop index */ 14270 /* NN = Local copy of N */ 14271 /* PHI = Latitude */ 14272 /* THETA = Longitude */ 14273 14274 /* Parameter adjustments */ 14275 --z__; 14276 --y; 14277 --x; 14278 --rlon; 14279 --rlat; 14280 14281 /* Function Body */ 14282 nn = *n; 14283 i__1 = nn; 14284 for (i__ = 1; i__ <= i__1; ++i__) { 14285 phi = rlat[i__]; 14286 theta = rlon[i__]; 14287 cosphi = cos(phi); 14288 x[i__] = cosphi * cos(theta); 14289 y[i__] = cosphi * sin(theta); 14290 z__[i__] = sin(phi); 14291 /* L1: */ 14292 } 14293 return 0; 14294 } /* trans_ */
|
|
Definition at line 14296 of file util_sparx.cpp. References abs, jrand_(), lstptr_(), q, and store_(). Referenced by addnod_(), and nearnd_(). 14300 { 14301 /* Initialized data */ 14302 14303 static int ix = 1; 14304 static int iy = 2; 14305 static int iz = 3; 14306 14307 /* System generated locals */ 14308 int i__1; 14309 double d__1, d__2; 14310 14311 /* Local variables */ 14312 static double q[3]; 14313 static int n0, n1, n2, n3, n4, nf; 14314 static double s12; 14315 static int nl, lp; 14316 static double xp, yp, zp; 14317 static int n1s, n2s; 14318 static double eps, tol, ptn1, ptn2; 14319 static int next; 14320 extern int jrand_(int *, int *, int *, int *); 14321 extern double store_(double *); 14322 extern int lstptr_(int *, int *, int *, int *); 14323 14324 14325 /* *********************************************************** */ 14326 14327 /* From STRIPACK */ 14328 /* Robert J. Renka */ 14329 /* Dept. of Computer Science */ 14330 /* Univ. of North Texas */ 14331 /* renka@cs.unt.edu */ 14332 /* 11/30/99 */ 14333 14334 /* This subroutine locates a point P relative to a triangu- */ 14335 /* lation created by Subroutine TRMESH. If P is contained in */ 14336 /* a triangle, the three vertex indexes and barycentric coor- */ 14337 /* dinates are returned. Otherwise, the indexes of the */ 14338 /* visible boundary nodes are returned. */ 14339 14340 14341 /* On input: */ 14342 14343 /* NST = Index of a node at which TRFIND begins its */ 14344 /* search. Search time depends on the proximity */ 14345 /* of this node to P. */ 14346 14347 /* P = Array of length 3 containing the x, y, and z */ 14348 /* coordinates (in that order) of the point P to be */ 14349 /* located. */ 14350 14351 /* N = Number of nodes in the triangulation. N .GE. 3. */ 14352 14353 /* X,Y,Z = Arrays of length N containing the Cartesian */ 14354 /* coordinates of the triangulation nodes (unit */ 14355 /* vectors). (X(I),Y(I),Z(I)) defines node I */ 14356 /* for I = 1 to N. */ 14357 14358 /* LIST,LPTR,LEND = Data structure defining the trian- */ 14359 /* gulation. Refer to Subroutine */ 14360 /* TRMESH. */ 14361 14362 /* Input parameters are not altered by this routine. */ 14363 14364 /* On output: */ 14365 14366 /* B1,B2,B3 = Unnormalized barycentric coordinates of */ 14367 /* the central projection of P onto the un- */ 14368 /* derlying planar triangle if P is in the */ 14369 /* convex hull of the nodes. These parame- */ 14370 /* ters are not altered if I1 = 0. */ 14371 14372 /* I1,I2,I3 = Counterclockwise-ordered vertex indexes */ 14373 /* of a triangle containing P if P is con- */ 14374 /* tained in a triangle. If P is not in the */ 14375 /* convex hull of the nodes, I1 and I2 are */ 14376 /* the rightmost and leftmost (boundary) */ 14377 /* nodes that are visible from P, and */ 14378 /* I3 = 0. (If all boundary nodes are vis- */ 14379 /* ible from P, then I1 and I2 coincide.) */ 14380 /* I1 = I2 = I3 = 0 if P and all of the */ 14381 /* nodes are coplanar (lie on a common great */ 14382 /* circle. */ 14383 14384 /* Modules required by TRFIND: JRAND, LSTPTR, STORE */ 14385 14386 /* Intrinsic function called by TRFIND: ABS */ 14387 14388 /* *********************************************************** */ 14389 14390 14391 /* Parameter adjustments */ 14392 --p; 14393 --lend; 14394 --z__; 14395 --y; 14396 --x; 14397 --list; 14398 --lptr; 14399 14400 /* Function Body */ 14401 14402 /* Local parameters: */ 14403 14404 /* EPS = Machine precision */ 14405 /* IX,IY,IZ = int seeds for JRAND */ 14406 /* LP = LIST pointer */ 14407 /* N0,N1,N2 = Nodes in counterclockwise order defining a */ 14408 /* cone (with vertex N0) containing P, or end- */ 14409 /* points of a boundary edge such that P Right */ 14410 /* N1->N2 */ 14411 /* N1S,N2S = Initially-determined values of N1 and N2 */ 14412 /* N3,N4 = Nodes opposite N1->N2 and N2->N1, respectively */ 14413 /* NEXT = Candidate for I1 or I2 when P is exterior */ 14414 /* NF,NL = First and last neighbors of N0, or first */ 14415 /* (rightmost) and last (leftmost) nodes */ 14416 /* visible from P when P is exterior to the */ 14417 /* triangulation */ 14418 /* PTN1 = Scalar product <P,N1> */ 14419 /* PTN2 = Scalar product <P,N2> */ 14420 /* Q = (N2 X N1) X N2 or N1 X (N2 X N1) -- used in */ 14421 /* the boundary traversal when P is exterior */ 14422 /* S12 = Scalar product <N1,N2> */ 14423 /* TOL = Tolerance (multiple of EPS) defining an upper */ 14424 /* bound on the magnitude of a negative bary- */ 14425 /* centric coordinate (B1 or B2) for P in a */ 14426 /* triangle -- used to avoid an infinite number */ 14427 /* of restarts with 0 <= B3 < EPS and B1 < 0 or */ 14428 /* B2 < 0 but small in magnitude */ 14429 /* XP,YP,ZP = Local variables containing P(1), P(2), and P(3) */ 14430 /* X0,Y0,Z0 = Dummy arguments for DET */ 14431 /* X1,Y1,Z1 = Dummy arguments for DET */ 14432 /* X2,Y2,Z2 = Dummy arguments for DET */ 14433 14434 /* Statement function: */ 14435 14436 /* DET(X1,...,Z0) .GE. 0 if and only if (X0,Y0,Z0) is in the */ 14437 /* (closed) left hemisphere defined by */ 14438 /* the plane containing (0,0,0), */ 14439 /* (X1,Y1,Z1), and (X2,Y2,Z2), where */ 14440 /* left is defined relative to an ob- */ 14441 /* server at (X1,Y1,Z1) facing */ 14442 /* (X2,Y2,Z2). */ 14443 14444 14445 /* Initialize variables. */ 14446 14447 xp = p[1]; 14448 yp = p[2]; 14449 zp = p[3]; 14450 n0 = *nst; 14451 if (n0 < 1 || n0 > *n) { 14452 n0 = jrand_(n, &ix, &iy, &iz); 14453 } 14454 14455 /* Compute the relative machine precision EPS and TOL. */ 14456 14457 eps = 1.; 14458 L1: 14459 eps /= 2.; 14460 d__1 = eps + 1.; 14461 if (store_(&d__1) > 1.) { 14462 goto L1; 14463 } 14464 eps *= 2.; 14465 tol = eps * 4.; 14466 14467 /* Set NF and NL to the first and last neighbors of N0, and */ 14468 /* initialize N1 = NF. */ 14469 14470 L2: 14471 lp = lend[n0]; 14472 nl = list[lp]; 14473 lp = lptr[lp]; 14474 nf = list[lp]; 14475 n1 = nf; 14476 14477 /* Find a pair of adjacent neighbors N1,N2 of N0 that define */ 14478 /* a wedge containing P: P LEFT N0->N1 and P RIGHT N0->N2. */ 14479 14480 if (nl > 0) { 14481 14482 /* N0 is an interior node. Find N1. */ 14483 14484 L3: 14485 if (xp * (y[n0] * z__[n1] - y[n1] * z__[n0]) - yp * (x[n0] * z__[n1] 14486 - x[n1] * z__[n0]) + zp * (x[n0] * y[n1] - x[n1] * y[n0]) < 14487 -1e-10) { 14488 lp = lptr[lp]; 14489 n1 = list[lp]; 14490 if (n1 == nl) { 14491 goto L6; 14492 } 14493 goto L3; 14494 } 14495 } else { 14496 14497 /* N0 is a boundary node. Test for P exterior. */ 14498 14499 nl = -nl; 14500 if (xp * (y[n0] * z__[nf] - y[nf] * z__[n0]) - yp * (x[n0] * z__[nf] 14501 - x[nf] * z__[n0]) + zp * (x[n0] * y[nf] - x[nf] * y[n0]) < 14502 -1e-10) { 14503 14504 /* P is to the right of the boundary edge N0->NF. */ 14505 14506 n1 = n0; 14507 n2 = nf; 14508 goto L9; 14509 } 14510 if (xp * (y[nl] * z__[n0] - y[n0] * z__[nl]) - yp * (x[nl] * z__[n0] 14511 - x[n0] * z__[nl]) + zp * (x[nl] * y[n0] - x[n0] * y[nl]) < 14512 -1e-10) { 14513 14514 /* P is to the right of the boundary edge NL->N0. */ 14515 14516 n1 = nl; 14517 n2 = n0; 14518 goto L9; 14519 } 14520 } 14521 14522 /* P is to the left of arcs N0->N1 and NL->N0. Set N2 to the */ 14523 /* next neighbor of N0 (following N1). */ 14524 14525 L4: 14526 lp = lptr[lp]; 14527 n2 = (i__1 = list[lp], abs(i__1)); 14528 if (xp * (y[n0] * z__[n2] - y[n2] * z__[n0]) - yp * (x[n0] * z__[n2] - x[ 14529 n2] * z__[n0]) + zp * (x[n0] * y[n2] - x[n2] * y[n0]) < -1e-10) { 14530 goto L7; 14531 } 14532 n1 = n2; 14533 if (n1 != nl) { 14534 goto L4; 14535 } 14536 if (xp * (y[n0] * z__[nf] - y[nf] * z__[n0]) - yp * (x[n0] * z__[nf] - x[ 14537 nf] * z__[n0]) + zp * (x[n0] * y[nf] - x[nf] * y[n0]) < -1e-10) { 14538 goto L6; 14539 } 14540 14541 /* P is left of or on arcs N0->NB for all neighbors NB */ 14542 /* of N0. Test for P = +/-N0. */ 14543 14544 d__2 = (d__1 = x[n0] * xp + y[n0] * yp + z__[n0] * zp, abs(d__1)); 14545 if (store_(&d__2) < 1. - eps * 4.) { 14546 14547 /* All points are collinear iff P Left NB->N0 for all */ 14548 /* neighbors NB of N0. Search the neighbors of N0. */ 14549 /* Note: N1 = NL and LP points to NL. */ 14550 14551 L5: 14552 if (xp * (y[n1] * z__[n0] - y[n0] * z__[n1]) - yp * (x[n1] * z__[n0] 14553 - x[n0] * z__[n1]) + zp * (x[n1] * y[n0] - x[n0] * y[n1]) > 14554 -1e-10) { 14555 lp = lptr[lp]; 14556 n1 = (i__1 = list[lp], abs(i__1)); 14557 if (n1 == nl) { 14558 goto L14; 14559 } 14560 goto L5; 14561 } 14562 } 14563 14564 /* P is to the right of N1->N0, or P = +/-N0. Set N0 to N1 */ 14565 /* and start over. */ 14566 14567 n0 = n1; 14568 goto L2; 14569 14570 /* P is between arcs N0->N1 and N0->NF. */ 14571 14572 L6: 14573 n2 = nf; 14574 14575 /* P is contained in a wedge defined by geodesics N0-N1 and */ 14576 /* N0-N2, where N1 is adjacent to N2. Save N1 and N2 to */ 14577 /* test for cycling. */ 14578 14579 L7: 14580 n3 = n0; 14581 n1s = n1; 14582 n2s = n2; 14583 14584 /* Top of edge-hopping loop: */ 14585 14586 L8: 14587 14588 *b3 = xp * (y[n1] * z__[n2] - y[n2] * z__[n1]) - yp * (x[n1] * z__[n2] - 14589 x[n2] * z__[n1]) + zp * (x[n1] * y[n2] - x[n2] * y[n1]); 14590 if (*b3 < -1e-10) { 14591 14592 /* Set N4 to the first neighbor of N2 following N1 (the */ 14593 /* node opposite N2->N1) unless N1->N2 is a boundary arc. */ 14594 14595 lp = lstptr_(&lend[n2], &n1, &list[1], &lptr[1]); 14596 if (list[lp] < 0) { 14597 goto L9; 14598 } 14599 lp = lptr[lp]; 14600 n4 = (i__1 = list[lp], abs(i__1)); 14601 14602 /* Define a new arc N1->N2 which intersects the geodesic */ 14603 /* N0-P. */ 14604 if (xp * (y[n0] * z__[n4] - y[n4] * z__[n0]) - yp * (x[n0] * z__[n4] 14605 - x[n4] * z__[n0]) + zp * (x[n0] * y[n4] - x[n4] * y[n0]) < 14606 -1e-10) { 14607 n3 = n2; 14608 n2 = n4; 14609 n1s = n1; 14610 if (n2 != n2s && n2 != n0) { 14611 goto L8; 14612 } 14613 } else { 14614 n3 = n1; 14615 n1 = n4; 14616 n2s = n2; 14617 if (n1 != n1s && n1 != n0) { 14618 goto L8; 14619 } 14620 } 14621 14622 /* The starting node N0 or edge N1-N2 was encountered */ 14623 /* again, implying a cycle (infinite loop). Restart */ 14624 /* with N0 randomly selected. */ 14625 14626 n0 = jrand_(n, &ix, &iy, &iz); 14627 goto L2; 14628 } 14629 14630 /* P is in (N1,N2,N3) unless N0, N1, N2, and P are collinear */ 14631 /* or P is close to -N0. */ 14632 14633 if (*b3 >= eps) { 14634 14635 /* B3 .NE. 0. */ 14636 14637 *b1 = xp * (y[n2] * z__[n3] - y[n3] * z__[n2]) - yp * (x[n2] * z__[n3] 14638 - x[n3] * z__[n2]) + zp * (x[n2] * y[n3] - x[n3] * y[n2]); 14639 *b2 = xp * (y[n3] * z__[n1] - y[n1] * z__[n3]) - yp * (x[n3] * z__[n1] 14640 - x[n1] * z__[n3]) + zp * (x[n3] * y[n1] - x[n1] * y[n3]); 14641 if (*b1 < -tol || *b2 < -tol) { 14642 14643 /* Restart with N0 randomly selected. */ 14644 14645 n0 = jrand_(n, &ix, &iy, &iz); 14646 goto L2; 14647 } 14648 } else { 14649 14650 /* B3 = 0 and thus P lies on N1->N2. Compute */ 14651 /* B1 = Det(P,N2 X N1,N2) and B2 = Det(P,N1,N2 X N1). */ 14652 14653 *b3 = 0.; 14654 s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2]; 14655 ptn1 = xp * x[n1] + yp * y[n1] + zp * z__[n1]; 14656 ptn2 = xp * x[n2] + yp * y[n2] + zp * z__[n2]; 14657 *b1 = ptn1 - s12 * ptn2; 14658 *b2 = ptn2 - s12 * ptn1; 14659 if (*b1 < -tol || *b2 < -tol) { 14660 14661 /* Restart with N0 randomly selected. */ 14662 14663 n0 = jrand_(n, &ix, &iy, &iz); 14664 goto L2; 14665 } 14666 } 14667 14668 /* P is in (N1,N2,N3). */ 14669 14670 *i1 = n1; 14671 *i2 = n2; 14672 *i3 = n3; 14673 if (*b1 < 0.f) { 14674 *b1 = 0.f; 14675 } 14676 if (*b2 < 0.f) { 14677 *b2 = 0.f; 14678 } 14679 return 0; 14680 14681 /* P Right N1->N2, where N1->N2 is a boundary edge. */ 14682 /* Save N1 and N2, and set NL = 0 to indicate that */ 14683 /* NL has not yet been found. */ 14684 14685 L9: 14686 n1s = n1; 14687 n2s = n2; 14688 nl = 0; 14689 14690 /* Counterclockwise Boundary Traversal: */ 14691 14692 L10: 14693 14694 lp = lend[n2]; 14695 lp = lptr[lp]; 14696 next = list[lp]; 14697 if (xp * (y[n2] * z__[next] - y[next] * z__[n2]) - yp * (x[n2] * z__[next] 14698 - x[next] * z__[n2]) + zp * (x[n2] * y[next] - x[next] * y[n2]) 14699 >= -1e-10) { 14700 14701 /* N2 is the rightmost visible node if P Forward N2->N1 */ 14702 /* or NEXT Forward N2->N1. Set Q to (N2 X N1) X N2. */ 14703 14704 s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2]; 14705 q[0] = x[n1] - s12 * x[n2]; 14706 q[1] = y[n1] - s12 * y[n2]; 14707 q[2] = z__[n1] - s12 * z__[n2]; 14708 if (xp * q[0] + yp * q[1] + zp * q[2] >= 0.) { 14709 goto L11; 14710 } 14711 if (x[next] * q[0] + y[next] * q[1] + z__[next] * q[2] >= 0.) { 14712 goto L11; 14713 } 14714 14715 /* N1, N2, NEXT, and P are nearly collinear, and N2 is */ 14716 /* the leftmost visible node. */ 14717 14718 nl = n2; 14719 } 14720 14721 /* Bottom of counterclockwise loop: */ 14722 14723 n1 = n2; 14724 n2 = next; 14725 if (n2 != n1s) { 14726 goto L10; 14727 } 14728 14729 /* All boundary nodes are visible from P. */ 14730 14731 *i1 = n1s; 14732 *i2 = n1s; 14733 *i3 = 0; 14734 return 0; 14735 14736 /* N2 is the rightmost visible node. */ 14737 14738 L11: 14739 nf = n2; 14740 if (nl == 0) { 14741 14742 /* Restore initial values of N1 and N2, and begin the search */ 14743 /* for the leftmost visible node. */ 14744 14745 n2 = n2s; 14746 n1 = n1s; 14747 14748 /* Clockwise Boundary Traversal: */ 14749 14750 L12: 14751 lp = lend[n1]; 14752 next = -list[lp]; 14753 if (xp * (y[next] * z__[n1] - y[n1] * z__[next]) - yp * (x[next] * 14754 z__[n1] - x[n1] * z__[next]) + zp * (x[next] * y[n1] - x[n1] * 14755 y[next]) >= -1e-10) { 14756 14757 /* N1 is the leftmost visible node if P or NEXT is */ 14758 /* forward of N1->N2. Compute Q = N1 X (N2 X N1). */ 14759 14760 s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2]; 14761 q[0] = x[n2] - s12 * x[n1]; 14762 q[1] = y[n2] - s12 * y[n1]; 14763 q[2] = z__[n2] - s12 * z__[n1]; 14764 if (xp * q[0] + yp * q[1] + zp * q[2] >= 0.) { 14765 goto L13; 14766 } 14767 if (x[next] * q[0] + y[next] * q[1] + z__[next] * q[2] >= 0.) { 14768 goto L13; 14769 } 14770 14771 /* P, NEXT, N1, and N2 are nearly collinear and N1 is the */ 14772 /* rightmost visible node. */ 14773 14774 nf = n1; 14775 } 14776 14777 /* Bottom of clockwise loop: */ 14778 14779 n2 = n1; 14780 n1 = next; 14781 if (n1 != n1s) { 14782 goto L12; 14783 } 14784 14785 /* All boundary nodes are visible from P. */ 14786 14787 *i1 = n1; 14788 *i2 = n1; 14789 *i3 = 0; 14790 return 0; 14791 14792 /* N1 is the leftmost visible node. */ 14793 14794 L13: 14795 nl = n1; 14796 } 14797 14798 /* NF and NL have been found. */ 14799 14800 *i1 = nf; 14801 *i2 = nl; 14802 *i3 = 0; 14803 return 0; 14804 14805 /* All points are collinear (coplanar). */ 14806 14807 L14: 14808 *i1 = 0; 14809 *i2 = 0; 14810 *i3 = 0; 14811 return 0; 14812 } /* trfind_ */
|
|
Definition at line 14814 of file util_sparx.cpp. References abs. 14817 { 14818 /* System generated locals */ 14819 int ltri_dim1, ltri_offset, i__1, i__2; 14820 14821 /* Local variables */ 14822 static int i__, j, i1, i2, i3, n1, n2, n3, ka, kn, lp, kt, nm2, lp2, 14823 lpl, isv; 14824 static long int arcs; 14825 static int lpln1; 14826 14827 14828 /* *********************************************************** */ 14829 14830 /* From STRIPACK */ 14831 /* Robert J. Renka */ 14832 /* Dept. of Computer Science */ 14833 /* Univ. of North Texas */ 14834 /* renka@cs.unt.edu */ 14835 /* 07/20/96 */ 14836 14837 /* This subroutine converts a triangulation data structure */ 14838 /* from the linked list created by Subroutine TRMESH to a */ 14839 /* triangle list. */ 14840 14841 /* On input: */ 14842 14843 /* N = Number of nodes in the triangulation. N .GE. 3. */ 14844 14845 /* LIST,LPTR,LEND = Linked list data structure defin- */ 14846 /* ing the triangulation. Refer to */ 14847 /* Subroutine TRMESH. */ 14848 14849 /* NROW = Number of rows (entries per triangle) re- */ 14850 /* served for the triangle list LTRI. The value */ 14851 /* must be 6 if only the vertex indexes and */ 14852 /* neighboring triangle indexes are to be */ 14853 /* stored, or 9 if arc indexes are also to be */ 14854 /* assigned and stored. Refer to LTRI. */ 14855 14856 /* The above parameters are not altered by this routine. */ 14857 14858 /* LTRI = int array of length at least NROW*NT, */ 14859 /* where NT is at most 2N-4. (A sufficient */ 14860 /* length is 12N if NROW=6 or 18N if NROW=9.) */ 14861 14862 /* On output: */ 14863 14864 /* NT = Number of triangles in the triangulation unless */ 14865 /* IER .NE. 0, in which case NT = 0. NT = 2N-NB-2 */ 14866 /* if NB .GE. 3 or 2N-4 if NB = 0, where NB is the */ 14867 /* number of boundary nodes. */ 14868 14869 /* LTRI = NROW by NT array whose J-th column contains */ 14870 /* the vertex nodal indexes (first three rows), */ 14871 /* neighboring triangle indexes (second three */ 14872 /* rows), and, if NROW = 9, arc indexes (last */ 14873 /* three rows) associated with triangle J for */ 14874 /* J = 1,...,NT. The vertices are ordered */ 14875 /* counterclockwise with the first vertex taken */ 14876 /* to be the one with smallest index. Thus, */ 14877 /* LTRI(2,J) and LTRI(3,J) are larger than */ 14878 /* LTRI(1,J) and index adjacent neighbors of */ 14879 /* node LTRI(1,J). For I = 1,2,3, LTRI(I+3,J) */ 14880 /* and LTRI(I+6,J) index the triangle and arc, */ 14881 /* respectively, which are opposite (not shared */ 14882 /* by) node LTRI(I,J), with LTRI(I+3,J) = 0 if */ 14883 /* LTRI(I+6,J) indexes a boundary arc. Vertex */ 14884 /* indexes range from 1 to N, triangle indexes */ 14885 /* from 0 to NT, and, if included, arc indexes */ 14886 /* from 1 to NA, where NA = 3N-NB-3 if NB .GE. 3 */ 14887 /* or 3N-6 if NB = 0. The triangles are or- */ 14888 /* dered on first (smallest) vertex indexes. */ 14889 14890 /* IER = Error indicator. */ 14891 /* IER = 0 if no errors were encountered. */ 14892 /* IER = 1 if N or NROW is outside its valid */ 14893 /* range on input. */ 14894 /* IER = 2 if the triangulation data structure */ 14895 /* (LIST,LPTR,LEND) is invalid. Note, */ 14896 /* however, that these arrays are not */ 14897 /* completely tested for validity. */ 14898 14899 /* Modules required by TRLIST: None */ 14900 14901 /* Intrinsic function called by TRLIST: ABS */ 14902 14903 /* *********************************************************** */ 14904 14905 14906 /* Local parameters: */ 14907 14908 /* ARCS = long int variable with value TRUE iff are */ 14909 /* indexes are to be stored */ 14910 /* I,J = LTRI row indexes (1 to 3) associated with */ 14911 /* triangles KT and KN, respectively */ 14912 /* I1,I2,I3 = Nodal indexes of triangle KN */ 14913 /* ISV = Variable used to permute indexes I1,I2,I3 */ 14914 /* KA = Arc index and number of currently stored arcs */ 14915 /* KN = Index of the triangle that shares arc I1-I2 */ 14916 /* with KT */ 14917 /* KT = Triangle index and number of currently stored */ 14918 /* triangles */ 14919 /* LP = LIST pointer */ 14920 /* LP2 = Pointer to N2 as a neighbor of N1 */ 14921 /* LPL = Pointer to the last neighbor of I1 */ 14922 /* LPLN1 = Pointer to the last neighbor of N1 */ 14923 /* N1,N2,N3 = Nodal indexes of triangle KT */ 14924 /* NM2 = N-2 */ 14925 14926 14927 /* Test for invalid input parameters. */ 14928 14929 /* Parameter adjustments */ 14930 --lend; 14931 --list; 14932 --lptr; 14933 ltri_dim1 = *nrow; 14934 ltri_offset = 1 + ltri_dim1; 14935 ltri -= ltri_offset; 14936 14937 /* Function Body */ 14938 if (*n < 3 || *nrow != 6 && *nrow != 9) { 14939 goto L11; 14940 } 14941 14942 /* Initialize parameters for loop on triangles KT = (N1,N2, */ 14943 /* N3), where N1 < N2 and N1 < N3. */ 14944 14945 /* ARCS = TRUE iff arc indexes are to be stored. */ 14946 /* KA,KT = Numbers of currently stored arcs and triangles. */ 14947 /* NM2 = Upper bound on candidates for N1. */ 14948 14949 arcs = *nrow == 9; 14950 ka = 0; 14951 kt = 0; 14952 nm2 = *n - 2; 14953 14954 /* Loop on nodes N1. */ 14955 14956 i__1 = nm2; 14957 for (n1 = 1; n1 <= i__1; ++n1) { 14958 14959 /* Loop on pairs of adjacent neighbors (N2,N3). LPLN1 points */ 14960 /* to the last neighbor of N1, and LP2 points to N2. */ 14961 14962 lpln1 = lend[n1]; 14963 lp2 = lpln1; 14964 L1: 14965 lp2 = lptr[lp2]; 14966 n2 = list[lp2]; 14967 lp = lptr[lp2]; 14968 n3 = (i__2 = list[lp], abs(i__2)); 14969 if (n2 < n1 || n3 < n1) { 14970 goto L8; 14971 } 14972 14973 /* Add a new triangle KT = (N1,N2,N3). */ 14974 14975 ++kt; 14976 ltri[kt * ltri_dim1 + 1] = n1; 14977 ltri[kt * ltri_dim1 + 2] = n2; 14978 ltri[kt * ltri_dim1 + 3] = n3; 14979 14980 /* Loop on triangle sides (I2,I1) with neighboring triangles */ 14981 /* KN = (I1,I2,I3). */ 14982 14983 for (i__ = 1; i__ <= 3; ++i__) { 14984 if (i__ == 1) { 14985 i1 = n3; 14986 i2 = n2; 14987 } else if (i__ == 2) { 14988 i1 = n1; 14989 i2 = n3; 14990 } else { 14991 i1 = n2; 14992 i2 = n1; 14993 } 14994 14995 /* Set I3 to the neighbor of I1 that follows I2 unless */ 14996 /* I2->I1 is a boundary arc. */ 14997 14998 lpl = lend[i1]; 14999 lp = lptr[lpl]; 15000 L2: 15001 if (list[lp] == i2) { 15002 goto L3; 15003 } 15004 lp = lptr[lp]; 15005 if (lp != lpl) { 15006 goto L2; 15007 } 15008 15009 /* I2 is the last neighbor of I1 unless the data structure */ 15010 /* is invalid. Bypass the search for a neighboring */ 15011 /* triangle if I2->I1 is a boundary arc. */ 15012 15013 if ((i__2 = list[lp], abs(i__2)) != i2) { 15014 goto L12; 15015 } 15016 kn = 0; 15017 if (list[lp] < 0) { 15018 goto L6; 15019 } 15020 15021 /* I2->I1 is not a boundary arc, and LP points to I2 as */ 15022 /* a neighbor of I1. */ 15023 15024 L3: 15025 lp = lptr[lp]; 15026 i3 = (i__2 = list[lp], abs(i__2)); 15027 15028 /* Find J such that LTRI(J,KN) = I3 (not used if KN > KT), */ 15029 /* and permute the vertex indexes of KN so that I1 is */ 15030 /* smallest. */ 15031 15032 if (i1 < i2 && i1 < i3) { 15033 j = 3; 15034 } else if (i2 < i3) { 15035 j = 2; 15036 isv = i1; 15037 i1 = i2; 15038 i2 = i3; 15039 i3 = isv; 15040 } else { 15041 j = 1; 15042 isv = i1; 15043 i1 = i3; 15044 i3 = i2; 15045 i2 = isv; 15046 } 15047 15048 /* Test for KN > KT (triangle index not yet assigned). */ 15049 15050 if (i1 > n1) { 15051 goto L7; 15052 } 15053 15054 /* Find KN, if it exists, by searching the triangle list in */ 15055 /* reverse order. */ 15056 15057 for (kn = kt - 1; kn >= 1; --kn) { 15058 if (ltri[kn * ltri_dim1 + 1] == i1 && ltri[kn * ltri_dim1 + 2] 15059 == i2 && ltri[kn * ltri_dim1 + 3] == i3) { 15060 goto L5; 15061 } 15062 /* L4: */ 15063 } 15064 goto L7; 15065 15066 /* Store KT as a neighbor of KN. */ 15067 15068 L5: 15069 ltri[j + 3 + kn * ltri_dim1] = kt; 15070 15071 /* Store KN as a neighbor of KT, and add a new arc KA. */ 15072 15073 L6: 15074 ltri[i__ + 3 + kt * ltri_dim1] = kn; 15075 if (arcs) { 15076 ++ka; 15077 ltri[i__ + 6 + kt * ltri_dim1] = ka; 15078 if (kn != 0) { 15079 ltri[j + 6 + kn * ltri_dim1] = ka; 15080 } 15081 } 15082 L7: 15083 ; 15084 } 15085 15086 /* Bottom of loop on triangles. */ 15087 15088 L8: 15089 if (lp2 != lpln1) { 15090 goto L1; 15091 } 15092 /* L9: */ 15093 } 15094 15095 /* No errors encountered. */ 15096 15097 *nt = kt; 15098 *ier = 0; 15099 return 0; 15100 15101 /* Invalid input parameter. */ 15102 15103 L11: 15104 *nt = 0; 15105 *ier = 1; 15106 return 0; 15107 15108 /* Invalid triangulation data structure: I1 is a neighbor of */ 15109 /* I2, but I2 is not a neighbor of I1. */ 15110 15111 L12: 15112 *nt = 0; 15113 *ier = 2; 15114 return 0; 15115 } /* trlist_ */
|
|
Definition at line 15117 of file util_sparx.cpp. 15120 { 15121 /* Initialized data */ 15122 15123 static int nmax = 9999; 15124 static int nlmax = 58; 15125 15126 /* System generated locals */ 15127 int ltri_dim1, ltri_offset, i__1; 15128 15129 /* Local variables */ 15130 static int i__, k, na, nb, nl, lun; 15131 15132 15133 /* *********************************************************** */ 15134 15135 /* From STRIPACK */ 15136 /* Robert J. Renka */ 15137 /* Dept. of Computer Science */ 15138 /* Univ. of North Texas */ 15139 /* renka@cs.unt.edu */ 15140 /* 07/02/98 */ 15141 15142 /* This subroutine prints the triangle list created by Sub- */ 15143 /* routine TRLIST and, optionally, the nodal coordinates */ 15144 /* (either latitude and longitude or Cartesian coordinates) */ 15145 /* on long int unit LOUT. The numbers of boundary nodes, */ 15146 /* triangles, and arcs are also printed. */ 15147 15148 15149 /* On input: */ 15150 15151 /* N = Number of nodes in the triangulation. */ 15152 /* 3 .LE. N .LE. 9999. */ 15153 15154 /* X,Y,Z = Arrays of length N containing the Cartesian */ 15155 /* coordinates of the nodes if IFLAG = 0, or */ 15156 /* (X and Y only) arrays of length N containing */ 15157 /* longitude and latitude, respectively, if */ 15158 /* IFLAG > 0, or unused dummy parameters if */ 15159 /* IFLAG < 0. */ 15160 15161 /* IFLAG = Nodal coordinate option indicator: */ 15162 /* IFLAG = 0 if X, Y, and Z (assumed to contain */ 15163 /* Cartesian coordinates) are to be */ 15164 /* printed (to 6 decimal places). */ 15165 /* IFLAG > 0 if only X and Y (assumed to con- */ 15166 /* tain longitude and latitude) are */ 15167 /* to be printed (to 6 decimal */ 15168 /* places). */ 15169 /* IFLAG < 0 if only the adjacency lists are to */ 15170 /* be printed. */ 15171 15172 /* NROW = Number of rows (entries per triangle) re- */ 15173 /* served for the triangle list LTRI. The value */ 15174 /* must be 6 if only the vertex indexes and */ 15175 /* neighboring triangle indexes are stored, or 9 */ 15176 /* if arc indexes are also stored. */ 15177 15178 /* NT = Number of triangles in the triangulation. */ 15179 /* 1 .LE. NT .LE. 9999. */ 15180 15181 /* LTRI = NROW by NT array whose J-th column contains */ 15182 /* the vertex nodal indexes (first three rows), */ 15183 /* neighboring triangle indexes (second three */ 15184 /* rows), and, if NROW = 9, arc indexes (last */ 15185 /* three rows) associated with triangle J for */ 15186 /* J = 1,...,NT. */ 15187 15188 /* LOUT = long int unit number for output. If LOUT is */ 15189 /* not in the range 0 to 99, output is written */ 15190 /* to unit 6. */ 15191 15192 /* Input parameters are not altered by this routine. */ 15193 15194 /* On output: */ 15195 15196 /* The triangle list and nodal coordinates (as specified by */ 15197 /* IFLAG) are written to unit LOUT. */ 15198 15199 /* Modules required by TRLPRT: None */ 15200 15201 /* *********************************************************** */ 15202 15203 /* Parameter adjustments */ 15204 --z__; 15205 --y; 15206 --x; 15207 ltri_dim1 = *nrow; 15208 ltri_offset = 1 + ltri_dim1; 15209 ltri -= ltri_offset; 15210 15211 /* Function Body */ 15212 15213 /* Local parameters: */ 15214 15215 /* I = DO-loop, nodal index, and row index for LTRI */ 15216 /* K = DO-loop and triangle index */ 15217 /* LUN = long int unit number for output */ 15218 /* NA = Number of triangulation arcs */ 15219 /* NB = Number of boundary nodes */ 15220 /* NL = Number of lines printed on the current page */ 15221 /* NLMAX = Maximum number of print lines per page (except */ 15222 /* for the last page which may have two addi- */ 15223 /* tional lines) */ 15224 /* NMAX = Maximum value of N and NT (4-digit format) */ 15225 15226 lun = *lout; 15227 if (lun < 0 || lun > 99) { 15228 lun = 6; 15229 } 15230 15231 /* Print a heading and test for invalid input. */ 15232 15233 /* WRITE (LUN,100) N */ 15234 nl = 3; 15235 if (*n < 3 || *n > nmax || *nrow != 6 && *nrow != 9 || *nt < 1 || *nt > 15236 nmax) { 15237 15238 /* Print an error message and exit. */ 15239 15240 /* WRITE (LUN,110) N, NROW, NT */ 15241 return 0; 15242 } 15243 if (*iflag == 0) { 15244 15245 /* Print X, Y, and Z. */ 15246 15247 /* WRITE (LUN,101) */ 15248 nl = 6; 15249 i__1 = *n; 15250 for (i__ = 1; i__ <= i__1; ++i__) { 15251 if (nl >= nlmax) { 15252 /* WRITE (LUN,108) */ 15253 nl = 0; 15254 } 15255 /* WRITE (LUN,103) I, X(I), Y(I), Z(I) */ 15256 ++nl; 15257 /* L1: */ 15258 } 15259 } else if (*iflag > 0) { 15260 15261 /* Print X (longitude) and Y (latitude). */ 15262 15263 /* WRITE (LUN,102) */ 15264 nl = 6; 15265 i__1 = *n; 15266 for (i__ = 1; i__ <= i__1; ++i__) { 15267 if (nl >= nlmax) { 15268 /* WRITE (LUN,108) */ 15269 nl = 0; 15270 } 15271 /* WRITE (LUN,104) I, X(I), Y(I) */ 15272 ++nl; 15273 /* L2: */ 15274 } 15275 } 15276 15277 /* Print the triangulation LTRI. */ 15278 15279 if (nl > nlmax / 2) { 15280 /* WRITE (LUN,108) */ 15281 nl = 0; 15282 } 15283 if (*nrow == 6) { 15284 /* WRITE (LUN,105) */ 15285 } else { 15286 /* WRITE (LUN,106) */ 15287 } 15288 nl += 5; 15289 i__1 = *nt; 15290 for (k = 1; k <= i__1; ++k) { 15291 if (nl >= nlmax) { 15292 /* WRITE (LUN,108) */ 15293 nl = 0; 15294 } 15295 /* WRITE (LUN,107) K, (LTRI(I,K), I = 1,NROW) */ 15296 ++nl; 15297 /* L3: */ 15298 } 15299 15300 /* Print NB, NA, and NT (boundary nodes, arcs, and */ 15301 /* triangles). */ 15302 15303 nb = (*n << 1) - *nt - 2; 15304 if (nb < 3) { 15305 nb = 0; 15306 na = *n * 3 - 6; 15307 } else { 15308 na = *nt + *n - 1; 15309 } 15310 /* WRITE (LUN,109) NB, NA, NT */ 15311 return 0; 15312 15313 /* Print formats: */ 15314 15315 /* 100 FORMAT (///18X,'STRIPACK (TRLIST) Output, N = ',I4) */ 15316 /* 101 FORMAT (//8X,'Node',10X,'X(Node)',10X,'Y(Node)',10X, */ 15317 /* . 'Z(Node)'//) */ 15318 /* 102 FORMAT (//16X,'Node',8X,'Longitude',9X,'Latitude'//) */ 15319 /* 103 FORMAT (8X,I4,3D17.6) */ 15320 /* 104 FORMAT (16X,I4,2D17.6) */ 15321 /* 105 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors'/ */ 15322 /* . 4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1',4X, */ 15323 /* . 'KT2',4X,'KT3'/) */ 15324 /* 106 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors', */ 15325 /* . 14X,'Arcs'/ */ 15326 /* . 4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1',4X, */ 15327 /* . 'KT2',4X,'KT3',4X,'KA1',4X,'KA2',4X,'KA3'/) */ 15328 /* 107 FORMAT (2X,I4,2X,6(3X,I4),3(2X,I5)) */ 15329 /* 108 FORMAT (///) */ 15330 /* 109 FORMAT (/1X,'NB = ',I4,' Boundary Nodes',5X, */ 15331 /* . 'NA = ',I5,' Arcs',5X,'NT = ',I5, */ 15332 /* . ' Triangles') */ 15333 /* 110 FORMAT (//1X,10X,'*** Invalid Parameter: N =',I5, */ 15334 /* . ', NROW =',I5,', NT =',I5,' ***') */ 15335 } /* trlprt_ */
|
|
Definition at line 15337 of file util_sparx.cpp. References abs, addnod_(), left_(), and nn(). 15340 { 15341 /* System generated locals */ 15342 int i__1, i__2; 15343 15344 /* Local variables */ 15345 static double d__; 15346 static int i__, j, k; 15347 static double d1, d2, d3; 15348 static int i0, lp, nn, lpl; 15349 extern long int left_(double *, double *, double *, double 15350 *, double *, double *, double *, double *, 15351 double *); 15352 static int nexti; 15353 extern /* Subroutine */ int addnod_(int *, int *, double *, 15354 double *, double *, int *, int *, int *, 15355 int *, int *); 15356 15357 15358 /* *********************************************************** */ 15359 15360 /* From STRIPACK */ 15361 /* Robert J. Renka */ 15362 /* Dept. of Computer Science */ 15363 /* Univ. of North Texas */ 15364 /* renka@cs.unt.edu */ 15365 /* 03/04/03 */ 15366 15367 /* This subroutine creates a Delaunay triangulation of a */ 15368 /* set of N arbitrarily distributed points, referred to as */ 15369 /* nodes, on the surface of the unit sphere. The Delaunay */ 15370 /* triangulation is defined as a set of (spherical) triangles */ 15371 /* with the following five properties: */ 15372 15373 /* 1) The triangle vertices are nodes. */ 15374 /* 2) No triangle contains a node other than its vertices. */ 15375 /* 3) The interiors of the triangles are pairwise disjoint. */ 15376 /* 4) The union of triangles is the convex hull of the set */ 15377 /* of nodes (the smallest convex set that contains */ 15378 /* the nodes). If the nodes are not contained in a */ 15379 /* single hemisphere, their convex hull is the en- */ 15380 /* tire sphere and there are no boundary nodes. */ 15381 /* Otherwise, there are at least three boundary nodes. */ 15382 /* 5) The interior of the circumcircle of each triangle */ 15383 /* contains no node. */ 15384 15385 /* The first four properties define a triangulation, and the */ 15386 /* last property results in a triangulation which is as close */ 15387 /* as possible to equiangular in a certain sense and which is */ 15388 /* uniquely defined unless four or more nodes lie in a common */ 15389 /* plane. This property makes the triangulation well-suited */ 15390 /* for solving closest-point problems and for triangle-based */ 15391 /* interpolation. */ 15392 15393 /* The algorithm has expected time complexity O(N*log(N)) */ 15394 /* for most nodal distributions. */ 15395 15396 /* Spherical coordinates (latitude and longitude) may be */ 15397 /* converted to Cartesian coordinates by Subroutine TRANS. */ 15398 15399 /* The following is a list of the software package modules */ 15400 /* which a user may wish to call directly: */ 15401 15402 /* ADDNOD - Updates the triangulation by appending a new */ 15403 /* node. */ 15404 15405 /* AREAS - Returns the area of a spherical triangle. */ 15406 15407 /* AREAV - Returns the area of a Voronoi region associated */ 15408 /* with an interior node without requiring that the */ 15409 /* entire Voronoi diagram be computed and stored. */ 15410 15411 /* BNODES - Returns an array containing the indexes of the */ 15412 /* boundary nodes (if any) in counterclockwise */ 15413 /* order. Counts of boundary nodes, triangles, */ 15414 /* and arcs are also returned. */ 15415 15416 /* CIRCLE - Computes the coordinates of a sequence of uni- */ 15417 /* formly spaced points on the unit circle centered */ 15418 /* at (0,0). */ 15419 15420 /* CIRCUM - Returns the circumcenter of a spherical trian- */ 15421 /* gle. */ 15422 15423 /* CRLIST - Returns the set of triangle circumcenters */ 15424 /* (Voronoi vertices) and circumradii associated */ 15425 /* with a triangulation. */ 15426 15427 /* DELARC - Deletes a boundary arc from a triangulation. */ 15428 15429 /* DELNOD - Updates the triangulation with a nodal deletion. */ 15430 15431 /* EDGE - Forces an arbitrary pair of nodes to be connec- */ 15432 /* ted by an arc in the triangulation. */ 15433 15434 /* GETNP - Determines the ordered sequence of L closest */ 15435 /* nodes to a given node, along with the associ- */ 15436 /* ated distances. */ 15437 15438 /* INSIDE - Locates a point relative to a polygon on the */ 15439 /* surface of the sphere. */ 15440 15441 /* INTRSC - Returns the point of intersection between a */ 15442 /* pair of great circle arcs. */ 15443 15444 /* JRAND - Generates a uniformly distributed pseudo-random */ 15445 /* int. */ 15446 15447 /* LEFT - Locates a point relative to a great circle. */ 15448 15449 /* NEARND - Returns the index of the nearest node to an */ 15450 /* arbitrary point, along with its squared */ 15451 /* distance. */ 15452 15453 /* PROJCT - Applies a perspective-depth projection to a */ 15454 /* point in 3-space. */ 15455 15456 /* SCOORD - Converts a point from Cartesian coordinates to */ 15457 /* spherical coordinates. */ 15458 15459 /* STORE - Forces a value to be stored in main memory so */ 15460 /* that the precision of floating point numbers */ 15461 /* in memory locations rather than registers is */ 15462 /* computed. */ 15463 15464 /* TRANS - Transforms spherical coordinates into Cartesian */ 15465 /* coordinates on the unit sphere for input to */ 15466 /* Subroutine TRMESH. */ 15467 15468 /* TRLIST - Converts the triangulation data structure to a */ 15469 /* triangle list more suitable for use in a fin- */ 15470 /* ite element code. */ 15471 15472 /* TRLPRT - Prints the triangle list created by Subroutine */ 15473 /* TRLIST. */ 15474 15475 /* TRMESH - Creates a Delaunay triangulation of a set of */ 15476 /* nodes. */ 15477 15478 /* TRPLOT - Creates a level-2 Encapsulated Postscript (EPS) */ 15479 /* file containing a triangulation plot. */ 15480 15481 /* TRPRNT - Prints the triangulation data structure and, */ 15482 /* optionally, the nodal coordinates. */ 15483 15484 /* VRPLOT - Creates a level-2 Encapsulated Postscript (EPS) */ 15485 /* file containing a Voronoi diagram plot. */ 15486 15487 15488 /* On input: */ 15489 15490 /* N = Number of nodes in the triangulation. N .GE. 3. */ 15491 15492 /* X,Y,Z = Arrays of length N containing the Cartesian */ 15493 /* coordinates of distinct nodes. (X(K),Y(K), */ 15494 /* Z(K)) is referred to as node K, and K is re- */ 15495 /* ferred to as a nodal index. It is required */ 15496 /* that X(K)**2 + Y(K)**2 + Z(K)**2 = 1 for all */ 15497 /* K. The first three nodes must not be col- */ 15498 /* linear (lie on a common great circle). */ 15499 15500 /* The above parameters are not altered by this routine. */ 15501 15502 /* LIST,LPTR = Arrays of length at least 6N-12. */ 15503 15504 /* LEND = Array of length at least N. */ 15505 15506 /* NEAR,NEXT,DIST = Work space arrays of length at */ 15507 /* least N. The space is used to */ 15508 /* efficiently determine the nearest */ 15509 /* triangulation node to each un- */ 15510 /* processed node for use by ADDNOD. */ 15511 15512 /* On output: */ 15513 15514 /* LIST = Set of nodal indexes which, along with LPTR, */ 15515 /* LEND, and LNEW, define the triangulation as a */ 15516 /* set of N adjacency lists -- counterclockwise- */ 15517 /* ordered sequences of neighboring nodes such */ 15518 /* that the first and last neighbors of a bound- */ 15519 /* ary node are boundary nodes (the first neigh- */ 15520 /* bor of an interior node is arbitrary). In */ 15521 /* order to distinguish between interior and */ 15522 /* boundary nodes, the last neighbor of each */ 15523 /* boundary node is represented by the negative */ 15524 /* of its index. */ 15525 15526 /* LPTR = Set of pointers (LIST indexes) in one-to-one */ 15527 /* correspondence with the elements of LIST. */ 15528 /* LIST(LPTR(I)) indexes the node which follows */ 15529 /* LIST(I) in cyclical counterclockwise order */ 15530 /* (the first neighbor follows the last neigh- */ 15531 /* bor). */ 15532 15533 /* LEND = Set of pointers to adjacency lists. LEND(K) */ 15534 /* points to the last neighbor of node K for */ 15535 /* K = 1,...,N. Thus, LIST(LEND(K)) < 0 if and */ 15536 /* only if K is a boundary node. */ 15537 15538 /* LNEW = Pointer to the first empty location in LIST */ 15539 /* and LPTR (list length plus one). LIST, LPTR, */ 15540 /* LEND, and LNEW are not altered if IER < 0, */ 15541 /* and are incomplete if IER > 0. */ 15542 15543 /* NEAR,NEXT,DIST = Garbage. */ 15544 15545 /* IER = Error indicator: */ 15546 /* IER = 0 if no errors were encountered. */ 15547 /* IER = -1 if N < 3 on input. */ 15548 /* IER = -2 if the first three nodes are */ 15549 /* collinear. */ 15550 /* IER = L if nodes L and M coincide for some */ 15551 /* M > L. The data structure represents */ 15552 /* a triangulation of nodes 1 to M-1 in */ 15553 /* this case. */ 15554 15555 /* Modules required by TRMESH: ADDNOD, BDYADD, COVSPH, */ 15556 /* INSERT, INTADD, JRAND, */ 15557 /* LEFT, LSTPTR, STORE, SWAP, */ 15558 /* SWPTST, TRFIND */ 15559 15560 /* Intrinsic function called by TRMESH: ABS */ 15561 15562 /* *********************************************************** */ 15563 15564 15565 /* Local parameters: */ 15566 15567 /* D = (Negative cosine of) distance from node K to */ 15568 /* node I */ 15569 /* D1,D2,D3 = Distances from node K to nodes 1, 2, and 3, */ 15570 /* respectively */ 15571 /* I,J = Nodal indexes */ 15572 /* I0 = Index of the node preceding I in a sequence of */ 15573 /* unprocessed nodes: I = NEXT(I0) */ 15574 /* K = Index of node to be added and DO-loop index: */ 15575 /* K > 3 */ 15576 /* LP = LIST index (pointer) of a neighbor of K */ 15577 /* LPL = Pointer to the last neighbor of K */ 15578 /* NEXTI = NEXT(I) */ 15579 /* NN = Local copy of N */ 15580 15581 /* Parameter adjustments */ 15582 --dist; 15583 --next; 15584 --near__; 15585 --lend; 15586 --z__; 15587 --y; 15588 --x; 15589 --list; 15590 --lptr; 15591 15592 /* Function Body */ 15593 nn = *n; 15594 if (nn < 3) { 15595 *ier = -1; 15596 return 0; 15597 } 15598 15599 /* Store the first triangle in the linked list. */ 15600 15601 if (! left_(&x[1], &y[1], &z__[1], &x[2], &y[2], &z__[2], &x[3], &y[3], & 15602 z__[3])) { 15603 15604 /* The first triangle is (3,2,1) = (2,1,3) = (1,3,2). */ 15605 15606 list[1] = 3; 15607 lptr[1] = 2; 15608 list[2] = -2; 15609 lptr[2] = 1; 15610 lend[1] = 2; 15611 15612 list[3] = 1; 15613 lptr[3] = 4; 15614 list[4] = -3; 15615 lptr[4] = 3; 15616 lend[2] = 4; 15617 15618 list[5] = 2; 15619 lptr[5] = 6; 15620 list[6] = -1; 15621 lptr[6] = 5; 15622 lend[3] = 6; 15623 15624 } else if (! left_(&x[2], &y[2], &z__[2], &x[1], &y[1], &z__[1], &x[3], & 15625 y[3], &z__[3])) { 15626 15627 /* The first triangle is (1,2,3): 3 Strictly Left 1->2, */ 15628 /* i.e., node 3 lies in the left hemisphere defined by */ 15629 /* arc 1->2. */ 15630 15631 list[1] = 2; 15632 lptr[1] = 2; 15633 list[2] = -3; 15634 lptr[2] = 1; 15635 lend[1] = 2; 15636 15637 list[3] = 3; 15638 lptr[3] = 4; 15639 list[4] = -1; 15640 lptr[4] = 3; 15641 lend[2] = 4; 15642 15643 list[5] = 1; 15644 lptr[5] = 6; 15645 list[6] = -2; 15646 lptr[6] = 5; 15647 lend[3] = 6; 15648 15649 } else { 15650 15651 /* The first three nodes are collinear. */ 15652 15653 *ier = -2; 15654 return 0; 15655 } 15656 15657 /* Initialize LNEW and test for N = 3. */ 15658 15659 *lnew = 7; 15660 if (nn == 3) { 15661 *ier = 0; 15662 return 0; 15663 } 15664 15665 /* A nearest-node data structure (NEAR, NEXT, and DIST) is */ 15666 /* used to obtain an expected-time (N*log(N)) incremental */ 15667 /* algorithm by enabling constant search time for locating */ 15668 /* each new node in the triangulation. */ 15669 15670 /* For each unprocessed node K, NEAR(K) is the index of the */ 15671 /* triangulation node closest to K (used as the starting */ 15672 /* point for the search in Subroutine TRFIND) and DIST(K) */ 15673 /* is an increasing function of the arc length (angular */ 15674 /* distance) between nodes K and NEAR(K): -Cos(a) for arc */ 15675 /* length a. */ 15676 15677 /* Since it is necessary to efficiently find the subset of */ 15678 /* unprocessed nodes associated with each triangulation */ 15679 /* node J (those that have J as their NEAR entries), the */ 15680 /* subsets are stored in NEAR and NEXT as follows: for */ 15681 /* each node J in the triangulation, I = NEAR(J) is the */ 15682 /* first unprocessed node in J's set (with I = 0 if the */ 15683 /* set is empty), L = NEXT(I) (if I > 0) is the second, */ 15684 /* NEXT(L) (if L > 0) is the third, etc. The nodes in each */ 15685 /* set are initially ordered by increasing indexes (which */ 15686 /* maximizes efficiency) but that ordering is not main- */ 15687 /* tained as the data structure is updated. */ 15688 15689 /* Initialize the data structure for the single triangle. */ 15690 15691 near__[1] = 0; 15692 near__[2] = 0; 15693 near__[3] = 0; 15694 for (k = nn; k >= 4; --k) { 15695 d1 = -(x[k] * x[1] + y[k] * y[1] + z__[k] * z__[1]); 15696 d2 = -(x[k] * x[2] + y[k] * y[2] + z__[k] * z__[2]); 15697 d3 = -(x[k] * x[3] + y[k] * y[3] + z__[k] * z__[3]); 15698 if (d1 <= d2 && d1 <= d3) { 15699 near__[k] = 1; 15700 dist[k] = d1; 15701 next[k] = near__[1]; 15702 near__[1] = k; 15703 } else if (d2 <= d1 && d2 <= d3) { 15704 near__[k] = 2; 15705 dist[k] = d2; 15706 next[k] = near__[2]; 15707 near__[2] = k; 15708 } else { 15709 near__[k] = 3; 15710 dist[k] = d3; 15711 next[k] = near__[3]; 15712 near__[3] = k; 15713 } 15714 /* L1: */ 15715 } 15716 15717 /* Add the remaining nodes */ 15718 15719 i__1 = nn; 15720 for (k = 4; k <= i__1; ++k) { 15721 addnod_(&near__[k], &k, &x[1], &y[1], &z__[1], &list[1], &lptr[1], & 15722 lend[1], lnew, ier); 15723 if (*ier != 0) { 15724 return 0; 15725 } 15726 15727 /* Remove K from the set of unprocessed nodes associated */ 15728 /* with NEAR(K). */ 15729 15730 i__ = near__[k]; 15731 if (near__[i__] == k) { 15732 near__[i__] = next[k]; 15733 } else { 15734 i__ = near__[i__]; 15735 L2: 15736 i0 = i__; 15737 i__ = next[i0]; 15738 if (i__ != k) { 15739 goto L2; 15740 } 15741 next[i0] = next[k]; 15742 } 15743 near__[k] = 0; 15744 15745 /* Loop on neighbors J of node K. */ 15746 15747 lpl = lend[k]; 15748 lp = lpl; 15749 L3: 15750 lp = lptr[lp]; 15751 j = (i__2 = list[lp], abs(i__2)); 15752 15753 /* Loop on elements I in the sequence of unprocessed nodes */ 15754 /* associated with J: K is a candidate for replacing J */ 15755 /* as the nearest triangulation node to I. The next value */ 15756 /* of I in the sequence, NEXT(I), must be saved before I */ 15757 /* is moved because it is altered by adding I to K's set. */ 15758 15759 i__ = near__[j]; 15760 L4: 15761 if (i__ == 0) { 15762 goto L5; 15763 } 15764 nexti = next[i__]; 15765 15766 /* Test for the distance from I to K less than the distance */ 15767 /* from I to J. */ 15768 15769 d__ = -(x[i__] * x[k] + y[i__] * y[k] + z__[i__] * z__[k]); 15770 if (d__ < dist[i__]) { 15771 15772 /* Replace J by K as the nearest triangulation node to I: */ 15773 /* update NEAR(I) and DIST(I), and remove I from J's set */ 15774 /* of unprocessed nodes and add it to K's set. */ 15775 15776 near__[i__] = k; 15777 dist[i__] = d__; 15778 if (i__ == near__[j]) { 15779 near__[j] = nexti; 15780 } else { 15781 next[i0] = nexti; 15782 } 15783 next[i__] = near__[k]; 15784 near__[k] = i__; 15785 } else { 15786 i0 = i__; 15787 } 15788 15789 /* Bottom of loop on I. */ 15790 15791 i__ = nexti; 15792 goto L4; 15793 15794 /* Bottom of loop on neighbors J. */ 15795 15796 L5: 15797 if (lp != lpl) { 15798 goto L3; 15799 } 15800 /* L6: */ 15801 } 15802 return 0; 15803 } /* trmesh_ */
|
|
Definition at line 15805 of file util_sparx.cpp. References abs, drwarc_(), i_dnnt(), sqrt(), t, TRUE_, and wr. 15809 { 15810 /* Initialized data */ 15811 15812 static long int annot = TRUE_; 15813 static double fsizn = 10.; 15814 static double fsizt = 16.; 15815 static double tol = .5; 15816 15817 /* System generated locals */ 15818 int i__1, i__2; 15819 double d__1; 15820 15821 /* Builtin functions */ 15822 //double atan(double), sin(double); 15823 //int i_dnnt(double *); 15824 //double cos(double), sqrt(double); 15825 15826 /* Local variables */ 15827 static double t; 15828 static int n0, n1; 15829 static double p0[3], p1[3], cf, r11, r12, r21, ct, r22, r23, sf; 15830 static int ir, lp; 15831 static double ex, ey, ez, wr, tx, ty; 15832 static int lpl; 15833 static double wrs; 15834 static int ipx1, ipx2, ipy1, ipy2, nseg; 15835 extern /* Subroutine */ int drwarc_(int *, double *, double *, 15836 double *, int *); 15837 15838 15839 /* *********************************************************** */ 15840 15841 /* From STRIPACK */ 15842 /* Robert J. Renka */ 15843 /* Dept. of Computer Science */ 15844 /* Univ. of North Texas */ 15845 /* renka@cs.unt.edu */ 15846 /* 03/04/03 */ 15847 15848 /* This subroutine creates a level-2 Encapsulated Post- */ 15849 /* script (EPS) file containing a graphical display of a */ 15850 /* triangulation of a set of nodes on the surface of the unit */ 15851 /* sphere. The visible portion of the triangulation is */ 15852 /* projected onto the plane that contains the origin and has */ 15853 /* normal defined by a user-specified eye-position. */ 15854 15855 15856 /* On input: */ 15857 15858 /* LUN = long int unit number in the range 0 to 99. */ 15859 /* The unit should be opened with an appropriate */ 15860 /* file name before the call to this routine. */ 15861 15862 /* PLTSIZ = Plot size in inches. A circular window in */ 15863 /* the projection plane is mapped to a circu- */ 15864 /* lar viewport with diameter equal to .88* */ 15865 /* PLTSIZ (leaving room for labels outside the */ 15866 /* viewport). The viewport is centered on the */ 15867 /* 8.5 by 11 inch page, and its boundary is */ 15868 /* drawn. 1.0 .LE. PLTSIZ .LE. 8.5. */ 15869 15870 /* ELAT,ELON = Latitude and longitude (in degrees) of */ 15871 /* the center of projection E (the center */ 15872 /* of the plot). The projection plane is */ 15873 /* the plane that contains the origin and */ 15874 /* has E as unit normal. In a rotated */ 15875 /* coordinate system for which E is the */ 15876 /* north pole, the projection plane con- */ 15877 /* tains the equator, and only northern */ 15878 /* hemisphere nodes are visible (from the */ 15879 /* point at infinity in the direction E). */ 15880 /* These are projected orthogonally onto */ 15881 /* the projection plane (by zeroing the z- */ 15882 /* component in the rotated coordinate */ 15883 /* system). ELAT and ELON must be in the */ 15884 /* range -90 to 90 and -180 to 180, respec- */ 15885 /* tively. */ 15886 15887 /* A = Angular distance in degrees from E to the boun- */ 15888 /* dary of a circular window against which the */ 15889 /* triangulation is clipped. The projected window */ 15890 /* is a disk of radius r = Sin(A) centered at the */ 15891 /* origin, and only visible nodes whose projections */ 15892 /* are within distance r of the origin are included */ 15893 /* in the plot. Thus, if A = 90, the plot includes */ 15894 /* the entire hemisphere centered at E. 0 .LT. A */ 15895 /* .LE. 90. */ 15896 15897 /* N = Number of nodes in the triangulation. N .GE. 3. */ 15898 15899 /* X,Y,Z = Arrays of length N containing the Cartesian */ 15900 /* coordinates of the nodes (unit vectors). */ 15901 15902 /* LIST,LPTR,LEND = Data structure defining the trian- */ 15903 /* gulation. Refer to Subroutine */ 15904 /* TRMESH. */ 15905 15906 /* TITLE = Type CHARACTER variable or constant contain- */ 15907 /* ing a string to be centered above the plot. */ 15908 /* The string must be enclosed in parentheses; */ 15909 /* i.e., the first and last characters must be */ 15910 /* '(' and ')', respectively, but these are not */ 15911 /* displayed. TITLE may have at most 80 char- */ 15912 /* acters including the parentheses. */ 15913 15914 /* NUMBR = Option indicator: If NUMBR = TRUE, the */ 15915 /* nodal indexes are plotted next to the nodes. */ 15916 15917 /* Input parameters are not altered by this routine. */ 15918 15919 /* On output: */ 15920 15921 /* IER = Error indicator: */ 15922 /* IER = 0 if no errors were encountered. */ 15923 /* IER = 1 if LUN, PLTSIZ, or N is outside its */ 15924 /* valid range. */ 15925 /* IER = 2 if ELAT, ELON, or A is outside its */ 15926 /* valid range. */ 15927 /* IER = 3 if an error was encountered in writing */ 15928 /* to unit LUN. */ 15929 15930 /* The values in the data statement below may be altered */ 15931 /* in order to modify various plotting options. */ 15932 15933 /* Module required by TRPLOT: DRWARC */ 15934 15935 /* Intrinsic functions called by TRPLOT: ABS, ATAN, COS, */ 15936 /* DBLE, NINT, SIN, */ 15937 /* SQRT */ 15938 15939 /* *********************************************************** */ 15940 15941 15942 /* Parameter adjustments */ 15943 --lend; 15944 --z__; 15945 --y; 15946 --x; 15947 --list; 15948 --lptr; 15949 15950 /* Function Body */ 15951 15952 /* Local parameters: */ 15953 15954 /* ANNOT = long int variable with value TRUE iff the plot */ 15955 /* is to be annotated with the values of ELAT, */ 15956 /* ELON, and A */ 15957 /* CF = Conversion factor for degrees to radians */ 15958 /* CT = Cos(ELAT) */ 15959 /* EX,EY,EZ = Cartesian coordinates of the eye-position E */ 15960 /* FSIZN = Font size in points for labeling nodes with */ 15961 /* their indexes if NUMBR = TRUE */ 15962 /* FSIZT = Font size in points for the title (and */ 15963 /* annotation if ANNOT = TRUE) */ 15964 /* IPX1,IPY1 = X and y coordinates (in points) of the lower */ 15965 /* left corner of the bounding box or viewport */ 15966 /* box */ 15967 /* IPX2,IPY2 = X and y coordinates (in points) of the upper */ 15968 /* right corner of the bounding box or viewport */ 15969 /* box */ 15970 /* IR = Half the width (height) of the bounding box or */ 15971 /* viewport box in points -- viewport radius */ 15972 /* LP = LIST index (pointer) */ 15973 /* LPL = Pointer to the last neighbor of N0 */ 15974 /* N0 = Index of a node whose incident arcs are to be */ 15975 /* drawn */ 15976 /* N1 = Neighbor of N0 */ 15977 /* NSEG = Number of line segments used by DRWARC in a */ 15978 /* polygonal approximation to a projected edge */ 15979 /* P0 = Coordinates of N0 in the rotated coordinate */ 15980 /* system or label location (first two */ 15981 /* components) */ 15982 /* P1 = Coordinates of N1 in the rotated coordinate */ 15983 /* system or intersection of edge N0-N1 with */ 15984 /* the equator (in the rotated coordinate */ 15985 /* system) */ 15986 /* R11...R23 = Components of the first two rows of a rotation */ 15987 /* that maps E to the north pole (0,0,1) */ 15988 /* SF = Scale factor for mapping world coordinates */ 15989 /* (window coordinates in [-WR,WR] X [-WR,WR]) */ 15990 /* to viewport coordinates in [IPX1,IPX2] X */ 15991 /* [IPY1,IPY2] */ 15992 /* T = Temporary variable */ 15993 /* TOL = Maximum distance in points between a projected */ 15994 /* triangulation edge and its approximation by */ 15995 /* a polygonal curve */ 15996 /* TX,TY = Translation vector for mapping world coordi- */ 15997 /* nates to viewport coordinates */ 15998 /* WR = Window radius r = Sin(A) */ 15999 /* WRS = WR**2 */ 16000 16001 16002 /* Test for invalid parameters. */ 16003 16004 if (*lun < 0 || *lun > 99 || *pltsiz < 1. || *pltsiz > 8.5 || *n < 3) { 16005 goto L11; 16006 } 16007 if (abs(*elat) > 90. || abs(*elon) > 180. || *a > 90.) { 16008 goto L12; 16009 } 16010 16011 /* Compute a conversion factor CF for degrees to radians */ 16012 /* and compute the window radius WR. */ 16013 16014 cf = atan(1.) / 45.; 16015 wr = sin(cf * *a); 16016 wrs = wr * wr; 16017 16018 /* Compute the lower left (IPX1,IPY1) and upper right */ 16019 /* (IPX2,IPY2) corner coordinates of the bounding box. */ 16020 /* The coordinates, specified in default user space units */ 16021 /* (points, at 72 points/inch with origin at the lower */ 16022 /* left corner of the page), are chosen to preserve the */ 16023 /* square aspect ratio, and to center the plot on the 8.5 */ 16024 /* by 11 inch page. The center of the page is (306,396), */ 16025 /* and IR = PLTSIZ/2 in points. */ 16026 16027 d__1 = *pltsiz * 36.; 16028 ir = i_dnnt(&d__1); 16029 ipx1 = 306 - ir; 16030 ipx2 = ir + 306; 16031 ipy1 = 396 - ir; 16032 ipy2 = ir + 396; 16033 16034 /* Output header comments. */ 16035 16036 /* WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 */ 16037 /* 100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/ */ 16038 /* . '%%BoundingBox:',4I4/ */ 16039 /* . '%%Title: Triangulation'/ */ 16040 /* . '%%Creator: STRIPACK'/ */ 16041 /* . '%%EndComments') */ 16042 16043 /* Set (IPX1,IPY1) and (IPX2,IPY2) to the corner coordinates */ 16044 /* of a viewport box obtained by shrinking the bounding box */ 16045 /* by 12% in each dimension. */ 16046 16047 d__1 = (double) ir * .88; 16048 ir = i_dnnt(&d__1); 16049 ipx1 = 306 - ir; 16050 ipx2 = ir + 306; 16051 ipy1 = 396 - ir; 16052 ipy2 = ir + 396; 16053 16054 /* Set the line thickness to 2 points, and draw the */ 16055 /* viewport boundary. */ 16056 16057 t = 2.; 16058 /* WRITE (LUN,110,ERR=13) T */ 16059 /* WRITE (LUN,120,ERR=13) IR */ 16060 /* WRITE (LUN,130,ERR=13) */ 16061 /* 110 FORMAT (F12.6,' setlinewidth') */ 16062 /* 120 FORMAT ('306 396 ',I3,' 0 360 arc') */ 16063 /* 130 FORMAT ('stroke') */ 16064 16065 /* Set up an affine mapping from the window box [-WR,WR] X */ 16066 /* [-WR,WR] to the viewport box. */ 16067 16068 sf = (double) ir / wr; 16069 tx = ipx1 + sf * wr; 16070 ty = ipy1 + sf * wr; 16071 /* WRITE (LUN,140,ERR=13) TX, TY, SF, SF */ 16072 /* 140 FORMAT (2F12.6,' translate'/ */ 16073 /* . 2F12.6,' scale') */ 16074 16075 /* The line thickness must be changed to reflect the new */ 16076 /* scaling which is applied to all subsequent output. */ 16077 /* Set it to 1.0 point. */ 16078 16079 t = 1. / sf; 16080 /* WRITE (LUN,110,ERR=13) T */ 16081 16082 /* Save the current graphics state, and set the clip path to */ 16083 /* the boundary of the window. */ 16084 16085 /* WRITE (LUN,150,ERR=13) */ 16086 /* WRITE (LUN,160,ERR=13) WR */ 16087 /* WRITE (LUN,170,ERR=13) */ 16088 /* 150 FORMAT ('gsave') */ 16089 /* 160 FORMAT ('0 0 ',F12.6,' 0 360 arc') */ 16090 /* 170 FORMAT ('clip newpath') */ 16091 16092 /* Compute the Cartesian coordinates of E and the components */ 16093 /* of a rotation R which maps E to the north pole (0,0,1). */ 16094 /* R is taken to be a rotation about the z-axis (into the */ 16095 /* yz-plane) followed by a rotation about the x-axis chosen */ 16096 /* so that the view-up direction is (0,0,1), or (-1,0,0) if */ 16097 /* E is the north or south pole. */ 16098 16099 /* ( R11 R12 0 ) */ 16100 /* R = ( R21 R22 R23 ) */ 16101 /* ( EX EY EZ ) */ 16102 16103 t = cf * *elon; 16104 ct = cos(cf * *elat); 16105 ex = ct * cos(t); 16106 ey = ct * sin(t); 16107 ez = sin(cf * *elat); 16108 if (ct != 0.) { 16109 r11 = -ey / ct; 16110 r12 = ex / ct; 16111 } else { 16112 r11 = 0.; 16113 r12 = 1.; 16114 } 16115 r21 = -ez * r12; 16116 r22 = ez * r11; 16117 r23 = ct; 16118 16119 /* Loop on visible nodes N0 that project to points */ 16120 /* (P0(1),P0(2)) in the window. */ 16121 16122 i__1 = *n; 16123 for (n0 = 1; n0 <= i__1; ++n0) { 16124 p0[2] = ex * x[n0] + ey * y[n0] + ez * z__[n0]; 16125 if (p0[2] < 0.) { 16126 goto L3; 16127 } 16128 p0[0] = r11 * x[n0] + r12 * y[n0]; 16129 p0[1] = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0]; 16130 if (p0[0] * p0[0] + p0[1] * p0[1] > wrs) { 16131 goto L3; 16132 } 16133 lpl = lend[n0]; 16134 lp = lpl; 16135 16136 /* Loop on neighbors N1 of N0. LPL points to the last */ 16137 /* neighbor of N0. Copy the components of N1 into P. */ 16138 16139 L1: 16140 lp = lptr[lp]; 16141 n1 = (i__2 = list[lp], abs(i__2)); 16142 p1[0] = r11 * x[n1] + r12 * y[n1]; 16143 p1[1] = r21 * x[n1] + r22 * y[n1] + r23 * z__[n1]; 16144 p1[2] = ex * x[n1] + ey * y[n1] + ez * z__[n1]; 16145 if (p1[2] < 0.) { 16146 16147 /* N1 is a 'southern hemisphere' point. Move it to the */ 16148 /* intersection of edge N0-N1 with the equator so that */ 16149 /* the edge is clipped properly. P1(3) is set to 0. */ 16150 16151 p1[0] = p0[2] * p1[0] - p1[2] * p0[0]; 16152 p1[1] = p0[2] * p1[1] - p1[2] * p0[1]; 16153 t = sqrt(p1[0] * p1[0] + p1[1] * p1[1]); 16154 p1[0] /= t; 16155 p1[1] /= t; 16156 } 16157 16158 /* If node N1 is in the window and N1 < N0, bypass edge */ 16159 /* N0->N1 (since edge N1->N0 has already been drawn). */ 16160 16161 if (p1[2] >= 0. && p1[0] * p1[0] + p1[1] * p1[1] <= wrs && n1 < n0) { 16162 goto L2; 16163 } 16164 16165 /* Add the edge to the path. (TOL is converted to world */ 16166 /* coordinates.) */ 16167 16168 if (p1[2] < 0.) { 16169 p1[2] = 0.; 16170 } 16171 d__1 = tol / sf; 16172 drwarc_(lun, p0, p1, &d__1, &nseg); 16173 16174 /* Bottom of loops. */ 16175 16176 L2: 16177 if (lp != lpl) { 16178 goto L1; 16179 } 16180 L3: 16181 ; 16182 } 16183 16184 /* Paint the path and restore the saved graphics state (with */ 16185 /* no clip path). */ 16186 16187 /* WRITE (LUN,130,ERR=13) */ 16188 /* WRITE (LUN,190,ERR=13) */ 16189 /* 190 FORMAT ('grestore') */ 16190 if (*numbr) { 16191 16192 /* Nodes in the window are to be labeled with their indexes. */ 16193 /* Convert FSIZN from points to world coordinates, and */ 16194 /* output the commands to select a font and scale it. */ 16195 16196 t = fsizn / sf; 16197 /* WRITE (LUN,200,ERR=13) T */ 16198 /* 200 FORMAT ('/Helvetica findfont'/ */ 16199 /* . F12.6,' scalefont setfont') */ 16200 16201 /* Loop on visible nodes N0 that project to points */ 16202 /* P0 = (P0(1),P0(2)) in the window. */ 16203 16204 i__1 = *n; 16205 for (n0 = 1; n0 <= i__1; ++n0) { 16206 if (ex * x[n0] + ey * y[n0] + ez * z__[n0] < 0.) { 16207 goto L4; 16208 } 16209 p0[0] = r11 * x[n0] + r12 * y[n0]; 16210 p0[1] = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0]; 16211 if (p0[0] * p0[0] + p0[1] * p0[1] > wrs) { 16212 goto L4; 16213 } 16214 16215 /* Move to P0 and draw the label N0. The first character */ 16216 /* will will have its lower left corner about one */ 16217 /* character width to the right of the nodal position. */ 16218 16219 /* WRITE (LUN,210,ERR=13) P0(1), P0(2) */ 16220 /* WRITE (LUN,220,ERR=13) N0 */ 16221 /* 210 FORMAT (2F12.6,' moveto') */ 16222 /* 220 FORMAT ('(',I3,') show') */ 16223 L4: 16224 ; 16225 } 16226 } 16227 16228 /* Convert FSIZT from points to world coordinates, and output */ 16229 /* the commands to select a font and scale it. */ 16230 16231 t = fsizt / sf; 16232 /* WRITE (LUN,200,ERR=13) T */ 16233 16234 /* Display TITLE centered above the plot: */ 16235 16236 p0[1] = wr + t * 3.; 16237 /* WRITE (LUN,230,ERR=13) TITLE, P0(2) */ 16238 /* 230 FORMAT (A80/' stringwidth pop 2 div neg ',F12.6, */ 16239 /* . ' moveto') */ 16240 /* WRITE (LUN,240,ERR=13) TITLE */ 16241 /* 240 FORMAT (A80/' show') */ 16242 if (annot) { 16243 16244 /* Display the window center and radius below the plot. */ 16245 16246 p0[0] = -wr; 16247 p0[1] = -wr - 50. / sf; 16248 /* WRITE (LUN,210,ERR=13) P0(1), P0(2) */ 16249 /* WRITE (LUN,250,ERR=13) ELAT, ELON */ 16250 p0[1] -= t * 2.; 16251 /* WRITE (LUN,210,ERR=13) P0(1), P0(2) */ 16252 /* WRITE (LUN,260,ERR=13) A */ 16253 /* 250 FORMAT ('(Window center: ELAT = ',F7.2, */ 16254 /* . ', ELON = ',F8.2,') show') */ 16255 /* 260 FORMAT ('(Angular extent: A = ',F5.2,') show') */ 16256 } 16257 16258 /* Paint the path and output the showpage command and */ 16259 /* end-of-file indicator. */ 16260 16261 /* WRITE (LUN,270,ERR=13) */ 16262 /* 270 FORMAT ('stroke'/ */ 16263 /* . 'showpage'/ */ 16264 /* . '%%EOF') */ 16265 16266 /* HP's interpreters require a one-byte End-of-PostScript-Job */ 16267 /* indicator (to eliminate a timeout error message): */ 16268 /* ASCII 4. */ 16269 16270 /* WRITE (LUN,280,ERR=13) CHAR(4) */ 16271 /* 280 FORMAT (A1) */ 16272 16273 /* No error encountered. */ 16274 16275 *ier = 0; 16276 return 0; 16277 16278 /* Invalid input parameter LUN, PLTSIZ, or N. */ 16279 16280 L11: 16281 *ier = 1; 16282 return 0; 16283 16284 /* Invalid input parameter ELAT, ELON, or A. */ 16285 16286 L12: 16287 *ier = 2; 16288 return 0; 16289 16290 /* Error writing to unit LUN. */ 16291 16292 /* L13: */ 16293 *ier = 3; 16294 return 0; 16295 } /* trplot_ */
|
|
Definition at line 16297 of file util_sparx.cpp. References nn(). 16300 { 16301 /* Initialized data */ 16302 16303 static int nmax = 9999; 16304 static int nlmax = 58; 16305 16306 /* System generated locals */ 16307 int i__1; 16308 16309 /* Local variables */ 16310 static int k, na, nb, nd, nl, lp, nn, nt, inc, lpl, lun, node, nabor[ 16311 400]; 16312 16313 16314 /* *********************************************************** */ 16315 16316 /* From STRIPACK */ 16317 /* Robert J. Renka */ 16318 /* Dept. of Computer Science */ 16319 /* Univ. of North Texas */ 16320 /* renka@cs.unt.edu */ 16321 /* 07/25/98 */ 16322 16323 /* This subroutine prints the triangulation adjacency lists */ 16324 /* created by Subroutine TRMESH and, optionally, the nodal */ 16325 /* coordinates (either latitude and longitude or Cartesian */ 16326 /* coordinates) on long int unit LOUT. The list of neighbors */ 16327 /* of a boundary node is followed by index 0. The numbers of */ 16328 /* boundary nodes, triangles, and arcs are also printed. */ 16329 16330 16331 /* On input: */ 16332 16333 /* N = Number of nodes in the triangulation. N .GE. 3 */ 16334 /* and N .LE. 9999. */ 16335 16336 /* X,Y,Z = Arrays of length N containing the Cartesian */ 16337 /* coordinates of the nodes if IFLAG = 0, or */ 16338 /* (X and Y only) arrays of length N containing */ 16339 /* longitude and latitude, respectively, if */ 16340 /* IFLAG > 0, or unused dummy parameters if */ 16341 /* IFLAG < 0. */ 16342 16343 /* IFLAG = Nodal coordinate option indicator: */ 16344 /* IFLAG = 0 if X, Y, and Z (assumed to contain */ 16345 /* Cartesian coordinates) are to be */ 16346 /* printed (to 6 decimal places). */ 16347 /* IFLAG > 0 if only X and Y (assumed to con- */ 16348 /* tain longitude and latitude) are */ 16349 /* to be printed (to 6 decimal */ 16350 /* places). */ 16351 /* IFLAG < 0 if only the adjacency lists are to */ 16352 /* be printed. */ 16353 16354 /* LIST,LPTR,LEND = Data structure defining the trian- */ 16355 /* gulation. Refer to Subroutine */ 16356 /* TRMESH. */ 16357 16358 /* LOUT = long int unit for output. If LOUT is not in */ 16359 /* the range 0 to 99, output is written to */ 16360 /* long int unit 6. */ 16361 16362 /* Input parameters are not altered by this routine. */ 16363 16364 /* On output: */ 16365 16366 /* The adjacency lists and nodal coordinates (as specified */ 16367 /* by IFLAG) are written to unit LOUT. */ 16368 16369 /* Modules required by TRPRNT: None */ 16370 16371 /* *********************************************************** */ 16372 16373 /* Parameter adjustments */ 16374 --lend; 16375 --z__; 16376 --y; 16377 --x; 16378 --list; 16379 --lptr; 16380 16381 /* Function Body */ 16382 16383 /* Local parameters: */ 16384 16385 /* I = NABOR index (1 to K) */ 16386 /* INC = Increment for NL associated with an adjacency list */ 16387 /* K = Counter and number of neighbors of NODE */ 16388 /* LP = LIST pointer of a neighbor of NODE */ 16389 /* LPL = Pointer to the last neighbor of NODE */ 16390 /* LUN = long int unit for output (copy of LOUT) */ 16391 /* NA = Number of arcs in the triangulation */ 16392 /* NABOR = Array containing the adjacency list associated */ 16393 /* with NODE, with zero appended if NODE is a */ 16394 /* boundary node */ 16395 /* NB = Number of boundary nodes encountered */ 16396 /* ND = Index of a neighbor of NODE (or negative index) */ 16397 /* NL = Number of lines that have been printed on the */ 16398 /* current page */ 16399 /* NLMAX = Maximum number of print lines per page (except */ 16400 /* for the last page which may have two addi- */ 16401 /* tional lines) */ 16402 /* NMAX = Upper bound on N (allows 4-digit indexes) */ 16403 /* NODE = Index of a node and DO-loop index (1 to N) */ 16404 /* NN = Local copy of N */ 16405 /* NT = Number of triangles in the triangulation */ 16406 16407 nn = *n; 16408 lun = *lout; 16409 if (lun < 0 || lun > 99) { 16410 lun = 6; 16411 } 16412 16413 /* Print a heading and test the range of N. */ 16414 16415 /* WRITE (LUN,100) NN */ 16416 if (nn < 3 || nn > nmax) { 16417 16418 /* N is outside its valid range. */ 16419 16420 /* WRITE (LUN,110) */ 16421 return 0; 16422 } 16423 16424 /* Initialize NL (the number of lines printed on the current */ 16425 /* page) and NB (the number of boundary nodes encountered). */ 16426 16427 nl = 6; 16428 nb = 0; 16429 if (*iflag < 0) { 16430 16431 /* Print LIST only. K is the number of neighbors of NODE */ 16432 /* that have been stored in NABOR. */ 16433 16434 /* WRITE (LUN,101) */ 16435 i__1 = nn; 16436 for (node = 1; node <= i__1; ++node) { 16437 lpl = lend[node]; 16438 lp = lpl; 16439 k = 0; 16440 16441 L1: 16442 ++k; 16443 lp = lptr[lp]; 16444 nd = list[lp]; 16445 nabor[k - 1] = nd; 16446 if (lp != lpl) { 16447 goto L1; 16448 } 16449 if (nd <= 0) { 16450 16451 /* NODE is a boundary node. Correct the sign of the last */ 16452 /* neighbor, add 0 to the end of the list, and increment */ 16453 /* NB. */ 16454 16455 nabor[k - 1] = -nd; 16456 ++k; 16457 nabor[k - 1] = 0; 16458 ++nb; 16459 } 16460 16461 /* Increment NL and print the list of neighbors. */ 16462 16463 inc = (k - 1) / 14 + 2; 16464 nl += inc; 16465 if (nl > nlmax) { 16466 /* WRITE (LUN,108) */ 16467 nl = inc; 16468 } 16469 /* WRITE (LUN,104) NODE, (NABOR(I), I = 1,K) */ 16470 /* IF (K .NE. 14) */ 16471 /* WRITE (LUN,107) */ 16472 /* L2: */ 16473 } 16474 } else if (*iflag > 0) { 16475 16476 /* Print X (longitude), Y (latitude), and LIST. */ 16477 16478 /* WRITE (LUN,102) */ 16479 i__1 = nn; 16480 for (node = 1; node <= i__1; ++node) { 16481 lpl = lend[node]; 16482 lp = lpl; 16483 k = 0; 16484 16485 L3: 16486 ++k; 16487 lp = lptr[lp]; 16488 nd = list[lp]; 16489 nabor[k - 1] = nd; 16490 if (lp != lpl) { 16491 goto L3; 16492 } 16493 if (nd <= 0) { 16494 16495 /* NODE is a boundary node. */ 16496 16497 nabor[k - 1] = -nd; 16498 ++k; 16499 nabor[k - 1] = 0; 16500 ++nb; 16501 } 16502 16503 /* Increment NL and print X, Y, and NABOR. */ 16504 16505 inc = (k - 1) / 8 + 2; 16506 nl += inc; 16507 if (nl > nlmax) { 16508 /* WRITE (LUN,108) */ 16509 nl = inc; 16510 } 16511 /* WRITE (LUN,105) NODE, X(NODE), Y(NODE), (NABOR(I), I = 1,K) */ 16512 /* IF (K .NE. 8) */ 16513 /* PRINT *,K */ 16514 /* WRITE (LUN,107) */ 16515 /* L4: */ 16516 } 16517 } else { 16518 16519 /* Print X, Y, Z, and LIST. */ 16520 16521 /* WRITE (LUN,103) */ 16522 i__1 = nn; 16523 for (node = 1; node <= i__1; ++node) { 16524 lpl = lend[node]; 16525 lp = lpl; 16526 k = 0; 16527 16528 L5: 16529 ++k; 16530 lp = lptr[lp]; 16531 nd = list[lp]; 16532 nabor[k - 1] = nd; 16533 if (lp != lpl) { 16534 goto L5; 16535 } 16536 if (nd <= 0) { 16537 16538 /* NODE is a boundary node. */ 16539 16540 nabor[k - 1] = -nd; 16541 ++k; 16542 nabor[k - 1] = 0; 16543 ++nb; 16544 } 16545 16546 /* Increment NL and print X, Y, Z, and NABOR. */ 16547 16548 inc = (k - 1) / 5 + 2; 16549 nl += inc; 16550 if (nl > nlmax) { 16551 /* WRITE (LUN,108) */ 16552 nl = inc; 16553 } 16554 /* WRITE (LUN,106) NODE, X(NODE), Y(NODE),Z(NODE), (NABOR(I), I = 1,K) */ 16555 /* IF (K .NE. 5) */ 16556 /* print *,K */ 16557 /* WRITE (LUN,107) */ 16558 /* L6: */ 16559 } 16560 } 16561 16562 /* Print NB, NA, and NT (boundary nodes, arcs, and */ 16563 /* triangles). */ 16564 16565 if (nb != 0) { 16566 na = nn * 3 - nb - 3; 16567 nt = (nn << 1) - nb - 2; 16568 } else { 16569 na = nn * 3 - 6; 16570 nt = (nn << 1) - 4; 16571 } 16572 /* WRITE (LUN,109) NB, NA, NT */ 16573 return 0; 16574 16575 /* Print formats: */ 16576 16577 /* 100 FORMAT (///15X,'STRIPACK Triangulation Data ', */ 16578 /* . 'Structure, N = ',I5//) */ 16579 /* 101 FORMAT (1X,'Node',31X,'Neighbors of Node'//) */ 16580 /* 102 FORMAT (1X,'Node',5X,'Longitude',6X,'Latitude', */ 16581 /* . 18X,'Neighbors of Node'//) */ 16582 /* 103 FORMAT (1X,'Node',5X,'X(Node)',8X,'Y(Node)',8X, */ 16583 /* . 'Z(Node)',11X,'Neighbors of Node'//) */ 16584 /* 104 FORMAT (1X,I4,4X,14I5/(1X,8X,14I5)) */ 16585 /* 105 FORMAT (1X,I4,2D15.6,4X,8I5/(1X,38X,8I5)) */ 16586 /* 106 FORMAT (1X,I4,3D15.6,4X,5I5/(1X,53X,5I5)) */ 16587 /* 107 FORMAT (1X) */ 16588 /* 108 FORMAT (///) */ 16589 /* 109 FORMAT (/1X,'NB = ',I4,' Boundary Nodes',5X, */ 16590 /* . 'NA = ',I5,' Arcs',5X,'NT = ',I5, */ 16591 /* . ' Triangles') */ 16592 /* 110 FORMAT (1X,10X,'*** N is outside its valid', */ 16593 /* . ' range ***') */ 16594 } /* trprnt_ */
|
|
Definition at line 16596 of file util_sparx.cpp. References abs, drwarc_(), i_dnnt(), sqrt(), t, TRUE_, and wr. 16601 { 16602 /* Initialized data */ 16603 16604 static long int annot = TRUE_; 16605 static double fsizn = 10.; 16606 static double fsizt = 16.; 16607 static double tol = .5; 16608 16609 /* System generated locals */ 16610 int i__1; 16611 double d__1; 16612 16613 /* Builtin functions */ 16614 //double atan(double), sin(double); 16615 //int i_dnnt(double *); 16616 //double cos(double), sqrt(double); 16617 16618 /* Local variables */ 16619 static double t; 16620 static int n0; 16621 static double p1[3], p2[3], x0, y0, cf, r11, r12, r21, ct, r22, r23, 16622 sf; 16623 static int ir, lp; 16624 static double ex, ey, ez, wr, tx, ty; 16625 static long int in1, in2; 16626 static int kv1, kv2, lpl; 16627 static double wrs; 16628 static int ipx1, ipx2, ipy1, ipy2, nseg; 16629 extern /* Subroutine */ int drwarc_(int *, double *, double *, 16630 double *, int *); 16631 16632 16633 /* *********************************************************** */ 16634 16635 /* From STRIPACK */ 16636 /* Robert J. Renka */ 16637 /* Dept. of Computer Science */ 16638 /* Univ. of North Texas */ 16639 /* renka@cs.unt.edu */ 16640 /* 03/04/03 */ 16641 16642 /* This subroutine creates a level-2 Encapsulated Post- */ 16643 /* script (EPS) file containing a graphical depiction of a */ 16644 /* Voronoi diagram of a set of nodes on the unit sphere. */ 16645 /* The visible portion of the diagram is projected orthog- */ 16646 /* onally onto the plane that contains the origin and has */ 16647 /* normal defined by a user-specified eye-position. */ 16648 16649 /* The parameters defining the Voronoi diagram may be com- */ 16650 /* puted by Subroutine CRLIST. */ 16651 16652 16653 /* On input: */ 16654 16655 /* LUN = long int unit number in the range 0 to 99. */ 16656 /* The unit should be opened with an appropriate */ 16657 /* file name before the call to this routine. */ 16658 16659 /* PLTSIZ = Plot size in inches. A circular window in */ 16660 /* the projection plane is mapped to a circu- */ 16661 /* lar viewport with diameter equal to .88* */ 16662 /* PLTSIZ (leaving room for labels outside the */ 16663 /* viewport). The viewport is centered on the */ 16664 /* 8.5 by 11 inch page, and its boundary is */ 16665 /* drawn. 1.0 .LE. PLTSIZ .LE. 8.5. */ 16666 16667 /* ELAT,ELON = Latitude and longitude (in degrees) of */ 16668 /* the center of projection E (the center */ 16669 /* of the plot). The projection plane is */ 16670 /* the plane that contains the origin and */ 16671 /* has E as unit normal. In a rotated */ 16672 /* coordinate system for which E is the */ 16673 /* north pole, the projection plane con- */ 16674 /* tains the equator, and only northern */ 16675 /* hemisphere points are visible (from the */ 16676 /* point at infinity in the direction E). */ 16677 /* These are projected orthogonally onto */ 16678 /* the projection plane (by zeroing the z- */ 16679 /* component in the rotated coordinate */ 16680 /* system). ELAT and ELON must be in the */ 16681 /* range -90 to 90 and -180 to 180, respec- */ 16682 /* tively. */ 16683 16684 /* A = Angular distance in degrees from E to the boun- */ 16685 /* dary of a circular window against which the */ 16686 /* Voronoi diagram is clipped. The projected win- */ 16687 /* dow is a disk of radius r = Sin(A) centered at */ 16688 /* the origin, and only visible vertices whose */ 16689 /* projections are within distance r of the origin */ 16690 /* are included in the plot. Thus, if A = 90, the */ 16691 /* plot includes the entire hemisphere centered at */ 16692 /* E. 0 .LT. A .LE. 90. */ 16693 16694 /* N = Number of nodes (Voronoi centers) and Voronoi */ 16695 /* regions. N .GE. 3. */ 16696 16697 /* X,Y,Z = Arrays of length N containing the Cartesian */ 16698 /* coordinates of the nodes (unit vectors). */ 16699 16700 /* NT = Number of Voronoi region vertices (triangles, */ 16701 /* including those in the extended triangulation */ 16702 /* if the number of boundary nodes NB is nonzero): */ 16703 /* NT = 2*N-4. */ 16704 16705 /* LISTC = Array of length 3*NT containing triangle */ 16706 /* indexes (indexes to XC, YC, and ZC) stored */ 16707 /* in 1-1 correspondence with LIST/LPTR entries */ 16708 /* (or entries that would be stored in LIST for */ 16709 /* the extended triangulation): the index of */ 16710 /* triangle (N1,N2,N3) is stored in LISTC(K), */ 16711 /* LISTC(L), and LISTC(M), where LIST(K), */ 16712 /* LIST(L), and LIST(M) are the indexes of N2 */ 16713 /* as a neighbor of N1, N3 as a neighbor of N2, */ 16714 /* and N1 as a neighbor of N3. The Voronoi */ 16715 /* region associated with a node is defined by */ 16716 /* the CCW-ordered sequence of circumcenters in */ 16717 /* one-to-one correspondence with its adjacency */ 16718 /* list (in the extended triangulation). */ 16719 16720 /* LPTR = Array of length 3*NT = 6*N-12 containing a */ 16721 /* set of pointers (LISTC indexes) in one-to-one */ 16722 /* correspondence with the elements of LISTC. */ 16723 /* LISTC(LPTR(I)) indexes the triangle which */ 16724 /* follows LISTC(I) in cyclical counterclockwise */ 16725 /* order (the first neighbor follows the last */ 16726 /* neighbor). */ 16727 16728 /* LEND = Array of length N containing a set of */ 16729 /* pointers to triangle lists. LP = LEND(K) */ 16730 /* points to a triangle (indexed by LISTC(LP)) */ 16731 /* containing node K for K = 1 to N. */ 16732 16733 /* XC,YC,ZC = Arrays of length NT containing the */ 16734 /* Cartesian coordinates of the triangle */ 16735 /* circumcenters (Voronoi vertices). */ 16736 /* XC(I)**2 + YC(I)**2 + ZC(I)**2 = 1. */ 16737 16738 /* TITLE = Type CHARACTER variable or constant contain- */ 16739 /* ing a string to be centered above the plot. */ 16740 /* The string must be enclosed in parentheses; */ 16741 /* i.e., the first and last characters must be */ 16742 /* '(' and ')', respectively, but these are not */ 16743 /* displayed. TITLE may have at most 80 char- */ 16744 /* acters including the parentheses. */ 16745 16746 /* NUMBR = Option indicator: If NUMBR = TRUE, the */ 16747 /* nodal indexes are plotted at the Voronoi */ 16748 /* region centers. */ 16749 16750 /* Input parameters are not altered by this routine. */ 16751 16752 /* On output: */ 16753 16754 /* IER = Error indicator: */ 16755 /* IER = 0 if no errors were encountered. */ 16756 /* IER = 1 if LUN, PLTSIZ, N, or NT is outside */ 16757 /* its valid range. */ 16758 /* IER = 2 if ELAT, ELON, or A is outside its */ 16759 /* valid range. */ 16760 /* IER = 3 if an error was encountered in writing */ 16761 /* to unit LUN. */ 16762 16763 /* Module required by VRPLOT: DRWARC */ 16764 16765 /* Intrinsic functions called by VRPLOT: ABS, ATAN, COS, */ 16766 /* DBLE, NINT, SIN, */ 16767 /* SQRT */ 16768 16769 /* *********************************************************** */ 16770 16771 16772 /* Parameter adjustments */ 16773 --lend; 16774 --z__; 16775 --y; 16776 --x; 16777 --zc; 16778 --yc; 16779 --xc; 16780 --listc; 16781 --lptr; 16782 16783 /* Function Body */ 16784 16785 /* Local parameters: */ 16786 16787 /* ANNOT = long int variable with value TRUE iff the plot */ 16788 /* is to be annotated with the values of ELAT, */ 16789 /* ELON, and A */ 16790 /* CF = Conversion factor for degrees to radians */ 16791 /* CT = Cos(ELAT) */ 16792 /* EX,EY,EZ = Cartesian coordinates of the eye-position E */ 16793 /* FSIZN = Font size in points for labeling nodes with */ 16794 /* their indexes if NUMBR = TRUE */ 16795 /* FSIZT = Font size in points for the title (and */ 16796 /* annotation if ANNOT = TRUE) */ 16797 /* IN1,IN2 = long int variables with value TRUE iff the */ 16798 /* projections of vertices KV1 and KV2, respec- */ 16799 /* tively, are inside the window */ 16800 /* IPX1,IPY1 = X and y coordinates (in points) of the lower */ 16801 /* left corner of the bounding box or viewport */ 16802 /* box */ 16803 /* IPX2,IPY2 = X and y coordinates (in points) of the upper */ 16804 /* right corner of the bounding box or viewport */ 16805 /* box */ 16806 /* IR = Half the width (height) of the bounding box or */ 16807 /* viewport box in points -- viewport radius */ 16808 /* KV1,KV2 = Endpoint indexes of a Voronoi edge */ 16809 /* LP = LIST index (pointer) */ 16810 /* LPL = Pointer to the last neighbor of N0 */ 16811 /* N0 = Index of a node */ 16812 /* NSEG = Number of line segments used by DRWARC in a */ 16813 /* polygonal approximation to a projected edge */ 16814 /* P1 = Coordinates of vertex KV1 in the rotated */ 16815 /* coordinate system */ 16816 /* P2 = Coordinates of vertex KV2 in the rotated */ 16817 /* coordinate system or intersection of edge */ 16818 /* KV1-KV2 with the equator (in the rotated */ 16819 /* coordinate system) */ 16820 /* R11...R23 = Components of the first two rows of a rotation */ 16821 /* that maps E to the north pole (0,0,1) */ 16822 /* SF = Scale factor for mapping world coordinates */ 16823 /* (window coordinates in [-WR,WR] X [-WR,WR]) */ 16824 /* to viewport coordinates in [IPX1,IPX2] X */ 16825 /* [IPY1,IPY2] */ 16826 /* T = Temporary variable */ 16827 /* TOL = Maximum distance in points between a projected */ 16828 /* Voronoi edge and its approximation by a */ 16829 /* polygonal curve */ 16830 /* TX,TY = Translation vector for mapping world coordi- */ 16831 /* nates to viewport coordinates */ 16832 /* WR = Window radius r = Sin(A) */ 16833 /* WRS = WR**2 */ 16834 /* X0,Y0 = Projection plane coordinates of node N0 or */ 16835 /* label location */ 16836 16837 16838 /* Test for invalid parameters. */ 16839 16840 if (*lun < 0 || *lun > 99 || *pltsiz < 1. || *pltsiz > 8.5 || *n < 3 || * 16841 nt != 2 * *n - 4) { 16842 goto L11; 16843 } 16844 if (abs(*elat) > 90. || abs(*elon) > 180. || *a > 90.) { 16845 goto L12; 16846 } 16847 16848 /* Compute a conversion factor CF for degrees to radians */ 16849 /* and compute the window radius WR. */ 16850 16851 cf = atan(1.) / 45.; 16852 wr = sin(cf * *a); 16853 wrs = wr * wr; 16854 16855 /* Compute the lower left (IPX1,IPY1) and upper right */ 16856 /* (IPX2,IPY2) corner coordinates of the bounding box. */ 16857 /* The coordinates, specified in default user space units */ 16858 /* (points, at 72 points/inch with origin at the lower */ 16859 /* left corner of the page), are chosen to preserve the */ 16860 /* square aspect ratio, and to center the plot on the 8.5 */ 16861 /* by 11 inch page. The center of the page is (306,396), */ 16862 /* and IR = PLTSIZ/2 in points. */ 16863 16864 d__1 = *pltsiz * 36.; 16865 ir = i_dnnt(&d__1); 16866 ipx1 = 306 - ir; 16867 ipx2 = ir + 306; 16868 ipy1 = 396 - ir; 16869 ipy2 = ir + 396; 16870 16871 /* Output header comments. */ 16872 16873 /* WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 */ 16874 /* 100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/ */ 16875 /* . '%%BoundingBox:',4I4/ */ 16876 /* . '%%Title: Voronoi diagram'/ */ 16877 /* . '%%Creator: STRIPACK'/ */ 16878 /* . '%%EndComments') */ 16879 /* Set (IPX1,IPY1) and (IPX2,IPY2) to the corner coordinates */ 16880 /* of a viewport box obtained by shrinking the bounding box */ 16881 /* by 12% in each dimension. */ 16882 16883 d__1 = (double) ir * .88; 16884 ir = i_dnnt(&d__1); 16885 ipx1 = 306 - ir; 16886 ipx2 = ir + 306; 16887 ipy1 = 396 - ir; 16888 ipy2 = ir + 396; 16889 16890 /* Set the line thickness to 2 points, and draw the */ 16891 /* viewport boundary. */ 16892 16893 t = 2.; 16894 /* WRITE (LUN,110,ERR=13) T */ 16895 /* WRITE (LUN,120,ERR=13) IR */ 16896 /* WRITE (LUN,130,ERR=13) */ 16897 /* 110 FORMAT (F12.6,' setlinewidth') */ 16898 /* 120 FORMAT ('306 396 ',I3,' 0 360 arc') */ 16899 /* 130 FORMAT ('stroke') */ 16900 16901 /* Set up an affine mapping from the window box [-WR,WR] X */ 16902 /* [-WR,WR] to the viewport box. */ 16903 16904 sf = (double) ir / wr; 16905 tx = ipx1 + sf * wr; 16906 ty = ipy1 + sf * wr; 16907 /* WRITE (LUN,140,ERR=13) TX, TY, SF, SF */ 16908 /* 140 FORMAT (2F12.6,' translate'/ */ 16909 /* . 2F12.6,' scale') */ 16910 16911 /* The line thickness must be changed to reflect the new */ 16912 /* scaling which is applied to all subsequent output. */ 16913 /* Set it to 1.0 point. */ 16914 16915 t = 1. / sf; 16916 /* WRITE (LUN,110,ERR=13) T */ 16917 16918 /* Save the current graphics state, and set the clip path to */ 16919 /* the boundary of the window. */ 16920 16921 /* WRITE (LUN,150,ERR=13) */ 16922 /* WRITE (LUN,160,ERR=13) WR */ 16923 /* WRITE (LUN,170,ERR=13) */ 16924 /* 150 FORMAT ('gsave') */ 16925 /* 160 FORMAT ('0 0 ',F12.6,' 0 360 arc') */ 16926 /* 170 FORMAT ('clip newpath') */ 16927 16928 /* Compute the Cartesian coordinates of E and the components */ 16929 /* of a rotation R which maps E to the north pole (0,0,1). */ 16930 /* R is taken to be a rotation about the z-axis (into the */ 16931 /* yz-plane) followed by a rotation about the x-axis chosen */ 16932 /* so that the view-up direction is (0,0,1), or (-1,0,0) if */ 16933 /* E is the north or south pole. */ 16934 16935 /* ( R11 R12 0 ) */ 16936 /* R = ( R21 R22 R23 ) */ 16937 /* ( EX EY EZ ) */ 16938 16939 t = cf * *elon; 16940 ct = cos(cf * *elat); 16941 ex = ct * cos(t); 16942 ey = ct * sin(t); 16943 ez = sin(cf * *elat); 16944 if (ct != 0.) { 16945 r11 = -ey / ct; 16946 r12 = ex / ct; 16947 } else { 16948 r11 = 0.; 16949 r12 = 1.; 16950 } 16951 r21 = -ez * r12; 16952 r22 = ez * r11; 16953 r23 = ct; 16954 16955 /* Loop on nodes (Voronoi centers) N0. */ 16956 /* LPL indexes the last neighbor of N0. */ 16957 16958 i__1 = *n; 16959 for (n0 = 1; n0 <= i__1; ++n0) { 16960 lpl = lend[n0]; 16961 16962 /* Set KV2 to the first (and last) vertex index and compute */ 16963 /* its coordinates P2 in the rotated coordinate system. */ 16964 16965 kv2 = listc[lpl]; 16966 p2[0] = r11 * xc[kv2] + r12 * yc[kv2]; 16967 p2[1] = r21 * xc[kv2] + r22 * yc[kv2] + r23 * zc[kv2]; 16968 p2[2] = ex * xc[kv2] + ey * yc[kv2] + ez * zc[kv2]; 16969 16970 /* IN2 = TRUE iff KV2 is in the window. */ 16971 16972 in2 = p2[2] >= 0. && p2[0] * p2[0] + p2[1] * p2[1] <= wrs; 16973 16974 /* Loop on neighbors N1 of N0. For each triangulation edge */ 16975 /* N0-N1, KV1-KV2 is the corresponding Voronoi edge. */ 16976 16977 lp = lpl; 16978 L1: 16979 lp = lptr[lp]; 16980 kv1 = kv2; 16981 p1[0] = p2[0]; 16982 p1[1] = p2[1]; 16983 p1[2] = p2[2]; 16984 in1 = in2; 16985 kv2 = listc[lp]; 16986 16987 /* Compute the new values of P2 and IN2. */ 16988 16989 p2[0] = r11 * xc[kv2] + r12 * yc[kv2]; 16990 p2[1] = r21 * xc[kv2] + r22 * yc[kv2] + r23 * zc[kv2]; 16991 p2[2] = ex * xc[kv2] + ey * yc[kv2] + ez * zc[kv2]; 16992 in2 = p2[2] >= 0. && p2[0] * p2[0] + p2[1] * p2[1] <= wrs; 16993 16994 /* Add edge KV1-KV2 to the path iff both endpoints are inside */ 16995 /* the window and KV2 > KV1, or KV1 is inside and KV2 is */ 16996 /* outside (so that the edge is drawn only once). */ 16997 16998 if (! in1 || in2 && kv2 <= kv1) { 16999 goto L2; 17000 } 17001 if (p2[2] < 0.) { 17002 17003 /* KV2 is a 'southern hemisphere' point. Move it to the */ 17004 /* intersection of edge KV1-KV2 with the equator so that */ 17005 /* the edge is clipped properly. P2(3) is set to 0. */ 17006 17007 p2[0] = p1[2] * p2[0] - p2[2] * p1[0]; 17008 p2[1] = p1[2] * p2[1] - p2[2] * p1[1]; 17009 t = sqrt(p2[0] * p2[0] + p2[1] * p2[1]); 17010 p2[0] /= t; 17011 p2[1] /= t; 17012 } 17013 17014 /* Add the edge to the path. (TOL is converted to world */ 17015 /* coordinates.) */ 17016 17017 if (p2[2] < 0.) { 17018 p2[2] = 0.f; 17019 } 17020 d__1 = tol / sf; 17021 drwarc_(lun, p1, p2, &d__1, &nseg); 17022 17023 /* Bottom of loops. */ 17024 17025 L2: 17026 if (lp != lpl) { 17027 goto L1; 17028 } 17029 /* L3: */ 17030 } 17031 17032 /* Paint the path and restore the saved graphics state (with */ 17033 /* no clip path). */ 17034 17035 /* WRITE (LUN,130,ERR=13) */ 17036 /* WRITE (LUN,190,ERR=13) */ 17037 /* 190 FORMAT ('grestore') */ 17038 if (*numbr) { 17039 17040 /* Nodes in the window are to be labeled with their indexes. */ 17041 /* Convert FSIZN from points to world coordinates, and */ 17042 /* output the commands to select a font and scale it. */ 17043 17044 t = fsizn / sf; 17045 /* WRITE (LUN,200,ERR=13) T */ 17046 /* 200 FORMAT ('/Helvetica findfont'/ */ 17047 /* . F12.6,' scalefont setfont') */ 17048 17049 /* Loop on visible nodes N0 that project to points (X0,Y0) in */ 17050 /* the window. */ 17051 17052 i__1 = *n; 17053 for (n0 = 1; n0 <= i__1; ++n0) { 17054 if (ex * x[n0] + ey * y[n0] + ez * z__[n0] < 0.) { 17055 goto L4; 17056 } 17057 x0 = r11 * x[n0] + r12 * y[n0]; 17058 y0 = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0]; 17059 if (x0 * x0 + y0 * y0 > wrs) { 17060 goto L4; 17061 } 17062 17063 /* Move to (X0,Y0), and draw the label N0 with the origin */ 17064 /* of the first character at (X0,Y0). */ 17065 17066 /* WRITE (LUN,210,ERR=13) X0, Y0 */ 17067 /* WRITE (LUN,220,ERR=13) N0 */ 17068 /* 210 FORMAT (2F12.6,' moveto') */ 17069 /* 220 FORMAT ('(',I3,') show') */ 17070 L4: 17071 ; 17072 } 17073 } 17074 17075 /* Convert FSIZT from points to world coordinates, and output */ 17076 /* the commands to select a font and scale it. */ 17077 17078 t = fsizt / sf; 17079 /* WRITE (LUN,200,ERR=13) T */ 17080 17081 /* Display TITLE centered above the plot: */ 17082 17083 y0 = wr + t * 3.; 17084 /* WRITE (LUN,230,ERR=13) TITLE, Y0 */ 17085 /* 230 FORMAT (A80/' stringwidth pop 2 div neg ',F12.6, */ 17086 /* . ' moveto') */ 17087 /* WRITE (LUN,240,ERR=13) TITLE */ 17088 /* 240 FORMAT (A80/' show') */ 17089 if (annot) { 17090 17091 /* Display the window center and radius below the plot. */ 17092 17093 x0 = -wr; 17094 y0 = -wr - 50. / sf; 17095 /* WRITE (LUN,210,ERR=13) X0, Y0 */ 17096 /* WRITE (LUN,250,ERR=13) ELAT, ELON */ 17097 y0 -= t * 2.; 17098 /* WRITE (LUN,210,ERR=13) X0, Y0 */ 17099 /* WRITE (LUN,260,ERR=13) A */ 17100 /* 250 FORMAT ('(Window center: ELAT = ',F7.2, */ 17101 /* . ', ELON = ',F8.2,') show') */ 17102 /* 260 FORMAT ('(Angular extent: A = ',F5.2,') show') */ 17103 } 17104 17105 /* Paint the path and output the showpage command and */ 17106 /* end-of-file indicator. */ 17107 17108 /* WRITE (LUN,270,ERR=13) */ 17109 /* 270 FORMAT ('stroke'/ */ 17110 /* . 'showpage'/ */ 17111 /* . '%%EOF') */ 17112 17113 /* HP's interpreters require a one-byte End-of-PostScript-Job */ 17114 /* indicator (to eliminate a timeout error message): */ 17115 /* ASCII 4. */ 17116 17117 /* WRITE (LUN,280,ERR=13) CHAR(4) */ 17118 /* 280 FORMAT (A1) */ 17119 17120 /* No error encountered. */ 17121 17122 *ier = 0; 17123 return 0; 17124 17125 /* Invalid input parameter LUN, PLTSIZ, N, or NT. */ 17126 17127 L11: 17128 *ier = 1; 17129 return 0; 17130 17131 /* Invalid input parameter ELAT, ELON, or A. */ 17132 17133 L12: 17134 *ier = 2; 17135 return 0; 17136 17137 /* Error writing to unit LUN. */ 17138 17139 /* L13: */ 17140 *ier = 3; 17141 return 0; 17142 } /* vrplot_ */
|
|
Definition at line 7683 of file util_sparx.cpp. |