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