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