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