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