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