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