#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 19954 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 19953 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 19578 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 19577 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 19724 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(). 19725 {
19726 int offs[][3] = { {-1, 0, 0}, {1, 0, 0}, {0, -1, 0}, {0, 1, 0}, {0, 0, -1}, {0, 0, 1} };
19727 int noff = 6;
19728
19729 int nx = visited->get_xsize();
19730 int ny = visited->get_ysize();
19731 int nz = visited->get_zsize();
19732
19733 vector< point3d_t > pts;
19734 pts.push_back( point3d_t(ix, iy, iz) );
19735 visited->set_value_at( ix, iy, iz, (float)grpid );
19736
19737 int start = 0;
19738 int end = pts.size();
19739
19740 while( end > start ) {
19741 for(int i=start; i < end; ++i ) {
19742 int ix = pts[i].x;
19743 int iy = pts[i].y;
19744 int iz = pts[i].z;
19745
19746 for( int j=0; j < noff; ++j ) {
19747 int jx = ix + offs[j][0];
19748 int jy = iy + offs[j][1];
19749 int jz = iz + offs[j][2];
19750
19751 if( jx < 0 || jx >= nx ) continue;
19752 if( jy < 0 || jy >= ny ) continue;
19753 if( jz < 0 || jz >= nz ) continue;
19754
19755
19756 if( (*mg)(jx, jy, jz)>0 && (*visited)(jx, jy, jz)==0.0 ) {
19757 pts.push_back( point3d_t(jx, jy, jz) );
19758 visited->set_value_at( jx, jy, jz, (float)grpid );
19759 }
19760
19761 }
19762 }
19763
19764 start = end;
19765 end = pts.size();
19766 }
19767 return pts.size();
19768 }
|
|
||||||||||||||||||||||||||||||||||||||||||||
|
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 21015 of file util_sparx.cpp. References costlist_global. 21015 {
21016 return (costlist_global[j] < costlist_global[i]) ;
21017
21018 }
|
|
||||||||||||||||||||
|
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 20858 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 21012 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_(). |
1.3.9.1