util_sparx.cpp File Reference

#include <cstring>
#include <ctime>
#include <iostream>
#include <cstdio>
#include <cstdlib>
#include <boost/format.hpp>
#include "emdata.h"
#include "util.h"
#include "fundamentals.h"
#include "lapackblas.h"
#include "lbfgsb.h"
#include "steepest.h"
#include "emassert.h"
#include "randnum.h"
#include <gsl/gsl_sf_bessel.h>
#include <cmath>

Include dependency graph for util_sparx.cpp:

Go to the source code of this file.

Classes

struct  ori_t
struct  cmpang
struct  tmpstruct
struct  stcom_
struct  peak_table
struct  ccf_point
struct  ccf_value
struct  point3d_t

Defines

#define fdata(i, j)   fdata[ i-1 + (j-1)*nxdata ]
#define fdata(i, j)   fdata[ i-1 + (j-1)*nxdata ]
#define circ(i)   circ[i-1]
#define numr(i, j)   numr[(j-1)*3 + i-1]
#define xim(i, j)   xim[(j-1)*nsam + i-1]
#define tab1(i)   tab1[i-1]
#define xcmplx(i, j)   xcmplx [(j-1)*2 + i-1]
#define br(i)   br[i-1]
#define bi(i)   bi[i-1]
#define b(i)   b[i-1]
#define circ1(i)   circ1[i-1]
#define circ2(i)   circ2[i-1]
#define t(i)   t[i-1]
#define q(i)   q[i-1]
#define b(i)   b[i-1]
#define t7(i)   t7[i-1]
#define dout(i, j)   dout[i+maxrin*j]
#define circ1b(i)   circ1b[i-1]
#define circ2b(i)   circ2b[i-1]
#define dout(i, j)   dout[i+maxrin*j]
#define circ1b(i)   circ1b[i-1]
#define circ2b(i)   circ2b[i-1]
#define QUADPI   3.141592653589793238462643383279502884197
#define PI2   2*QUADPI
#define QUADPI   3.141592653589793238462643383279502884197
#define PI2   QUADPI*2
#define deg_rad   QUADPI/180.0
#define rad_deg   180.0/QUADPI
#define old_ptr(i, j, k)   old_ptr[i+(j+(k*ny))*(size_t)nx]
#define new_ptr(iptr, jptr, kptr)   new_ptr[iptr+(jptr+(kptr*new_ny))*(size_t)new_nx]
#define inp(i, j, k)   inp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*ny))*(size_t)nx]
#define outp(i, j, k)   outp[i+(j+(k*new_ny))*(size_t)new_nx]
#define inp(i, j, k)   inp[i+(j+(k*ny))*(size_t)nx]
#define outp(i, j, k)   outp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*new_ny))*(size_t)new_nx]
#define QUADPI   3.141592653589793238462643383279502884197
#define DGR_TO_RAD   QUADPI/180
#define DM(I)   DM [I-1]
#define SS(I)   SS [I-1]
#define DM(I)   DM[I-1]
#define B(i, j)   Bptr[i-1+((j-1)*NSAM)]
#define CUBE(i, j, k)   CUBEptr[(i-1)+((j-1)+((k-1)*NY3D))*(size_t)NX3D]
#define W(i, j)   Wptr [i-1+((j-1)*Wnx)]
#define PROJ(i, j)   PROJptr [i-1+((j-1)*NNNN)]
#define SS(I, J)   SS [I-1 + (J-1)*6]
#define W(i, j)   Wptr [i-1+((j-1)*Wnx)]
#define PROJ(i, j)   PROJptr [i-1+((j-1)*NNNN)]
#define SS(I, J)   SS [I-1 + (J-1)*6]
#define RI(i, j)   RI [(i-1) + ((j-1)*3)]
#define CC(i)   CC [i-1]
#define CP(i)   CP [i-1]
#define VP(i)   VP [i-1]
#define VV(i)   VV [i-1]
#define AMAX1(i, j)   i>j?i:j
#define AMIN1(i, j)   i<j?i:j
#define mymax(x, y)   (((x)>(y))?(x):(y))
#define mymin(x, y)   (((x)<(y))?(x):(y))
#define sign(x, y)   (((((y)>0)?(1):(-1))*(y!=0))*(x))
#define quadpi   3.141592653589793238462643383279502884197
#define dgr_to_rad   quadpi/180
#define deg_to_rad   quadpi/180
#define rad_to_deg   180/quadpi
#define rad_to_dgr   180/quadpi
#define TRUE   1
#define FALSE   0
#define theta(i)   theta [i-1]
#define phi(i)   phi [i-1]
#define weight(i)   weight [i-1]
#define lband(i)   lband [i-1]
#define ts(i)   ts [i-1]
#define thetast(i)   thetast [i-1]
#define key(i)   key [i-1]
#define TRUE_   (1)
#define FALSE_   (0)
#define abs(x)   ((x) >= 0 ? (x) : -(x))
#define img_ptr(i, j, k)   img_ptr[2*(i-1)+((j-1)+((k-1)*ny))*(size_t)nxo]
#define img_ptr(i, j, k)   img_ptr[i+(j+(k*ny))*(size_t)nx]
#define img2_ptr(i, j, k)   img2_ptr[i+(j+(k*ny))*(size_t)nx]
#define cent(i)   out[i+N]
#define assign(i)   out[i]
#define data(i, j)   group[i*ny+j]

Functions

int circum_ (double *, double *, double *, double *, int *)
long int left_ (double *, double *, double *, double *, double *, double *, double *, double *, double *)
int addnod_ (int *, int *, double *, double *, double *, int *, int *, int *, int *, int *)
int i_dnnt (double *x)
double angle_ (double *v1, double *v2, double *v3)
double areas_ (double *v1, double *v2, double *v3)
double areav_new__ (int *k, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *ier)
int bdyadd_ (int *kk, int *i1, int *i2, int *list, int *lptr, int *lend, int *lnew)
int bnodes_ (int *n, int *list, int *lptr, int *lend, int *nodes, int *nb, int *na, int *nt)
int circle_ (int *k, double *xc, double *yc, int *ier)
int covsph_ (int *kk, int *n0, int *list, int *lptr, int *lend, int *lnew)
int crlist_ (int *n, int *ncol, double *x, double *y, double *z__, int *list, int *lend, int *lptr, int *lnew, int *ltri, int *listc, int *nb, double *xc, double *yc, double *zc, double *rc, int *ier)
int delarc_ (int *n, int *io1, int *io2, int *list, int *lptr, int *lend, int *lnew, int *ier)
int delnb_ (int *n0, int *nb, int *n, int *list, int *lptr, int *lend, int *lnew, int *lph)
int delnod_ (int *k, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *lnew, int *lwk, int *iwk, int *ier)
int drwarc_ (int *, double *p, double *q, double *tol, int *nseg)
int edge_ (int *in1, int *in2, double *x, double *y, double *z__, int *lwk, int *iwk, int *list, int *lptr, int *lend, int *ier)
int getnp_ (double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *l, int *npts, double *df, int *ier)
int insert_ (int *k, int *lp, int *list, int *lptr, int *lnew)
long int inside_ (double *p, int *lv, double *xv, double *yv, double *zv, int *nv, int *listv, int *ier)
int intadd_ (int *kk, int *i1, int *i2, int *i3, int *list, int *lptr, int *lend, int *lnew)
int intrsc_ (double *p1, double *p2, double *cn, double *p, int *ier)
int jrand_ (int *n, int *ix, int *iy, int *iz)
int lstptr_ (int *lpl, int *nb, int *list, int *lptr)
int nbcnt_ (int *lpl, int *lptr)
int nearnd_ (double *p, int *ist, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, double *al)
int optim_ (double *x, double *y, double *z__, int *na, int *list, int *lptr, int *lend, int *nit, int *iwk, int *ier)
int projct_ (double *px, double *py, double *pz, double *ox, double *oy, double *oz, double *ex, double *ey, double *ez, double *vx, double *vy, double *vz, long int *init, double *x, double *y, double *z__, int *ier)
int scoord_ (double *px, double *py, double *pz, double *plat, double *plon, double *pnrm)
double store_ (double *x)
int swap_ (int *in1, int *in2, int *io1, int *io2, int *list, int *lptr, int *lend, int *lp21)
long int swptst_ (int *n1, int *n2, int *n3, int *n4, double *x, double *y, double *z__)
int trans_ (int *n, double *rlat, double *rlon, double *x, double *y, double *z__)
int trfind_ (int *nst, double *p, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, double *b1, double *b2, double *b3, int *i1, int *i2, int *i3)
int trlist_ (int *n, int *list, int *lptr, int *lend, int *nrow, int *nt, int *ltri, int *ier)
int trlprt_ (int *n, double *x, double *y, double *z__, int *iflag, int *nrow, int *nt, int *ltri, int *lout)
int trmesh_ (int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, int *lnew, int *near__, int *next, double *dist, int *ier)
int trplot_ (int *lun, double *pltsiz, double *elat, double *elon, double *a, int *n, double *x, double *y, double *z__, int *list, int *lptr, int *lend, char *, long int *numbr, int *ier, short)
int trprnt_ (int *n, double *x, double *y, double *z__, int *iflag, int *list, int *lptr, int *lend, int *lout)
int vrplot_ (int *lun, double *pltsiz, double *elat, double *elon, double *a, int *n, double *x, double *y, double *z__, int *nt, int *listc, int *lptr, int *lend, double *xc, double *yc, double *zc, char *, long int *numbr, int *ier, short)
int random_ (int *ix, int *iy, int *iz, double *rannum)
int find_group (int ix, int iy, int iz, int grpid, EMData *mg, EMData *visited)
bool jiafunc (int i, int j)

Variables

stcom_ stcom_1
int branch_all = 0
int * costlist_global


Define Documentation

#define abs (  )     ((x) >= 0 ? (x) : -(x))

Definition at line 7840 of file util_sparx.cpp.

#define AMAX1 ( i,
 )     i>j?i:j

Definition at line 5985 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define AMIN1 ( i,
 )     i<j?i:j

Definition at line 5986 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define assign (  )     out[i]

Definition at line 20273 of file util_sparx.cpp.

Referenced by EMAN::Util::cluster_pairwise().

#define B ( i,
 )     Bptr[i-1+((j-1)*NSAM)]

Definition at line 5728 of file util_sparx.cpp.

Referenced by EMAN::Util::BPCQ(), EMAN::Util::branch_factor_0(), EMAN::Util::branch_factor_2(), EMAN::Util::branch_factor_3(), EMAN::Util::branch_factor_4(), EMAN::LowpassAutoBProcessor::create_radial_func(), EMAN::Util::histc(), EMAN::Util::im_diff(), and submatrix().

#define b (  )     b[i-1]

Definition at line 3167 of file util_sparx.cpp.

#define b (  )     b[i-1]

Definition at line 3167 of file util_sparx.cpp.

Referenced by EMAN::CtfCAutoAverager::add_image(), EMAN::CtfCWautoAverager::add_image(), bmv_(), EMAN::Util::cml_line_insino(), EMAN::Util::cml_line_insino_all(), EMAN::OptVarianceCmp::cmp(), Derivatives(), Derivatives_G(), formk_(), GCVmin_Tik(), EMAN::TetrahedralSym::get_asym_unit_points(), EMAN::PlatonicSym::get_asym_unit_points(), EMAN::HSym::get_asym_unit_points(), EMAN::EMUtil::get_euler_names(), EMAN::Util::initial_prune(), inside_(), EMAN::Matrix4::inverse(), main(), EMAN::Matrix4::operator *(), EMAN::operator *(), EMAN::Quaternion::operator *=(), ccf_value::operator()(), cmpang::operator()(), EMAN::operator+(), EMAN::operator-(), EMAN::operator/(), EMAN::Quaternion::operator/=(), peak_table::operator<(), EMAN::Util::prb1d(), prb1d(), EMAN::TestImageEllipse::process_inplace(), EMAN::TestImageGradient::process_inplace(), EMAN::NormalizeToLeastSquareProcessor::process_inplace(), EMAN::GradientRemoverProcessor::process_inplace(), EMAN::Util::splint(), subsm_(), and varmx().

#define bi (  )     bi[i-1]

Definition at line 2620 of file util_sparx.cpp.

Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::EMData::onelinenn(), EMAN::EMData::onelinenn_ctf(), EMAN::EMData::onelinenn_ctf_applied(), EMAN::EMData::onelinenn_mult(), and EMAN::TestImageEllipse::process_inplace().

#define br (  )     br[i-1]

Definition at line 2619 of file util_sparx.cpp.

Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::EMData::render_amp24(), and EMAN::EMData::render_ap24().

#define CC (  )     CC [i-1]

Definition at line 5981 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define cent (  )     out[i+N]

Definition at line 20272 of file util_sparx.cpp.

Referenced by EMAN::Util::cluster_pairwise().

#define circ (  )     circ[i-1]

Definition at line 2137 of file util_sparx.cpp.

Referenced by EMAN::Util::alrl_ms(), alrq(), alrq_ms(), applyws(), Applyws(), EMAN::Util::Frngs(), frngs(), EMAN::Util::Frngs_inv(), EMAN::Util::Polar2D(), EMAN::Util::Polar2Dm(), and EMAN::Util::Polar2Dmi().

#define circ1 (  )     circ1[i-1]

Definition at line 3163 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_msg_vec_p(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), and EMAN::Util::Crosrng_sm_psi().

#define circ1b (  )     circ1b[i-1]

Definition at line 4216 of file util_sparx.cpp.

#define circ1b (  )     circ1b[i-1]

Definition at line 4216 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), and EMAN::Util::Crosrng_msg_vec().

#define circ2 (  )     circ2[i-1]

Definition at line 3164 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_msg_vec_p(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), and EMAN::Util::Crosrng_sm_psi().

#define circ2b (  )     circ2b[i-1]

Definition at line 4217 of file util_sparx.cpp.

#define circ2b (  )     circ2b[i-1]

Definition at line 4217 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), and EMAN::Util::Crosrng_msg_vec().

#define CP (  )     CP [i-1]

Definition at line 5982 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define CUBE ( i,
j,
 )     CUBEptr[(i-1)+((j-1)+((k-1)*NY3D))*(size_t)NX3D]

Definition at line 5729 of file util_sparx.cpp.

Referenced by EMAN::Util::BPCQ().

#define data ( i,
 )     group[i*ny+j]

Definition at line 20579 of file util_sparx.cpp.

Referenced by EMAN::EMData::absi(), EMAN::EMData::add(), EMAN::file_store::add_image(), EMAN::TomoAverager::add_image(), EMAN::EMData::addsquare(), EMAN::Refine3DAlignerGrid::align(), EMAN::RotateTranslateFlipAlignerPawel::align(), EMAN::RotateTranslateAlignerPawel::align(), EMAN::RotationalAlignerIterative::align(), EMAN::RotatePrecenterAligner::align(), EMAN::TranslationalAligner::align(), EMAN::RotationalAligner::align_180_ambiguous(), EMAN::EMData::amplitude(), EMAN::EMData::apply_radial_func(), EMAN::EMData::calc_az_dist(), EMAN::EMData::calc_center_of_mass(), EMAN::EMData::calc_highest_locations(), EMAN::EMData::calc_hist(), EMAN::MaskEdgeMeanProcessor::calc_locals(), EMAN::EMData::calc_max_location(), EMAN::EMData::calc_min_location(), EMAN::EMData::calc_n_highest_locations(), EMAN::EMData::calc_radial_dist(), circumference(), EMAN::BoxingTools::classify(), EMAN::EMData::common_lines(), EMAN::EMData::common_lines_real(), EMAN::Util::cyclicshift(), EMAN::PointArray::distmx(), EMAN::EMData::div(), EMAN::EMData::do_ift_inplace(), EMAN::EMData::EMData(), EMAN::EMData::get_attr(), EMAN::EMData::get_circle_mean(), get_data_as_vector(), EMAN::EMData::get_edge_mean(), EMAN::EMData::get_fft_amplitude(), EMAN::EMData::get_fft_phase(), EMAN::file_store::get_image(), EMAN::newfile_store::get_image(), EMAN::EMData::helicise_grid(), EMAN::Util::histc(), EMAN::EMData::imag(), EMAN::ImagicIO2::init_test(), EMAN::EMData::insert_scaled_sum(), EMAN::SingleSpiderIO::is_valid(), EMAN::SpiderIO::is_valid(), EMAN::PifIO::is_valid(), EMAN::OmapIO::is_valid(), EMAN::MrcIO::is_valid(), EMAN::ImagicIO2::is_valid(), EMAN::ImagicIO::is_valid(), EMAN::IcosIO::is_valid(), EMAN::Gatan2IO::is_valid(), EMAN::EmIO::is_valid(), EMAN::EmimIO::is_valid(), EMAN::DM3IO::is_valid(), EMAN::EMData::little_big_dot(), EMAN::EMData::log(), EMAN::EMData::log10(), main(), EMAN::TestUtil::make_image_file_by_mode(), mpi_bcast_recv(), mpi_bcast_send(), mpi_init(), mpi_recv(), mpi_send(), mpi_start(), EMAN::EMData::mult(), EMAN::EMData::mult_complex_efficient(), EMAN::EMData::norm_pad(), EMAN::Util::Normalize_ring(), EMAN::EMData::operator=(), EMAN::EMData::phase(), EMAN::XYZProcessor::process_inplace(), EMAN::CutoffBlockProcessor::process_inplace(), EMAN::DiffBlockProcessor::process_inplace(), EMAN::BoxStatProcessor::process_inplace(), EMAN::AreaProcessor::process_inplace(), EMAN::ComplexPixelProcessor::process_inplace(), EMAN::ToMinvalProcessor::process_inplace(), EMAN::CoordinateProcessor::process_inplace(), EMAN::RealPixelProcessor::process_inplace(), EMAN::LowpassRandomPhaseProcessor::process_inplace(), EMAN::ImageProcessor::process_inplace(), EMAN::BoxMedianProcessor::process_pixel(), EMAN::GaussFFTProjector::project3d(), EMAN::Gatan::TagData::read_array_data(), EMAN::EMData::real(), EMAN::EMData::render_amp24(), EMAN::EMData::render_ap24(), EMAN::EMData::ri2ap(), EMAN::EMData::ri2inten(), EMAN::EMData::rot_scale_conv_new(), EMAN::EMData::rot_scale_conv_new_3D(), EMAN::EMData::rot_scale_conv_new_background(), EMAN::EMData::rot_scale_conv_new_background_3D(), EMAN::EMData::rotate_x(), EMAN::Isosurface::set_data(), EMAN::MarchingCubes::setCmapData(), EMAN::BoxSVDClassifier::setDims(), EMAN::EMData::setup4slice(), EMAN::EMData::sqrt(), EMAN::EMData::sub(), EMAN::EMData::subsquare(), EMAN::EMData::to_value(), EMAN::EMData::update_stat(), EMAN::Util::vareas(), EMAN::TestUtil::verify_image_file_by_mode(), EMAN::EMUtil::vertical_acf(), wustl_mm::SkeletonMaker::VolumeData::VolumeData(), EMAN::RT3DSphereAligner::xform_align_nbest(), and EMAN::RT3DGridAligner::xform_align_nbest().

#define deg_rad   QUADPI/180.0

Definition at line 4597 of file util_sparx.cpp.

Referenced by EMAN::Util::cml_init_rot(), EMAN::Util::cml_line_in3d(), and EMAN::Util::cml_update_rot().

#define deg_to_rad   quadpi/180

Definition at line 7131 of file util_sparx.cpp.

#define dgr_to_rad   quadpi/180

Definition at line 7130 of file util_sparx.cpp.

Referenced by EMAN::Util::ang_to_xyz(), apmq(), aprq2d(), EMAN::Util::even_angles(), and EMAN::ChaoProjector::setdm().

#define DGR_TO_RAD   QUADPI/180

Definition at line 5680 of file util_sparx.cpp.

#define DM (  )     DM[I-1]

Definition at line 5727 of file util_sparx.cpp.

#define DM (  )     DM [I-1]

Definition at line 5727 of file util_sparx.cpp.

Referenced by EMAN::Util::BPCQ(), and EMAN::Util::CANG().

#define dout ( i,
 )     dout[i+maxrin*j]

Definition at line 4215 of file util_sparx.cpp.

#define dout ( i,
 )     dout[i+maxrin*j]

Definition at line 4215 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), and EMAN::Util::Crosrng_msg_s().

#define FALSE   0

Definition at line 7135 of file util_sparx.cpp.

#define FALSE_   (0)

Definition at line 7839 of file util_sparx.cpp.

#define fdata ( i,
 )     fdata[ i-1 + (j-1)*nxdata ]

Definition at line 713 of file util_sparx.cpp.

#define fdata ( i,
 )     fdata[ i-1 + (j-1)*nxdata ]

Definition at line 713 of file util_sparx.cpp.

Referenced by EMAN::Util::quadri(), quadri(), and EMAN::Util::quadri_background().

#define img2_ptr ( i,
j,
 )     img2_ptr[i+(j+(k*ny))*(size_t)nx]

Definition at line 19887 of file util_sparx.cpp.

Referenced by EMAN::Util::addn_img(), EMAN::Util::divn_filter(), EMAN::Util::divn_img(), EMAN::Util::madn_scalar(), EMAN::Util::move_points(), EMAN::Util::muln_img(), EMAN::Util::mult_scalar(), and EMAN::Util::subn_img().

#define img_ptr ( i,
j,
 )     img_ptr[i+(j+(k*ny))*(size_t)nx]

Definition at line 19886 of file util_sparx.cpp.

#define img_ptr ( i,
j,
 )     img_ptr[2*(i-1)+((j-1)+((k-1)*ny))*(size_t)nxo]

Definition at line 19886 of file util_sparx.cpp.

Referenced by EMAN::Util::add_img(), EMAN::Util::add_img2(), EMAN::Util::add_img_abs(), EMAN::Util::addn_img(), EMAN::Util::compress_image_mask(), EMAN::Util::div_filter(), EMAN::Util::div_img(), EMAN::Util::divn_filter(), EMAN::Util::divn_img(), EMAN::Util::hist_comp_freq(), EMAN::Util::mad_scalar(), EMAN::Util::madn_scalar(), EMAN::Util::move_points(), EMAN::Util::mul_img(), EMAN::Util::mul_scalar(), EMAN::Util::muln_img(), EMAN::Util::mult_scalar(), EMAN::Util::pack_complex_to_real(), ReadStackandDist(), ReadStackandDist_Cart(), EMAN::Util::reconstitute_image_mask(), EMAN::Util::set_line(), EMAN::Util::sub_img(), and EMAN::Util::subn_img().

#define inp ( i,
j,
 )     inp[i+(j+(k*ny))*(size_t)nx]

Definition at line 5350 of file util_sparx.cpp.

#define inp ( i,
j,
 )     inp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*ny))*(size_t)nx]

Definition at line 5350 of file util_sparx.cpp.

Referenced by EMAN::Util::pad(), and EMAN::Util::window().

#define key (  )     key [i-1]

Definition at line 7144 of file util_sparx.cpp.

Referenced by EMAN::EMUtil::getRenderMinMax(), EMAN::Util::hsortd(), mpi_comm_split(), EMAN::Log::vlog(), EMAN::Util::voronoi(), and EMAN::Util::vrdg().

#define lband (  )     lband [i-1]

Definition at line 7141 of file util_sparx.cpp.

#define mymax ( x,
 )     (((x)>(y))?(x):(y))

Definition at line 7124 of file util_sparx.cpp.

#define mymin ( x,
 )     (((x)<(y))?(x):(y))

Definition at line 7125 of file util_sparx.cpp.

#define new_ptr ( iptr,
jptr,
kptr   )     new_ptr[iptr+(jptr+(kptr*new_ny))*(size_t)new_nx]

Definition at line 5246 of file util_sparx.cpp.

Referenced by EMAN::Util::compress_image_mask(), EMAN::Util::decimate(), and EMAN::Util::reconstitute_image_mask().

#define numr ( i,
 )     numr[(j-1)*3 + i-1]

Definition at line 2138 of file util_sparx.cpp.

Referenced by ali3d_d(), alprbs(), EMAN::Util::alrl_ms(), alrq(), alrq_ms(), apmd(), apmq(), applyws(), apring1(), aprq2d(), EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_s(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), EMAN::Util::Crosrng_sm_psi(), EMAN::Util::ener(), EMAN::Util::ener_tot(), EMAN::Util::Frngs(), frngs(), EMAN::Util::Frngs_inv(), numrinit(), Numrinit(), EMAN::Util::Polar2D(), EMAN::Util::Polar2Dm(), EMAN::Util::Polar2Dmi(), ringwe(), EMAN::Util::sub_fav(), and EMAN::Util::update_fav().

#define old_ptr ( i,
j,
 )     old_ptr[i+(j+(k*ny))*(size_t)nx]

Definition at line 5245 of file util_sparx.cpp.

Referenced by EMAN::Util::decimate().

#define outp ( i,
j,
 )     outp[(i+new_st_x)+((j+new_st_y)+((k+new_st_z)*new_ny))*(size_t)new_nx]

Definition at line 5351 of file util_sparx.cpp.

#define outp ( i,
j,
 )     outp[i+(j+(k*new_ny))*(size_t)new_nx]

Definition at line 5351 of file util_sparx.cpp.

Referenced by EMAN::Util::pad(), and EMAN::Util::window().

#define phi (  )     phi [i-1]

Definition at line 7139 of file util_sparx.cpp.

Referenced by EMAN::file_store::add_image(), EMAN::OrientationGenerator::add_orientation(), ali3d_d(), EMAN::Refine3DAlignerGrid::align(), EMAN::SymAlignProcessor::align(), EMAN::PawelProjector::backproject3d(), EMAN::ChaoProjector::backproject3d(), EMAN::Util::even_angles(), fcalc(), fgcalc(), EMAN::RandomOrientationGenerator::gen_orientations(), EMAN::file_store::get_image(), EMAN::Transform::get_rotation(), EMAN::Util::hsortd(), LBD_Cart(), main(), EMAN::Util::multiref_polar_ali_2d_local(), EMAN::Util::multiref_polar_ali_2d_local_psi(), EMAN::Util::multiref_polar_ali_helical_90_local(), EMAN::Util::multiref_polar_ali_helical_local(), EMAN::TestImageSinewave::process_inplace(), EMAN::ChaoProjector::project3d(), EMAN::FourierGriddingProjector::project3d(), recons3d_4nn(), recons3d_CGLS_mpi_Cart(), recons3d_HyBR_mpi_Cart(), recons3d_sirt_mpi(), recons3d_sirt_mpi_Cart(), EMAN::Transform::set_rotation(), EMAN::ChaoProjector::setdm(), slaed4_(), trans_(), unified(), EMAN::Util::vrdg(), EMAN::RT3DSphereAligner::xform_align_nbest(), and EMAN::RT3DGridAligner::xform_align_nbest().

#define PI2   QUADPI*2

Definition at line 4596 of file util_sparx.cpp.

#define PI2   2*QUADPI

Definition at line 4596 of file util_sparx.cpp.

Referenced by EMAN::Util::cml_weights(), EMAN::Util::ener(), EMAN::Util::ener_tot(), EMAN::Util::sub_fav(), and EMAN::Util::update_fav().

#define PROJ ( i,
 )     PROJptr [i-1+((j-1)*NNNN)]

Definition at line 5978 of file util_sparx.cpp.

#define PROJ ( i,
 )     PROJptr [i-1+((j-1)*NNNN)]

Definition at line 5978 of file util_sparx.cpp.

Referenced by EMAN::Util::WTF(), and EMAN::Util::WTM().

#define q (  )     q[i-1]

Definition at line 3166 of file util_sparx.cpp.

Referenced by EMAN::Util::cluster_pairwise(), EMAN::Quaternion::create_inverse(), EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_s(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), EMAN::Util::Crosrng_sm_psi(), dcstep_(), GCVmin_Tik(), EMAN::EMData::get_pixel_conv(), EMAN::EMData::get_pixel_filtered(), EMAN::Util::getBaldwinGridWeights(), inside_(), EMAN::Quaternion::interpolate(), EMAN::Util::list_mutation(), EMAN::operator *(), EMAN::Quaternion::operator *=(), EMAN::operator+(), EMAN::Quaternion::operator+=(), EMAN::operator-(), EMAN::Quaternion::operator-=(), EMAN::operator/(), EMAN::Quaternion::operator/=(), EMAN::Util::pw_extract(), EMAN::Quaternion::Quaternion(), recons3d_CGLS_mpi_Cart(), refalin3d_perturbquat(), EMAN::EMData::rot_scale_conv(), EMAN::Quaternion::to_angle(), EMAN::Quaternion::to_axis(), trfind_(), and EMAN::Util::WTF().

#define quadpi   3.141592653589793238462643383279502884197

Definition at line 7129 of file util_sparx.cpp.

Referenced by apmq(), and aprq2d().

#define QUADPI   3.141592653589793238462643383279502884197

Definition at line 5679 of file util_sparx.cpp.

#define QUADPI   3.141592653589793238462643383279502884197

Definition at line 5679 of file util_sparx.cpp.

#define QUADPI   3.141592653589793238462643383279502884197

Definition at line 5679 of file util_sparx.cpp.

#define rad_deg   180.0/QUADPI

Definition at line 4598 of file util_sparx.cpp.

Referenced by EMAN::Util::cml_line_in3d(), EMAN::Util::cml_line_insino(), and EMAN::Util::cml_line_insino_all().

#define rad_to_deg   180/quadpi

Definition at line 7132 of file util_sparx.cpp.

#define rad_to_dgr   180/quadpi

Definition at line 7133 of file util_sparx.cpp.

#define RI ( i,
 )     RI [(i-1) + ((j-1)*3)]

Definition at line 5980 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define sign ( x,
 )     (((((y)>0)?(1):(-1))*(y!=0))*(x))

Definition at line 7126 of file util_sparx.cpp.

Referenced by EMAN::Processor::EMFourierFilterFunc(), EMAN::nnSSNR_ctfReconstructor::setup(), EMAN::nn4_ctf_rectReconstructor::setup(), and EMAN::nn4_ctfReconstructor::setup().

#define SS ( I,
 )     SS [I-1 + (J-1)*6]

Definition at line 5979 of file util_sparx.cpp.

#define SS ( I,
 )     SS [I-1 + (J-1)*6]

Definition at line 5979 of file util_sparx.cpp.

#define SS (  )     SS [I-1]

Definition at line 5979 of file util_sparx.cpp.

Referenced by EMAN::Util::CANG(), EMAN::Util::WTF(), and EMAN::Util::WTM().

#define t (  )     t[i-1]

Definition at line 3165 of file util_sparx.cpp.

Referenced by EMAN::OrientationGenerator::add_orientation(), EMAN::Util::ali2d_ccf_list(), EMAN::RT3DSphereAligner::align(), EMAN::RT3DGridAligner::align(), EMAN::Refine3DAlignerGrid::align(), EMAN::Refine3DAlignerQuaternion::align(), EMAN::SymAlignProcessorQuat::align(), EMAN::RefineAligner::align(), EMAN::SymAlignProcessor::align(), EMAN::RTFSlowExhaustiveAligner::align(), EMAN::RTFExhaustiveAligner::align(), EMAN::RotateFlipAlignerIterative::align(), EMAN::RotateFlipAligner::align(), EMAN::RotateTranslateFlipAlignerIterative::align(), EMAN::RotateTranslateFlipAligner::align(), EMAN::RotateTranslateAligner::align(), EMAN::RotateTranslateAlignerIterative::align(), EMAN::TranslationalAligner::align(), EMAN::ScaleAligner::align(), EMAN::ScaleAlignerABS::align_using_base(), EMAN::Util::array_mutation(), bmv_(), EMAN::Util::BPCQ(), EMAN::Symmetry3D::cache_au_planes(), EMAN::EMData::calc_max_location(), EMAN::EMData::calc_min_location(), EMAN::EMData::calc_mutual_correlation(), EMAN::EMData::common_lines_real(), crlist_(), EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_psi(), EMAN::EMData::cut_slice(), EMAN::EMData::do_radon(), EMAN::EMData::dot_rotate_translate(), EMAN::TestUtil::emobject_to_py(), EMAN::TestUtil::emobject_transformarray_to_py(), EMAN::EMData::extract_box(), EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), fftr_q(), formk_(), EMAN::RandomOrientationGenerator::gen_orientations(), EMAN::EmanOrientationGenerator::gen_orientations(), EMAN::TetrahedralSym::get_asym_unit_points(), EMAN::PlatonicSym::get_asym_unit_points(), EMAN::EMData::get_attr(), EMAN::ImagicIO2::get_datatype_from_name(), EMAN::ImagicIO::get_datatype_from_name(), EMAN::TestUtil::get_debug_transform(), EMAN::EMData::get_pixel_filtered(), EMAN::Transform::get_sym_proj(), EMAN::Util::get_time_label(), EMAN::Symmetry3D::get_touching_au_transforms(), EMAN::Transform::icos_5_to_2(), EMAN::nnSSNR_ctfReconstructor::insert_padfft_slice(), EMAN::nn4_ctf_rectReconstructor::insert_padfft_slice(), EMAN::nn4_ctfReconstructor::insert_padfft_slice(), EMAN::nnSSNR_Reconstructor::insert_padfft_slice(), EMAN::nn4_rectReconstructor::insert_padfft_slice(), EMAN::nn4Reconstructor::insert_padfft_slice(), EMAN::nnSSNR_ctfReconstructor::insert_slice(), EMAN::nn4_ctf_rectReconstructor::insert_slice(), EMAN::nn4_ctfReconstructor::insert_slice(), EMAN::nnSSNR_Reconstructor::insert_slice(), EMAN::nn4_rectReconstructor::insert_slice(), EMAN::nn4Reconstructor::insert_slice(), EMAN::BackProjectionReconstructor::insert_slice(), intrsc_(), EMAN::Transform::inverse(), EMAN::Vec2< Type >::length(), EMAN::Vec3< Type >::length(), EMAN::Vec4< Type >::length(), EMAN::Util::list_mutation(), main(), EMAN::EMData::max_3D_pixel_error(), EMAN::Util::multiref_polar_ali_2d_local(), EMAN::Util::multiref_polar_ali_2d_local_psi(), EMAN::Util::multiref_polar_ali_helical_90_local(), EMAN::Util::multiref_polar_ali_helical_local(), EMAN::Transform::negate(), EMAN::FloatPoint::operator vector(), EMAN::FloatSize::operator vector(), EMAN::padfft_slice(), EMAN::Symmetry3D::point_in_which_asym_unit(), EMAN::Util::point_is_in_triangle_2d(), EMAN::PawelProjector::prepcubes(), EMAN::BackProjectionReconstructor::preprocess_slice(), EMAN::FourierReconstructor::preprocess_slice(), EMAN::Randnum::print_generator_type(), EMAN::ScaleTransformProcessor::process(), EMAN::TransformProcessor::process(), EMAN::ApplySymProcessor::process(), EMAN::TomoTiltEdgeMaskProcessor::process_inplace(), EMAN::TestTomoImage::process_inplace(), EMAN::Rotate180Processor::process_inplace(), EMAN::ScaleTransformProcessor::process_inplace(), EMAN::TransformProcessor::process_inplace(), EMAN::TestImageEllipse::process_inplace(), EMAN::TestImageHollowEllipse::process_inplace(), EMAN::IterBinMaskProcessor::process_inplace(), EMAN::AutoMask3DProcessor::process_inplace(), EMAN::SymSearchProcessor::process_inplace(), EMAN::ACFCenterProcessor::process_inplace(), EMAN::PhaseToMassCenterProcessor::process_inplace(), EMAN::ToMassCenterProcessor::process_inplace(), EMAN::FlipProcessor::process_inplace(), EMAN::NormalizeToLeastSquareProcessor::process_inplace(), EMAN::CutoffBlockProcessor::process_inplace(), EMAN::ImageProcessor::process_inplace(), EMAN::BoxMedianProcessor::process_pixel(), EMAN::StandardProjector::project3d(), EMAN::Symmetry3D::reduce(), refalifn(), refalifn3dquat(), EMAN::EMData::render_amp24(), EMAN::EMData::render_ap24(), EMAN::EMData::rot_scale_conv(), EMAN::EMData::rot_scale_conv7(), EMAN::EMData::rot_scale_trans(), EMAN::EMData::rot_scale_trans_background(), EMAN::EMData::rotate(), EMAN::Util::rotate_phase_origin(), EMAN::EMData::rotate_translate(), EMAN::Matrix4::rotation(), EMAN::EMData::scale(), EMAN::EMData::set_attr_python(), setulb_(), slaed2_(), slaed8_(), slamch_(), slasq2_(), slasq3_(), slasv2_(), sormlq_(), sormqr_(), subsm_(), symquat(), test_shared_pointer(), EMAN::Transform::tet_3_to_2(), EMAN::Gatan::to_em_datatype(), EMAN::TransformProcessor::transform(), EMAN::EMData::translate(), EMAN::Transform::transpose(), trplot_(), EMAN::EMData::unwrap(), EMAN::EMData::unwrap_largerR(), varmx(), vrplot_(), EMAN::SpiderIO::write_single_header(), EMAN::RT3DSymmetryAligner::xform_align_nbest(), EMAN::RT3DSphereAligner::xform_align_nbest(), and EMAN::RT3DGridAligner::xform_align_nbest().

#define t7 (  )     t7[i-1]

Definition at line 3168 of file util_sparx.cpp.

Referenced by EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ns(), and EMAN::Util::Crosrng_psi_0_180_no_mirror().

#define tab1 (  )     tab1[i-1]

Definition at line 2617 of file util_sparx.cpp.

Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), and fftr_q().

#define theta (  )     theta [i-1]

Definition at line 7138 of file util_sparx.cpp.

Referenced by ali3d_d(), EMAN::PawelProjector::backproject3d(), EMAN::ChaoProjector::backproject3d(), EMAN::Util::even_angles(), fcalc(), fgcalc(), EMAN::file_store::get_image(), EMAN::Util::hsortd(), LBD_Cart(), main(), mainlb_(), EMAN::Util::multiref_polar_ali_2d_local(), EMAN::Util::multiref_polar_ali_2d_local_psi(), EMAN::Util::multiref_polar_ali_helical_90_local(), EMAN::Util::multiref_polar_ali_helical_local(), EMAN::ChaoProjector::project3d(), EMAN::FourierGriddingProjector::project3d(), recons3d_4nn(), recons3d_CGLS_mpi_Cart(), recons3d_HyBR_mpi_Cart(), recons3d_sirt_mpi(), recons3d_sirt_mpi_Cart(), EMAN::Transform::set_rotation(), EMAN::ChaoProjector::setdm(), trans_(), unified(), and EMAN::Util::vrdg().

#define thetast (  )     thetast [i-1]

Definition at line 7143 of file util_sparx.cpp.

#define TRUE   1

Definition at line 7134 of file util_sparx.cpp.

#define TRUE_   (1)

Definition at line 7838 of file util_sparx.cpp.

#define ts (  )     ts [i-1]

Definition at line 7142 of file util_sparx.cpp.

#define VP (  )     VP [i-1]

Definition at line 5983 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define VV (  )     VV [i-1]

Definition at line 5984 of file util_sparx.cpp.

Referenced by EMAN::Util::WTM().

#define W ( i,
 )     Wptr [i-1+((j-1)*Wnx)]

Definition at line 5977 of file util_sparx.cpp.

#define W ( i,
 )     Wptr [i-1+((j-1)*Wnx)]

Definition at line 5977 of file util_sparx.cpp.

Referenced by EMAN::Util::getBaldwinGridWeights(), EMAN::Util::WTF(), and EMAN::Util::WTM().

#define weight (  )     weight [i-1]

Definition at line 7140 of file util_sparx.cpp.

Referenced by ali3d_d(), EMAN::FRCCmp::cmp(), EMAN::WienerFourierReconstructor::do_insert_slice_work(), EMAN::BackProjectionReconstructor::insert_slice(), and EMAN::Util::vrdg().

#define xcmplx ( i,
 )     xcmplx [(j-1)*2 + i-1]

Definition at line 2618 of file util_sparx.cpp.

Referenced by EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), and fftr_q().

#define xim ( i,
 )     xim[(j-1)*nsam + i-1]

Definition at line 2139 of file util_sparx.cpp.

Referenced by EMAN::Util::bilinear(), EMAN::Util::Polar2D(), and EMAN::Util::Polar2Dm().


Function Documentation

int addnod_ ( int *  ,
int *  ,
double *  ,
double *  ,
double *  ,
int *  ,
int *  ,
int *  ,
int *  ,
int *   
)

Definition at line 8286 of file util_sparx.cpp.

References abs, bdyadd_(), covsph_(), intadd_(), lstptr_(), swap_(), swptst_(), and trfind_().

Referenced by trmesh_(), and EMAN::Util::trmsh3_().

08289 {
08290     /* Initialized data */
08291 
08292     static double tol = 0.;
08293 
08294     /* System generated locals */
08295     int i__1;
08296 
08297     /* Local variables */
08298     static int l;
08299     static double p[3], b1, b2, b3;
08300     static int i1, i2, i3, kk, lp, in1, io1, io2, km1, lpf, ist, lpo1;
08301     /* Subroutine */ int swap_(int *, int *, int *,
08302             int *, int *, int *, int *, int *);
08303     static int lpo1s;
08304     /* Subroutine */ int bdyadd_(int *, int *, int *,
08305             int *, int *, int *, int *), intadd_(int *,
08306             int *, int *, int *, int *, int *, int *,
08307             int *), trfind_(int *, double *, int *,
08308             double *, double *, double *, int *, int *,
08309             int *, double *, double *, double *, int *,
08310             int *, int *), covsph_(int *, int *, int *,
08311             int *, int *, int *);
08312     int lstptr_(int *, int *, int *, int *);
08313     long int swptst_(int *, int *, int *, int *,
08314             double *, double *, double *);
08315 
08316 
08317 /* *********************************************************** */
08318 
08319 /*                                              From STRIPACK */
08320 /*                                            Robert J. Renka */
08321 /*                                  Dept. of Computer Science */
08322 /*                                       Univ. of North Texas */
08323 /*                                           renka@cs.unt.edu */
08324 /*                                                   01/08/03 */
08325 
08326 /*   This subroutine adds node K to a triangulation of the */
08327 /* convex hull of nodes 1,...,K-1, producing a triangulation */
08328 /* of the convex hull of nodes 1,...,K. */
08329 
08330 /*   The algorithm consists of the following steps:  node K */
08331 /* is located relative to the triangulation (TRFIND), its */
08332 /* index is added to the data structure (INTADD or BDYADD), */
08333 /* and a sequence of swaps (SWPTST and SWAP) are applied to */
08334 /* the arcs opposite K so that all arcs incident on node K */
08335 /* and opposite node K are locally optimal (satisfy the cir- */
08336 /* cumcircle test).  Thus, if a Delaunay triangulation is */
08337 /* input, a Delaunay triangulation will result. */
08338 
08339 
08340 /* On input: */
08341 
08342 /*       NST = Index of a node at which TRFIND begins its */
08343 /*             search.  Search time depends on the proximity */
08344 /*             of this node to K.  If NST < 1, the search is */
08345 /*             begun at node K-1. */
08346 
08347 /*       K = Nodal index (index for X, Y, Z, and LEND) of the */
08348 /*           new node to be added.  K .GE. 4. */
08349 
08350 /*       X,Y,Z = Arrays of length .GE. K containing Car- */
08351 /*               tesian coordinates of the nodes. */
08352 /*               (X(I),Y(I),Z(I)) defines node I for */
08353 /*               I = 1,...,K. */
08354 
08355 /* The above parameters are not altered by this routine. */
08356 
08357 /*       LIST,LPTR,LEND,LNEW = Data structure associated with */
08358 /*                             the triangulation of nodes 1 */
08359 /*                             to K-1.  The array lengths are */
08360 /*                             assumed to be large enough to */
08361 /*                             add node K.  Refer to Subrou- */
08362 /*                             tine TRMESH. */
08363 
08364 /* On output: */
08365 
08366 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
08367 /*                             the addition of node K as the */
08368 /*                             last entry unless IER .NE. 0 */
08369 /*                             and IER .NE. -3, in which case */
08370 /*                             the arrays are not altered. */
08371 
08372 /*       IER = Error indicator: */
08373 /*             IER =  0 if no errors were encountered. */
08374 /*             IER = -1 if K is outside its valid range */
08375 /*                      on input. */
08376 /*             IER = -2 if all nodes (including K) are col- */
08377 /*                      linear (lie on a common geodesic). */
08378 /*             IER =  L if nodes L and K coincide for some */
08379 /*                      L < K.  Refer to TOL below. */
08380 
08381 /* Modules required by ADDNOD:  BDYADD, COVSPH, INSERT, */
08382 /*                                INTADD, JRAND, LSTPTR, */
08383 /*                                STORE, SWAP, SWPTST, */
08384 /*                                TRFIND */
08385 
08386 /* Intrinsic function called by ADDNOD:  ABS */
08387 
08388 /* *********************************************************** */
08389 
08390 
08391 /* Local parameters: */
08392 
08393 /* B1,B2,B3 = Unnormalized barycentric coordinates returned */
08394 /*              by TRFIND. */
08395 /* I1,I2,I3 = Vertex indexes of a triangle containing K */
08396 /* IN1 =      Vertex opposite K:  first neighbor of IO2 */
08397 /*              that precedes IO1.  IN1,IO1,IO2 are in */
08398 /*              counterclockwise order. */
08399 /* IO1,IO2 =  Adjacent neighbors of K defining an arc to */
08400 /*              be tested for a swap */
08401 /* IST =      Index of node at which TRFIND begins its search */
08402 /* KK =       Local copy of K */
08403 /* KM1 =      K-1 */
08404 /* L =        Vertex index (I1, I2, or I3) returned in IER */
08405 /*              if node K coincides with a vertex */
08406 /* LP =       LIST pointer */
08407 /* LPF =      LIST pointer to the first neighbor of K */
08408 /* LPO1 =     LIST pointer to IO1 */
08409 /* LPO1S =    Saved value of LPO1 */
08410 /* P =        Cartesian coordinates of node K */
08411 /* TOL =      Tolerance defining coincident nodes:  bound on */
08412 /*              the deviation from 1 of the cosine of the */
08413 /*              angle between the nodes. */
08414 /*              Note that |1-cos(A)| is approximately A*A/2. */
08415 
08416     /* Parameter adjustments */
08417     --lend;
08418     --z__;
08419     --y;
08420     --x;
08421     --list;
08422     --lptr;
08423 
08424     /* Function Body */
08425 
08426     kk = *k;
08427     if (kk < 4) {
08428         goto L3;
08429     }
08430 
08431 /* Initialization: */
08432     km1 = kk - 1;
08433     ist = *nst;
08434     if (ist < 1) {
08435         ist = km1;
08436     }
08437     p[0] = x[kk];
08438     p[1] = y[kk];
08439     p[2] = z__[kk];
08440 
08441 /* Find a triangle (I1,I2,I3) containing K or the rightmost */
08442 /*   (I1) and leftmost (I2) visible boundary nodes as viewed */
08443 /*   from node K. */
08444     trfind_(&ist, p, &km1, &x[1], &y[1], &z__[1], &list[1], &lptr[1], &lend[1]
08445             , &b1, &b2, &b3, &i1, &i2, &i3);
08446 
08447 /*   Test for collinear or (nearly) duplicate nodes. */
08448 
08449     if (i1 == 0) {
08450         goto L4;
08451     }
08452     l = i1;
08453     if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) {
08454         goto L5;
08455     }
08456     l = i2;
08457     if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) {
08458         goto L5;
08459     }
08460     if (i3 != 0) {
08461         l = i3;
08462         if (p[0] * x[l] + p[1] * y[l] + p[2] * z__[l] >= 1. - tol) {
08463             goto L5;
08464         }
08465         intadd_(&kk, &i1, &i2, &i3, &list[1], &lptr[1], &lend[1], lnew);
08466     } else {
08467         if (i1 != i2) {
08468             bdyadd_(&kk, &i1, &i2, &list[1], &lptr[1], &lend[1], lnew);
08469         } else {
08470             covsph_(&kk, &i1, &list[1], &lptr[1], &lend[1], lnew);
08471         }
08472     }
08473     *ier = 0;
08474 
08475 /* Initialize variables for optimization of the */
08476 /*   triangulation. */
08477     lp = lend[kk];
08478     lpf = lptr[lp];
08479     io2 = list[lpf];
08480     lpo1 = lptr[lpf];
08481     io1 = (i__1 = list[lpo1], abs(i__1));
08482 
08483 /* Begin loop:  find the node opposite K. */
08484 
08485 L1:
08486     lp = lstptr_(&lend[io1], &io2, &list[1], &lptr[1]);
08487     if (list[lp] < 0) {
08488         goto L2;
08489     }
08490     lp = lptr[lp];
08491     in1 = (i__1 = list[lp], abs(i__1));
08492 
08493 /* Swap test:  if a swap occurs, two new arcs are */
08494 /*             opposite K and must be tested. */
08495 
08496     lpo1s = lpo1;
08497     if (! swptst_(&in1, &kk, &io1, &io2, &x[1], &y[1], &z__[1])) {
08498         goto L2;
08499     }
08500     swap_(&in1, &kk, &io1, &io2, &list[1], &lptr[1], &lend[1], &lpo1);
08501     if (lpo1 == 0) {
08502 
08503 /*   A swap is not possible because KK and IN1 are already */
08504 /*     adjacent.  This error in SWPTST only occurs in the */
08505 /*     neutral case and when there are nearly duplicate */
08506 /*     nodes. */
08507 
08508         lpo1 = lpo1s;
08509         goto L2;
08510     }
08511     io1 = in1;
08512     goto L1;
08513 
08514 /* No swap occurred.  Test for termination and reset */
08515 /*   IO2 and IO1. */
08516 
08517 L2:
08518     if (lpo1 == lpf || list[lpo1] < 0) {
08519         return 0;
08520     }
08521     io2 = io1;
08522     lpo1 = lptr[lpo1];
08523     io1 = (i__1 = list[lpo1], abs(i__1));
08524     goto L1;
08525 
08526 /* KK < 4. */
08527 
08528 L3:
08529     *ier = -1;
08530     return 0;
08531 
08532 /* All nodes are collinear. */
08533 
08534 L4:
08535     *ier = -2;
08536     return 0;
08537 
08538 /* Nodes L and K coincide. */
08539 
08540 L5:
08541     *ier = l;
08542     return 0;
08543 } /* addnod_ */

double angle_ ( double *  v1,
double *  v2,
double *  v3 
)

Definition at line 8545 of file util_sparx.cpp.

References left_(), and sqrt().

Referenced by areav_new__().

08546 {
08547     /* System generated locals */
08548     double ret_val;
08549 
08550     /* Builtin functions */
08551     //double sqrt(double), acos(double);
08552 
08553     /* Local variables */
08554     static double a;
08555     static int i__;
08556     static double ca, s21, s23, u21[3], u23[3];
08557 
08558 
08559 /* *********************************************************** */
08560 
08561 /*                                              From STRIPACK */
08562 /*                                            Robert J. Renka */
08563 /*                                  Dept. of Computer Science */
08564 /*                                       Univ. of North Texas */
08565 /*                                           renka@cs.unt.edu */
08566 /*                                                   06/03/03 */
08567 
08568 /*   Given a sequence of three nodes (V1,V2,V3) on the sur- */
08569 /* face of the unit sphere, this function returns the */
08570 /* interior angle at V2 -- the dihedral angle between the */
08571 /* plane defined by V2 and V3 (and the origin) and the plane */
08572 /* defined by V2 and V1 or, equivalently, the angle between */
08573 /* the normals V2 X V3 and V2 X V1.  Note that the angle is */
08574 /* in the range 0 to Pi if V3 Left V1->V2, Pi to 2*Pi other- */
08575 /* wise.  The surface area of a spherical polygon with CCW- */
08576 /* ordered vertices V1, V2, ..., Vm is Asum - (m-2)*Pi, where */
08577 /* Asum is the sum of the m interior angles computed from the */
08578 /* sequences (Vm,V1,V2), (V1,V2,V3), (V2,V3,V4), ..., */
08579 /* (Vm-1,Vm,V1). */
08580 
08581 
08582 /* On input: */
08583 
08584 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
08585 /*                  sian coordinates of unit vectors.  These */
08586 /*                  vectors, if nonzero, are implicitly */
08587 /*                  scaled to have length 1. */
08588 
08589 /* Input parameters are not altered by this function. */
08590 
08591 /* On output: */
08592 
08593 /*       ANGLE = Angle defined above, or 0 if V2 X V1 = 0 or */
08594 /*               V2 X V3 = 0. */
08595 
08596 /* Module required by ANGLE:  LEFT */
08597 
08598 /* Intrinsic functions called by ANGLE:  ACOS, SQRT */
08599 
08600 /* *********************************************************** */
08601 
08602 
08603 /* Local parameters: */
08604 
08605 /* A =       Interior angle at V2 */
08606 /* CA =      cos(A) */
08607 /* I =       DO-loop index and index for U21 and U23 */
08608 /* S21,S23 = Sum of squared components of U21 and U23 */
08609 /* U21,U23 = Unit normal vectors to the planes defined by */
08610 /*             pairs of triangle vertices */
08611 
08612 
08613 /* Compute cross products U21 = V2 X V1 and U23 = V2 X V3. */
08614 
08615     /* Parameter adjustments */
08616     --v3;
08617     --v2;
08618     --v1;
08619 
08620     /* Function Body */
08621     u21[0] = v2[2] * v1[3] - v2[3] * v1[2];
08622     u21[1] = v2[3] * v1[1] - v2[1] * v1[3];
08623     u21[2] = v2[1] * v1[2] - v2[2] * v1[1];
08624 
08625     u23[0] = v2[2] * v3[3] - v2[3] * v3[2];
08626     u23[1] = v2[3] * v3[1] - v2[1] * v3[3];
08627     u23[2] = v2[1] * v3[2] - v2[2] * v3[1];
08628 
08629 /* Normalize U21 and U23 to unit vectors. */
08630 
08631     s21 = 0.;
08632     s23 = 0.;
08633     for (i__ = 1; i__ <= 3; ++i__) {
08634         s21 += u21[i__ - 1] * u21[i__ - 1];
08635         s23 += u23[i__ - 1] * u23[i__ - 1];
08636 /* L1: */
08637     }
08638 
08639 /* Test for a degenerate triangle associated with collinear */
08640 /*   vertices. */
08641 
08642     if (s21 == 0. || s23 == 0.) {
08643         ret_val = 0.;
08644         return ret_val;
08645     }
08646     s21 = sqrt(s21);
08647     s23 = sqrt(s23);
08648     for (i__ = 1; i__ <= 3; ++i__) {
08649         u21[i__ - 1] /= s21;
08650         u23[i__ - 1] /= s23;
08651 /* L2: */
08652     }
08653 
08654 /* Compute the angle A between normals: */
08655 
08656 /*   CA = cos(A) = <U21,U23> */
08657 
08658     ca = u21[0] * u23[0] + u21[1] * u23[1] + u21[2] * u23[2];
08659     if (ca < -1.) {
08660         ca = -1.;
08661     }
08662     if (ca > 1.) {
08663         ca = 1.;
08664     }
08665     a = acos(ca);
08666 
08667 /* Adjust A to the interior angle:  A > Pi iff */
08668 /*   V3 Right V1->V2. */
08669 
08670     if (! left_(&v1[1], &v1[2], &v1[3], &v2[1], &v2[2], &v2[3], &v3[1], &v3[2]
08671             , &v3[3])) {
08672         a = acos(-1.) * 2. - a;
08673     }
08674     ret_val = a;
08675     return ret_val;
08676 } /* angle_ */

double areas_ ( double *  v1,
double *  v2,
double *  v3 
)

Definition at line 8678 of file util_sparx.cpp.

References sqrt().

Referenced by EMAN::Util::areav_().

08679 {
08680     /* System generated locals */
08681     double ret_val;
08682 
08683     /* Builtin functions */
08684     //double sqrt(double), acos(double);
08685 
08686     /* Local variables */
08687     static int i__;
08688     static double a1, a2, a3, s12, s31, s23, u12[3], u23[3], u31[3], ca1,
08689             ca2, ca3;
08690 
08691 
08692 /* *********************************************************** */
08693 
08694 /*                                              From STRIPACK */
08695 /*                                            Robert J. Renka */
08696 /*                                  Dept. of Computer Science */
08697 /*                                       Univ. of North Texas */
08698 /*                                           renka@cs.unt.edu */
08699 /*                                                   06/22/98 */
08700 
08701 /*   This function returns the area of a spherical triangle */
08702 /* on the unit sphere. */
08703 
08704 
08705 /* On input: */
08706 
08707 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
08708 /*                  sian coordinates of unit vectors (the */
08709 /*                  three triangle vertices in any order). */
08710 /*                  These vectors, if nonzero, are implicitly */
08711 /*                  scaled to have length 1. */
08712 
08713 /* Input parameters are not altered by this function. */
08714 
08715 /* On output: */
08716 
08717 /*       AREAS = Area of the spherical triangle defined by */
08718 /*               V1, V2, and V3 in the range 0 to 2*PI (the */
08719 /*               area of a hemisphere).  AREAS = 0 (or 2*PI) */
08720 /*               if and only if V1, V2, and V3 lie in (or */
08721 /*               close to) a plane containing the origin. */
08722 
08723 /* Modules required by AREAS:  None */
08724 
08725 /* Intrinsic functions called by AREAS:  ACOS, SQRT */
08726 
08727 /* *********************************************************** */
08728 
08729 
08730 /* Local parameters: */
08731 
08732 /* A1,A2,A3 =    Interior angles of the spherical triangle */
08733 /* CA1,CA2,CA3 = cos(A1), cos(A2), and cos(A3), respectively */
08734 /* I =           DO-loop index and index for Uij */
08735 /* S12,S23,S31 = Sum of squared components of U12, U23, U31 */
08736 /* U12,U23,U31 = Unit normal vectors to the planes defined by */
08737 /*                 pairs of triangle vertices */
08738 
08739 
08740 /* Compute cross products Uij = Vi X Vj. */
08741 
08742     /* Parameter adjustments */
08743     --v3;
08744     --v2;
08745     --v1;
08746 
08747     /* Function Body */
08748     u12[0] = v1[2] * v2[3] - v1[3] * v2[2];
08749     u12[1] = v1[3] * v2[1] - v1[1] * v2[3];
08750     u12[2] = v1[1] * v2[2] - v1[2] * v2[1];
08751 
08752     u23[0] = v2[2] * v3[3] - v2[3] * v3[2];
08753     u23[1] = v2[3] * v3[1] - v2[1] * v3[3];
08754     u23[2] = v2[1] * v3[2] - v2[2] * v3[1];
08755 
08756     u31[0] = v3[2] * v1[3] - v3[3] * v1[2];
08757     u31[1] = v3[3] * v1[1] - v3[1] * v1[3];
08758     u31[2] = v3[1] * v1[2] - v3[2] * v1[1];
08759 
08760 /* Normalize Uij to unit vectors. */
08761 
08762     s12 = 0.;
08763     s23 = 0.;
08764     s31 = 0.;
08765     for (i__ = 1; i__ <= 3; ++i__) {
08766         s12 += u12[i__ - 1] * u12[i__ - 1];
08767         s23 += u23[i__ - 1] * u23[i__ - 1];
08768         s31 += u31[i__ - 1] * u31[i__ - 1];
08769 /* L2: */
08770     }
08771 
08772 /* Test for a degenerate triangle associated with collinear */
08773 /*   vertices. */
08774 
08775     if (s12 == 0. || s23 == 0. || s31 == 0.) {
08776         ret_val = 0.;
08777         return ret_val;
08778     }
08779     s12 = sqrt(s12);
08780     s23 = sqrt(s23);
08781     s31 = sqrt(s31);
08782     for (i__ = 1; i__ <= 3; ++i__) {
08783         u12[i__ - 1] /= s12;
08784         u23[i__ - 1] /= s23;
08785         u31[i__ - 1] /= s31;
08786 /* L3: */
08787     }
08788 
08789 /* Compute interior angles Ai as the dihedral angles between */
08790 /*   planes: */
08791 /*           CA1 = cos(A1) = -<U12,U31> */
08792 /*           CA2 = cos(A2) = -<U23,U12> */
08793 /*           CA3 = cos(A3) = -<U31,U23> */
08794 
08795     ca1 = -u12[0] * u31[0] - u12[1] * u31[1] - u12[2] * u31[2];
08796     ca2 = -u23[0] * u12[0] - u23[1] * u12[1] - u23[2] * u12[2];
08797     ca3 = -u31[0] * u23[0] - u31[1] * u23[1] - u31[2] * u23[2];
08798     if (ca1 < -1.) {
08799         ca1 = -1.;
08800     }
08801     if (ca1 > 1.) {
08802         ca1 = 1.;
08803     }
08804     if (ca2 < -1.) {
08805         ca2 = -1.;
08806     }
08807     if (ca2 > 1.) {
08808         ca2 = 1.;
08809     }
08810     if (ca3 < -1.) {
08811         ca3 = -1.;
08812     }
08813     if (ca3 > 1.) {
08814         ca3 = 1.;
08815     }
08816     a1 = acos(ca1);
08817     a2 = acos(ca2);
08818     a3 = acos(ca3);
08819 
08820 /* Compute AREAS = A1 + A2 + A3 - PI. */
08821 
08822     ret_val = a1 + a2 + a3 - acos(-1.);
08823     if (ret_val < 0.) {
08824         ret_val = 0.;
08825     }
08826     return ret_val;
08827 } /* areas_ */

double areav_new__ ( int *  k,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
int *  ier 
)

Definition at line 9032 of file util_sparx.cpp.

References angle_(), circum_(), and ierr.

09035 {
09036     /* System generated locals */
09037     double ret_val = 0;
09038 
09039     /* Builtin functions */
09040     //double acos(double);
09041 
09042     /* Local variables */
09043     static int m;
09044     static double c1[3], c2[3], c3[3];
09045     static int n1, n2, n3;
09046     static double v1[3], v2[3], v3[3];
09047     static int lp;
09048     static double c1s[3], c2s[3];
09049     static int lpl, ierr;
09050     static double asum;
09051     double angle_(double *, double *, double *);
09052     static float areav;
09053 
09054 
09055 /* *********************************************************** */
09056 
09057 /*                                            Robert J. Renka */
09058 /*                                  Dept. of Computer Science */
09059 /*                                       Univ. of North Texas */
09060 /*                                           renka@cs.unt.edu */
09061 /*                                                   06/03/03 */
09062 
09063 /*   Given a Delaunay triangulation and the index K of an */
09064 /* interior node, this subroutine returns the (surface) area */
09065 /* of the Voronoi region associated with node K.  The Voronoi */
09066 /* region is the polygon whose vertices are the circumcenters */
09067 /* of the triangles that contain node K, where a triangle */
09068 /* circumcenter is the point (unit vector) lying at the same */
09069 /* angular distance from the three vertices and contained in */
09070 /* the same hemisphere as the vertices.  The Voronoi region */
09071 /* area is computed as Asum-(m-2)*Pi, where m is the number */
09072 /* of Voronoi vertices (neighbors of K) and Asum is the sum */
09073 /* of interior angles at the vertices. */
09074 
09075 
09076 /* On input: */
09077 
09078 /*       K = Nodal index in the range 1 to N. */
09079 
09080 /*       N = Number of nodes in the triangulation.  N > 3. */
09081 
09082 /*       X,Y,Z = Arrays of length N containing the Cartesian */
09083 /*               coordinates of the nodes (unit vectors). */
09084 
09085 /*       LIST,LPTR,LEND = Data structure defining the trian- */
09086 /*                        gulation.  Refer to Subroutine */
09087 /*                        TRMESH. */
09088 
09089 /* Input parameters are not altered by this function. */
09090 
09091 /* On output: */
09092 
09093 /*       AREAV = Area of Voronoi region K unless IER > 0, */
09094 /*               in which case AREAV = 0. */
09095 
09096 /*       IER = Error indicator: */
09097 /*             IER = 0 if no errors were encountered. */
09098 /*             IER = 1 if K or N is outside its valid range */
09099 /*                     on input. */
09100 /*             IER = 2 if K indexes a boundary node. */
09101 /*             IER = 3 if an error flag is returned by CIRCUM */
09102 /*                     (null triangle). */
09103 
09104 /* Modules required by AREAV:  ANGLE, CIRCUM */
09105 
09106 /* Intrinsic functions called by AREAV:  ACOS, DBLE */
09107 
09108 /* *********************************************************** */
09109 
09110 
09111 /* Test for invalid input. */
09112 
09113     /* Parameter adjustments */
09114     --lend;
09115     --z__;
09116     --y;
09117     --x;
09118     --list;
09119     --lptr;
09120 
09121     /* Function Body */
09122     if (*k < 1 || *k > *n || *n <= 3) {
09123         goto L11;
09124     }
09125 
09126 /* Initialization:  Set N3 to the last neighbor of N1 = K. */
09127 /*   The number of neighbors and the sum of interior angles */
09128 /*   are accumulated in M and ASUM, respectively. */
09129 
09130     n1 = *k;
09131     v1[0] = x[n1];
09132     v1[1] = y[n1];
09133     v1[2] = z__[n1];
09134     lpl = lend[n1];
09135     n3 = list[lpl];
09136     if (n3 < 0) {
09137         goto L12;
09138     }
09139     lp = lpl;
09140     m = 0;
09141     asum = 0.;
09142 
09143 /* Loop on triangles (N1,N2,N3) containing N1 = K. */
09144 
09145 L1:
09146     ++m;
09147     n2 = n3;
09148     lp = lptr[lp];
09149     n3 = list[lp];
09150     v2[0] = x[n2];
09151     v2[1] = y[n2];
09152     v2[2] = z__[n2];
09153     v3[0] = x[n3];
09154     v3[1] = y[n3];
09155     v3[2] = z__[n3];
09156     if (m == 1) {
09157 
09158 /* First triangle:  compute the circumcenter C2 and save a */
09159 /*   copy in C1S. */
09160 
09161         circum_(v1, v2, v3, c2, &ierr);
09162         if (ierr != 0) {
09163             goto L13;
09164         }
09165         c1s[0] = c2[0];
09166         c1s[1] = c2[1];
09167         c1s[2] = c2[2];
09168     } else if (m == 2) {
09169 
09170 /* Second triangle:  compute the circumcenter C3 and save a */
09171 /*   copy in C2S. */
09172 
09173         circum_(v1, v2, v3, c3, &ierr);
09174         if (ierr != 0) {
09175             goto L13;
09176         }
09177         c2s[0] = c3[0];
09178         c2s[1] = c3[1];
09179         c2s[2] = c3[2];
09180     } else {
09181 
09182 /* Set C1 to C2, set C2 to C3, compute the new circumcenter */
09183 /*   C3, and compute the interior angle at C2 from the */
09184 /*   sequence of vertices (C1,C2,C3). */
09185 
09186         c1[0] = c2[0];
09187         c1[1] = c2[1];
09188         c1[2] = c2[2];
09189         c2[0] = c3[0];
09190         c2[1] = c3[1];
09191         c2[2] = c3[2];
09192         circum_(v1, v2, v3, c3, &ierr);
09193         if (ierr != 0) {
09194             goto L13;
09195         }
09196         asum += angle_(c1, c2, c3);
09197     }
09198 
09199 /* Bottom on loop on neighbors of K. */
09200 
09201     if (lp != lpl) {
09202         goto L1;
09203     }
09204 
09205 /* C3 is the last vertex.  Compute its interior angle from */
09206 /*   the sequence (C2,C3,C1S). */
09207 
09208     asum += angle_(c2, c3, c1s);
09209 
09210 /* Compute the interior angle at C1S from */
09211 /*   the sequence (C3,C1S,C2S). */
09212 
09213     asum += angle_(c3, c1s, c2s);
09214 
09215 /* No error encountered. */
09216 
09217     *ier = 0;
09218     ret_val = asum - (double) (m - 2) * acos(-1.);
09219     return ret_val;
09220 
09221 /* Invalid input. */
09222 
09223 L11:
09224     *ier = 1;
09225     areav = 0.f;
09226     return ret_val;
09227 
09228 /* K indexes a boundary node. */
09229 
09230 L12:
09231     *ier = 2;
09232     areav = 0.f;
09233     return ret_val;
09234 
09235 /* Error in CIRCUM. */
09236 
09237 L13:
09238     *ier = 3;
09239     areav = 0.f;
09240     return ret_val;
09241 } /* areav_new__ */

int bdyadd_ ( int *  kk,
int *  i1,
int *  i2,
int *  list,
int *  lptr,
int *  lend,
int *  lnew 
)

Definition at line 9243 of file util_sparx.cpp.

References insert_().

Referenced by addnod_().

09245 {
09246     static int k, n1, n2, lp, lsav, nsav, next;
09247     /* Subroutine */ int insert_(int *, int *, int *,
09248             int *, int *);
09249 
09250 
09251 /* *********************************************************** */
09252 
09253 /*                                              From STRIPACK */
09254 /*                                            Robert J. Renka */
09255 /*                                  Dept. of Computer Science */
09256 /*                                       Univ. of North Texas */
09257 /*                                           renka@cs.unt.edu */
09258 /*                                                   07/11/96 */
09259 
09260 /*   This subroutine adds a boundary node to a triangulation */
09261 /* of a set of KK-1 points on the unit sphere.  The data */
09262 /* structure is updated with the insertion of node KK, but no */
09263 /* optimization is performed. */
09264 
09265 /*   This routine is identical to the similarly named routine */
09266 /* in TRIPACK. */
09267 
09268 
09269 /* On input: */
09270 
09271 /*       KK = Index of a node to be connected to the sequence */
09272 /*            of all visible boundary nodes.  KK .GE. 1 and */
09273 /*            KK must not be equal to I1 or I2. */
09274 
09275 /*       I1 = First (rightmost as viewed from KK) boundary */
09276 /*            node in the triangulation that is visible from */
09277 /*            node KK (the line segment KK-I1 intersects no */
09278 /*            arcs. */
09279 
09280 /*       I2 = Last (leftmost) boundary node that is visible */
09281 /*            from node KK.  I1 and I2 may be determined by */
09282 /*            Subroutine TRFIND. */
09283 
09284 /* The above parameters are not altered by this routine. */
09285 
09286 /*       LIST,LPTR,LEND,LNEW = Triangulation data structure */
09287 /*                             created by Subroutine TRMESH. */
09288 /*                             Nodes I1 and I2 must be in- */
09289 /*                             cluded in the triangulation. */
09290 
09291 /* On output: */
09292 
09293 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
09294 /*                             the addition of node KK.  Node */
09295 /*                             KK is connected to I1, I2, and */
09296 /*                             all boundary nodes in between. */
09297 
09298 /* Module required by BDYADD:  INSERT */
09299 
09300 /* *********************************************************** */
09301 
09302 
09303 /* Local parameters: */
09304 
09305 /* K =     Local copy of KK */
09306 /* LP =    LIST pointer */
09307 /* LSAV =  LIST pointer */
09308 /* N1,N2 = Local copies of I1 and I2, respectively */
09309 /* NEXT =  Boundary node visible from K */
09310 /* NSAV =  Boundary node visible from K */
09311 
09312     /* Parameter adjustments */
09313     --lend;
09314     --lptr;
09315     --list;
09316 
09317     /* Function Body */
09318     k = *kk;
09319     n1 = *i1;
09320     n2 = *i2;
09321 
09322 /* Add K as the last neighbor of N1. */
09323 
09324     lp = lend[n1];
09325     lsav = lptr[lp];
09326     lptr[lp] = *lnew;
09327     list[*lnew] = -k;
09328     lptr[*lnew] = lsav;
09329     lend[n1] = *lnew;
09330     ++(*lnew);
09331     next = -list[lp];
09332     list[lp] = next;
09333     nsav = next;
09334 
09335 /* Loop on the remaining boundary nodes between N1 and N2, */
09336 /*   adding K as the first neighbor. */
09337 
09338 L1:
09339     lp = lend[next];
09340     insert_(&k, &lp, &list[1], &lptr[1], lnew);
09341     if (next == n2) {
09342         goto L2;
09343     }
09344     next = -list[lp];
09345     list[lp] = next;
09346     goto L1;
09347 
09348 /* Add the boundary nodes between N1 and N2 as neighbors */
09349 /*   of node K. */
09350 
09351 L2:
09352     lsav = *lnew;
09353     list[*lnew] = n1;
09354     lptr[*lnew] = *lnew + 1;
09355     ++(*lnew);
09356     next = nsav;
09357 
09358 L3:
09359     if (next == n2) {
09360         goto L4;
09361     }
09362     list[*lnew] = next;
09363     lptr[*lnew] = *lnew + 1;
09364     ++(*lnew);
09365     lp = lend[next];
09366     next = list[lp];
09367     goto L3;
09368 
09369 L4:
09370     list[*lnew] = -n2;
09371     lptr[*lnew] = lsav;
09372     lend[k] = *lnew;
09373     ++(*lnew);
09374     return 0;
09375 } /* bdyadd_ */

int bnodes_ ( int *  n,
int *  list,
int *  lptr,
int *  lend,
int *  nodes,
int *  nb,
int *  na,
int *  nt 
)

Definition at line 9377 of file util_sparx.cpp.

References nn().

09379 {
09380     /* System generated locals */
09381     int i__1;
09382 
09383     /* Local variables */
09384     static int k, n0, lp, nn, nst;
09385 
09386 
09387 /* *********************************************************** */
09388 
09389 /*                                              From STRIPACK */
09390 /*                                            Robert J. Renka */
09391 /*                                  Dept. of Computer Science */
09392 /*                                       Univ. of North Texas */
09393 /*                                           renka@cs.unt.edu */
09394 /*                                                   06/26/96 */
09395 
09396 /*   Given a triangulation of N nodes on the unit sphere */
09397 /* created by Subroutine TRMESH, this subroutine returns an */
09398 /* array containing the indexes (if any) of the counterclock- */
09399 /* wise-ordered sequence of boundary nodes -- the nodes on */
09400 /* the boundary of the convex hull of the set of nodes.  (The */
09401 /* boundary is empty if the nodes do not lie in a single */
09402 /* hemisphere.)  The numbers of boundary nodes, arcs, and */
09403 /* triangles are also returned. */
09404 
09405 
09406 /* On input: */
09407 
09408 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
09409 
09410 /*       LIST,LPTR,LEND = Data structure defining the trian- */
09411 /*                        gulation.  Refer to Subroutine */
09412 /*                        TRMESH. */
09413 
09414 /* The above parameters are not altered by this routine. */
09415 
09416 /*       NODES = int array of length at least NB */
09417 /*               (NB .LE. N). */
09418 
09419 /* On output: */
09420 
09421 /*       NODES = Ordered sequence of boundary node indexes */
09422 /*               in the range 1 to N (in the first NB loca- */
09423 /*               tions). */
09424 
09425 /*       NB = Number of boundary nodes. */
09426 
09427 /*       NA,NT = Number of arcs and triangles, respectively, */
09428 /*               in the triangulation. */
09429 
09430 /* Modules required by BNODES:  None */
09431 
09432 /* *********************************************************** */
09433 
09434 
09435 /* Local parameters: */
09436 
09437 /* K =   NODES index */
09438 /* LP =  LIST pointer */
09439 /* N0 =  Boundary node to be added to NODES */
09440 /* NN =  Local copy of N */
09441 /* NST = First element of nodes (arbitrarily chosen to be */
09442 /*         the one with smallest index) */
09443 
09444     /* Parameter adjustments */
09445     --lend;
09446     --list;
09447     --lptr;
09448     --nodes;
09449 
09450     /* Function Body */
09451     nn = *n;
09452 
09453 /* Search for a boundary node. */
09454 
09455     i__1 = nn;
09456     for (nst = 1; nst <= i__1; ++nst) {
09457         lp = lend[nst];
09458         if (list[lp] < 0) {
09459             goto L2;
09460         }
09461 /* L1: */
09462     }
09463 
09464 /* The triangulation contains no boundary nodes. */
09465 
09466     *nb = 0;
09467     *na = (nn - 2) * 3;
09468     *nt = nn - (2<<1);
09469     return 0;
09470 
09471 /* NST is the first boundary node encountered.  Initialize */
09472 /*   for traversal of the boundary. */
09473 
09474 L2:
09475     nodes[1] = nst;
09476     k = 1;
09477     n0 = nst;
09478 
09479 /* Traverse the boundary in counterclockwise order. */
09480 
09481 L3:
09482     lp = lend[n0];
09483     lp = lptr[lp];
09484     n0 = list[lp];
09485     if (n0 == nst) {
09486         goto L4;
09487     }
09488     ++k;
09489     nodes[k] = n0;
09490     goto L3;
09491 
09492 /* Store the counts. */
09493 
09494 L4:
09495     *nb = k;
09496     *nt = (*n << 1) - *nb - 2;
09497     *na = *nt + *n - 1;
09498     return 0;
09499 } /* bnodes_ */

int circle_ ( int *  k,
double *  xc,
double *  yc,
int *  ier 
)

Definition at line 9501 of file util_sparx.cpp.

09503 {
09504     /* System generated locals */
09505     int i__1;
09506 
09507     /* Builtin functions */
09508     //double atan(double), cos(double), sin(double);
09509 
09510     /* Local variables */
09511     static double a, c__;
09512     static int i__;
09513     static double s;
09514     static int k2, k3;
09515     static double x0, y0;
09516     static int kk, np1;
09517 
09518 
09519 /* *********************************************************** */
09520 
09521 /*                                              From STRIPACK */
09522 /*                                            Robert J. Renka */
09523 /*                                  Dept. of Computer Science */
09524 /*                                       Univ. of North Texas */
09525 /*                                           renka@cs.unt.edu */
09526 /*                                                   04/06/90 */
09527 
09528 /*   This subroutine computes the coordinates of a sequence */
09529 /* of N equally spaced points on the unit circle centered at */
09530 /* (0,0).  An N-sided polygonal approximation to the circle */
09531 /* may be plotted by connecting (XC(I),YC(I)) to (XC(I+1), */
09532 /* YC(I+1)) for I = 1,...,N, where XC(N+1) = XC(1) and */
09533 /* YC(N+1) = YC(1).  A reasonable value for N in this case */
09534 /* is 2*PI*R, where R is the radius of the circle in device */
09535 /* coordinates. */
09536 
09537 
09538 /* On input: */
09539 
09540 /*       K = Number of points in each quadrant, defining N as */
09541 /*           4K.  K .GE. 1. */
09542 
09543 /*       XC,YC = Arrays of length at least N+1 = 4K+1. */
09544 
09545 /* K is not altered by this routine. */
09546 
09547 /* On output: */
09548 
09549 /*       XC,YC = Cartesian coordinates of the points on the */
09550 /*               unit circle in the first N+1 locations. */
09551 /*               XC(I) = cos(A*(I-1)), YC(I) = sin(A*(I-1)), */
09552 /*               where A = 2*PI/N.  Note that XC(N+1) = XC(1) */
09553 /*               and YC(N+1) = YC(1). */
09554 
09555 /*       IER = Error indicator: */
09556 /*             IER = 0 if no errors were encountered. */
09557 /*             IER = 1 if K < 1 on input. */
09558 
09559 /* Modules required by CIRCLE:  None */
09560 
09561 /* Intrinsic functions called by CIRCLE:  ATAN, COS, DBLE, */
09562 /*                                          SIN */
09563 
09564 /* *********************************************************** */
09565 
09566 
09567 /* Local parameters: */
09568 
09569 /* I =     DO-loop index and index for XC and YC */
09570 /* KK =    Local copy of K */
09571 /* K2 =    K*2 */
09572 /* K3 =    K*3 */
09573 /* NP1 =   N+1 = 4*K + 1 */
09574 /* A =     Angular separation between adjacent points */
09575 /* C,S =   Cos(A) and sin(A), respectively, defining a */
09576 /*           rotation through angle A */
09577 /* X0,Y0 = Cartesian coordinates of a point on the unit */
09578 /*           circle in the first quadrant */
09579 
09580     /* Parameter adjustments */
09581     --yc;
09582     --xc;
09583 
09584     /* Function Body */
09585     kk = *k;
09586     k2 = kk << 1;
09587     k3 = kk * 3;
09588     np1 = (kk << 2) + 1;
09589 
09590 /* Test for invalid input, compute A, C, and S, and */
09591 /*   initialize (X0,Y0) to (1,0). */
09592 
09593     if (kk < 1) {
09594         goto L2;
09595     }
09596     a = atan(1.) * 2. / (double) kk;
09597     c__ = cos(a);
09598     s = sin(a);
09599     x0 = 1.;
09600     y0 = 0.;
09601 
09602 /* Loop on points (X0,Y0) in the first quadrant, storing */
09603 /*   the point and its reflections about the x axis, the */
09604 /*   y axis, and the line y = -x. */
09605 
09606     i__1 = kk;
09607     for (i__ = 1; i__ <= i__1; ++i__) {
09608         xc[i__] = x0;
09609         yc[i__] = y0;
09610         xc[i__ + kk] = -y0;
09611         yc[i__ + kk] = x0;
09612         xc[i__ + k2] = -x0;
09613         yc[i__ + k2] = -y0;
09614         xc[i__ + k3] = y0;
09615         yc[i__ + k3] = -x0;
09616 
09617 /*   Rotate (X0,Y0) counterclockwise through angle A. */
09618 
09619         x0 = c__ * x0 - s * y0;
09620         y0 = s * x0 + c__ * y0;
09621 /* L1: */
09622     }
09623 
09624 /* Store the coordinates of the first point as the last */
09625 /*   point. */
09626 
09627     xc[np1] = xc[1];
09628     yc[np1] = yc[1];
09629     *ier = 0;
09630     return 0;
09631 
09632 /* K < 1. */
09633 
09634 L2:
09635     *ier = 1;
09636     return 0;
09637 } /* circle_ */

int circum_ ( double *  ,
double *  ,
double *  ,
double *  ,
int *   
)

Definition at line 9639 of file util_sparx.cpp.

References sqrt().

Referenced by EMAN::Util::areav_(), areav_new__(), and crlist_().

09641 {
09642     /* Builtin functions */
09643     //double sqrt(double);
09644 
09645     /* Local variables */
09646     static int i__;
09647     static double e1[3], e2[3], cu[3], cnorm;
09648 
09649 
09650 /* *********************************************************** */
09651 
09652 /*                                              From STRIPACK */
09653 /*                                            Robert J. Renka */
09654 /*                                  Dept. of Computer Science */
09655 /*                                       Univ. of North Texas */
09656 /*                                           renka@cs.unt.edu */
09657 /*                                                   10/27/02 */
09658 
09659 /*   This subroutine returns the circumcenter of a spherical */
09660 /* triangle on the unit sphere:  the point on the sphere sur- */
09661 /* face that is equally distant from the three triangle */
09662 /* vertices and lies in the same hemisphere, where distance */
09663 /* is taken to be arc-length on the sphere surface. */
09664 
09665 
09666 /* On input: */
09667 
09668 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
09669 /*                  sian coordinates of the three triangle */
09670 /*                  vertices (unit vectors) in CCW order. */
09671 
09672 /* The above parameters are not altered by this routine. */
09673 
09674 /*       C = Array of length 3. */
09675 
09676 /* On output: */
09677 
09678 /*       C = Cartesian coordinates of the circumcenter unless */
09679 /*           IER > 0, in which case C is not defined.  C = */
09680 /*           (V2-V1) X (V3-V1) normalized to a unit vector. */
09681 
09682 /*       IER = Error indicator: */
09683 /*             IER = 0 if no errors were encountered. */
09684 /*             IER = 1 if V1, V2, and V3 lie on a common */
09685 /*                     line:  (V2-V1) X (V3-V1) = 0. */
09686 /*             (The vertices are not tested for validity.) */
09687 
09688 /* Modules required by CIRCUM:  None */
09689 
09690 /* Intrinsic function called by CIRCUM:  SQRT */
09691 
09692 /* *********************************************************** */
09693 
09694 
09695 /* Local parameters: */
09696 
09697 /* CNORM = Norm of CU:  used to compute C */
09698 /* CU =    Scalar multiple of C:  E1 X E2 */
09699 /* E1,E2 = Edges of the underlying planar triangle: */
09700 /*           V2-V1 and V3-V1, respectively */
09701 /* I =     DO-loop index */
09702 
09703     /* Parameter adjustments */
09704     --c__;
09705     --v3;
09706     --v2;
09707     --v1;
09708 
09709     /* Function Body */
09710     for (i__ = 1; i__ <= 3; ++i__) {
09711         e1[i__ - 1] = v2[i__] - v1[i__];
09712         e2[i__ - 1] = v3[i__] - v1[i__];
09713 /* L1: */
09714     }
09715 
09716 /* Compute CU = E1 X E2 and CNORM**2. */
09717 
09718     cu[0] = e1[1] * e2[2] - e1[2] * e2[1];
09719     cu[1] = e1[2] * e2[0] - e1[0] * e2[2];
09720     cu[2] = e1[0] * e2[1] - e1[1] * e2[0];
09721     cnorm = cu[0] * cu[0] + cu[1] * cu[1] + cu[2] * cu[2];
09722 
09723 /* The vertices lie on a common line if and only if CU is */
09724 /*   the zero vector. */
09725 
09726     if (cnorm != 0.) {
09727 
09728 /*   No error:  compute C. */
09729 
09730         cnorm = sqrt(cnorm);
09731         for (i__ = 1; i__ <= 3; ++i__) {
09732             c__[i__] = cu[i__ - 1] / cnorm;
09733 /* L2: */
09734         }
09735 
09736 /* If the vertices are nearly identical, the problem is */
09737 /*   ill-conditioned and it is possible for the computed */
09738 /*   value of C to be 180 degrees off:  <C,V1> near -1 */
09739 /*   when it should be positive. */
09740 
09741         if (c__[1] * v1[1] + c__[2] * v1[2] + c__[3] * v1[3] < -.5) {
09742             c__[1] = -c__[1];
09743             c__[2] = -c__[2];
09744             c__[3] = -c__[3];
09745         }
09746         *ier = 0;
09747     } else {
09748 
09749 /*   CU = 0. */
09750 
09751         *ier = 1;
09752     }
09753     return 0;
09754 } /* circum_ */

int covsph_ ( int *  kk,
int *  n0,
int *  list,
int *  lptr,
int *  lend,
int *  lnew 
)

Definition at line 9756 of file util_sparx.cpp.

References insert_().

Referenced by addnod_().

09758 {
09759     static int k, lp, nst, lsav, next;
09760     /* Subroutine */ int insert_(int *, int *, int *,
09761             int *, int *);
09762 
09763 
09764 /* *********************************************************** */
09765 
09766 /*                                              From STRIPACK */
09767 /*                                            Robert J. Renka */
09768 /*                                  Dept. of Computer Science */
09769 /*                                       Univ. of North Texas */
09770 /*                                           renka@cs.unt.edu */
09771 /*                                                   07/17/96 */
09772 
09773 /*   This subroutine connects an exterior node KK to all */
09774 /* boundary nodes of a triangulation of KK-1 points on the */
09775 /* unit sphere, producing a triangulation that covers the */
09776 /* sphere.  The data structure is updated with the addition */
09777 /* of node KK, but no optimization is performed.  All boun- */
09778 /* dary nodes must be visible from node KK. */
09779 
09780 
09781 /* On input: */
09782 
09783 /*       KK = Index of the node to be connected to the set of */
09784 /*            all boundary nodes.  KK .GE. 4. */
09785 
09786 /*       N0 = Index of a boundary node (in the range 1 to */
09787 /*            KK-1).  N0 may be determined by Subroutine */
09788 /*            TRFIND. */
09789 
09790 /* The above parameters are not altered by this routine. */
09791 
09792 /*       LIST,LPTR,LEND,LNEW = Triangulation data structure */
09793 /*                             created by Subroutine TRMESH. */
09794 /*                             Node N0 must be included in */
09795 /*                             the triangulation. */
09796 
09797 /* On output: */
09798 
09799 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
09800 /*                             the addition of node KK as the */
09801 /*                             last entry.  The updated */
09802 /*                             triangulation contains no */
09803 /*                             boundary nodes. */
09804 
09805 /* Module required by COVSPH:  INSERT */
09806 
09807 /* *********************************************************** */
09808 
09809 
09810 /* Local parameters: */
09811 
09812 /* K =     Local copy of KK */
09813 /* LP =    LIST pointer */
09814 /* LSAV =  LIST pointer */
09815 /* NEXT =  Boundary node visible from K */
09816 /* NST =   Local copy of N0 */
09817 
09818     /* Parameter adjustments */
09819     --lend;
09820     --lptr;
09821     --list;
09822 
09823     /* Function Body */
09824     k = *kk;
09825     nst = *n0;
09826 
09827 /* Traverse the boundary in clockwise order, inserting K as */
09828 /*   the first neighbor of each boundary node, and converting */
09829 /*   the boundary node to an interior node. */
09830 
09831     next = nst;
09832 L1:
09833     lp = lend[next];
09834     insert_(&k, &lp, &list[1], &lptr[1], lnew);
09835     next = -list[lp];
09836     list[lp] = next;
09837     if (next != nst) {
09838         goto L1;
09839     }
09840 
09841 /* Traverse the boundary again, adding each node to K's */
09842 /*   adjacency list. */
09843 
09844     lsav = *lnew;
09845 L2:
09846     lp = lend[next];
09847     list[*lnew] = next;
09848     lptr[*lnew] = *lnew + 1;
09849     ++(*lnew);
09850     next = list[lp];
09851     if (next != nst) {
09852         goto L2;
09853     }
09854 
09855     lptr[*lnew - 1] = lsav;
09856     lend[k] = *lnew - 1;
09857     return 0;
09858 } /* covsph_ */

int crlist_ ( int *  n,
int *  ncol,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lend,
int *  lptr,
int *  lnew,
int *  ltri,
int *  listc,
int *  nb,
double *  xc,
double *  yc,
double *  zc,
double *  rc,
int *  ier 
)

Definition at line 9861 of file util_sparx.cpp.

References abs, circum_(), FALSE_, ierr, lstptr_(), nn(), swptst_(), t, and TRUE_.

09866 {
09867     /* System generated locals */
09868     int i__1, i__2;
09869 
09870     /* Builtin functions */
09871     //double acos(double);
09872 
09873     /* Local variables */
09874     static double c__[3], t;
09875     static int i1, i2, i3, i4, n0, n1, n2, n3, n4;
09876     static double v1[3], v2[3], v3[3];
09877     static int lp, kt, nn, nt, nm2, kt1, kt2, kt11, kt12, kt21, kt22, lpl,
09878              lpn;
09879     static long int swp;
09880     static int ierr;
09881     int lstptr_(int *, int *, int *, int *);
09882     long int swptst_(int *, int *, int *, int *,
09883             double *, double *, double *);
09884 
09885 
09886 /* *********************************************************** */
09887 
09888 /*                                              From STRIPACK */
09889 /*                                            Robert J. Renka */
09890 /*                                  Dept. of Computer Science */
09891 /*                                       Univ. of North Texas */
09892 /*                                           renka@cs.unt.edu */
09893 /*                                                   03/05/03 */
09894 
09895 /*   Given a Delaunay triangulation of nodes on the surface */
09896 /* of the unit sphere, this subroutine returns the set of */
09897 /* triangle circumcenters corresponding to Voronoi vertices, */
09898 /* along with the circumradii and a list of triangle indexes */
09899 /* LISTC stored in one-to-one correspondence with LIST/LPTR */
09900 /* entries. */
09901 
09902 /*   A triangle circumcenter is the point (unit vector) lying */
09903 /* at the same angular distance from the three vertices and */
09904 /* contained in the same hemisphere as the vertices.  (Note */
09905 /* that the negative of a circumcenter is also equidistant */
09906 /* from the vertices.)  If the triangulation covers the sur- */
09907 /* face, the Voronoi vertices are the circumcenters of the */
09908 /* triangles in the Delaunay triangulation.  LPTR, LEND, and */
09909 /* LNEW are not altered in this case. */
09910 
09911 /*   On the other hand, if the nodes are contained in a sin- */
09912 /* gle hemisphere, the triangulation is implicitly extended */
09913 /* to the entire surface by adding pseudo-arcs (of length */
09914 /* greater than 180 degrees) between boundary nodes forming */
09915 /* pseudo-triangles whose 'circumcenters' are included in the */
09916 /* list.  This extension to the triangulation actually con- */
09917 /* sists of a triangulation of the set of boundary nodes in */
09918 /* which the swap test is reversed (a non-empty circumcircle */
09919 /* test).  The negative circumcenters are stored as the */
09920 /* pseudo-triangle 'circumcenters'.  LISTC, LPTR, LEND, and */
09921 /* LNEW contain a data structure corresponding to the ex- */
09922 /* tended triangulation (Voronoi diagram), but LIST is not */
09923 /* altered in this case.  Thus, if it is necessary to retain */
09924 /* the original (unextended) triangulation data structure, */
09925 /* copies of LPTR and LNEW must be saved before calling this */
09926 /* routine. */
09927 
09928 
09929 /* On input: */
09930 
09931 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
09932 /*           Note that, if N = 3, there are only two Voronoi */
09933 /*           vertices separated by 180 degrees, and the */
09934 /*           Voronoi regions are not well defined. */
09935 
09936 /*       NCOL = Number of columns reserved for LTRI.  This */
09937 /*              must be at least NB-2, where NB is the number */
09938 /*              of boundary nodes. */
09939 
09940 /*       X,Y,Z = Arrays of length N containing the Cartesian */
09941 /*               coordinates of the nodes (unit vectors). */
09942 
09943 /*       LIST = int array containing the set of adjacency */
09944 /*              lists.  Refer to Subroutine TRMESH. */
09945 
09946 /*       LEND = Set of pointers to ends of adjacency lists. */
09947 /*              Refer to Subroutine TRMESH. */
09948 
09949 /* The above parameters are not altered by this routine. */
09950 
09951 /*       LPTR = Array of pointers associated with LIST.  Re- */
09952 /*              fer to Subroutine TRMESH. */
09953 
09954 /*       LNEW = Pointer to the first empty location in LIST */
09955 /*              and LPTR (list length plus one). */
09956 
09957 /*       LTRI = int work space array dimensioned 6 by */
09958 /*              NCOL, or unused dummy parameter if NB = 0. */
09959 
09960 /*       LISTC = int array of length at least 3*NT, where */
09961 /*               NT = 2*N-4 is the number of triangles in the */
09962 /*               triangulation (after extending it to cover */
09963 /*               the entire surface if necessary). */
09964 
09965 /*       XC,YC,ZC,RC = Arrays of length NT = 2*N-4. */
09966 
09967 /* On output: */
09968 
09969 /*       LPTR = Array of pointers associated with LISTC: */
09970 /*              updated for the addition of pseudo-triangles */
09971 /*              if the original triangulation contains */
09972 /*              boundary nodes (NB > 0). */
09973 
09974 /*       LNEW = Pointer to the first empty location in LISTC */
09975 /*              and LPTR (list length plus one).  LNEW is not */
09976 /*              altered if NB = 0. */
09977 
09978 /*       LTRI = Triangle list whose first NB-2 columns con- */
09979 /*              tain the indexes of a clockwise-ordered */
09980 /*              sequence of vertices (first three rows) */
09981 /*              followed by the LTRI column indexes of the */
09982 /*              triangles opposite the vertices (or 0 */
09983 /*              denoting the exterior region) in the last */
09984 /*              three rows.  This array is not generally of */
09985 /*              any use. */
09986 
09987 /*       LISTC = Array containing triangle indexes (indexes */
09988 /*               to XC, YC, ZC, and RC) stored in 1-1 corres- */
09989 /*               pondence with LIST/LPTR entries (or entries */
09990 /*               that would be stored in LIST for the */
09991 /*               extended triangulation):  the index of tri- */
09992 /*               angle (N1,N2,N3) is stored in LISTC(K), */
09993 /*               LISTC(L), and LISTC(M), where LIST(K), */
09994 /*               LIST(L), and LIST(M) are the indexes of N2 */
09995 /*               as a neighbor of N1, N3 as a neighbor of N2, */
09996 /*               and N1 as a neighbor of N3.  The Voronoi */
09997 /*               region associated with a node is defined by */
09998 /*               the CCW-ordered sequence of circumcenters in */
09999 /*               one-to-one correspondence with its adjacency */
10000 /*               list (in the extended triangulation). */
10001 
10002 /*       NB = Number of boundary nodes unless IER = 1. */
10003 
10004 /*       XC,YC,ZC = Arrays containing the Cartesian coordi- */
10005 /*                  nates of the triangle circumcenters */
10006 /*                  (Voronoi vertices).  XC(I)**2 + YC(I)**2 */
10007 /*                  + ZC(I)**2 = 1.  The first NB-2 entries */
10008 /*                  correspond to pseudo-triangles if NB > 0. */
10009 
10010 /*       RC = Array containing circumradii (the arc lengths */
10011 /*            or angles between the circumcenters and associ- */
10012 /*            ated triangle vertices) in 1-1 correspondence */
10013 /*            with circumcenters. */
10014 
10015 /*       IER = Error indicator: */
10016 /*             IER = 0 if no errors were encountered. */
10017 /*             IER = 1 if N < 3. */
10018 /*             IER = 2 if NCOL < NB-2. */
10019 /*             IER = 3 if a triangle is degenerate (has ver- */
10020 /*                     tices lying on a common geodesic). */
10021 
10022 /* Modules required by CRLIST:  CIRCUM, LSTPTR, SWPTST */
10023 
10024 /* Intrinsic functions called by CRLIST:  ABS, ACOS */
10025 
10026 /* *********************************************************** */
10027 
10028 
10029 /* Local parameters: */
10030 
10031 /* C =         Circumcenter returned by Subroutine CIRCUM */
10032 /* I1,I2,I3 =  Permutation of (1,2,3):  LTRI row indexes */
10033 /* I4 =        LTRI row index in the range 1 to 3 */
10034 /* IERR =      Error flag for calls to CIRCUM */
10035 /* KT =        Triangle index */
10036 /* KT1,KT2 =   Indexes of a pair of adjacent pseudo-triangles */
10037 /* KT11,KT12 = Indexes of the pseudo-triangles opposite N1 */
10038 /*               and N2 as vertices of KT1 */
10039 /* KT21,KT22 = Indexes of the pseudo-triangles opposite N1 */
10040 /*               and N2 as vertices of KT2 */
10041 /* LP,LPN =    LIST pointers */
10042 /* LPL =       LIST pointer of the last neighbor of N1 */
10043 /* N0 =        Index of the first boundary node (initial */
10044 /*               value of N1) in the loop on boundary nodes */
10045 /*               used to store the pseudo-triangle indexes */
10046 /*               in LISTC */
10047 /* N1,N2,N3 =  Nodal indexes defining a triangle (CCW order) */
10048 /*               or pseudo-triangle (clockwise order) */
10049 /* N4 =        Index of the node opposite N2 -> N1 */
10050 /* NM2 =       N-2 */
10051 /* NN =        Local copy of N */
10052 /* NT =        Number of pseudo-triangles:  NB-2 */
10053 /* SWP =       long int variable set to TRUE in each optimiza- */
10054 /*               tion loop (loop on pseudo-arcs) iff a swap */
10055 /*               is performed */
10056 /* V1,V2,V3 =  Vertices of triangle KT = (N1,N2,N3) sent to */
10057 /*               Subroutine CIRCUM */
10058 
10059     /* Parameter adjustments */
10060     --lend;
10061     --z__;
10062     --y;
10063     --x;
10064     ltri -= 7;
10065     --list;
10066     --lptr;
10067     --listc;
10068     --xc;
10069     --yc;
10070     --zc;
10071     --rc;
10072 
10073     /* Function Body */
10074     nn = *n;
10075     *nb = 0;
10076     nt = 0;
10077     if (nn < 3) {
10078         goto L21;
10079     }
10080 
10081 /* Search for a boundary node N1. */
10082 
10083     i__1 = nn;
10084     for (n1 = 1; n1 <= i__1; ++n1) {
10085         lp = lend[n1];
10086         if (list[lp] < 0) {
10087             goto L2;
10088         }
10089 /* L1: */
10090     }
10091 
10092 /* The triangulation already covers the sphere. */
10093 
10094     goto L9;
10095 
10096 /* There are NB .GE. 3 boundary nodes.  Add NB-2 pseudo- */
10097 /*   triangles (N1,N2,N3) by connecting N3 to the NB-3 */
10098 /*   boundary nodes to which it is not already adjacent. */
10099 
10100 /*   Set N3 and N2 to the first and last neighbors, */
10101 /*     respectively, of N1. */
10102 
10103 L2:
10104     n2 = -list[lp];
10105     lp = lptr[lp];
10106     n3 = list[lp];
10107 
10108 /*   Loop on boundary arcs N1 -> N2 in clockwise order, */
10109 /*     storing triangles (N1,N2,N3) in column NT of LTRI */
10110 /*     along with the indexes of the triangles opposite */
10111 /*     the vertices. */
10112 
10113 L3:
10114     ++nt;
10115     if (nt <= *ncol) {
10116         ltri[nt * 6 + 1] = n1;
10117         ltri[nt * 6 + 2] = n2;
10118         ltri[nt * 6 + 3] = n3;
10119         ltri[nt * 6 + 4] = nt + 1;
10120         ltri[nt * 6 + 5] = nt - 1;
10121         ltri[nt * 6 + 6] = 0;
10122     }
10123     n1 = n2;
10124     lp = lend[n1];
10125     n2 = -list[lp];
10126     if (n2 != n3) {
10127         goto L3;
10128     }
10129 
10130     *nb = nt + 2;
10131     if (*ncol < nt) {
10132         goto L22;
10133     }
10134     ltri[nt * 6 + 4] = 0;
10135     if (nt == 1) {
10136         goto L7;
10137     }
10138 
10139 /* Optimize the exterior triangulation (set of pseudo- */
10140 /*   triangles) by applying swaps to the pseudo-arcs N1-N2 */
10141 /*   (pairs of adjacent pseudo-triangles KT1 and KT2 > KT1). */
10142 /*   The loop on pseudo-arcs is repeated until no swaps are */
10143 /*   performed. */
10144 
10145 L4:
10146     swp = FALSE_;
10147     i__1 = nt - 1;
10148     for (kt1 = 1; kt1 <= i__1; ++kt1) {
10149         for (i3 = 1; i3 <= 3; ++i3) {
10150             kt2 = ltri[i3 + 3 + kt1 * 6];
10151             if (kt2 <= kt1) {
10152                 goto L5;
10153             }
10154 
10155 /*   The LTRI row indexes (I1,I2,I3) of triangle KT1 = */
10156 /*     (N1,N2,N3) are a cyclical permutation of (1,2,3). */
10157 
10158             if (i3 == 1) {
10159                 i1 = 2;
10160                 i2 = 3;
10161             } else if (i3 == 2) {
10162                 i1 = 3;
10163                 i2 = 1;
10164             } else {
10165                 i1 = 1;
10166                 i2 = 2;
10167             }
10168             n1 = ltri[i1 + kt1 * 6];
10169             n2 = ltri[i2 + kt1 * 6];
10170             n3 = ltri[i3 + kt1 * 6];
10171 
10172 /*   KT2 = (N2,N1,N4) for N4 = LTRI(I,KT2), where */
10173 /*     LTRI(I+3,KT2) = KT1. */
10174 
10175             if (ltri[kt2 * 6 + 4] == kt1) {
10176                 i4 = 1;
10177             } else if (ltri[kt2 * 6 + 5] == kt1) {
10178                 i4 = 2;
10179             } else {
10180                 i4 = 3;
10181             }
10182             n4 = ltri[i4 + kt2 * 6];
10183 
10184 /*   The empty circumcircle test is reversed for the pseudo- */
10185 /*     triangles.  The reversal is implicit in the clockwise */
10186 /*     ordering of the vertices. */
10187 
10188             if (! swptst_(&n1, &n2, &n3, &n4, &x[1], &y[1], &z__[1])) {
10189                 goto L5;
10190             }
10191 
10192 /*   Swap arc N1-N2 for N3-N4.  KTij is the triangle opposite */
10193 /*     Nj as a vertex of KTi. */
10194 
10195             swp = TRUE_;
10196             kt11 = ltri[i1 + 3 + kt1 * 6];
10197             kt12 = ltri[i2 + 3 + kt1 * 6];
10198             if (i4 == 1) {
10199                 i2 = 2;
10200                 i1 = 3;
10201             } else if (i4 == 2) {
10202                 i2 = 3;
10203                 i1 = 1;
10204             } else {
10205                 i2 = 1;
10206                 i1 = 2;
10207             }
10208             kt21 = ltri[i1 + 3 + kt2 * 6];
10209             kt22 = ltri[i2 + 3 + kt2 * 6];
10210             ltri[kt1 * 6 + 1] = n4;
10211             ltri[kt1 * 6 + 2] = n3;
10212             ltri[kt1 * 6 + 3] = n1;
10213             ltri[kt1 * 6 + 4] = kt12;
10214             ltri[kt1 * 6 + 5] = kt22;
10215             ltri[kt1 * 6 + 6] = kt2;
10216             ltri[kt2 * 6 + 1] = n3;
10217             ltri[kt2 * 6 + 2] = n4;
10218             ltri[kt2 * 6 + 3] = n2;
10219             ltri[kt2 * 6 + 4] = kt21;
10220             ltri[kt2 * 6 + 5] = kt11;
10221             ltri[kt2 * 6 + 6] = kt1;
10222 
10223 /*   Correct the KT11 and KT22 entries that changed. */
10224 
10225             if (kt11 != 0) {
10226                 i4 = 4;
10227                 if (ltri[kt11 * 6 + 4] != kt1) {
10228                     i4 = 5;
10229                     if (ltri[kt11 * 6 + 5] != kt1) {
10230                         i4 = 6;
10231                     }
10232                 }
10233                 ltri[i4 + kt11 * 6] = kt2;
10234             }
10235             if (kt22 != 0) {
10236                 i4 = 4;
10237                 if (ltri[kt22 * 6 + 4] != kt2) {
10238                     i4 = 5;
10239                     if (ltri[kt22 * 6 + 5] != kt2) {
10240                         i4 = 6;
10241                     }
10242                 }
10243                 ltri[i4 + kt22 * 6] = kt1;
10244             }
10245 L5:
10246             ;
10247         }
10248 /* L6: */
10249     }
10250     if (swp) {
10251         goto L4;
10252     }
10253 
10254 /* Compute and store the negative circumcenters and radii of */
10255 /*   the pseudo-triangles in the first NT positions. */
10256 
10257 L7:
10258     i__1 = nt;
10259     for (kt = 1; kt <= i__1; ++kt) {
10260         n1 = ltri[kt * 6 + 1];
10261         n2 = ltri[kt * 6 + 2];
10262         n3 = ltri[kt * 6 + 3];
10263         v1[0] = x[n1];
10264         v1[1] = y[n1];
10265         v1[2] = z__[n1];
10266         v2[0] = x[n2];
10267         v2[1] = y[n2];
10268         v2[2] = z__[n2];
10269         v3[0] = x[n3];
10270         v3[1] = y[n3];
10271         v3[2] = z__[n3];
10272         circum_(v2, v1, v3, c__, &ierr);
10273         if (ierr != 0) {
10274             goto L23;
10275         }
10276 
10277 /*   Store the negative circumcenter and radius (computed */
10278 /*     from <V1,C>). */
10279 
10280         xc[kt] = -c__[0];
10281         yc[kt] = -c__[1];
10282         zc[kt] = -c__[2];
10283         t = -(v1[0] * c__[0] + v1[1] * c__[1] + v1[2] * c__[2]);
10284         if (t < -1.) {
10285             t = -1.;
10286         }
10287         if (t > 1.) {
10288             t = 1.;
10289         }
10290         rc[kt] = acos(t);
10291 /* L8: */
10292     }
10293 
10294 /* Compute and store the circumcenters and radii of the */
10295 /*   actual triangles in positions KT = NT+1, NT+2, ... */
10296 /*   Also, store the triangle indexes KT in the appropriate */
10297 /*   LISTC positions. */
10298 
10299 L9:
10300     kt = nt;
10301 
10302 /*   Loop on nodes N1. */
10303 
10304     nm2 = nn - 2;
10305     i__1 = nm2;
10306     for (n1 = 1; n1 <= i__1; ++n1) {
10307         lpl = lend[n1];
10308         lp = lpl;
10309         n3 = list[lp];
10310 
10311 /*   Loop on adjacent neighbors N2,N3 of N1 for which N2 > N1 */
10312 /*     and N3 > N1. */
10313 
10314 L10:
10315         lp = lptr[lp];
10316         n2 = n3;
10317         n3 = (i__2 = list[lp], abs(i__2));
10318         if (n2 <= n1 || n3 <= n1) {
10319             goto L11;
10320         }
10321         ++kt;
10322 
10323 /*   Compute the circumcenter C of triangle KT = (N1,N2,N3). */
10324 
10325         v1[0] = x[n1];
10326         v1[1] = y[n1];
10327         v1[2] = z__[n1];
10328         v2[0] = x[n2];
10329         v2[1] = y[n2];
10330         v2[2] = z__[n2];
10331         v3[0] = x[n3];
10332         v3[1] = y[n3];
10333         v3[2] = z__[n3];
10334         circum_(v1, v2, v3, c__, &ierr);
10335         if (ierr != 0) {
10336             goto L23;
10337         }
10338 
10339 /*   Store the circumcenter, radius and triangle index. */
10340 
10341         xc[kt] = c__[0];
10342         yc[kt] = c__[1];
10343         zc[kt] = c__[2];
10344         t = v1[0] * c__[0] + v1[1] * c__[1] + v1[2] * c__[2];
10345         if (t < -1.) {
10346             t = -1.;
10347         }
10348         if (t > 1.) {
10349             t = 1.;
10350         }
10351         rc[kt] = acos(t);
10352 
10353 /*   Store KT in LISTC(LPN), where Abs(LIST(LPN)) is the */
10354 /*     index of N2 as a neighbor of N1, N3 as a neighbor */
10355 /*     of N2, and N1 as a neighbor of N3. */
10356 
10357         lpn = lstptr_(&lpl, &n2, &list[1], &lptr[1]);
10358         listc[lpn] = kt;
10359         lpn = lstptr_(&lend[n2], &n3, &list[1], &lptr[1]);
10360         listc[lpn] = kt;
10361         lpn = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]);
10362         listc[lpn] = kt;
10363 L11:
10364         if (lp != lpl) {
10365             goto L10;
10366         }
10367 /* L12: */
10368     }
10369     if (nt == 0) {
10370         goto L20;
10371     }
10372 
10373 /* Store the first NT triangle indexes in LISTC. */
10374 
10375 /*   Find a boundary triangle KT1 = (N1,N2,N3) with a */
10376 /*     boundary arc opposite N3. */
10377 
10378     kt1 = 0;
10379 L13:
10380     ++kt1;
10381     if (ltri[kt1 * 6 + 4] == 0) {
10382         i1 = 2;
10383         i2 = 3;
10384         i3 = 1;
10385         goto L14;
10386     } else if (ltri[kt1 * 6 + 5] == 0) {
10387         i1 = 3;
10388         i2 = 1;
10389         i3 = 2;
10390         goto L14;
10391     } else if (ltri[kt1 * 6 + 6] == 0) {
10392         i1 = 1;
10393         i2 = 2;
10394         i3 = 3;
10395         goto L14;
10396     }
10397     goto L13;
10398 L14:
10399     n1 = ltri[i1 + kt1 * 6];
10400     n0 = n1;
10401 
10402 /*   Loop on boundary nodes N1 in CCW order, storing the */
10403 /*     indexes of the clockwise-ordered sequence of triangles */
10404 /*     that contain N1.  The first triangle overwrites the */
10405 /*     last neighbor position, and the remaining triangles, */
10406 /*     if any, are appended to N1's adjacency list. */
10407 
10408 /*   A pointer to the first neighbor of N1 is saved in LPN. */
10409 
10410 L15:
10411     lp = lend[n1];
10412     lpn = lptr[lp];
10413     listc[lp] = kt1;
10414 
10415 /*   Loop on triangles KT2 containing N1. */
10416 
10417 L16:
10418     kt2 = ltri[i2 + 3 + kt1 * 6];
10419     if (kt2 != 0) {
10420 
10421 /*   Append KT2 to N1's triangle list. */
10422 
10423         lptr[lp] = *lnew;
10424         lp = *lnew;
10425         listc[lp] = kt2;
10426         ++(*lnew);
10427 
10428 /*   Set KT1 to KT2 and update (I1,I2,I3) such that */
10429 /*     LTRI(I1,KT1) = N1. */
10430 
10431         kt1 = kt2;
10432         if (ltri[kt1 * 6 + 1] == n1) {
10433             i1 = 1;
10434             i2 = 2;
10435             i3 = 3;
10436         } else if (ltri[kt1 * 6 + 2] == n1) {
10437             i1 = 2;
10438             i2 = 3;
10439             i3 = 1;
10440         } else {
10441             i1 = 3;
10442             i2 = 1;
10443             i3 = 2;
10444         }
10445         goto L16;
10446     }
10447 
10448 /*   Store the saved first-triangle pointer in LPTR(LP), set */
10449 /*     N1 to the next boundary node, test for termination, */
10450 /*     and permute the indexes:  the last triangle containing */
10451 /*     a boundary node is the first triangle containing the */
10452 /*     next boundary node. */
10453 
10454     lptr[lp] = lpn;
10455     n1 = ltri[i3 + kt1 * 6];
10456     if (n1 != n0) {
10457         i4 = i3;
10458         i3 = i2;
10459         i2 = i1;
10460         i1 = i4;
10461         goto L15;
10462     }
10463 
10464 /* No errors encountered. */
10465 
10466 L20:
10467     *ier = 0;
10468     return 0;
10469 
10470 /* N < 3. */
10471 
10472 L21:
10473     *ier = 1;
10474     return 0;
10475 
10476 /* Insufficient space reserved for LTRI. */
10477 
10478 L22:
10479     *ier = 2;
10480     return 0;
10481 
10482 /* Error flag returned by CIRCUM: KT indexes a null triangle. */
10483 
10484 L23:
10485     *ier = 3;
10486     return 0;
10487 } /* crlist_ */

int delarc_ ( int *  n,
int *  io1,
int *  io2,
int *  list,
int *  lptr,
int *  lend,
int *  lnew,
int *  ier 
)

Definition at line 10489 of file util_sparx.cpp.

References abs, delnb_(), and lstptr_().

10491 {
10492     /* System generated locals */
10493     int i__1;
10494 
10495     /* Local variables */
10496     static int n1, n2, n3, lp, lph, lpl;
10497     /* Subroutine */ int delnb_(int *, int *, int *,
10498             int *, int *, int *, int *, int *);
10499     int lstptr_(int *, int *, int *, int *);
10500 
10501 
10502 /* *********************************************************** */
10503 
10504 /*                                              From STRIPACK */
10505 /*                                            Robert J. Renka */
10506 /*                                  Dept. of Computer Science */
10507 /*                                       Univ. of North Texas */
10508 /*                                           renka@cs.unt.edu */
10509 /*                                                   07/17/96 */
10510 
10511 /*   This subroutine deletes a boundary arc from a triangula- */
10512 /* tion.  It may be used to remove a null triangle from the */
10513 /* convex hull boundary.  Note, however, that if the union of */
10514 /* triangles is rendered nonconvex, Subroutines DELNOD, EDGE, */
10515 /* and TRFIND (and hence ADDNOD) may fail.  Also, Function */
10516 /* NEARND should not be called following an arc deletion. */
10517 
10518 /*   This routine is identical to the similarly named routine */
10519 /* in TRIPACK. */
10520 
10521 
10522 /* On input: */
10523 
10524 /*       N = Number of nodes in the triangulation.  N .GE. 4. */
10525 
10526 /*       IO1,IO2 = Indexes (in the range 1 to N) of a pair of */
10527 /*                 adjacent boundary nodes defining the arc */
10528 /*                 to be removed. */
10529 
10530 /* The above parameters are not altered by this routine. */
10531 
10532 /*       LIST,LPTR,LEND,LNEW = Triangulation data structure */
10533 /*                             created by Subroutine TRMESH. */
10534 
10535 /* On output: */
10536 
10537 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
10538 /*                             the removal of arc IO1-IO2 */
10539 /*                             unless IER > 0. */
10540 
10541 /*       IER = Error indicator: */
10542 /*             IER = 0 if no errors were encountered. */
10543 /*             IER = 1 if N, IO1, or IO2 is outside its valid */
10544 /*                     range, or IO1 = IO2. */
10545 /*             IER = 2 if IO1-IO2 is not a boundary arc. */
10546 /*             IER = 3 if the node opposite IO1-IO2 is al- */
10547 /*                     ready a boundary node, and thus IO1 */
10548 /*                     or IO2 has only two neighbors or a */
10549 /*                     deletion would result in two triangu- */
10550 /*                     lations sharing a single node. */
10551 /*             IER = 4 if one of the nodes is a neighbor of */
10552 /*                     the other, but not vice versa, imply- */
10553 /*                     ing an invalid triangulation data */
10554 /*                     structure. */
10555 
10556 /* Module required by DELARC:  DELNB, LSTPTR */
10557 
10558 /* Intrinsic function called by DELARC:  ABS */
10559 
10560 /* *********************************************************** */
10561 
10562 
10563 /* Local parameters: */
10564 
10565 /* LP =       LIST pointer */
10566 /* LPH =      LIST pointer or flag returned by DELNB */
10567 /* LPL =      Pointer to the last neighbor of N1, N2, or N3 */
10568 /* N1,N2,N3 = Nodal indexes of a triangle such that N1->N2 */
10569 /*              is the directed boundary edge associated */
10570 /*              with IO1-IO2 */
10571 
10572     /* Parameter adjustments */
10573     --lend;
10574     --list;
10575     --lptr;
10576 
10577     /* Function Body */
10578     n1 = *io1;
10579     n2 = *io2;
10580 
10581 /* Test for errors, and set N1->N2 to the directed boundary */
10582 /*   edge associated with IO1-IO2:  (N1,N2,N3) is a triangle */
10583 /*   for some N3. */
10584 
10585     if (*n < 4 || n1 < 1 || n1 > *n || n2 < 1 || n2 > *n || n1 == n2) {
10586         *ier = 1;
10587         return 0;
10588     }
10589 
10590     lpl = lend[n2];
10591     if (-list[lpl] != n1) {
10592         n1 = n2;
10593         n2 = *io1;
10594         lpl = lend[n2];
10595         if (-list[lpl] != n1) {
10596             *ier = 2;
10597             return 0;
10598         }
10599     }
10600 
10601 /* Set N3 to the node opposite N1->N2 (the second neighbor */
10602 /*   of N1), and test for error 3 (N3 already a boundary */
10603 /*   node). */
10604 
10605     lpl = lend[n1];
10606     lp = lptr[lpl];
10607     lp = lptr[lp];
10608     n3 = (i__1 = list[lp], abs(i__1));
10609     lpl = lend[n3];
10610     if (list[lpl] <= 0) {
10611         *ier = 3;
10612         return 0;
10613     }
10614 
10615 /* Delete N2 as a neighbor of N1, making N3 the first */
10616 /*   neighbor, and test for error 4 (N2 not a neighbor */
10617 /*   of N1).  Note that previously computed pointers may */
10618 /*   no longer be valid following the call to DELNB. */
10619 
10620     delnb_(&n1, &n2, n, &list[1], &lptr[1], &lend[1], lnew, &lph);
10621     if (lph < 0) {
10622         *ier = 4;
10623         return 0;
10624     }
10625 
10626 /* Delete N1 as a neighbor of N2, making N3 the new last */
10627 /*   neighbor. */
10628 
10629     delnb_(&n2, &n1, n, &list[1], &lptr[1], &lend[1], lnew, &lph);
10630 
10631 /* Make N3 a boundary node with first neighbor N2 and last */
10632 /*   neighbor N1. */
10633 
10634     lp = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]);
10635     lend[n3] = lp;
10636     list[lp] = -n1;
10637 
10638 /* No errors encountered. */
10639 
10640     *ier = 0;
10641     return 0;
10642 } /* delarc_ */

int delnb_ ( int *  n0,
int *  nb,
int *  n,
int *  list,
int *  lptr,
int *  lend,
int *  lnew,
int *  lph 
)

Definition at line 10644 of file util_sparx.cpp.

References abs, and nn().

Referenced by delarc_(), and delnod_().

10646 {
10647     /* System generated locals */
10648     int i__1;
10649 
10650     /* Local variables */
10651     static int i__, lp, nn, lpb, lpl, lpp, lnw;
10652 
10653 
10654 /* *********************************************************** */
10655 
10656 /*                                              From STRIPACK */
10657 /*                                            Robert J. Renka */
10658 /*                                  Dept. of Computer Science */
10659 /*                                       Univ. of North Texas */
10660 /*                                           renka@cs.unt.edu */
10661 /*                                                   07/29/98 */
10662 
10663 /*   This subroutine deletes a neighbor NB from the adjacency */
10664 /* list of node N0 (but N0 is not deleted from the adjacency */
10665 /* list of NB) and, if NB is a boundary node, makes N0 a */
10666 /* boundary node.  For pointer (LIST index) LPH to NB as a */
10667 /* neighbor of N0, the empty LIST,LPTR location LPH is filled */
10668 /* in with the values at LNEW-1, pointer LNEW-1 (in LPTR and */
10669 /* possibly in LEND) is changed to LPH, and LNEW is decremen- */
10670 /* ted.  This requires a search of LEND and LPTR entailing an */
10671 /* expected operation count of O(N). */
10672 
10673 /*   This routine is identical to the similarly named routine */
10674 /* in TRIPACK. */
10675 
10676 
10677 /* On input: */
10678 
10679 /*       N0,NB = Indexes, in the range 1 to N, of a pair of */
10680 /*               nodes such that NB is a neighbor of N0. */
10681 /*               (N0 need not be a neighbor of NB.) */
10682 
10683 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
10684 
10685 /* The above parameters are not altered by this routine. */
10686 
10687 /*       LIST,LPTR,LEND,LNEW = Data structure defining the */
10688 /*                             triangulation. */
10689 
10690 /* On output: */
10691 
10692 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
10693 /*                             the removal of NB from the ad- */
10694 /*                             jacency list of N0 unless */
10695 /*                             LPH < 0. */
10696 
10697 /*       LPH = List pointer to the hole (NB as a neighbor of */
10698 /*             N0) filled in by the values at LNEW-1 or error */
10699 /*             indicator: */
10700 /*             LPH > 0 if no errors were encountered. */
10701 /*             LPH = -1 if N0, NB, or N is outside its valid */
10702 /*                      range. */
10703 /*             LPH = -2 if NB is not a neighbor of N0. */
10704 
10705 /* Modules required by DELNB:  None */
10706 
10707 /* Intrinsic function called by DELNB:  ABS */
10708 
10709 /* *********************************************************** */
10710 
10711 
10712 /* Local parameters: */
10713 
10714 /* I =   DO-loop index */
10715 /* LNW = LNEW-1 (output value of LNEW) */
10716 /* LP =  LIST pointer of the last neighbor of NB */
10717 /* LPB = Pointer to NB as a neighbor of N0 */
10718 /* LPL = Pointer to the last neighbor of N0 */
10719 /* LPP = Pointer to the neighbor of N0 that precedes NB */
10720 /* NN =  Local copy of N */
10721 
10722     /* Parameter adjustments */
10723     --lend;
10724     --list;
10725     --lptr;
10726 
10727     /* Function Body */
10728     nn = *n;
10729 
10730 /* Test for error 1. */
10731 
10732     if (*n0 < 1 || *n0 > nn || *nb < 1 || *nb > nn || nn < 3) {
10733         *lph = -1;
10734         return 0;
10735     }
10736 
10737 /*   Find pointers to neighbors of N0: */
10738 
10739 /*     LPL points to the last neighbor, */
10740 /*     LPP points to the neighbor NP preceding NB, and */
10741 /*     LPB points to NB. */
10742 
10743     lpl = lend[*n0];
10744     lpp = lpl;
10745     lpb = lptr[lpp];
10746 L1:
10747     if (list[lpb] == *nb) {
10748         goto L2;
10749     }
10750     lpp = lpb;
10751     lpb = lptr[lpp];
10752     if (lpb != lpl) {
10753         goto L1;
10754     }
10755 
10756 /*   Test for error 2 (NB not found). */
10757 
10758     if ((i__1 = list[lpb], abs(i__1)) != *nb) {
10759         *lph = -2;
10760         return 0;
10761     }
10762 
10763 /*   NB is the last neighbor of N0.  Make NP the new last */
10764 /*     neighbor and, if NB is a boundary node, then make N0 */
10765 /*     a boundary node. */
10766 
10767     lend[*n0] = lpp;
10768     lp = lend[*nb];
10769     if (list[lp] < 0) {
10770         list[lpp] = -list[lpp];
10771     }
10772     goto L3;
10773 
10774 /*   NB is not the last neighbor of N0.  If NB is a boundary */
10775 /*     node and N0 is not, then make N0 a boundary node with */
10776 /*     last neighbor NP. */
10777 
10778 L2:
10779     lp = lend[*nb];
10780     if (list[lp] < 0 && list[lpl] > 0) {
10781         lend[*n0] = lpp;
10782         list[lpp] = -list[lpp];
10783     }
10784 
10785 /*   Update LPTR so that the neighbor following NB now fol- */
10786 /*     lows NP, and fill in the hole at location LPB. */
10787 
10788 L3:
10789     lptr[lpp] = lptr[lpb];
10790     lnw = *lnew - 1;
10791     list[lpb] = list[lnw];
10792     lptr[lpb] = lptr[lnw];
10793     for (i__ = nn; i__ >= 1; --i__) {
10794         if (lend[i__] == lnw) {
10795             lend[i__] = lpb;
10796             goto L5;
10797         }
10798 /* L4: */
10799     }
10800 
10801 L5:
10802     i__1 = lnw - 1;
10803     for (i__ = 1; i__ <= i__1; ++i__) {
10804         if (lptr[i__] == lnw) {
10805             lptr[i__] = lpb;
10806         }
10807 /* L6: */
10808     }
10809 
10810 /* No errors encountered. */
10811 
10812     *lnew = lnw;
10813     *lph = lpb;
10814     return 0;
10815 } /* delnb_ */

int delnod_ ( int *  k,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
int *  lnew,
int *  lwk,
int *  iwk,
int *  ier 
)

Definition at line 10817 of file util_sparx.cpp.

References abs, delnb_(), FALSE_, ierr, left_(), lstptr_(), nbcnt_(), nn(), optim_(), swap_(), and TRUE_.

10820 {
10821     /* System generated locals */
10822     int i__1;
10823 
10824     /* Local variables */
10825     static int i__, j, n1, n2;
10826     static double x1, x2, y1, y2, z1, z2;
10827     static int nl, lp, nn, nr;
10828     static double xl, yl, zl, xr, yr, zr;
10829     static int nnb, lp21, lpf, lph, lpl, lpn, iwl, nit, lnw, lpl2;
10830     static long int bdry;
10831     static int ierr, lwkl;
10832     /* Subroutine */ int swap_(int *, int *, int *,
10833             int *, int *, int *, int *, int *), delnb_(
10834             int *, int *, int *, int *, int *, int *,
10835             int *, int *);
10836     int nbcnt_(int *, int *);
10837     /* Subroutine */ int optim_(double *, double *, double
10838             *, int *, int *, int *, int *, int *, int
10839             *, int *);
10840     static int nfrst;
10841     int lstptr_(int *, int *, int *, int *);
10842 
10843 
10844 /* *********************************************************** */
10845 
10846 /*                                              From STRIPACK */
10847 /*                                            Robert J. Renka */
10848 /*                                  Dept. of Computer Science */
10849 /*                                       Univ. of North Texas */
10850 /*                                           renka@cs.unt.edu */
10851 /*                                                   11/30/99 */
10852 
10853 /*   This subroutine deletes node K (along with all arcs */
10854 /* incident on node K) from a triangulation of N nodes on the */
10855 /* unit sphere, and inserts arcs as necessary to produce a */
10856 /* triangulation of the remaining N-1 nodes.  If a Delaunay */
10857 /* triangulation is input, a Delaunay triangulation will */
10858 /* result, and thus, DELNOD reverses the effect of a call to */
10859 /* Subroutine ADDNOD. */
10860 
10861 
10862 /* On input: */
10863 
10864 /*       K = Index (for X, Y, and Z) of the node to be */
10865 /*           deleted.  1 .LE. K .LE. N. */
10866 
10867 /* K is not altered by this routine. */
10868 
10869 /*       N = Number of nodes in the triangulation on input. */
10870 /*           N .GE. 4.  Note that N will be decremented */
10871 /*           following the deletion. */
10872 
10873 /*       X,Y,Z = Arrays of length N containing the Cartesian */
10874 /*               coordinates of the nodes in the triangula- */
10875 /*               tion. */
10876 
10877 /*       LIST,LPTR,LEND,LNEW = Data structure defining the */
10878 /*                             triangulation.  Refer to Sub- */
10879 /*                             routine TRMESH. */
10880 
10881 /*       LWK = Number of columns reserved for IWK.  LWK must */
10882 /*             be at least NNB-3, where NNB is the number of */
10883 /*             neighbors of node K, including an extra */
10884 /*             pseudo-node if K is a boundary node. */
10885 
10886 /*       IWK = int work array dimensioned 2 by LWK (or */
10887 /*             array of length .GE. 2*LWK). */
10888 
10889 /* On output: */
10890 
10891 /*       N = Number of nodes in the triangulation on output. */
10892 /*           The input value is decremented unless 1 .LE. IER */
10893 /*           .LE. 4. */
10894 
10895 /*       X,Y,Z = Updated arrays containing nodal coordinates */
10896 /*               (with elements K+1,...,N+1 shifted up one */
10897 /*               position, thus overwriting element K) unless */
10898 /*               1 .LE. IER .LE. 4. */
10899 
10900 /*       LIST,LPTR,LEND,LNEW = Updated triangulation data */
10901 /*                             structure reflecting the dele- */
10902 /*                             tion unless 1 .LE. IER .LE. 4. */
10903 /*                             Note that the data structure */
10904 /*                             may have been altered if IER > */
10905 /*                             3. */
10906 
10907 /*       LWK = Number of IWK columns required unless IER = 1 */
10908 /*             or IER = 3. */
10909 
10910 /*       IWK = Indexes of the endpoints of the new arcs added */
10911 /*             unless LWK = 0 or 1 .LE. IER .LE. 4.  (Arcs */
10912 /*             are associated with columns, or pairs of */
10913 /*             adjacent elements if IWK is declared as a */
10914 /*             singly-subscripted array.) */
10915 
10916 /*       IER = Error indicator: */
10917 /*             IER = 0 if no errors were encountered. */
10918 /*             IER = 1 if K or N is outside its valid range */
10919 /*                     or LWK < 0 on input. */
10920 /*             IER = 2 if more space is required in IWK. */
10921 /*                     Refer to LWK. */
10922 /*             IER = 3 if the triangulation data structure is */
10923 /*                     invalid on input. */
10924 /*             IER = 4 if K indexes an interior node with */
10925 /*                     four or more neighbors, none of which */
10926 /*                     can be swapped out due to collineari- */
10927 /*                     ty, and K cannot therefore be deleted. */
10928 /*             IER = 5 if an error flag (other than IER = 1) */
10929 /*                     was returned by OPTIM.  An error */
10930 /*                     message is written to the standard */
10931 /*                     output unit in this case. */
10932 /*             IER = 6 if error flag 1 was returned by OPTIM. */
10933 /*                     This is not necessarily an error, but */
10934 /*                     the arcs may not be optimal. */
10935 
10936 /*   Note that the deletion may result in all remaining nodes */
10937 /* being collinear.  This situation is not flagged. */
10938 
10939 /* Modules required by DELNOD:  DELNB, LEFT, LSTPTR, NBCNT, */
10940 /*                                OPTIM, SWAP, SWPTST */
10941 
10942 /* Intrinsic function called by DELNOD:  ABS */
10943 
10944 /* *********************************************************** */
10945 
10946 
10947 /* Local parameters: */
10948 
10949 /* BDRY =    long int variable with value TRUE iff N1 is a */
10950 /*             boundary node */
10951 /* I,J =     DO-loop indexes */
10952 /* IERR =    Error flag returned by OPTIM */
10953 /* IWL =     Number of IWK columns containing arcs */
10954 /* LNW =     Local copy of LNEW */
10955 /* LP =      LIST pointer */
10956 /* LP21 =    LIST pointer returned by SWAP */
10957 /* LPF,LPL = Pointers to the first and last neighbors of N1 */
10958 /* LPH =     Pointer (or flag) returned by DELNB */
10959 /* LPL2 =    Pointer to the last neighbor of N2 */
10960 /* LPN =     Pointer to a neighbor of N1 */
10961 /* LWKL =    Input value of LWK */
10962 /* N1 =      Local copy of K */
10963 /* N2 =      Neighbor of N1 */
10964 /* NFRST =   First neighbor of N1:  LIST(LPF) */
10965 /* NIT =     Number of iterations in OPTIM */
10966 /* NR,NL =   Neighbors of N1 preceding (to the right of) and */
10967 /*             following (to the left of) N2, respectively */
10968 /* NN =      Number of nodes in the triangulation */
10969 /* NNB =     Number of neighbors of N1 (including a pseudo- */
10970 /*             node representing the boundary if N1 is a */
10971 /*             boundary node) */
10972 /* X1,Y1,Z1 = Coordinates of N1 */
10973 /* X2,Y2,Z2 = Coordinates of N2 */
10974 /* XL,YL,ZL = Coordinates of NL */
10975 /* XR,YR,ZR = Coordinates of NR */
10976 
10977 
10978 /* Set N1 to K and NNB to the number of neighbors of N1 (plus */
10979 /*   one if N1 is a boundary node), and test for errors.  LPF */
10980 /*   and LPL are LIST indexes of the first and last neighbors */
10981 /*   of N1, IWL is the number of IWK columns containing arcs, */
10982 /*   and BDRY is TRUE iff N1 is a boundary node. */
10983 
10984     /* Parameter adjustments */
10985     iwk -= 3;
10986     --lend;
10987     --lptr;
10988     --list;
10989     --z__;
10990     --y;
10991     --x;
10992 
10993     /* Function Body */
10994     n1 = *k;
10995     nn = *n;
10996     if (n1 < 1 || n1 > nn || nn < 4 || *lwk < 0) {
10997         goto L21;
10998     }
10999     lpl = lend[n1];
11000     lpf = lptr[lpl];
11001     nnb = nbcnt_(&lpl, &lptr[1]);
11002     bdry = list[lpl] < 0;
11003     if (bdry) {
11004         ++nnb;
11005     }
11006     if (nnb < 3) {
11007         goto L23;
11008     }
11009     lwkl = *lwk;
11010     *lwk = nnb - 3;
11011     if (lwkl < *lwk) {
11012         goto L22;
11013     }
11014     iwl = 0;
11015     if (nnb == 3) {
11016         goto L3;
11017     }
11018 
11019 /* Initialize for loop on arcs N1-N2 for neighbors N2 of N1, */
11020 /*   beginning with the second neighbor.  NR and NL are the */
11021 /*   neighbors preceding and following N2, respectively, and */
11022 /*   LP indexes NL.  The loop is exited when all possible */
11023 /*   swaps have been applied to arcs incident on N1. */
11024 
11025     x1 = x[n1];
11026     y1 = y[n1];
11027     z1 = z__[n1];
11028     nfrst = list[lpf];
11029     nr = nfrst;
11030     xr = x[nr];
11031     yr = y[nr];
11032     zr = z__[nr];
11033     lp = lptr[lpf];
11034     n2 = list[lp];
11035     x2 = x[n2];
11036     y2 = y[n2];
11037     z2 = z__[n2];
11038     lp = lptr[lp];
11039 
11040 /* Top of loop:  set NL to the neighbor following N2. */
11041 
11042 L1:
11043     nl = (i__1 = list[lp], abs(i__1));
11044     if (nl == nfrst && bdry) {
11045         goto L3;
11046     }
11047     xl = x[nl];
11048     yl = y[nl];
11049     zl = z__[nl];
11050 
11051 /*   Test for a convex quadrilateral.  To avoid an incorrect */
11052 /*     test caused by collinearity, use the fact that if N1 */
11053 /*     is a boundary node, then N1 LEFT NR->NL and if N2 is */
11054 /*     a boundary node, then N2 LEFT NL->NR. */
11055 
11056     lpl2 = lend[n2];
11057     if (! ((bdry || left_(&xr, &yr, &zr, &xl, &yl, &zl, &x1, &y1, &z1)) && (
11058             list[lpl2] < 0 || left_(&xl, &yl, &zl, &xr, &yr, &zr, &x2, &y2, &
11059             z2)))) {
11060 
11061 /*   Nonconvex quadrilateral -- no swap is possible. */
11062 
11063         nr = n2;
11064         xr = x2;
11065         yr = y2;
11066         zr = z2;
11067         goto L2;
11068     }
11069 
11070 /*   The quadrilateral defined by adjacent triangles */
11071 /*     (N1,N2,NL) and (N2,N1,NR) is convex.  Swap in */
11072 /*     NL-NR and store it in IWK unless NL and NR are */
11073 /*     already adjacent, in which case the swap is not */
11074 /*     possible.  Indexes larger than N1 must be decremented */
11075 /*     since N1 will be deleted from X, Y, and Z. */
11076 
11077     swap_(&nl, &nr, &n1, &n2, &list[1], &lptr[1], &lend[1], &lp21);
11078     if (lp21 == 0) {
11079         nr = n2;
11080         xr = x2;
11081         yr = y2;
11082         zr = z2;
11083         goto L2;
11084     }
11085     ++iwl;
11086     if (nl <= n1) {
11087         iwk[(iwl << 1) + 1] = nl;
11088     } else {
11089         iwk[(iwl << 1) + 1] = nl - 1;
11090     }
11091     if (nr <= n1) {
11092         iwk[(iwl << 1) + 2] = nr;
11093     } else {
11094         iwk[(iwl << 1) + 2] = nr - 1;
11095     }
11096 
11097 /*   Recompute the LIST indexes and NFRST, and decrement NNB. */
11098 
11099     lpl = lend[n1];
11100     --nnb;
11101     if (nnb == 3) {
11102         goto L3;
11103     }
11104     lpf = lptr[lpl];
11105     nfrst = list[lpf];
11106     lp = lstptr_(&lpl, &nl, &list[1], &lptr[1]);
11107     if (nr == nfrst) {
11108         goto L2;
11109     }
11110 
11111 /*   NR is not the first neighbor of N1. */
11112 /*     Back up and test N1-NR for a swap again:  Set N2 to */
11113 /*     NR and NR to the previous neighbor of N1 -- the */
11114 /*     neighbor of NR which follows N1.  LP21 points to NL */
11115 /*     as a neighbor of NR. */
11116 
11117     n2 = nr;
11118     x2 = xr;
11119     y2 = yr;
11120     z2 = zr;
11121     lp21 = lptr[lp21];
11122     lp21 = lptr[lp21];
11123     nr = (i__1 = list[lp21], abs(i__1));
11124     xr = x[nr];
11125     yr = y[nr];
11126     zr = z__[nr];
11127     goto L1;
11128 
11129 /*   Bottom of loop -- test for termination of loop. */
11130 
11131 L2:
11132     if (n2 == nfrst) {
11133         goto L3;
11134     }
11135     n2 = nl;
11136     x2 = xl;
11137     y2 = yl;
11138     z2 = zl;
11139     lp = lptr[lp];
11140     goto L1;
11141 
11142 /* Delete N1 and all its incident arcs.  If N1 is an interior */
11143 /*   node and either NNB > 3 or NNB = 3 and N2 LEFT NR->NL, */
11144 /*   then N1 must be separated from its neighbors by a plane */
11145 /*   containing the origin -- its removal reverses the effect */
11146 /*   of a call to COVSPH, and all its neighbors become */
11147 /*   boundary nodes.  This is achieved by treating it as if */
11148 /*   it were a boundary node (setting BDRY to TRUE, changing */
11149 /*   a sign in LIST, and incrementing NNB). */
11150 
11151 L3:
11152     if (! bdry) {
11153         if (nnb > 3) {
11154             bdry = TRUE_;
11155         } else {
11156             lpf = lptr[lpl];
11157             nr = list[lpf];
11158             lp = lptr[lpf];
11159             n2 = list[lp];
11160             nl = list[lpl];
11161             bdry = left_(&x[nr], &y[nr], &z__[nr], &x[nl], &y[nl], &z__[nl], &
11162                     x[n2], &y[n2], &z__[n2]);
11163         }
11164         if (bdry) {
11165 
11166 /*   IF a boundary node already exists, then N1 and its */
11167 /*     neighbors cannot be converted to boundary nodes. */
11168 /*     (They must be collinear.)  This is a problem if */
11169 /*     NNB > 3. */
11170 
11171             i__1 = nn;
11172             for (i__ = 1; i__ <= i__1; ++i__) {
11173                 if (list[lend[i__]] < 0) {
11174                     bdry = FALSE_;
11175                     goto L5;
11176                 }
11177 /* L4: */
11178             }
11179             list[lpl] = -list[lpl];
11180             ++nnb;
11181         }
11182     }
11183 L5:
11184     if (! bdry && nnb > 3) {
11185         goto L24;
11186     }
11187 
11188 /* Initialize for loop on neighbors.  LPL points to the last */
11189 /*   neighbor of N1.  LNEW is stored in local variable LNW. */
11190 
11191     lp = lpl;
11192     lnw = *lnew;
11193 
11194 /* Loop on neighbors N2 of N1, beginning with the first. */
11195 
11196 L6:
11197     lp = lptr[lp];
11198     n2 = (i__1 = list[lp], abs(i__1));
11199     delnb_(&n2, &n1, n, &list[1], &lptr[1], &lend[1], &lnw, &lph);
11200     if (lph < 0) {
11201         goto L23;
11202     }
11203 
11204 /*   LP and LPL may require alteration. */
11205 
11206     if (lpl == lnw) {
11207         lpl = lph;
11208     }
11209     if (lp == lnw) {
11210         lp = lph;
11211     }
11212     if (lp != lpl) {
11213         goto L6;
11214     }
11215 
11216 /* Delete N1 from X, Y, Z, and LEND, and remove its adjacency */
11217 /*   list from LIST and LPTR.  LIST entries (nodal indexes) */
11218 /*   which are larger than N1 must be decremented. */
11219 
11220     --nn;
11221     if (n1 > nn) {
11222         goto L9;
11223     }
11224     i__1 = nn;
11225     for (i__ = n1; i__ <= i__1; ++i__) {
11226         x[i__] = x[i__ + 1];
11227         y[i__] = y[i__ + 1];
11228         z__[i__] = z__[i__ + 1];
11229         lend[i__] = lend[i__ + 1];
11230 /* L7: */
11231     }
11232 
11233     i__1 = lnw - 1;
11234     for (i__ = 1; i__ <= i__1; ++i__) {
11235         if (list[i__] > n1) {
11236             --list[i__];
11237         }
11238         if (list[i__] < -n1) {
11239             ++list[i__];
11240         }
11241 /* L8: */
11242     }
11243 
11244 /*   For LPN = first to last neighbors of N1, delete the */
11245 /*     preceding neighbor (indexed by LP). */
11246 
11247 /*   Each empty LIST,LPTR location LP is filled in with the */
11248 /*     values at LNW-1, and LNW is decremented.  All pointers */
11249 /*     (including those in LPTR and LEND) with value LNW-1 */
11250 /*     must be changed to LP. */
11251 
11252 /*  LPL points to the last neighbor of N1. */
11253 
11254 L9:
11255     if (bdry) {
11256         --nnb;
11257     }
11258     lpn = lpl;
11259     i__1 = nnb;
11260     for (j = 1; j <= i__1; ++j) {
11261         --lnw;
11262         lp = lpn;
11263         lpn = lptr[lp];
11264         list[lp] = list[lnw];
11265         lptr[lp] = lptr[lnw];
11266         if (lptr[lpn] == lnw) {
11267             lptr[lpn] = lp;
11268         }
11269         if (lpn == lnw) {
11270             lpn = lp;
11271         }
11272         for (i__ = nn; i__ >= 1; --i__) {
11273             if (lend[i__] == lnw) {
11274                 lend[i__] = lp;
11275                 goto L11;
11276             }
11277 /* L10: */
11278         }
11279 
11280 L11:
11281         for (i__ = lnw - 1; i__ >= 1; --i__) {
11282             if (lptr[i__] == lnw) {
11283                 lptr[i__] = lp;
11284             }
11285 /* L12: */
11286         }
11287 /* L13: */
11288     }
11289 
11290 /* Update N and LNEW, and optimize the patch of triangles */
11291 /*   containing K (on input) by applying swaps to the arcs */
11292 /*   in IWK. */
11293 
11294     *n = nn;
11295     *lnew = lnw;
11296     if (iwl > 0) {
11297         nit = iwl << 2;
11298         optim_(&x[1], &y[1], &z__[1], &iwl, &list[1], &lptr[1], &lend[1], &
11299                 nit, &iwk[3], &ierr);
11300         if (ierr != 0 && ierr != 1) {
11301             goto L25;
11302         }
11303         if (ierr == 1) {
11304             goto L26;
11305         }
11306     }
11307 
11308 /* Successful termination. */
11309 
11310     *ier = 0;
11311     return 0;
11312 
11313 /* Invalid input parameter. */
11314 
11315 L21:
11316     *ier = 1;
11317     return 0;
11318 
11319 /* Insufficient space reserved for IWK. */
11320 
11321 L22:
11322     *ier = 2;
11323     return 0;
11324 
11325 /* Invalid triangulation data structure.  NNB < 3 on input or */
11326 /*   N2 is a neighbor of N1 but N1 is not a neighbor of N2. */
11327 
11328 L23:
11329     *ier = 3;
11330     return 0;
11331 
11332 /* N1 is interior but NNB could not be reduced to 3. */
11333 
11334 L24:
11335     *ier = 4;
11336     return 0;
11337 
11338 /* Error flag (other than 1) returned by OPTIM. */
11339 
11340 L25:
11341     *ier = 5;
11342 /*      WRITE (*,100) NIT, IERR */
11343 /*  100 FORMAT (//5X,'*** Error in OPTIM (called from ', */
11344 /*     .        'DELNOD):  NIT = ',I4,', IER = ',I1,' ***'/) */
11345     return 0;
11346 
11347 /* Error flag 1 returned by OPTIM. */
11348 
11349 L26:
11350     *ier = 6;
11351     return 0;
11352 } /* delnod_ */

int drwarc_ ( int *  ,
double *  p,
double *  q,
double *  tol,
int *  nseg 
)

Definition at line 11354 of file util_sparx.cpp.

References abs, and sqrt().

Referenced by trplot_(), and vrplot_().

11356 {
11357     /* System generated locals */
11358     int i__1;
11359     double d__1;
11360 
11361     /* Builtin functions */
11362     //double sqrt(double);
11363 
11364     /* Local variables */
11365     static int i__, k;
11366     static double s, p1[3], p2[3], u1, u2, v1, v2;
11367     static int na;
11368     static double dp[3], du, dv, pm[3], um, vm, err, enrm;
11369 
11370 
11371 /* *********************************************************** */
11372 
11373 /*                                              From STRIPACK */
11374 /*                                            Robert J. Renka */
11375 /*                                  Dept. of Computer Science */
11376 /*                                       Univ. of North Texas */
11377 /*                                           renka@cs.unt.edu */
11378 /*                                                   03/04/03 */
11379 
11380 /*   Given unit vectors P and Q corresponding to northern */
11381 /* hemisphere points (with positive third components), this */
11382 /* subroutine draws a polygonal line which approximates the */
11383 /* projection of arc P-Q onto the plane containing the */
11384 /* equator. */
11385 
11386 /*   The line segment is drawn by writing a sequence of */
11387 /* 'moveto' and 'lineto' Postscript commands to unit LUN.  It */
11388 /* is assumed that an open file is attached to the unit, */
11389 /* header comments have been written to the file, a window- */
11390 /* to-viewport mapping has been established, etc. */
11391 
11392 /* On input: */
11393 
11394 /*       LUN = long int unit number in the range 0 to 99. */
11395 
11396 /*       P,Q = Arrays of length 3 containing the endpoints of */
11397 /*             the arc to be drawn. */
11398 
11399 /*       TOL = Maximum distance in world coordinates between */
11400 /*             the projected arc and polygonal line. */
11401 
11402 /* Input parameters are not altered by this routine. */
11403 
11404 /* On output: */
11405 
11406 /*       NSEG = Number of line segments in the polygonal */
11407 /*              approximation to the projected arc.  This is */
11408 /*              a decreasing function of TOL.  NSEG = 0 and */
11409 /*              no drawing is performed if P = Q or P = -Q */
11410 /*              or an error is encountered in writing to unit */
11411 /*              LUN. */
11412 
11413 /* STRIPACK modules required by DRWARC:  None */
11414 
11415 /* Intrinsic functions called by DRWARC:  ABS, DBLE, SQRT */
11416 
11417 /* *********************************************************** */
11418 
11419 
11420 /* Local parameters: */
11421 
11422 /* DP =    (Q-P)/NSEG */
11423 /* DU,DV = Components of the projection Q'-P' of arc P->Q */
11424 /*           onto the projection plane */
11425 /* ENRM =  Euclidean norm (or squared norm) of Q'-P' or PM */
11426 /* ERR =   Orthogonal distance from the projected midpoint */
11427 /*           PM' to the line defined by P' and Q': */
11428 /*           |Q'-P' X PM'-P'|/|Q'-P'| */
11429 /* I,K =   DO-loop indexes */
11430 /* NA =    Number of arcs (segments) in the partition of P-Q */
11431 /* P1,P2 = Pairs of adjacent points in a uniform partition of */
11432 /*           arc P-Q into NSEG segments; obtained by normal- */
11433 /*           izing PM values */
11434 /* PM =    Midpoint of arc P-Q or a point P + k*DP in a */
11435 /*           uniform partition of the line segment P-Q into */
11436 /*           NSEG segments */
11437 /* S =     Scale factor 1/NA */
11438 /* U1,V1 = Components of P' */
11439 /* U2,V2 = Components of Q' */
11440 /* UM,VM = Components of the midpoint PM' */
11441 
11442 
11443 /* Compute the midpoint PM of arc P-Q. */
11444 
11445     /* Parameter adjustments */
11446     --q;
11447     --p;
11448 
11449     /* Function Body */
11450     enrm = 0.;
11451     for (i__ = 1; i__ <= 3; ++i__) {
11452         pm[i__ - 1] = p[i__] + q[i__];
11453         enrm += pm[i__ - 1] * pm[i__ - 1];
11454 /* L1: */
11455     }
11456     if (enrm == 0.) {
11457         goto L5;
11458     }
11459     enrm = sqrt(enrm);
11460     pm[0] /= enrm;
11461     pm[1] /= enrm;
11462     pm[2] /= enrm;
11463 
11464 /* Project P, Q, and PM to P' = (U1,V1), Q' = (U2,V2), and */
11465 /*   PM' = (UM,VM), respectively. */
11466 
11467     u1 = p[1];
11468     v1 = p[2];
11469     u2 = q[1];
11470     v2 = q[2];
11471     um = pm[0];
11472     vm = pm[1];
11473 
11474 /* Compute the orthogonal distance ERR from PM' to the line */
11475 /*   defined by P' and Q'.  This is the maximum deviation */
11476 /*   between the projected arc and the line segment.  It is */
11477 /*   undefined if P' = Q'. */
11478 
11479     du = u2 - u1;
11480     dv = v2 - v1;
11481     enrm = du * du + dv * dv;
11482     if (enrm == 0.) {
11483         goto L5;
11484     }
11485     err = (d__1 = du * (vm - v1) - (um - u1) * dv, abs(d__1)) / sqrt(enrm);
11486 
11487 /* Compute the number of arcs into which P-Q will be parti- */
11488 /*   tioned (the number of line segments to be drawn): */
11489 /*   NA = ERR/TOL. */
11490 
11491     na = (int) (err / *tol + 1.);
11492 
11493 /* Initialize for loop on arcs P1-P2, where the intermediate */
11494 /*   points are obtained by normalizing PM = P + k*DP for */
11495 /*   DP = (Q-P)/NA */
11496 
11497     s = 1. / (double) na;
11498     for (i__ = 1; i__ <= 3; ++i__) {
11499         dp[i__ - 1] = s * (q[i__] - p[i__]);
11500         pm[i__ - 1] = p[i__];
11501         p1[i__ - 1] = p[i__];
11502 /* L2: */
11503     }
11504 
11505 /* Loop on arcs P1-P2, drawing the line segments associated */
11506 /*   with the projected endpoints. */
11507 
11508     i__1 = na - 1;
11509     for (k = 1; k <= i__1; ++k) {
11510         enrm = 0.;
11511         for (i__ = 1; i__ <= 3; ++i__) {
11512             pm[i__ - 1] += dp[i__ - 1];
11513             enrm += pm[i__ - 1] * pm[i__ - 1];
11514 /* L3: */
11515         }
11516         if (enrm == 0.) {
11517             goto L5;
11518         }
11519         enrm = sqrt(enrm);
11520         p2[0] = pm[0] / enrm;
11521         p2[1] = pm[1] / enrm;
11522         p2[2] = pm[2] / enrm;
11523 /*        WRITE (LUN,100,ERR=5) P1(1), P1(2), P2(1), P2(2) */
11524 /*  100   FORMAT (2F12.6,' moveto',2F12.6,' lineto') */
11525         p1[0] = p2[0];
11526         p1[1] = p2[1];
11527         p1[2] = p2[2];
11528 /* L4: */
11529     }
11530 /*      WRITE (LUN,100,ERR=5) P1(1), P1(2), Q(1), Q(2) */
11531 
11532 /* No error encountered. */
11533 
11534     *nseg = na;
11535     return 0;
11536 
11537 /* Invalid input value of P or Q. */
11538 
11539 L5:
11540     *nseg = 0;
11541     return 0;
11542 } /* drwarc_ */

int edge_ ( int *  in1,
int *  in2,
double *  x,
double *  y,
double *  z__,
int *  lwk,
int *  iwk,
int *  list,
int *  lptr,
int *  lend,
int *  ier 
)

Definition at line 11544 of file util_sparx.cpp.

References abs, ierr, left_(), optim_(), and swap_().

11547 {
11548     /* System generated locals */
11549     int i__1;
11550 
11551     /* Local variables */
11552     static int i__, n0, n1, n2;
11553     static double x0, x1, x2, y0, y1, y2, z0, z1, z2;
11554     static int nl, lp, nr;
11555     static double dp12;
11556     static int lp21, iwc, iwf, lft, lpl, iwl, nit;
11557     static double dp1l, dp2l, dp1r, dp2r;
11558     static int ierr;
11559     /* Subroutine */ int swap_(int *, int *, int *,
11560             int *, int *, int *, int *, int *);
11561     static int next, iwcp1, n1lst, iwend;
11562     /* Subroutine */ int optim_(double *, double *, double
11563             *, int *, int *, int *, int *, int *, int
11564             *, int *);
11565     static int n1frst;
11566 
11567 
11568 /* *********************************************************** */
11569 
11570 /*                                              From STRIPACK */
11571 /*                                            Robert J. Renka */
11572 /*                                  Dept. of Computer Science */
11573 /*                                       Univ. of North Texas */
11574 /*                                           renka@cs.unt.edu */
11575 /*                                                   07/30/98 */
11576 
11577 /*   Given a triangulation of N nodes and a pair of nodal */
11578 /* indexes IN1 and IN2, this routine swaps arcs as necessary */
11579 /* to force IN1 and IN2 to be adjacent.  Only arcs which */
11580 /* intersect IN1-IN2 are swapped out.  If a Delaunay triangu- */
11581 /* lation is input, the resulting triangulation is as close */
11582 /* as possible to a Delaunay triangulation in the sense that */
11583 /* all arcs other than IN1-IN2 are locally optimal. */
11584 
11585 /*   A sequence of calls to EDGE may be used to force the */
11586 /* presence of a set of edges defining the boundary of a non- */
11587 /* convex and/or multiply connected region, or to introduce */
11588 /* barriers into the triangulation.  Note that Subroutine */
11589 /* GETNP will not necessarily return closest nodes if the */
11590 /* triangulation has been constrained by a call to EDGE. */
11591 /* However, this is appropriate in some applications, such */
11592 /* as triangle-based interpolation on a nonconvex domain. */
11593 
11594 
11595 /* On input: */
11596 
11597 /*       IN1,IN2 = Indexes (of X, Y, and Z) in the range 1 to */
11598 /*                 N defining a pair of nodes to be connected */
11599 /*                 by an arc. */
11600 
11601 /*       X,Y,Z = Arrays of length N containing the Cartesian */
11602 /*               coordinates of the nodes. */
11603 
11604 /* The above parameters are not altered by this routine. */
11605 
11606 /*       LWK = Number of columns reserved for IWK.  This must */
11607 /*             be at least NI -- the number of arcs that */
11608 /*             intersect IN1-IN2.  (NI is bounded by N-3.) */
11609 
11610 /*       IWK = int work array of length at least 2*LWK. */
11611 
11612 /*       LIST,LPTR,LEND = Data structure defining the trian- */
11613 /*                        gulation.  Refer to Subroutine */
11614 /*                        TRMESH. */
11615 
11616 /* On output: */
11617 
11618 /*       LWK = Number of arcs which intersect IN1-IN2 (but */
11619 /*             not more than the input value of LWK) unless */
11620 /*             IER = 1 or IER = 3.  LWK = 0 if and only if */
11621 /*             IN1 and IN2 were adjacent (or LWK=0) on input. */
11622 
11623 /*       IWK = Array containing the indexes of the endpoints */
11624 /*             of the new arcs other than IN1-IN2 unless */
11625 /*             IER > 0 or LWK = 0.  New arcs to the left of */
11626 /*             IN1->IN2 are stored in the first K-1 columns */
11627 /*             (left portion of IWK), column K contains */
11628 /*             zeros, and new arcs to the right of IN1->IN2 */
11629 /*             occupy columns K+1,...,LWK.  (K can be deter- */
11630 /*             mined by searching IWK for the zeros.) */
11631 
11632 /*       LIST,LPTR,LEND = Data structure updated if necessary */
11633 /*                        to reflect the presence of an arc */
11634 /*                        connecting IN1 and IN2 unless IER > */
11635 /*                        0.  The data structure has been */
11636 /*                        altered if IER >= 4. */
11637 
11638 /*       IER = Error indicator: */
11639 /*             IER = 0 if no errors were encountered. */
11640 /*             IER = 1 if IN1 < 1, IN2 < 1, IN1 = IN2, */
11641 /*                     or LWK < 0 on input. */
11642 /*             IER = 2 if more space is required in IWK. */
11643 /*                     Refer to LWK. */
11644 /*             IER = 3 if IN1 and IN2 could not be connected */
11645 /*                     due to either an invalid data struc- */
11646 /*                     ture or collinear nodes (and floating */
11647 /*                     point error). */
11648 /*             IER = 4 if an error flag other than IER = 1 */
11649 /*                     was returned by OPTIM. */
11650 /*             IER = 5 if error flag 1 was returned by OPTIM. */
11651 /*                     This is not necessarily an error, but */
11652 /*                     the arcs other than IN1-IN2 may not */
11653 /*                     be optimal. */
11654 
11655 /*   An error message is written to the standard output unit */
11656 /* in the case of IER = 3 or IER = 4. */
11657 
11658 /* Modules required by EDGE:  LEFT, LSTPTR, OPTIM, SWAP, */
11659 /*                              SWPTST */
11660 
11661 /* Intrinsic function called by EDGE:  ABS */
11662 
11663 /* *********************************************************** */
11664 
11665 
11666 /* Local parameters: */
11667 
11668 /* DPij =     Dot product <Ni,Nj> */
11669 /* I =        DO-loop index and column index for IWK */
11670 /* IERR =     Error flag returned by Subroutine OPTIM */
11671 /* IWC =      IWK index between IWF and IWL -- NL->NR is */
11672 /*              stored in IWK(1,IWC)->IWK(2,IWC) */
11673 /* IWCP1 =    IWC + 1 */
11674 /* IWEND =    Input or output value of LWK */
11675 /* IWF =      IWK (column) index of the first (leftmost) arc */
11676 /*              which intersects IN1->IN2 */
11677 /* IWL =      IWK (column) index of the last (rightmost) are */
11678 /*              which intersects IN1->IN2 */
11679 /* LFT =      Flag used to determine if a swap results in the */
11680 /*              new arc intersecting IN1-IN2 -- LFT = 0 iff */
11681 /*              N0 = IN1, LFT = -1 implies N0 LEFT IN1->IN2, */
11682 /*              and LFT = 1 implies N0 LEFT IN2->IN1 */
11683 /* LP =       List pointer (index for LIST and LPTR) */
11684 /* LP21 =     Unused parameter returned by SWAP */
11685 /* LPL =      Pointer to the last neighbor of IN1 or NL */
11686 /* N0 =       Neighbor of N1 or node opposite NR->NL */
11687 /* N1,N2 =    Local copies of IN1 and IN2 */
11688 /* N1FRST =   First neighbor of IN1 */
11689 /* N1LST =    (Signed) last neighbor of IN1 */
11690 /* NEXT =     Node opposite NL->NR */
11691 /* NIT =      Flag or number of iterations employed by OPTIM */
11692 /* NL,NR =    Endpoints of an arc which intersects IN1-IN2 */
11693 /*              with NL LEFT IN1->IN2 */
11694 /* X0,Y0,Z0 = Coordinates of N0 */
11695 /* X1,Y1,Z1 = Coordinates of IN1 */
11696 /* X2,Y2,Z2 = Coordinates of IN2 */
11697 
11698 
11699 /* Store IN1, IN2, and LWK in local variables and test for */
11700 /*   errors. */
11701 
11702     /* Parameter adjustments */
11703     --lend;
11704     --lptr;
11705     --list;
11706     iwk -= 3;
11707     --z__;
11708     --y;
11709     --x;
11710 
11711     /* Function Body */
11712     n1 = *in1;
11713     n2 = *in2;
11714     iwend = *lwk;
11715     if (n1 < 1 || n2 < 1 || n1 == n2 || iwend < 0) {
11716         goto L31;
11717     }
11718 
11719 /* Test for N2 as a neighbor of N1.  LPL points to the last */
11720 /*   neighbor of N1. */
11721 
11722     lpl = lend[n1];
11723     n0 = (i__1 = list[lpl], abs(i__1));
11724     lp = lpl;
11725 L1:
11726     if (n0 == n2) {
11727         goto L30;
11728     }
11729     lp = lptr[lp];
11730     n0 = list[lp];
11731     if (lp != lpl) {
11732         goto L1;
11733     }
11734 
11735 /* Initialize parameters. */
11736 
11737     iwl = 0;
11738     nit = 0;
11739 
11740 /* Store the coordinates of N1 and N2. */
11741 
11742 L2:
11743     x1 = x[n1];
11744     y1 = y[n1];
11745     z1 = z__[n1];
11746     x2 = x[n2];
11747     y2 = y[n2];
11748     z2 = z__[n2];
11749 
11750 /* Set NR and NL to adjacent neighbors of N1 such that */
11751 /*   NR LEFT N2->N1 and NL LEFT N1->N2, */
11752 /*   (NR Forward N1->N2 or NL Forward N1->N2), and */
11753 /*   (NR Forward N2->N1 or NL Forward N2->N1). */
11754 
11755 /*   Initialization:  Set N1FRST and N1LST to the first and */
11756 /*     (signed) last neighbors of N1, respectively, and */
11757 /*     initialize NL to N1FRST. */
11758 
11759     lpl = lend[n1];
11760     n1lst = list[lpl];
11761     lp = lptr[lpl];
11762     n1frst = list[lp];
11763     nl = n1frst;
11764     if (n1lst < 0) {
11765         goto L4;
11766     }
11767 
11768 /*   N1 is an interior node.  Set NL to the first candidate */
11769 /*     for NR (NL LEFT N2->N1). */
11770 
11771 L3:
11772     if (left_(&x2, &y2, &z2, &x1, &y1, &z1, &x[nl], &y[nl], &z__[nl])) {
11773         goto L4;
11774     }
11775     lp = lptr[lp];
11776     nl = list[lp];
11777     if (nl != n1frst) {
11778         goto L3;
11779     }
11780 
11781 /*   All neighbors of N1 are strictly left of N1->N2. */
11782 
11783     goto L5;
11784 
11785 /*   NL = LIST(LP) LEFT N2->N1.  Set NR to NL and NL to the */
11786 /*     following neighbor of N1. */
11787 
11788 L4:
11789     nr = nl;
11790     lp = lptr[lp];
11791     nl = (i__1 = list[lp], abs(i__1));
11792     if (left_(&x1, &y1, &z1, &x2, &y2, &z2, &x[nl], &y[nl], &z__[nl])) {
11793 
11794 /*   NL LEFT N1->N2 and NR LEFT N2->N1.  The Forward tests */
11795 /*     are employed to avoid an error associated with */
11796 /*     collinear nodes. */
11797 
11798         dp12 = x1 * x2 + y1 * y2 + z1 * z2;
11799         dp1l = x1 * x[nl] + y1 * y[nl] + z1 * z__[nl];
11800         dp2l = x2 * x[nl] + y2 * y[nl] + z2 * z__[nl];
11801         dp1r = x1 * x[nr] + y1 * y[nr] + z1 * z__[nr];
11802         dp2r = x2 * x[nr] + y2 * y[nr] + z2 * z__[nr];
11803         if ((dp2l - dp12 * dp1l >= 0. || dp2r - dp12 * dp1r >= 0.) && (dp1l -
11804                 dp12 * dp2l >= 0. || dp1r - dp12 * dp2r >= 0.)) {
11805             goto L6;
11806         }
11807 
11808 /*   NL-NR does not intersect N1-N2.  However, there is */
11809 /*     another candidate for the first arc if NL lies on */
11810 /*     the line N1-N2. */
11811 
11812         if (! left_(&x2, &y2, &z2, &x1, &y1, &z1, &x[nl], &y[nl], &z__[nl])) {
11813             goto L5;
11814         }
11815     }
11816 
11817 /*   Bottom of loop. */
11818 
11819     if (nl != n1frst) {
11820         goto L4;
11821     }
11822 
11823 /* Either the triangulation is invalid or N1-N2 lies on the */
11824 /*   convex hull boundary and an edge NR->NL (opposite N1 and */
11825 /*   intersecting N1-N2) was not found due to floating point */
11826 /*   error.  Try interchanging N1 and N2 -- NIT > 0 iff this */
11827 /*   has already been done. */
11828 
11829 L5:
11830     if (nit > 0) {
11831         goto L33;
11832     }
11833     nit = 1;
11834     n1 = n2;
11835     n2 = *in1;
11836     goto L2;
11837 
11838 /* Store the ordered sequence of intersecting edges NL->NR in */
11839 /*   IWK(1,IWL)->IWK(2,IWL). */
11840 
11841 L6:
11842     ++iwl;
11843     if (iwl > iwend) {
11844         goto L32;
11845     }
11846     iwk[(iwl << 1) + 1] = nl;
11847     iwk[(iwl << 1) + 2] = nr;
11848 
11849 /*   Set NEXT to the neighbor of NL which follows NR. */
11850 
11851     lpl = lend[nl];
11852     lp = lptr[lpl];
11853 
11854 /*   Find NR as a neighbor of NL.  The search begins with */
11855 /*     the first neighbor. */
11856 
11857 L7:
11858     if (list[lp] == nr) {
11859         goto L8;
11860     }
11861     lp = lptr[lp];
11862     if (lp != lpl) {
11863         goto L7;
11864     }
11865 
11866 /*   NR must be the last neighbor, and NL->NR cannot be a */
11867 /*     boundary edge. */
11868 
11869     if (list[lp] != nr) {
11870         goto L33;
11871     }
11872 
11873 /*   Set NEXT to the neighbor following NR, and test for */
11874 /*     termination of the store loop. */
11875 
11876 L8:
11877     lp = lptr[lp];
11878     next = (i__1 = list[lp], abs(i__1));
11879     if (next == n2) {
11880         goto L9;
11881     }
11882 
11883 /*   Set NL or NR to NEXT. */
11884 
11885     if (left_(&x1, &y1, &z1, &x2, &y2, &z2, &x[next], &y[next], &z__[next])) {
11886         nl = next;
11887     } else {
11888         nr = next;
11889     }
11890     goto L6;
11891 
11892 /* IWL is the number of arcs which intersect N1-N2. */
11893 /*   Store LWK. */
11894 
11895 L9:
11896     *lwk = iwl;
11897     iwend = iwl;
11898 
11899 /* Initialize for edge swapping loop -- all possible swaps */
11900 /*   are applied (even if the new arc again intersects */
11901 /*   N1-N2), arcs to the left of N1->N2 are stored in the */
11902 /*   left portion of IWK, and arcs to the right are stored in */
11903 /*   the right portion.  IWF and IWL index the first and last */
11904 /*   intersecting arcs. */
11905 
11906     iwf = 1;
11907 
11908 /* Top of loop -- set N0 to N1 and NL->NR to the first edge. */
11909 /*   IWC points to the arc currently being processed.  LFT */
11910 /*   .LE. 0 iff N0 LEFT N1->N2. */
11911 
11912 L10:
11913     lft = 0;
11914     n0 = n1;
11915     x0 = x1;
11916     y0 = y1;
11917     z0 = z1;
11918     nl = iwk[(iwf << 1) + 1];
11919     nr = iwk[(iwf << 1) + 2];
11920     iwc = iwf;
11921 
11922 /*   Set NEXT to the node opposite NL->NR unless IWC is the */
11923 /*     last arc. */
11924 
11925 L11:
11926     if (iwc == iwl) {
11927         goto L21;
11928     }
11929     iwcp1 = iwc + 1;
11930     next = iwk[(iwcp1 << 1) + 1];
11931     if (next != nl) {
11932         goto L16;
11933     }
11934     next = iwk[(iwcp1 << 1) + 2];
11935 
11936 /*   NEXT RIGHT N1->N2 and IWC .LT. IWL.  Test for a possible */
11937 /*     swap. */
11938 
11939     if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x[next], &y[next], &
11940             z__[next])) {
11941         goto L14;
11942     }
11943     if (lft >= 0) {
11944         goto L12;
11945     }
11946     if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x[next], &y[next], &
11947             z__[next])) {
11948         goto L14;
11949     }
11950 
11951 /*   Replace NL->NR with N0->NEXT. */
11952 
11953     swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
11954     iwk[(iwc << 1) + 1] = n0;
11955     iwk[(iwc << 1) + 2] = next;
11956     goto L15;
11957 
11958 /*   Swap NL-NR for N0-NEXT, shift columns IWC+1,...,IWL to */
11959 /*     the left, and store N0-NEXT in the right portion of */
11960 /*     IWK. */
11961 
11962 L12:
11963     swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
11964     i__1 = iwl;
11965     for (i__ = iwcp1; i__ <= i__1; ++i__) {
11966         iwk[(i__ - (1<<1)) + 1] = iwk[(i__ << 1) + 1];
11967         iwk[(i__ - (1<<1)) + 2] = iwk[(i__ << 1) + 2];
11968 /* L13: */
11969     }
11970     iwk[(iwl << 1) + 1] = n0;
11971     iwk[(iwl << 1) + 2] = next;
11972     --iwl;
11973     nr = next;
11974     goto L11;
11975 
11976 /*   A swap is not possible.  Set N0 to NR. */
11977 
11978 L14:
11979     n0 = nr;
11980     x0 = x[n0];
11981     y0 = y[n0];
11982     z0 = z__[n0];
11983     lft = 1;
11984 
11985 /*   Advance to the next arc. */
11986 
11987 L15:
11988     nr = next;
11989     ++iwc;
11990     goto L11;
11991 
11992 /*   NEXT LEFT N1->N2, NEXT .NE. N2, and IWC .LT. IWL. */
11993 /*     Test for a possible swap. */
11994 
11995 L16:
11996     if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x[next], &y[next], &
11997             z__[next])) {
11998         goto L19;
11999     }
12000     if (lft <= 0) {
12001         goto L17;
12002     }
12003     if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x[next], &y[next], &
12004             z__[next])) {
12005         goto L19;
12006     }
12007 
12008 /*   Replace NL->NR with NEXT->N0. */
12009 
12010     swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
12011     iwk[(iwc << 1) + 1] = next;
12012     iwk[(iwc << 1) + 2] = n0;
12013     goto L20;
12014 
12015 /*   Swap NL-NR for N0-NEXT, shift columns IWF,...,IWC-1 to */
12016 /*     the right, and store N0-NEXT in the left portion of */
12017 /*     IWK. */
12018 
12019 L17:
12020     swap_(&next, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
12021     i__1 = iwf;
12022     for (i__ = iwc - 1; i__ >= i__1; --i__) {
12023         iwk[(i__ + (1<<1)) + 1] = iwk[(i__ << 1) + 1];
12024         iwk[(i__ + (1<<1)) + 2] = iwk[(i__ << 1) + 2];
12025 /* L18: */
12026     }
12027     iwk[(iwf << 1) + 1] = n0;
12028     iwk[(iwf << 1) + 2] = next;
12029     ++iwf;
12030     goto L20;
12031 
12032 /*   A swap is not possible.  Set N0 to NL. */
12033 
12034 L19:
12035     n0 = nl;
12036     x0 = x[n0];
12037     y0 = y[n0];
12038     z0 = z__[n0];
12039     lft = -1;
12040 
12041 /*   Advance to the next arc. */
12042 
12043 L20:
12044     nl = next;
12045     ++iwc;
12046     goto L11;
12047 
12048 /*   N2 is opposite NL->NR (IWC = IWL). */
12049 
12050 L21:
12051     if (n0 == n1) {
12052         goto L24;
12053     }
12054     if (lft < 0) {
12055         goto L22;
12056     }
12057 
12058 /*   N0 RIGHT N1->N2.  Test for a possible swap. */
12059 
12060     if (! left_(&x0, &y0, &z0, &x[nr], &y[nr], &z__[nr], &x2, &y2, &z2)) {
12061         goto L10;
12062     }
12063 
12064 /*   Swap NL-NR for N0-N2 and store N0-N2 in the right */
12065 /*     portion of IWK. */
12066 
12067     swap_(&n2, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
12068     iwk[(iwl << 1) + 1] = n0;
12069     iwk[(iwl << 1) + 2] = n2;
12070     --iwl;
12071     goto L10;
12072 
12073 /*   N0 LEFT N1->N2.  Test for a possible swap. */
12074 
12075 L22:
12076     if (! left_(&x[nl], &y[nl], &z__[nl], &x0, &y0, &z0, &x2, &y2, &z2)) {
12077         goto L10;
12078     }
12079 
12080 /*   Swap NL-NR for N0-N2, shift columns IWF,...,IWL-1 to the */
12081 /*     right, and store N0-N2 in the left portion of IWK. */
12082 
12083     swap_(&n2, &n0, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
12084     i__ = iwl;
12085 L23:
12086     iwk[(i__ << 1) + 1] = iwk[(i__ - (1<<1)) + 1];
12087     iwk[(i__ << 1) + 2] = iwk[(i__ - (1<<1)) + 2];
12088     --i__;
12089     if (i__ > iwf) {
12090         goto L23;
12091     }
12092     iwk[(iwf << 1) + 1] = n0;
12093     iwk[(iwf << 1) + 2] = n2;
12094     ++iwf;
12095     goto L10;
12096 
12097 /* IWF = IWC = IWL.  Swap out the last arc for N1-N2 and */
12098 /*   store zeros in IWK. */
12099 
12100 L24:
12101     swap_(&n2, &n1, &nl, &nr, &list[1], &lptr[1], &lend[1], &lp21);
12102     iwk[(iwc << 1) + 1] = 0;
12103     iwk[(iwc << 1) + 2] = 0;
12104 
12105 /* Optimization procedure -- */
12106 
12107     *ier = 0;
12108     if (iwc > 1) {
12109 
12110 /*   Optimize the set of new arcs to the left of IN1->IN2. */
12111 
12112         nit = iwc - (1<<2);
12113         i__1 = iwc - 1;
12114         optim_(&x[1], &y[1], &z__[1], &i__1, &list[1], &lptr[1], &lend[1], &
12115                 nit, &iwk[3], &ierr);
12116         if (ierr != 0 && ierr != 1) {
12117             goto L34;
12118         }
12119         if (ierr == 1) {
12120             *ier = 5;
12121         }
12122     }
12123     if (iwc < iwend) {
12124 
12125 /*   Optimize the set of new arcs to the right of IN1->IN2. */
12126 
12127         nit = iwend - (iwc<<2);
12128         i__1 = iwend - iwc;
12129         optim_(&x[1], &y[1], &z__[1], &i__1, &list[1], &lptr[1], &lend[1], &
12130                 nit, &iwk[(iwc + (1<<1)) + 1], &ierr);
12131         if (ierr != 0 && ierr != 1) {
12132             goto L34;
12133         }
12134         if (ierr == 1) {
12135             goto L35;
12136         }
12137     }
12138     if (*ier == 5) {
12139         goto L35;
12140     }
12141 
12142 /* Successful termination (IER = 0). */
12143 
12144     return 0;
12145 
12146 /* IN1 and IN2 were adjacent on input. */
12147 
12148 L30:
12149     *ier = 0;
12150     return 0;
12151 
12152 /* Invalid input parameter. */
12153 
12154 L31:
12155     *ier = 1;
12156     return 0;
12157 
12158 /* Insufficient space reserved for IWK. */
12159 
12160 L32:
12161     *ier = 2;
12162     return 0;
12163 
12164 /* Invalid triangulation data structure or collinear nodes */
12165 /*   on convex hull boundary. */
12166 
12167 L33:
12168     *ier = 3;
12169 /*      WRITE (*,130) IN1, IN2 */
12170 /*  130 FORMAT (//5X,'*** Error in EDGE:  Invalid triangula', */
12171 /*     .        'tion or null triangles on boundary'/ */
12172 /*     .        9X,'IN1 =',I4,', IN2=',I4/) */
12173     return 0;
12174 
12175 /* Error flag (other than 1) returned by OPTIM. */
12176 
12177 L34:
12178     *ier = 4;
12179 /*      WRITE (*,140) NIT, IERR */
12180 /*  140 FORMAT (//5X,'*** Error in OPTIM (called from EDGE):', */
12181 /*     .        '  NIT = ',I4,', IER = ',I1,' ***'/) */
12182     return 0;
12183 
12184 /* Error flag 1 returned by OPTIM. */
12185 
12186 L35:
12187     *ier = 5;
12188     return 0;
12189 } /* edge_ */

int find_group ( int  ix,
int  iy,
int  iz,
int  grpid,
EMData mg,
EMData visited 
)

Definition at line 20033 of file util_sparx.cpp.

References EMAN::EMData::get_xsize(), EMAN::EMData::get_ysize(), EMAN::EMData::get_zsize(), nx, ny, and EMAN::EMData::set_value_at().

Referenced by EMAN::Util::get_biggest_cluster().

20034 {
20035         int offs[][3] = { {-1, 0, 0}, {1, 0, 0}, {0, -1, 0}, {0, 1, 0}, {0, 0, -1}, {0, 0, 1} };
20036         int noff = 6;
20037 
20038         int nx = visited->get_xsize();
20039         int ny = visited->get_ysize();
20040         int nz = visited->get_zsize();
20041 
20042         vector< point3d_t > pts;
20043         pts.push_back( point3d_t(ix, iy, iz) );
20044         visited->set_value_at( ix, iy, iz, (float)grpid );
20045 
20046         int start = 0;
20047         int end = pts.size();
20048 
20049         while( end > start ) {
20050                 for(int i=start; i < end; ++i ) {
20051                         int ix = pts[i].x;
20052                         int iy = pts[i].y;
20053                         int iz = pts[i].z;
20054 
20055                         for( int j=0; j < noff; ++j ) {
20056                                 int jx = ix + offs[j][0];
20057                                 int jy = iy + offs[j][1];
20058                                 int jz = iz + offs[j][2];
20059 
20060                                 if( jx < 0 || jx >= nx ) continue;
20061                                 if( jy < 0 || jy >= ny ) continue;
20062                                 if( jz < 0 || jz >= nz ) continue;
20063 
20064 
20065                                 if( (*mg)(jx, jy, jz)>0 && (*visited)(jx, jy, jz)==0.0 ) {
20066                                     pts.push_back( point3d_t(jx, jy, jz) );
20067                                     visited->set_value_at( jx, jy, jz, (float)grpid );
20068                                 }
20069 
20070                         }
20071                 }
20072 
20073                 start = end;
20074                 end = pts.size();
20075         }
20076         return pts.size();
20077 }

int getnp_ ( double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
int *  l,
int *  npts,
double *  df,
int *  ier 
)

Definition at line 12191 of file util_sparx.cpp.

References abs.

12194 {
12195     /* System generated locals */
12196     int i__1, i__2;
12197 
12198     /* Local variables */
12199     static int i__, n1;
12200     static double x1, y1, z1;
12201     static int nb, ni, lp, np, lm1;
12202     static double dnb, dnp;
12203     static int lpl;
12204 
12205 
12206 /* *********************************************************** */
12207 
12208 /*                                              From STRIPACK */
12209 /*                                            Robert J. Renka */
12210 /*                                  Dept. of Computer Science */
12211 /*                                       Univ. of North Texas */
12212 /*                                           renka@cs.unt.edu */
12213 /*                                                   07/28/98 */
12214 
12215 /*   Given a Delaunay triangulation of N nodes on the unit */
12216 /* sphere and an array NPTS containing the indexes of L-1 */
12217 /* nodes ordered by angular distance from NPTS(1), this sub- */
12218 /* routine sets NPTS(L) to the index of the next node in the */
12219 /* sequence -- the node, other than NPTS(1),...,NPTS(L-1), */
12220 /* that is closest to NPTS(1).  Thus, the ordered sequence */
12221 /* of K closest nodes to N1 (including N1) may be determined */
12222 /* by K-1 calls to GETNP with NPTS(1) = N1 and L = 2,3,...,K */
12223 /* for K .GE. 2. */
12224 
12225 /*   The algorithm uses the property of a Delaunay triangula- */
12226 /* tion that the K-th closest node to N1 is a neighbor of one */
12227 /* of the K-1 closest nodes to N1. */
12228 
12229 
12230 /* On input: */
12231 
12232 /*       X,Y,Z = Arrays of length N containing the Cartesian */
12233 /*               coordinates of the nodes. */
12234 
12235 /*       LIST,LPTR,LEND = Triangulation data structure.  Re- */
12236 /*                        fer to Subroutine TRMESH. */
12237 
12238 /*       L = Number of nodes in the sequence on output.  2 */
12239 /*           .LE. L .LE. N. */
12240 
12241 /* The above parameters are not altered by this routine. */
12242 
12243 /*       NPTS = Array of length .GE. L containing the indexes */
12244 /*              of the L-1 closest nodes to NPTS(1) in the */
12245 /*              first L-1 locations. */
12246 
12247 /* On output: */
12248 
12249 /*       NPTS = Array updated with the index of the L-th */
12250 /*              closest node to NPTS(1) in position L unless */
12251 /*              IER = 1. */
12252 
12253 /*       DF = Value of an increasing function (negative cos- */
12254 /*            ine) of the angular distance between NPTS(1) */
12255 /*            and NPTS(L) unless IER = 1. */
12256 
12257 /*       IER = Error indicator: */
12258 /*             IER = 0 if no errors were encountered. */
12259 /*             IER = 1 if L < 2. */
12260 
12261 /* Modules required by GETNP:  None */
12262 
12263 /* Intrinsic function called by GETNP:  ABS */
12264 
12265 /* *********************************************************** */
12266 
12267 
12268 /* Local parameters: */
12269 
12270 /* DNB,DNP =  Negative cosines of the angular distances from */
12271 /*              N1 to NB and to NP, respectively */
12272 /* I =        NPTS index and DO-loop index */
12273 /* LM1 =      L-1 */
12274 /* LP =       LIST pointer of a neighbor of NI */
12275 /* LPL =      Pointer to the last neighbor of NI */
12276 /* N1 =       NPTS(1) */
12277 /* NB =       Neighbor of NI and candidate for NP */
12278 /* NI =       NPTS(I) */
12279 /* NP =       Candidate for NPTS(L) */
12280 /* X1,Y1,Z1 = Coordinates of N1 */
12281 
12282     /* Parameter adjustments */
12283     --x;
12284     --y;
12285     --z__;
12286     --list;
12287     --lptr;
12288     --lend;
12289     --npts;
12290 
12291     /* Function Body */
12292     lm1 = *l - 1;
12293     if (lm1 < 1) {
12294         goto L6;
12295     }
12296     *ier = 0;
12297 
12298 /* Store N1 = NPTS(1) and mark the elements of NPTS. */
12299 
12300     n1 = npts[1];
12301     x1 = x[n1];
12302     y1 = y[n1];
12303     z1 = z__[n1];
12304     i__1 = lm1;
12305     for (i__ = 1; i__ <= i__1; ++i__) {
12306         ni = npts[i__];
12307         lend[ni] = -lend[ni];
12308 /* L1: */
12309     }
12310 
12311 /* Candidates for NP = NPTS(L) are the unmarked neighbors */
12312 /*   of nodes in NPTS.  DNP is initially greater than -cos(PI) */
12313 /*   (the maximum distance). */
12314 
12315     dnp = 2.;
12316 
12317 /* Loop on nodes NI in NPTS. */
12318 
12319     i__1 = lm1;
12320     for (i__ = 1; i__ <= i__1; ++i__) {
12321         ni = npts[i__];
12322         lpl = -lend[ni];
12323         lp = lpl;
12324 
12325 /* Loop on neighbors NB of NI. */
12326 
12327 L2:
12328         nb = (i__2 = list[lp], abs(i__2));
12329         if (lend[nb] < 0) {
12330             goto L3;
12331         }
12332 
12333 /* NB is an unmarked neighbor of NI.  Replace NP if NB is */
12334 /*   closer to N1. */
12335 
12336         dnb = -(x[nb] * x1 + y[nb] * y1 + z__[nb] * z1);
12337         if (dnb >= dnp) {
12338             goto L3;
12339         }
12340         np = nb;
12341         dnp = dnb;
12342 L3:
12343         lp = lptr[lp];
12344         if (lp != lpl) {
12345             goto L2;
12346         }
12347 /* L4: */
12348     }
12349     npts[*l] = np;
12350     *df = dnp;
12351 
12352 /* Unmark the elements of NPTS. */
12353 
12354     i__1 = lm1;
12355     for (i__ = 1; i__ <= i__1; ++i__) {
12356         ni = npts[i__];
12357         lend[ni] = -lend[ni];
12358 /* L5: */
12359     }
12360     return 0;
12361 
12362 /* L is outside its valid range. */
12363 
12364 L6:
12365     *ier = 1;
12366     return 0;
12367 } /* getnp_ */

int i_dnnt ( double *  x  ) 

Definition at line 7850 of file util_sparx.cpp.

Referenced by trplot_(), and vrplot_().

07852 {
07853         return (int)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
07854 }

int insert_ ( int *  k,
int *  lp,
int *  list,
int *  lptr,
int *  lnew 
)

Definition at line 12369 of file util_sparx.cpp.

Referenced by bdyadd_(), covsph_(), and intadd_().

12371 {
12372     static int lsav;
12373 
12374 
12375 /* *********************************************************** */
12376 
12377 /*                                              From STRIPACK */
12378 /*                                            Robert J. Renka */
12379 /*                                  Dept. of Computer Science */
12380 /*                                       Univ. of North Texas */
12381 /*                                           renka@cs.unt.edu */
12382 /*                                                   07/17/96 */
12383 
12384 /*   This subroutine inserts K as a neighbor of N1 following */
12385 /* N2, where LP is the LIST pointer of N2 as a neighbor of */
12386 /* N1.  Note that, if N2 is the last neighbor of N1, K will */
12387 /* become the first neighbor (even if N1 is a boundary node). */
12388 
12389 /*   This routine is identical to the similarly named routine */
12390 /* in TRIPACK. */
12391 
12392 
12393 /* On input: */
12394 
12395 /*       K = Index of the node to be inserted. */
12396 
12397 /*       LP = LIST pointer of N2 as a neighbor of N1. */
12398 
12399 /* The above parameters are not altered by this routine. */
12400 
12401 /*       LIST,LPTR,LNEW = Data structure defining the trian- */
12402 /*                        gulation.  Refer to Subroutine */
12403 /*                        TRMESH. */
12404 
12405 /* On output: */
12406 
12407 /*       LIST,LPTR,LNEW = Data structure updated with the */
12408 /*                        addition of node K. */
12409 
12410 /* Modules required by INSERT:  None */
12411 
12412 /* *********************************************************** */
12413 
12414 
12415     /* Parameter adjustments */
12416     --lptr;
12417     --list;
12418 
12419     /* Function Body */
12420     lsav = lptr[*lp];
12421     lptr[*lp] = *lnew;
12422     list[*lnew] = *k;
12423     lptr[*lnew] = lsav;
12424     ++(*lnew);
12425     return 0;
12426 } /* insert_ */

long int inside_ ( double *  p,
int *  lv,
double *  xv,
double *  yv,
double *  zv,
int *  nv,
int *  listv,
int *  ier 
)

Definition at line 12428 of file util_sparx.cpp.

References b, ierr, intrsc_(), q, sqrt(), and TRUE_.

12430 {
12431     /* Initialized data */
12432 
12433     static double eps = .001;
12434 
12435     /* System generated locals */
12436     int i__1;
12437     long int ret_val = 0;
12438 
12439     /* Builtin functions */
12440     //double sqrt(double);
12441 
12442     /* Local variables */
12443     static double b[3], d__;
12444     static int k, n;
12445     static double q[3];
12446     static int i1, i2, k0;
12447     static double v1[3], v2[3], cn[3], bp, bq;
12448     static int ni;
12449     static double pn[3], qn[3], vn[3];
12450     static int imx;
12451     static long int lft1, lft2, even;
12452     static int ierr;
12453     static long int pinr, qinr;
12454     static double qnrm, vnrm;
12455     /* Subroutine */ int intrsc_(double *, double *,
12456             double *, double *, int *);
12457 
12458 
12459 /* *********************************************************** */
12460 
12461 /*                                              From STRIPACK */
12462 /*                                            Robert J. Renka */
12463 /*                                  Dept. of Computer Science */
12464 /*                                       Univ. of North Texas */
12465 /*                                           renka@cs.unt.edu */
12466 /*                                                   12/27/93 */
12467 
12468 /*   This function locates a point P relative to a polygonal */
12469 /* region R on the surface of the unit sphere, returning */
12470 /* INSIDE = TRUE if and only if P is contained in R.  R is */
12471 /* defined by a cyclically ordered sequence of vertices which */
12472 /* form a positively-oriented simple closed curve.  Adjacent */
12473 /* vertices need not be distinct but the curve must not be */
12474 /* self-intersecting.  Also, while polygon edges are by defi- */
12475 /* nition restricted to a single hemisphere, R is not so */
12476 /* restricted.  Its interior is the region to the left as the */
12477 /* vertices are traversed in order. */
12478 
12479 /*   The algorithm consists of selecting a point Q in R and */
12480 /* then finding all points at which the great circle defined */
12481 /* by P and Q intersects the boundary of R.  P lies inside R */
12482 /* if and only if there is an even number of intersection */
12483 /* points between Q and P.  Q is taken to be a point immedi- */
12484 /* ately to the left of a directed boundary edge -- the first */
12485 /* one that results in no consistency-check failures. */
12486 
12487 /*   If P is close to the polygon boundary, the problem is */
12488 /* ill-conditioned and the decision may be incorrect.  Also, */
12489 /* an incorrect decision may result from a poor choice of Q */
12490 /* (if, for example, a boundary edge lies on the great cir- */
12491 /* cle defined by P and Q).  A more reliable result could be */
12492 /* obtained by a sequence of calls to INSIDE with the ver- */
12493 /* tices cyclically permuted before each call (to alter the */
12494 /* choice of Q). */
12495 
12496 
12497 /* On input: */
12498 
12499 /*       P = Array of length 3 containing the Cartesian */
12500 /*           coordinates of the point (unit vector) to be */
12501 /*           located. */
12502 
12503 /*       LV = Length of arrays XV, YV, and ZV. */
12504 
12505 /*       XV,YV,ZV = Arrays of length LV containing the Carte- */
12506 /*                  sian coordinates of unit vectors (points */
12507 /*                  on the unit sphere).  These values are */
12508 /*                  not tested for validity. */
12509 
12510 /*       NV = Number of vertices in the polygon.  3 .LE. NV */
12511 /*            .LE. LV. */
12512 
12513 /*       LISTV = Array of length NV containing the indexes */
12514 /*               (for XV, YV, and ZV) of a cyclically-ordered */
12515 /*               (and CCW-ordered) sequence of vertices that */
12516 /*               define R.  The last vertex (indexed by */
12517 /*               LISTV(NV)) is followed by the first (indexed */
12518 /*               by LISTV(1)).  LISTV entries must be in the */
12519 /*               range 1 to LV. */
12520 
12521 /* Input parameters are not altered by this function. */
12522 
12523 /* On output: */
12524 
12525 /*       INSIDE = TRUE if and only if P lies inside R unless */
12526 /*                IER .NE. 0, in which case the value is not */
12527 /*                altered. */
12528 
12529 /*       IER = Error indicator: */
12530 /*             IER = 0 if no errors were encountered. */
12531 /*             IER = 1 if LV or NV is outside its valid */
12532 /*                     range. */
12533 /*             IER = 2 if a LISTV entry is outside its valid */
12534 /*                     range. */
12535 /*             IER = 3 if the polygon boundary was found to */
12536 /*                     be self-intersecting.  This error will */
12537 /*                     not necessarily be detected. */
12538 /*             IER = 4 if every choice of Q (one for each */
12539 /*                     boundary edge) led to failure of some */
12540 /*                     internal consistency check.  The most */
12541 /*                     likely cause of this error is invalid */
12542 /*                     input:  P = (0,0,0), a null or self- */
12543 /*                     intersecting polygon, etc. */
12544 
12545 /* Module required by INSIDE:  INTRSC */
12546 
12547 /* Intrinsic function called by INSIDE:  SQRT */
12548 
12549 /* *********************************************************** */
12550 
12551 
12552 /* Local parameters: */
12553 
12554 /* B =         Intersection point between the boundary and */
12555 /*               the great circle defined by P and Q */
12556 /* BP,BQ =     <B,P> and <B,Q>, respectively, maximized over */
12557 /*               intersection points B that lie between P and */
12558 /*               Q (on the shorter arc) -- used to find the */
12559 /*               closest intersection points to P and Q */
12560 /* CN =        Q X P = normal to the plane of P and Q */
12561 /* D =         Dot product <B,P> or <B,Q> */
12562 /* EPS =       Parameter used to define Q as the point whose */
12563 /*               orthogonal distance to (the midpoint of) */
12564 /*               boundary edge V1->V2 is approximately EPS/ */
12565 /*               (2*Cos(A/2)), where <V1,V2> = Cos(A). */
12566 /* EVEN =      TRUE iff an even number of intersection points */
12567 /*               lie between P and Q (on the shorter arc) */
12568 /* I1,I2 =     Indexes (LISTV elements) of a pair of adjacent */
12569 /*               boundary vertices (endpoints of a boundary */
12570 /*               edge) */
12571 /* IERR =      Error flag for calls to INTRSC (not tested) */
12572 /* IMX =       Local copy of LV and maximum value of I1 and */
12573 /*               I2 */
12574 /* K =         DO-loop index and LISTV index */
12575 /* K0 =        LISTV index of the first endpoint of the */
12576 /*               boundary edge used to compute Q */
12577 /* LFT1,LFT2 = long int variables associated with I1 and I2 in */
12578 /*               the boundary traversal:  TRUE iff the vertex */
12579 /*               is strictly to the left of Q->P (<V,CN> > 0) */
12580 /* N =         Local copy of NV */
12581 /* NI =        Number of intersections (between the boundary */
12582 /*               curve and the great circle P-Q) encountered */
12583 /* PINR =      TRUE iff P is to the left of the directed */
12584 /*               boundary edge associated with the closest */
12585 /*               intersection point to P that lies between P */
12586 /*               and Q (a left-to-right intersection as */
12587 /*               viewed from Q), or there is no intersection */
12588 /*               between P and Q (on the shorter arc) */
12589 /* PN,QN =     P X CN and CN X Q, respectively:  used to */
12590 /*               locate intersections B relative to arc Q->P */
12591 /* Q =         (V1 + V2 + EPS*VN/VNRM)/QNRM, where V1->V2 is */
12592 /*               the boundary edge indexed by LISTV(K0) -> */
12593 /*               LISTV(K0+1) */
12594 /* QINR =      TRUE iff Q is to the left of the directed */
12595 /*               boundary edge associated with the closest */
12596 /*               intersection point to Q that lies between P */
12597 /*               and Q (a right-to-left intersection as */
12598 /*               viewed from Q), or there is no intersection */
12599 /*               between P and Q (on the shorter arc) */
12600 /* QNRM =      Euclidean norm of V1+V2+EPS*VN/VNRM used to */
12601 /*               compute (normalize) Q */
12602 /* V1,V2 =     Vertices indexed by I1 and I2 in the boundary */
12603 /*               traversal */
12604 /* VN =        V1 X V2, where V1->V2 is the boundary edge */
12605 /*               indexed by LISTV(K0) -> LISTV(K0+1) */
12606 /* VNRM =      Euclidean norm of VN */
12607 
12608     /* Parameter adjustments */
12609     --p;
12610     --zv;
12611     --yv;
12612     --xv;
12613     --listv;
12614 
12615     /* Function Body */
12616 
12617 /* Store local parameters, test for error 1, and initialize */
12618 /*   K0. */
12619 
12620     imx = *lv;
12621     n = *nv;
12622     if (n < 3 || n > imx) {
12623         goto L11;
12624     }
12625     k0 = 0;
12626     i1 = listv[1];
12627     if (i1 < 1 || i1 > imx) {
12628         goto L12;
12629     }
12630 
12631 /* Increment K0 and set Q to a point immediately to the left */
12632 /*   of the midpoint of edge V1->V2 = LISTV(K0)->LISTV(K0+1): */
12633 /*   Q = (V1 + V2 + EPS*VN/VNRM)/QNRM, where VN = V1 X V2. */
12634 
12635 L1:
12636     ++k0;
12637     if (k0 > n) {
12638         goto L14;
12639     }
12640     i1 = listv[k0];
12641     if (k0 < n) {
12642         i2 = listv[k0 + 1];
12643     } else {
12644         i2 = listv[1];
12645     }
12646     if (i2 < 1 || i2 > imx) {
12647         goto L12;
12648     }
12649     vn[0] = yv[i1] * zv[i2] - zv[i1] * yv[i2];
12650     vn[1] = zv[i1] * xv[i2] - xv[i1] * zv[i2];
12651     vn[2] = xv[i1] * yv[i2] - yv[i1] * xv[i2];
12652     vnrm = sqrt(vn[0] * vn[0] + vn[1] * vn[1] + vn[2] * vn[2]);
12653     if (vnrm == 0.) {
12654         goto L1;
12655     }
12656     q[0] = xv[i1] + xv[i2] + eps * vn[0] / vnrm;
12657     q[1] = yv[i1] + yv[i2] + eps * vn[1] / vnrm;
12658     q[2] = zv[i1] + zv[i2] + eps * vn[2] / vnrm;
12659     qnrm = sqrt(q[0] * q[0] + q[1] * q[1] + q[2] * q[2]);
12660     q[0] /= qnrm;
12661     q[1] /= qnrm;
12662     q[2] /= qnrm;
12663 
12664 /* Compute CN = Q X P, PN = P X CN, and QN = CN X Q. */
12665 
12666     cn[0] = q[1] * p[3] - q[2] * p[2];
12667     cn[1] = q[2] * p[1] - q[0] * p[3];
12668     cn[2] = q[0] * p[2] - q[1] * p[1];
12669     if (cn[0] == 0. && cn[1] == 0. && cn[2] == 0.) {
12670         goto L1;
12671     }
12672     pn[0] = p[2] * cn[2] - p[3] * cn[1];
12673     pn[1] = p[3] * cn[0] - p[1] * cn[2];
12674     pn[2] = p[1] * cn[1] - p[2] * cn[0];
12675     qn[0] = cn[1] * q[2] - cn[2] * q[1];
12676     qn[1] = cn[2] * q[0] - cn[0] * q[2];
12677     qn[2] = cn[0] * q[1] - cn[1] * q[0];
12678 
12679 /* Initialize parameters for the boundary traversal. */
12680 
12681     ni = 0;
12682     even = TRUE_;
12683     bp = -2.;
12684     bq = -2.;
12685     pinr = TRUE_;
12686     qinr = TRUE_;
12687     i2 = listv[n];
12688     if (i2 < 1 || i2 > imx) {
12689         goto L12;
12690     }
12691     lft2 = cn[0] * xv[i2] + cn[1] * yv[i2] + cn[2] * zv[i2] > 0.;
12692 
12693 /* Loop on boundary arcs I1->I2. */
12694 
12695     i__1 = n;
12696     for (k = 1; k <= i__1; ++k) {
12697         i1 = i2;
12698         lft1 = lft2;
12699         i2 = listv[k];
12700         if (i2 < 1 || i2 > imx) {
12701             goto L12;
12702         }
12703         lft2 = cn[0] * xv[i2] + cn[1] * yv[i2] + cn[2] * zv[i2] > 0.;
12704         if (lft1 == lft2) {
12705             goto L2;
12706         }
12707 
12708 /*   I1 and I2 are on opposite sides of Q->P.  Compute the */
12709 /*     point of intersection B. */
12710 
12711         ++ni;
12712         v1[0] = xv[i1];
12713         v1[1] = yv[i1];
12714         v1[2] = zv[i1];
12715         v2[0] = xv[i2];
12716         v2[1] = yv[i2];
12717         v2[2] = zv[i2];
12718         intrsc_(v1, v2, cn, b, &ierr);
12719 
12720 /*   B is between Q and P (on the shorter arc) iff */
12721 /*     B Forward Q->P and B Forward P->Q       iff */
12722 /*     <B,QN> > 0 and <B,PN> > 0. */
12723 
12724         if (b[0] * qn[0] + b[1] * qn[1] + b[2] * qn[2] > 0. && b[0] * pn[0] +
12725                 b[1] * pn[1] + b[2] * pn[2] > 0.) {
12726 
12727 /*   Update EVEN, BQ, QINR, BP, and PINR. */
12728 
12729             even = ! even;
12730             d__ = b[0] * q[0] + b[1] * q[1] + b[2] * q[2];
12731             if (d__ > bq) {
12732                 bq = d__;
12733                 qinr = lft2;
12734             }
12735             d__ = b[0] * p[1] + b[1] * p[2] + b[2] * p[3];
12736             if (d__ > bp) {
12737                 bp = d__;
12738                 pinr = lft1;
12739             }
12740         }
12741 L2:
12742         ;
12743     }
12744 
12745 /* Test for consistency:  NI must be even and QINR must be */
12746 /*   TRUE. */
12747 
12748     if (ni != ni / 2 << 1 || ! qinr) {
12749         goto L1;
12750     }
12751 
12752 /* Test for error 3:  different values of PINR and EVEN. */
12753 
12754     if (pinr != even) {
12755         goto L13;
12756     }
12757 
12758 /* No error encountered. */
12759 
12760     *ier = 0;
12761     ret_val = even;
12762     return ret_val;
12763 
12764 /* LV or NV is outside its valid range. */
12765 
12766 L11:
12767     *ier = 1;
12768     return ret_val;
12769 
12770 /* A LISTV entry is outside its valid range. */
12771 
12772 L12:
12773     *ier = 2;
12774     return ret_val;
12775 
12776 /* The polygon boundary is self-intersecting. */
12777 
12778 L13:
12779     *ier = 3;
12780     return ret_val;
12781 
12782 /* Consistency tests failed for all values of Q. */
12783 
12784 L14:
12785     *ier = 4;
12786     return ret_val;
12787 } /* inside_ */

int intadd_ ( int *  kk,
int *  i1,
int *  i2,
int *  i3,
int *  list,
int *  lptr,
int *  lend,
int *  lnew 
)

Definition at line 12789 of file util_sparx.cpp.

References insert_(), and lstptr_().

Referenced by addnod_().

12791 {
12792     static int k, n1, n2, n3, lp;
12793     /* Subroutine */ int insert_(int *, int *, int *,
12794             int *, int *);
12795     int lstptr_(int *, int *, int *, int *);
12796 
12797 
12798 /* *********************************************************** */
12799 
12800 /*                                              From STRIPACK */
12801 /*                                            Robert J. Renka */
12802 /*                                  Dept. of Computer Science */
12803 /*                                       Univ. of North Texas */
12804 /*                                           renka@cs.unt.edu */
12805 /*                                                   07/17/96 */
12806 
12807 /*   This subroutine adds an interior node to a triangulation */
12808 /* of a set of points on the unit sphere.  The data structure */
12809 /* is updated with the insertion of node KK into the triangle */
12810 /* whose vertices are I1, I2, and I3.  No optimization of the */
12811 /* triangulation is performed. */
12812 
12813 /*   This routine is identical to the similarly named routine */
12814 /* in TRIPACK. */
12815 
12816 
12817 /* On input: */
12818 
12819 /*       KK = Index of the node to be inserted.  KK .GE. 1 */
12820 /*            and KK must not be equal to I1, I2, or I3. */
12821 
12822 /*       I1,I2,I3 = Indexes of the counterclockwise-ordered */
12823 /*                  sequence of vertices of a triangle which */
12824 /*                  contains node KK. */
12825 
12826 /* The above parameters are not altered by this routine. */
12827 
12828 /*       LIST,LPTR,LEND,LNEW = Data structure defining the */
12829 /*                             triangulation.  Refer to Sub- */
12830 /*                             routine TRMESH.  Triangle */
12831 /*                             (I1,I2,I3) must be included */
12832 /*                             in the triangulation. */
12833 
12834 /* On output: */
12835 
12836 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
12837 /*                             the addition of node KK.  KK */
12838 /*                             will be connected to nodes I1, */
12839 /*                             I2, and I3. */
12840 
12841 /* Modules required by INTADD:  INSERT, LSTPTR */
12842 
12843 /* *********************************************************** */
12844 
12845 
12846 /* Local parameters: */
12847 
12848 /* K =        Local copy of KK */
12849 /* LP =       LIST pointer */
12850 /* N1,N2,N3 = Local copies of I1, I2, and I3 */
12851 
12852     /* Parameter adjustments */
12853     --lend;
12854     --lptr;
12855     --list;
12856 
12857     /* Function Body */
12858     k = *kk;
12859 
12860 /* Initialization. */
12861 
12862     n1 = *i1;
12863     n2 = *i2;
12864     n3 = *i3;
12865 
12866 /* Add K as a neighbor of I1, I2, and I3. */
12867 
12868     lp = lstptr_(&lend[n1], &n2, &list[1], &lptr[1]);
12869     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12870     lp = lstptr_(&lend[n2], &n3, &list[1], &lptr[1]);
12871     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12872     lp = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]);
12873     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12874 
12875 /* Add I1, I2, and I3 as neighbors of K. */
12876 
12877     list[*lnew] = n1;
12878     list[*lnew + 1] = n2;
12879     list[*lnew + 2] = n3;
12880     lptr[*lnew] = *lnew + 1;
12881     lptr[*lnew + 1] = *lnew + 2;
12882     lptr[*lnew + 2] = *lnew;
12883     lend[k] = *lnew + 2;
12884     *lnew += 3;
12885     return 0;
12886 } /* intadd_ */

int intrsc_ ( double *  p1,
double *  p2,
double *  cn,
double *  p,
int *  ier 
)

Definition at line 12888 of file util_sparx.cpp.

References sqrt(), and t.

Referenced by inside_().

12890 {
12891     /* Builtin functions */
12892     //double sqrt(double);
12893 
12894     /* Local variables */
12895     static int i__;
12896     static double t, d1, d2, pp[3], ppn;
12897 
12898 
12899 /* *********************************************************** */
12900 
12901 /*                                              From STRIPACK */
12902 /*                                            Robert J. Renka */
12903 /*                                  Dept. of Computer Science */
12904 /*                                       Univ. of North Texas */
12905 /*                                           renka@cs.unt.edu */
12906 /*                                                   07/19/90 */
12907 
12908 /*   Given a great circle C and points P1 and P2 defining an */
12909 /* arc A on the surface of the unit sphere, where A is the */
12910 /* shorter of the two portions of the great circle C12 assoc- */
12911 /* iated with P1 and P2, this subroutine returns the point */
12912 /* of intersection P between C and C12 that is closer to A. */
12913 /* Thus, if P1 and P2 lie in opposite hemispheres defined by */
12914 /* C, P is the point of intersection of C with A. */
12915 
12916 
12917 /* On input: */
12918 
12919 /*       P1,P2 = Arrays of length 3 containing the Cartesian */
12920 /*               coordinates of unit vectors. */
12921 
12922 /*       CN = Array of length 3 containing the Cartesian */
12923 /*            coordinates of a nonzero vector which defines C */
12924 /*            as the intersection of the plane whose normal */
12925 /*            is CN with the unit sphere.  Thus, if C is to */
12926 /*            be the great circle defined by P and Q, CN */
12927 /*            should be P X Q. */
12928 
12929 /* The above parameters are not altered by this routine. */
12930 
12931 /*       P = Array of length 3. */
12932 
12933 /* On output: */
12934 
12935 /*       P = Point of intersection defined above unless IER */
12936 /*           .NE. 0, in which case P is not altered. */
12937 
12938 /*       IER = Error indicator. */
12939 /*             IER = 0 if no errors were encountered. */
12940 /*             IER = 1 if <CN,P1> = <CN,P2>.  This occurs */
12941 /*                     iff P1 = P2 or CN = 0 or there are */
12942 /*                     two intersection points at the same */
12943 /*                     distance from A. */
12944 /*             IER = 2 if P2 = -P1 and the definition of A is */
12945 /*                     therefore ambiguous. */
12946 
12947 /* Modules required by INTRSC:  None */
12948 
12949 /* Intrinsic function called by INTRSC:  SQRT */
12950 
12951 /* *********************************************************** */
12952 
12953 
12954 /* Local parameters: */
12955 
12956 /* D1 =  <CN,P1> */
12957 /* D2 =  <CN,P2> */
12958 /* I =   DO-loop index */
12959 /* PP =  P1 + T*(P2-P1) = Parametric representation of the */
12960 /*         line defined by P1 and P2 */
12961 /* PPN = Norm of PP */
12962 /* T =   D1/(D1-D2) = Parameter value chosen so that PP lies */
12963 /*         in the plane of C */
12964 
12965     /* Parameter adjustments */
12966     --p;
12967     --cn;
12968     --p2;
12969     --p1;
12970 
12971     /* Function Body */
12972     d1 = cn[1] * p1[1] + cn[2] * p1[2] + cn[3] * p1[3];
12973     d2 = cn[1] * p2[1] + cn[2] * p2[2] + cn[3] * p2[3];
12974 
12975     if (d1 == d2) {
12976         *ier = 1;
12977         return 0;
12978     }
12979 
12980 /* Solve for T such that <PP,CN> = 0 and compute PP and PPN. */
12981 
12982     t = d1 / (d1 - d2);
12983     ppn = 0.;
12984     for (i__ = 1; i__ <= 3; ++i__) {
12985         pp[i__ - 1] = p1[i__] + t * (p2[i__] - p1[i__]);
12986         ppn += pp[i__ - 1] * pp[i__ - 1];
12987 /* L1: */
12988     }
12989 
12990 /* PPN = 0 iff PP = 0 iff P2 = -P1 (and T = .5). */
12991 
12992     if (ppn == 0.) {
12993         *ier = 2;
12994         return 0;
12995     }
12996     ppn = sqrt(ppn);
12997 
12998 /* Compute P = PP/PPN. */
12999 
13000     for (i__ = 1; i__ <= 3; ++i__) {
13001         p[i__] = pp[i__ - 1] / ppn;
13002 /* L2: */
13003     }
13004     *ier = 0;
13005     return 0;
13006 } /* intrsc_ */

bool jiafunc ( int  i,
int  j 
)

Definition at line 21335 of file util_sparx.cpp.

Referenced by EMAN::Util::branch_factor_0(), EMAN::Util::branch_factor_2(), EMAN::Util::branch_factor_3(), and EMAN::Util::branch_factor_4().

21335                           {
21336         return (costlist_global[j] < costlist_global[i]) ;
21337 
21338 }

int jrand_ ( int *  n,
int *  ix,
int *  iy,
int *  iz 
)

Definition at line 13008 of file util_sparx.cpp.

Referenced by trfind_().

13009 {
13010     /* System generated locals */
13011     int ret_val;
13012 
13013     /* Local variables */
13014     static float u, x;
13015 
13016 
13017 /* *********************************************************** */
13018 
13019 /*                                              From STRIPACK */
13020 /*                                            Robert J. Renka */
13021 /*                                  Dept. of Computer Science */
13022 /*                                       Univ. of North Texas */
13023 /*                                           renka@cs.unt.edu */
13024 /*                                                   07/28/98 */
13025 
13026 /*   This function returns a uniformly distributed pseudo- */
13027 /* random int in the range 1 to N. */
13028 
13029 
13030 /* On input: */
13031 
13032 /*       N = Maximum value to be returned. */
13033 
13034 /* N is not altered by this function. */
13035 
13036 /*       IX,IY,IZ = int seeds initialized to values in */
13037 /*                  the range 1 to 30,000 before the first */
13038 /*                  call to JRAND, and not altered between */
13039 /*                  subsequent calls (unless a sequence of */
13040 /*                  random numbers is to be repeated by */
13041 /*                  reinitializing the seeds). */
13042 
13043 /* On output: */
13044 
13045 /*       IX,IY,IZ = Updated int seeds. */
13046 
13047 /*       JRAND = Random int in the range 1 to N. */
13048 
13049 /* Reference:  B. A. Wichmann and I. D. Hill, "An Efficient */
13050 /*             and Portable Pseudo-random Number Generator", */
13051 /*             Applied Statistics, Vol. 31, No. 2, 1982, */
13052 /*             pp. 188-190. */
13053 
13054 /* Modules required by JRAND:  None */
13055 
13056 /* Intrinsic functions called by JRAND:  INT, MOD, float */
13057 
13058 /* *********************************************************** */
13059 
13060 
13061 /* Local parameters: */
13062 
13063 /* U = Pseudo-random number uniformly distributed in the */
13064 /*     interval (0,1). */
13065 /* X = Pseudo-random number in the range 0 to 3 whose frac- */
13066 /*       tional part is U. */
13067 
13068     *ix = *ix * 171 % 30269;
13069     *iy = *iy * 172 % 30307;
13070     *iz = *iz * 170 % 30323;
13071     x = (float) (*ix) / 30269.f + (float) (*iy) / 30307.f + (float) (*iz) /
13072             30323.f;
13073     u = x - (int) x;
13074     ret_val = (int) ((float) (*n) * u + 1.f);
13075     return ret_val;
13076 } /* jrand_ */

long int left_ ( double *  ,
double *  ,
double *  ,
double *  ,
double *  ,
double *  ,
double *  ,
double *  ,
double *   
)

Definition at line 13078 of file util_sparx.cpp.

Referenced by angle_(), delnod_(), edge_(), trmesh_(), and EMAN::Util::trmsh3_().

13081 {
13082     /* System generated locals */
13083     long int ret_val;
13084 
13085 
13086 /* *********************************************************** */
13087 
13088 /*                                              From STRIPACK */
13089 /*                                            Robert J. Renka */
13090 /*                                  Dept. of Computer Science */
13091 /*                                       Univ. of North Texas */
13092 /*                                           renka@cs.unt.edu */
13093 /*                                                   07/15/96 */
13094 
13095 /*   This function determines whether node N0 is in the */
13096 /* (closed) left hemisphere defined by the plane containing */
13097 /* N1, N2, and the origin, where left is defined relative to */
13098 /* an observer at N1 facing N2. */
13099 
13100 
13101 /* On input: */
13102 
13103 /*       X1,Y1,Z1 = Coordinates of N1. */
13104 
13105 /*       X2,Y2,Z2 = Coordinates of N2. */
13106 
13107 /*       X0,Y0,Z0 = Coordinates of N0. */
13108 
13109 /* Input parameters are not altered by this function. */
13110 
13111 /* On output: */
13112 
13113 /*       LEFT = TRUE if and only if N0 is in the closed */
13114 /*              left hemisphere. */
13115 
13116 /* Modules required by LEFT:  None */
13117 
13118 /* *********************************************************** */
13119 
13120 /* LEFT = TRUE iff <N0,N1 X N2> = det(N0,N1,N2) .GE. 0. */
13121 
13122     ret_val = *x0 * (*y1 * *z2 - *y2 * *z1) - *y0 * (*x1 * *z2 - *x2 * *z1) +
13123             *z0 * (*x1 * *y2 - *x2 * *y1) >= -0.000001;
13124 
13125 
13126     return ret_val;
13127 } /* left_ */

int lstptr_ ( int *  lpl,
int *  nb,
int *  list,
int *  lptr 
)

Definition at line 13129 of file util_sparx.cpp.

Referenced by addnod_(), crlist_(), delarc_(), delnod_(), intadd_(), nearnd_(), swap_(), and trfind_().

13130 {
13131     /* System generated locals */
13132     int ret_val;
13133 
13134     /* Local variables */
13135     static int nd, lp;
13136 
13137 
13138 /* *********************************************************** */
13139 
13140 /*                                              From STRIPACK */
13141 /*                                            Robert J. Renka */
13142 /*                                  Dept. of Computer Science */
13143 /*                                       Univ. of North Texas */
13144 /*                                           renka@cs.unt.edu */
13145 /*                                                   07/15/96 */
13146 
13147 /*   This function returns the index (LIST pointer) of NB in */
13148 /* the adjacency list for N0, where LPL = LEND(N0). */
13149 
13150 /*   This function is identical to the similarly named */
13151 /* function in TRIPACK. */
13152 
13153 
13154 /* On input: */
13155 
13156 /*       LPL = LEND(N0) */
13157 
13158 /*       NB = Index of the node whose pointer is to be re- */
13159 /*            turned.  NB must be connected to N0. */
13160 
13161 /*       LIST,LPTR = Data structure defining the triangula- */
13162 /*                   tion.  Refer to Subroutine TRMESH. */
13163 
13164 /* Input parameters are not altered by this function. */
13165 
13166 /* On output: */
13167 
13168 /*       LSTPTR = Pointer such that LIST(LSTPTR) = NB or */
13169 /*                LIST(LSTPTR) = -NB, unless NB is not a */
13170 /*                neighbor of N0, in which case LSTPTR = LPL. */
13171 
13172 /* Modules required by LSTPTR:  None */
13173 
13174 /* *********************************************************** */
13175 
13176 
13177 /* Local parameters: */
13178 
13179 /* LP = LIST pointer */
13180 /* ND = Nodal index */
13181 
13182     /* Parameter adjustments */
13183     --lptr;
13184     --list;
13185 
13186     /* Function Body */
13187     lp = lptr[*lpl];
13188 L1:
13189     nd = list[lp];
13190     if (nd == *nb) {
13191         goto L2;
13192     }
13193     lp = lptr[lp];
13194     if (lp != *lpl) {
13195         goto L1;
13196     }
13197 
13198 L2:
13199     ret_val = lp;
13200     return ret_val;
13201 } /* lstptr_ */

int nbcnt_ ( int *  lpl,
int *  lptr 
)

Definition at line 13203 of file util_sparx.cpp.

Referenced by delnod_().

13204 {
13205     /* System generated locals */
13206     int ret_val;
13207 
13208     /* Local variables */
13209     static int k, lp;
13210 
13211 
13212 /* *********************************************************** */
13213 
13214 /*                                              From STRIPACK */
13215 /*                                            Robert J. Renka */
13216 /*                                  Dept. of Computer Science */
13217 /*                                       Univ. of North Texas */
13218 /*                                           renka@cs.unt.edu */
13219 /*                                                   07/15/96 */
13220 
13221 /*   This function returns the number of neighbors of a node */
13222 /* N0 in a triangulation created by Subroutine TRMESH. */
13223 
13224 /*   This function is identical to the similarly named */
13225 /* function in TRIPACK. */
13226 
13227 
13228 /* On input: */
13229 
13230 /*       LPL = LIST pointer to the last neighbor of N0 -- */
13231 /*             LPL = LEND(N0). */
13232 
13233 /*       LPTR = Array of pointers associated with LIST. */
13234 
13235 /* Input parameters are not altered by this function. */
13236 
13237 /* On output: */
13238 
13239 /*       NBCNT = Number of neighbors of N0. */
13240 
13241 /* Modules required by NBCNT:  None */
13242 
13243 /* *********************************************************** */
13244 
13245 
13246 /* Local parameters: */
13247 
13248 /* K =  Counter for computing the number of neighbors */
13249 /* LP = LIST pointer */
13250 
13251     /* Parameter adjustments */
13252     --lptr;
13253 
13254     /* Function Body */
13255     lp = *lpl;
13256     k = 1;
13257 
13258 L1:
13259     lp = lptr[lp];
13260     if (lp == *lpl) {
13261         goto L2;
13262     }
13263     ++k;
13264     goto L1;
13265 
13266 L2:
13267     ret_val = k;
13268     return ret_val;
13269 } /* nbcnt_ */

int nearnd_ ( double *  p,
int *  ist,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
double *  al 
)

Definition at line 13271 of file util_sparx.cpp.

References abs, lstptr_(), nn(), and trfind_().

13274 {
13275     /* System generated locals */
13276     int ret_val, i__1;
13277 
13278     /* Builtin functions */
13279     //double acos(double);
13280 
13281     /* Local variables */
13282     static int l;
13283     static double b1, b2, b3;
13284     static int i1, i2, i3, n1, n2, n3, lp, nn, nr;
13285     static double ds1;
13286     static int lp1, lp2;
13287     static double dx1, dx2, dx3, dy1, dy2, dy3, dz1, dz2, dz3;
13288     static int lpl;
13289     static double dsr;
13290     static int nst, listp[25], lptrp[25];
13291     /* Subroutine */ int trfind_(int *, double *, int *,
13292             double *, double *, double *, int *, int *,
13293             int *, double *, double *, double *, int *,
13294             int *, int *);
13295     int lstptr_(int *, int *, int *, int *);
13296 
13297 
13298 /* *********************************************************** */
13299 
13300 /*                                              From STRIPACK */
13301 /*                                            Robert J. Renka */
13302 /*                                  Dept. of Computer Science */
13303 /*                                       Univ. of North Texas */
13304 /*                                           renka@cs.unt.edu */
13305 /*                                                   07/28/98 */
13306 
13307 /*   Given a point P on the surface of the unit sphere and a */
13308 /* Delaunay triangulation created by Subroutine TRMESH, this */
13309 /* function returns the index of the nearest triangulation */
13310 /* node to P. */
13311 
13312 /*   The algorithm consists of implicitly adding P to the */
13313 /* triangulation, finding the nearest neighbor to P, and */
13314 /* implicitly deleting P from the triangulation.  Thus, it */
13315 /* is based on the fact that, if P is a node in a Delaunay */
13316 /* triangulation, the nearest node to P is a neighbor of P. */
13317 
13318 
13319 /* On input: */
13320 
13321 /*       P = Array of length 3 containing the Cartesian coor- */
13322 /*           dinates of the point P to be located relative to */
13323 /*           the triangulation.  It is assumed without a test */
13324 /*           that P(1)**2 + P(2)**2 + P(3)**2 = 1. */
13325 
13326 /*       IST = Index of a node at which TRFIND begins the */
13327 /*             search.  Search time depends on the proximity */
13328 /*             of this node to P. */
13329 
13330 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
13331 
13332 /*       X,Y,Z = Arrays of length N containing the Cartesian */
13333 /*               coordinates of the nodes. */
13334 
13335 /*       LIST,LPTR,LEND = Data structure defining the trian- */
13336 /*                        gulation.  Refer to TRMESH. */
13337 
13338 /* Input parameters are not altered by this function. */
13339 
13340 /* On output: */
13341 
13342 /*       NEARND = Nodal index of the nearest node to P, or 0 */
13343 /*                if N < 3 or the triangulation data struc- */
13344 /*                ture is invalid. */
13345 
13346 /*       AL = Arc length (angular distance in radians) be- */
13347 /*            tween P and NEARND unless NEARND = 0. */
13348 
13349 /*       Note that the number of candidates for NEARND */
13350 /*       (neighbors of P) is limited to LMAX defined in */
13351 /*       the PARAMETER statement below. */
13352 
13353 /* Modules required by NEARND:  JRAND, LSTPTR, TRFIND, STORE */
13354 
13355 /* Intrinsic functions called by NEARND:  ABS, ACOS */
13356 
13357 /* *********************************************************** */
13358 
13359 
13360 /* Local parameters: */
13361 
13362 /* B1,B2,B3 =  Unnormalized barycentric coordinates returned */
13363 /*               by TRFIND */
13364 /* DS1 =       (Negative cosine of the) distance from P to N1 */
13365 /* DSR =       (Negative cosine of the) distance from P to NR */
13366 /* DX1,..DZ3 = Components of vectors used by the swap test */
13367 /* I1,I2,I3 =  Nodal indexes of a triangle containing P, or */
13368 /*               the rightmost (I1) and leftmost (I2) visible */
13369 /*               boundary nodes as viewed from P */
13370 /* L =         Length of LISTP/LPTRP and number of neighbors */
13371 /*               of P */
13372 /* LMAX =      Maximum value of L */
13373 /* LISTP =     Indexes of the neighbors of P */
13374 /* LPTRP =     Array of pointers in 1-1 correspondence with */
13375 /*               LISTP elements */
13376 /* LP =        LIST pointer to a neighbor of N1 and LISTP */
13377 /*               pointer */
13378 /* LP1,LP2 =   LISTP indexes (pointers) */
13379 /* LPL =       Pointer to the last neighbor of N1 */
13380 /* N1 =        Index of a node visible from P */
13381 /* N2 =        Index of an endpoint of an arc opposite P */
13382 /* N3 =        Index of the node opposite N1->N2 */
13383 /* NN =        Local copy of N */
13384 /* NR =        Index of a candidate for the nearest node to P */
13385 /* NST =       Index of the node at which TRFIND begins the */
13386 /*               search */
13387 
13388 
13389 /* Store local parameters and test for N invalid. */
13390 
13391     /* Parameter adjustments */
13392     --p;
13393     --lend;
13394     --z__;
13395     --y;
13396     --x;
13397     --list;
13398     --lptr;
13399 
13400     /* Function Body */
13401     nn = *n;
13402     if (nn < 3) {
13403         goto L6;
13404     }
13405     nst = *ist;
13406     if (nst < 1 || nst > nn) {
13407         nst = 1;
13408     }
13409 
13410 /* Find a triangle (I1,I2,I3) containing P, or the rightmost */
13411 /*   (I1) and leftmost (I2) visible boundary nodes as viewed */
13412 /*   from P. */
13413 
13414     trfind_(&nst, &p[1], n, &x[1], &y[1], &z__[1], &list[1], &lptr[1], &lend[
13415             1], &b1, &b2, &b3, &i1, &i2, &i3);
13416 
13417 /* Test for collinear nodes. */
13418 
13419     if (i1 == 0) {
13420         goto L6;
13421     }
13422 
13423 /* Store the linked list of 'neighbors' of P in LISTP and */
13424 /*   LPTRP.  I1 is the first neighbor, and 0 is stored as */
13425 /*   the last neighbor if P is not contained in a triangle. */
13426 /*   L is the length of LISTP and LPTRP, and is limited to */
13427 /*   LMAX. */
13428 
13429     if (i3 != 0) {
13430         listp[0] = i1;
13431         lptrp[0] = 2;
13432         listp[1] = i2;
13433         lptrp[1] = 3;
13434         listp[2] = i3;
13435         lptrp[2] = 1;
13436         l = 3;
13437     } else {
13438         n1 = i1;
13439         l = 1;
13440         lp1 = 2;
13441         listp[l - 1] = n1;
13442         lptrp[l - 1] = lp1;
13443 
13444 /*   Loop on the ordered sequence of visible boundary nodes */
13445 /*     N1 from I1 to I2. */
13446 
13447 L1:
13448         lpl = lend[n1];
13449         n1 = -list[lpl];
13450         l = lp1;
13451         lp1 = l + 1;
13452         listp[l - 1] = n1;
13453         lptrp[l - 1] = lp1;
13454         if (n1 != i2 && lp1 < 25) {
13455             goto L1;
13456         }
13457         l = lp1;
13458         listp[l - 1] = 0;
13459         lptrp[l - 1] = 1;
13460     }
13461 
13462 /* Initialize variables for a loop on arcs N1-N2 opposite P */
13463 /*   in which new 'neighbors' are 'swapped' in.  N1 follows */
13464 /*   N2 as a neighbor of P, and LP1 and LP2 are the LISTP */
13465 /*   indexes of N1 and N2. */
13466 
13467     lp2 = 1;
13468     n2 = i1;
13469     lp1 = lptrp[0];
13470     n1 = listp[lp1 - 1];
13471 
13472 /* Begin loop:  find the node N3 opposite N1->N2. */
13473 
13474 L2:
13475     lp = lstptr_(&lend[n1], &n2, &list[1], &lptr[1]);
13476     if (list[lp] < 0) {
13477         goto L3;
13478     }
13479     lp = lptr[lp];
13480     n3 = (i__1 = list[lp], abs(i__1));
13481 
13482 /* Swap test:  Exit the loop if L = LMAX. */
13483 
13484     if (l == 25) {
13485         goto L4;
13486     }
13487     dx1 = x[n1] - p[1];
13488     dy1 = y[n1] - p[2];
13489     dz1 = z__[n1] - p[3];
13490 
13491     dx2 = x[n2] - p[1];
13492     dy2 = y[n2] - p[2];
13493     dz2 = z__[n2] - p[3];
13494 
13495     dx3 = x[n3] - p[1];
13496     dy3 = y[n3] - p[2];
13497     dz3 = z__[n3] - p[3];
13498     if (dx3 * (dy2 * dz1 - dy1 * dz2) - dy3 * (dx2 * dz1 - dx1 * dz2) + dz3 *
13499             (dx2 * dy1 - dx1 * dy2) <= 0.) {
13500         goto L3;
13501     }
13502 
13503 /* Swap:  Insert N3 following N2 in the adjacency list for P. */
13504 /*        The two new arcs opposite P must be tested. */
13505 
13506     ++l;
13507     lptrp[lp2 - 1] = l;
13508     listp[l - 1] = n3;
13509     lptrp[l - 1] = lp1;
13510     lp1 = l;
13511     n1 = n3;
13512     goto L2;
13513 
13514 /* No swap:  Advance to the next arc and test for termination */
13515 /*           on N1 = I1 (LP1 = 1) or N1 followed by 0. */
13516 
13517 L3:
13518     if (lp1 == 1) {
13519         goto L4;
13520     }
13521     lp2 = lp1;
13522     n2 = n1;
13523     lp1 = lptrp[lp1 - 1];
13524     n1 = listp[lp1 - 1];
13525     if (n1 == 0) {
13526         goto L4;
13527     }
13528     goto L2;
13529 
13530 /* Set NR and DSR to the index of the nearest node to P and */
13531 /*   an increasing function (negative cosine) of its distance */
13532 /*   from P, respectively. */
13533 
13534 L4:
13535     nr = i1;
13536     dsr = -(x[nr] * p[1] + y[nr] * p[2] + z__[nr] * p[3]);
13537     i__1 = l;
13538     for (lp = 2; lp <= i__1; ++lp) {
13539         n1 = listp[lp - 1];
13540         if (n1 == 0) {
13541             goto L5;
13542         }
13543         ds1 = -(x[n1] * p[1] + y[n1] * p[2] + z__[n1] * p[3]);
13544         if (ds1 < dsr) {
13545             nr = n1;
13546             dsr = ds1;
13547         }
13548 L5:
13549         ;
13550     }
13551     dsr = -dsr;
13552     if (dsr > 1.) {
13553         dsr = 1.;
13554     }
13555     *al = acos(dsr);
13556     ret_val = nr;
13557     return ret_val;
13558 
13559 /* Invalid input. */
13560 
13561 L6:
13562     ret_val = 0;
13563     return ret_val;
13564 } /* nearnd_ */

int optim_ ( double *  x,
double *  y,
double *  z__,
int *  na,
int *  list,
int *  lptr,
int *  lend,
int *  nit,
int *  iwk,
int *  ier 
)

Definition at line 13566 of file util_sparx.cpp.

References abs, FALSE_, swap_(), swptst_(), and TRUE_.

Referenced by delnod_(), and edge_().

13569 {
13570     /* System generated locals */
13571     int i__1, i__2;
13572 
13573     /* Local variables */
13574     static int i__, n1, n2, lp, io1, io2, nna, lp21, lpl, lpp;
13575     static long int swp;
13576     static int iter;
13577     /* Subroutine */ int swap_(int *, int *, int *,
13578             int *, int *, int *, int *, int *);
13579     static int maxit;
13580     long int swptst_(int *, int *, int *, int *,
13581             double *, double *, double *);
13582 
13583 
13584 /* *********************************************************** */
13585 
13586 /*                                              From STRIPACK */
13587 /*                                            Robert J. Renka */
13588 /*                                  Dept. of Computer Science */
13589 /*                                       Univ. of North Texas */
13590 /*                                           renka@cs.unt.edu */
13591 /*                                                   07/30/98 */
13592 
13593 /*   Given a set of NA triangulation arcs, this subroutine */
13594 /* optimizes the portion of the triangulation consisting of */
13595 /* the quadrilaterals (pairs of adjacent triangles) which */
13596 /* have the arcs as diagonals by applying the circumcircle */
13597 /* test and appropriate swaps to the arcs. */
13598 
13599 /*   An iteration consists of applying the swap test and */
13600 /* swaps to all NA arcs in the order in which they are */
13601 /* stored.  The iteration is repeated until no swap occurs */
13602 /* or NIT iterations have been performed.  The bound on the */
13603 /* number of iterations may be necessary to prevent an */
13604 /* infinite loop caused by cycling (reversing the effect of a */
13605 /* previous swap) due to floating point inaccuracy when four */
13606 /* or more nodes are nearly cocircular. */
13607 
13608 
13609 /* On input: */
13610 
13611 /*       X,Y,Z = Arrays containing the nodal coordinates. */
13612 
13613 /*       NA = Number of arcs in the set.  NA .GE. 0. */
13614 
13615 /* The above parameters are not altered by this routine. */
13616 
13617 /*       LIST,LPTR,LEND = Data structure defining the trian- */
13618 /*                        gulation.  Refer to Subroutine */
13619 /*                        TRMESH. */
13620 
13621 /*       NIT = Maximum number of iterations to be performed. */
13622 /*             NIT = 4*NA should be sufficient.  NIT .GE. 1. */
13623 
13624 /*       IWK = int array dimensioned 2 by NA containing */
13625 /*             the nodal indexes of the arc endpoints (pairs */
13626 /*             of endpoints are stored in columns). */
13627 
13628 /* On output: */
13629 
13630 /*       LIST,LPTR,LEND = Updated triangulation data struc- */
13631 /*                        ture reflecting the swaps. */
13632 
13633 /*       NIT = Number of iterations performed. */
13634 
13635 /*       IWK = Endpoint indexes of the new set of arcs */
13636 /*             reflecting the swaps. */
13637 
13638 /*       IER = Error indicator: */
13639 /*             IER = 0 if no errors were encountered. */
13640 /*             IER = 1 if a swap occurred on the last of */
13641 /*                     MAXIT iterations, where MAXIT is the */
13642 /*                     value of NIT on input.  The new set */
13643 /*                     of arcs is not necessarily optimal */
13644 /*                     in this case. */
13645 /*             IER = 2 if NA < 0 or NIT < 1 on input. */
13646 /*             IER = 3 if IWK(2,I) is not a neighbor of */
13647 /*                     IWK(1,I) for some I in the range 1 */
13648 /*                     to NA.  A swap may have occurred in */
13649 /*                     this case. */
13650 /*             IER = 4 if a zero pointer was returned by */
13651 /*                     Subroutine SWAP. */
13652 
13653 /* Modules required by OPTIM:  LSTPTR, SWAP, SWPTST */
13654 
13655 /* Intrinsic function called by OPTIM:  ABS */
13656 
13657 /* *********************************************************** */
13658 
13659 
13660 /* Local parameters: */
13661 
13662 /* I =       Column index for IWK */
13663 /* IO1,IO2 = Nodal indexes of the endpoints of an arc in IWK */
13664 /* ITER =    Iteration count */
13665 /* LP =      LIST pointer */
13666 /* LP21 =    Parameter returned by SWAP (not used) */
13667 /* LPL =     Pointer to the last neighbor of IO1 */
13668 /* LPP =     Pointer to the node preceding IO2 as a neighbor */
13669 /*             of IO1 */
13670 /* MAXIT =   Input value of NIT */
13671 /* N1,N2 =   Nodes opposite IO1->IO2 and IO2->IO1, */
13672 /*             respectively */
13673 /* NNA =     Local copy of NA */
13674 /* SWP =     Flag set to TRUE iff a swap occurs in the */
13675 /*             optimization loop */
13676 
13677     /* Parameter adjustments */
13678     --x;
13679     --y;
13680     --z__;
13681     iwk -= 3;
13682     --list;
13683     --lptr;
13684     --lend;
13685 
13686     /* Function Body */
13687     nna = *na;
13688     maxit = *nit;
13689     if (nna < 0 || maxit < 1) {
13690         goto L7;
13691     }
13692 
13693 /* Initialize iteration count ITER and test for NA = 0. */
13694 
13695     iter = 0;
13696     if (nna == 0) {
13697         goto L5;
13698     }
13699 
13700 /* Top of loop -- */
13701 /*   SWP = TRUE iff a swap occurred in the current iteration. */
13702 
13703 L1:
13704     if (iter == maxit) {
13705         goto L6;
13706     }
13707     ++iter;
13708     swp = FALSE_;
13709 
13710 /*   Inner loop on arcs IO1-IO2 -- */
13711 
13712     i__1 = nna;
13713     for (i__ = 1; i__ <= i__1; ++i__) {
13714         io1 = iwk[(i__ << 1) + 1];
13715         io2 = iwk[(i__ << 1) + 2];
13716 
13717 /*   Set N1 and N2 to the nodes opposite IO1->IO2 and */
13718 /*     IO2->IO1, respectively.  Determine the following: */
13719 
13720 /*     LPL = pointer to the last neighbor of IO1, */
13721 /*     LP = pointer to IO2 as a neighbor of IO1, and */
13722 /*     LPP = pointer to the node N2 preceding IO2. */
13723 
13724         lpl = lend[io1];
13725         lpp = lpl;
13726         lp = lptr[lpp];
13727 L2:
13728         if (list[lp] == io2) {
13729             goto L3;
13730         }
13731         lpp = lp;
13732         lp = lptr[lpp];
13733         if (lp != lpl) {
13734             goto L2;
13735         }
13736 
13737 /*   IO2 should be the last neighbor of IO1.  Test for no */
13738 /*     arc and bypass the swap test if IO1 is a boundary */
13739 /*     node. */
13740 
13741         if ((i__2 = list[lp], abs(i__2)) != io2) {
13742             goto L8;
13743         }
13744         if (list[lp] < 0) {
13745             goto L4;
13746         }
13747 
13748 /*   Store N1 and N2, or bypass the swap test if IO1 is a */
13749 /*     boundary node and IO2 is its first neighbor. */
13750 
13751 L3:
13752         n2 = list[lpp];
13753         if (n2 < 0) {
13754             goto L4;
13755         }
13756         lp = lptr[lp];
13757         n1 = (i__2 = list[lp], abs(i__2));
13758 
13759 /*   Test IO1-IO2 for a swap, and update IWK if necessary. */
13760 
13761         if (! swptst_(&n1, &n2, &io1, &io2, &x[1], &y[1], &z__[1])) {
13762             goto L4;
13763         }
13764         swap_(&n1, &n2, &io1, &io2, &list[1], &lptr[1], &lend[1], &lp21);
13765         if (lp21 == 0) {
13766             goto L9;
13767         }
13768         swp = TRUE_;
13769         iwk[(i__ << 1) + 1] = n1;
13770         iwk[(i__ << 1) + 2] = n2;
13771 L4:
13772         ;
13773     }
13774     if (swp) {
13775         goto L1;
13776     }
13777 
13778 /* Successful termination. */
13779 
13780 L5:
13781     *nit = iter;
13782     *ier = 0;
13783     return 0;
13784 
13785 /* MAXIT iterations performed without convergence. */
13786 
13787 L6:
13788     *nit = maxit;
13789     *ier = 1;
13790     return 0;
13791 
13792 /* Invalid input parameter. */
13793 
13794 L7:
13795     *nit = 0;
13796     *ier = 2;
13797     return 0;
13798 
13799 /* IO2 is not a neighbor of IO1. */
13800 
13801 L8:
13802     *nit = iter;
13803     *ier = 3;
13804     return 0;
13805 
13806 /* Zero pointer returned by SWAP. */
13807 
13808 L9:
13809     *nit = iter;
13810     *ier = 4;
13811     return 0;
13812 } /* optim_ */

int projct_ ( double *  px,
double *  py,
double *  pz,
double *  ox,
double *  oy,
double *  oz,
double *  ex,
double *  ey,
double *  ez,
double *  vx,
double *  vy,
double *  vz,
long int *  init,
double *  x,
double *  y,
double *  z__,
int *  ier 
)

Definition at line 13814 of file util_sparx.cpp.

References FALSE_, and sqrt().

13819 {
13820     /* Builtin functions */
13821     //double sqrt(double);
13822 
13823     /* Local variables */
13824     static double s, sc, xe, ye, ze, xh, yh, zh, xv, yv, zv, xw, yw, zw,
13825             oes, xoe, yoe, zoe, xep, yep, zep;
13826 
13827 
13828 /* *********************************************************** */
13829 
13830 /*                        From PLTPACK, SCRPLOT, and STRIPACK */
13831 /*                                            Robert J. Renka */
13832 /*                                  Dept. of Computer Science */
13833 /*                                       Univ. of North Texas */
13834 /*                                           renka@cs.unt.edu */
13835 /*                                                   07/18/90 */
13836 
13837 /*   Given a projection plane and associated coordinate sys- */
13838 /* tem defined by an origin O, eye position E, and up-vector */
13839 /* V, this subroutine applies a perspective depth transform- */
13840 /* ation T to a point P = (PX,PY,PZ), returning the point */
13841 /* T(P) = (X,Y,Z), where X and Y are the projection plane */
13842 /* coordinates of the point that lies in the projection */
13843 /* plane and on the line defined by P and E, and Z is the */
13844 /* depth associated with P. */
13845 
13846 /*   The projection plane is defined to be the plane that */
13847 /* contains O and has normal defined by O and E. */
13848 
13849 /*   The depth Z is defined in such a way that Z < 1, T maps */
13850 /* lines to lines (and planes to planes), and if two distinct */
13851 /* points have the same projection plane coordinates, then */
13852 /* the one closer to E has a smaller depth.  (Z increases */
13853 /* monotonically with orthogonal distance from P to the plane */
13854 /* that is parallel to the projection plane and contains E.) */
13855 /* This depth value facilitates depth sorting and depth buf- */
13856 /* fer methods. */
13857 
13858 
13859 /* On input: */
13860 
13861 /*       PX,PY,PZ = Cartesian coordinates of the point P to */
13862 /*                  be mapped onto the projection plane.  The */
13863 /*                  half line that contains P and has end- */
13864 /*                  point at E must intersect the plane. */
13865 
13866 /*       OX,OY,OZ = Coordinates of O (the origin of a coordi- */
13867 /*                  nate system in the projection plane).  A */
13868 /*                  reasonable value for O is a point near */
13869 /*                  the center of an object or scene to be */
13870 /*                  viewed. */
13871 
13872 /*       EX,EY,EZ = Coordinates of the eye-position E defin- */
13873 /*                  ing the normal to the plane and the line */
13874 /*                  of sight for the projection.  E must not */
13875 /*                  coincide with O or P, and the angle be- */
13876 /*                  tween the vectors O-E and P-E must be */
13877 /*                  less than 90 degrees.  Note that E and P */
13878 /*                  may lie on opposite sides of the projec- */
13879 /*                  tion plane. */
13880 
13881 /*       VX,VY,VZ = Coordinates of a point V which defines */
13882 /*                  the positive Y axis of an X-Y coordinate */
13883 /*                  system in the projection plane as the */
13884 /*                  half-line containing O and the projection */
13885 /*                  of O+V onto the plane.  The positive X */
13886 /*                  axis has direction defined by the cross */
13887 /*                  product V X (E-O). */
13888 
13889 /* The above parameters are not altered by this routine. */
13890 
13891 /*       INIT = long int switch which must be set to TRUE on */
13892 /*              the first call and when the values of O, E, */
13893 /*              or V have been altered since a previous call. */
13894 /*              If INIT = FALSE, it is assumed that only the */
13895 /*              coordinates of P have changed since a previ- */
13896 /*              ous call.  Previously stored quantities are */
13897 /*              used for increased efficiency in this case. */
13898 
13899 /* On output: */
13900 
13901 /*       INIT = Switch with value reset to FALSE if IER = 0. */
13902 
13903 /*       X,Y = Projection plane coordinates of the point */
13904 /*             that lies in the projection plane and on the */
13905 /*             line defined by E and P.  X and Y are not */
13906 /*             altered if IER .NE. 0. */
13907 
13908 /*       Z = Depth value defined above unless IER .NE. 0. */
13909 
13910 /*       IER = Error indicator. */
13911 /*             IER = 0 if no errors were encountered. */
13912 /*             IER = 1 if the inner product of O-E with P-E */
13913 /*                     is not positive, implying that E is */
13914 /*                     too close to the plane. */
13915 /*             IER = 2 if O, E, and O+V are collinear.  See */
13916 /*                     the description of VX,VY,VZ. */
13917 
13918 /* Modules required by PROJCT:  None */
13919 
13920 /* Intrinsic function called by PROJCT:  SQRT */
13921 
13922 /* *********************************************************** */
13923 
13924 
13925 /* Local parameters: */
13926 
13927 /* OES =         Norm squared of OE -- inner product (OE,OE) */
13928 /* S =           Scale factor for computing projections */
13929 /* SC =          Scale factor for normalizing VN and HN */
13930 /* XE,YE,ZE =    Local copies of EX, EY, EZ */
13931 /* XEP,YEP,ZEP = Components of the vector EP from E to P */
13932 /* XH,YH,ZH =    Components of a unit vector HN defining the */
13933 /*                 positive X-axis in the plane */
13934 /* XOE,YOE,ZOE = Components of the vector OE from O to E */
13935 /* XV,YV,ZV =    Components of a unit vector VN defining the */
13936 /*                 positive Y-axis in the plane */
13937 /* XW,YW,ZW =    Components of the vector W from O to the */
13938 /*                 projection of P onto the plane */
13939 
13940     if (*init) {
13941 
13942 /* Compute parameters defining the transformation: */
13943 /*   17 adds, 27 multiplies, 3 divides, 2 compares, and */
13944 /*   2 square roots. */
13945 
13946 /* Set the coordinates of E to local variables, compute */
13947 /*   OE = E-O and OES, and test for OE = 0. */
13948 
13949         xe = *ex;
13950         ye = *ey;
13951         ze = *ez;
13952         xoe = xe - *ox;
13953         yoe = ye - *oy;
13954         zoe = ze - *oz;
13955         oes = xoe * xoe + yoe * yoe + zoe * zoe;
13956         if (oes == 0.) {
13957             goto L1;
13958         }
13959 
13960 /* Compute S = (OE,V)/OES and VN = V - S*OE. */
13961 
13962         s = (xoe * *vx + yoe * *vy + zoe * *vz) / oes;
13963         xv = *vx - s * xoe;
13964         yv = *vy - s * yoe;
13965         zv = *vz - s * zoe;
13966 
13967 /* Normalize VN to a unit vector. */
13968 
13969         sc = xv * xv + yv * yv + zv * zv;
13970         if (sc == 0.) {
13971             goto L2;
13972         }
13973         sc = 1. / sqrt(sc);
13974         xv = sc * xv;
13975         yv = sc * yv;
13976         zv = sc * zv;
13977 
13978 /* Compute HN = VN X OE (normalized). */
13979 
13980         xh = yv * zoe - yoe * zv;
13981         yh = xoe * zv - xv * zoe;
13982         zh = xv * yoe - xoe * yv;
13983         sc = sqrt(xh * xh + yh * yh + zh * zh);
13984         if (sc == 0.) {
13985             goto L2;
13986         }
13987         sc = 1. / sc;
13988         xh = sc * xh;
13989         yh = sc * yh;
13990         zh = sc * zh;
13991     }
13992 
13993 /* Apply the transformation:  13 adds, 12 multiplies, */
13994 /*                            1 divide, and 1 compare. */
13995 
13996 /* Compute EP = P-E, S = OES/(OE,EP), and W = OE - S*EP. */
13997 
13998     xep = *px - xe;
13999     yep = *py - ye;
14000     zep = *pz - ze;
14001     s = xoe * xep + yoe * yep + zoe * zep;
14002     if (s >= 0.) {
14003         goto L1;
14004     }
14005     s = oes / s;
14006     xw = xoe - s * xep;
14007     yw = yoe - s * yep;
14008     zw = zoe - s * zep;
14009 
14010 /* Map W into X = (W,HN), Y = (W,VN), compute Z = 1+S, and */
14011 /*   reset INIT. */
14012 
14013     *x = xw * xh + yw * yh + zw * zh;
14014     *y = xw * xv + yw * yv + zw * zv;
14015     *z__ = s + 1.;
14016     *init = FALSE_;
14017     *ier = 0;
14018     return 0;
14019 
14020 /* (OE,EP) .GE. 0. */
14021 
14022 L1:
14023     *ier = 1;
14024     return 0;
14025 
14026 /* O, E, and O+V are collinear. */
14027 
14028 L2:
14029     *ier = 2;
14030     return 0;
14031 } /* projct_ */

int random_ ( int *  ix,
int *  iy,
int *  iz,
double *  rannum 
)

Definition at line 17284 of file util_sparx.cpp.

17286 {
17287     static double x;
17288 
17289 
17290 /*   This routine returns pseudo-random numbers uniformly */
17291 /* distributed in the interval (0,1).  int seeds IX, IY, */
17292 /* and IZ should be initialized to values in the range 1 to */
17293 /* 30,000 before the first call to RANDOM, and should not */
17294 /* be altered between subsequent calls (unless a sequence */
17295 /* of random numbers is to be repeated by reinitializing the */
17296 /* seeds). */
17297 
17298 /* Reference:  B. A. Wichmann and I. D. Hill, An Efficient */
17299 /*             and Portable Pseudo-random Number Generator, */
17300 /*             Applied Statistics, Vol. 31, No. 2, 1982, */
17301 /*             pp. 188-190. */
17302 
17303     *ix = *ix * 171 % 30269;
17304     *iy = *iy * 172 % 30307;
17305     *iz = *iz * 170 % 30323;
17306     x = (double) (*ix) / 30269. + (double) (*iy) / 30307. + (
17307             double) (*iz) / 30323.;
17308     *rannum = x - (int) x;
17309     return 0;
17310 } /* random_ */

int scoord_ ( double *  px,
double *  py,
double *  pz,
double *  plat,
double *  plon,
double *  pnrm 
)

Definition at line 14033 of file util_sparx.cpp.

References sqrt().

14035 {
14036     /* Builtin functions */
14037     //double sqrt(double), atan2(double, double), asin(double);
14038 
14039 
14040 /* *********************************************************** */
14041 
14042 /*                                              From STRIPACK */
14043 /*                                            Robert J. Renka */
14044 /*                                  Dept. of Computer Science */
14045 /*                                       Univ. of North Texas */
14046 /*                                           renka@cs.unt.edu */
14047 /*                                                   08/27/90 */
14048 
14049 /*   This subroutine converts a point P from Cartesian coor- */
14050 /* dinates to spherical coordinates. */
14051 
14052 
14053 /* On input: */
14054 
14055 /*       PX,PY,PZ = Cartesian coordinates of P. */
14056 
14057 /* Input parameters are not altered by this routine. */
14058 
14059 /* On output: */
14060 
14061 /*       PLAT = Latitude of P in the range -PI/2 to PI/2, or */
14062 /*              0 if PNRM = 0.  PLAT should be scaled by */
14063 /*              180/PI to obtain the value in degrees. */
14064 
14065 /*       PLON = Longitude of P in the range -PI to PI, or 0 */
14066 /*              if P lies on the Z-axis.  PLON should be */
14067 /*              scaled by 180/PI to obtain the value in */
14068 /*              degrees. */
14069 
14070 /*       PNRM = Magnitude (Euclidean norm) of P. */
14071 
14072 /* Modules required by SCOORD:  None */
14073 
14074 /* Intrinsic functions called by SCOORD:  ASIN, ATAN2, SQRT */
14075 
14076 /* *********************************************************** */
14077 
14078     *pnrm = sqrt(*px * *px + *py * *py + *pz * *pz);
14079     if (*px != 0. || *py != 0.) {
14080         *plon = atan2(*py, *px);
14081     } else {
14082         *plon = 0.;
14083     }
14084     if (*pnrm != 0.) {
14085         *plat = asin(*pz / *pnrm);
14086     } else {
14087         *plat = 0.;
14088     }
14089     return 0;
14090 } /* scoord_ */

double store_ ( double *  x  ) 

Definition at line 14092 of file util_sparx.cpp.

References stcom_1, and stcom_::y.

Referenced by trfind_().

14093 {
14094     /* System generated locals */
14095     double ret_val;
14096 
14097 
14098 /* *********************************************************** */
14099 
14100 /*                                              From STRIPACK */
14101 /*                                            Robert J. Renka */
14102 /*                                  Dept. of Computer Science */
14103 /*                                       Univ. of North Texas */
14104 /*                                           renka@cs.unt.edu */
14105 /*                                                   05/09/92 */
14106 
14107 /*   This function forces its argument X to be stored in a */
14108 /* memory location, thus providing a means of determining */
14109 /* floating point number characteristics (such as the machine */
14110 /* precision) when it is necessary to avoid computation in */
14111 /* high precision registers. */
14112 
14113 
14114 /* On input: */
14115 
14116 /*       X = Value to be stored. */
14117 
14118 /* X is not altered by this function. */
14119 
14120 /* On output: */
14121 
14122 /*       STORE = Value of X after it has been stored and */
14123 /*               possibly truncated or rounded to the single */
14124 /*               precision word length. */
14125 
14126 /* Modules required by STORE:  None */
14127 
14128 /* *********************************************************** */
14129 
14130     stcom_1.y = *x;
14131     ret_val = stcom_1.y;
14132     return ret_val;
14133 } /* store_ */

int swap_ ( int *  in1,
int *  in2,
int *  io1,
int *  io2,
int *  list,
int *  lptr,
int *  lend,
int *  lp21 
)

Definition at line 14135 of file util_sparx.cpp.

References abs, and lstptr_().

Referenced by addnod_(), delnod_(), edge_(), and optim_().

14137 {
14138     /* System generated locals */
14139     int i__1;
14140 
14141     /* Local variables */
14142     static int lp, lph, lpsav;
14143     int lstptr_(int *, int *, int *, int *);
14144 
14145 
14146 /* *********************************************************** */
14147 
14148 /*                                              From STRIPACK */
14149 /*                                            Robert J. Renka */
14150 /*                                  Dept. of Computer Science */
14151 /*                                       Univ. of North Texas */
14152 /*                                           renka@cs.unt.edu */
14153 /*                                                   06/22/98 */
14154 
14155 /*   Given a triangulation of a set of points on the unit */
14156 /* sphere, this subroutine replaces a diagonal arc in a */
14157 /* strictly convex quadrilateral (defined by a pair of adja- */
14158 /* cent triangles) with the other diagonal.  Equivalently, a */
14159 /* pair of adjacent triangles is replaced by another pair */
14160 /* having the same union. */
14161 
14162 
14163 /* On input: */
14164 
14165 /*       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices of */
14166 /*                         the quadrilateral.  IO1-IO2 is re- */
14167 /*                         placed by IN1-IN2.  (IO1,IO2,IN1) */
14168 /*                         and (IO2,IO1,IN2) must be trian- */
14169 /*                         gles on input. */
14170 
14171 /* The above parameters are not altered by this routine. */
14172 
14173 /*       LIST,LPTR,LEND = Data structure defining the trian- */
14174 /*                        gulation.  Refer to Subroutine */
14175 /*                        TRMESH. */
14176 
14177 /* On output: */
14178 
14179 /*       LIST,LPTR,LEND = Data structure updated with the */
14180 /*                        swap -- triangles (IO1,IO2,IN1) and */
14181 /*                        (IO2,IO1,IN2) are replaced by */
14182 /*                        (IN1,IN2,IO2) and (IN2,IN1,IO1) */
14183 /*                        unless LP21 = 0. */
14184 
14185 /*       LP21 = Index of IN1 as a neighbor of IN2 after the */
14186 /*              swap is performed unless IN1 and IN2 are */
14187 /*              adjacent on input, in which case LP21 = 0. */
14188 
14189 /* Module required by SWAP:  LSTPTR */
14190 
14191 /* Intrinsic function called by SWAP:  ABS */
14192 
14193 /* *********************************************************** */
14194 
14195 
14196 /* Local parameters: */
14197 
14198 /* LP,LPH,LPSAV = LIST pointers */
14199 
14200 
14201 /* Test for IN1 and IN2 adjacent. */
14202 
14203     /* Parameter adjustments */
14204     --lend;
14205     --lptr;
14206     --list;
14207 
14208     /* Function Body */
14209     lp = lstptr_(&lend[*in1], in2, &list[1], &lptr[1]);
14210     if ((i__1 = list[lp], abs(i__1)) == *in2) {
14211         *lp21 = 0;
14212         return 0;
14213     }
14214 
14215 /* Delete IO2 as a neighbor of IO1. */
14216 
14217     lp = lstptr_(&lend[*io1], in2, &list[1], &lptr[1]);
14218     lph = lptr[lp];
14219     lptr[lp] = lptr[lph];
14220 
14221 /* If IO2 is the last neighbor of IO1, make IN2 the */
14222 /*   last neighbor. */
14223 
14224     if (lend[*io1] == lph) {
14225         lend[*io1] = lp;
14226     }
14227 
14228 /* Insert IN2 as a neighbor of IN1 following IO1 */
14229 /*   using the hole created above. */
14230 
14231     lp = lstptr_(&lend[*in1], io1, &list[1], &lptr[1]);
14232     lpsav = lptr[lp];
14233     lptr[lp] = lph;
14234     list[lph] = *in2;
14235     lptr[lph] = lpsav;
14236 
14237 /* Delete IO1 as a neighbor of IO2. */
14238 
14239     lp = lstptr_(&lend[*io2], in1, &list[1], &lptr[1]);
14240     lph = lptr[lp];
14241     lptr[lp] = lptr[lph];
14242 
14243 /* If IO1 is the last neighbor of IO2, make IN1 the */
14244 /*   last neighbor. */
14245 
14246     if (lend[*io2] == lph) {
14247         lend[*io2] = lp;
14248     }
14249 
14250 /* Insert IN1 as a neighbor of IN2 following IO2. */
14251 
14252     lp = lstptr_(&lend[*in2], io2, &list[1], &lptr[1]);
14253     lpsav = lptr[lp];
14254     lptr[lp] = lph;
14255     list[lph] = *in1;
14256     lptr[lph] = lpsav;
14257     *lp21 = lph;
14258     return 0;
14259 } /* swap_ */

long int swptst_ ( int *  n1,
int *  n2,
int *  n3,
int *  n4,
double *  x,
double *  y,
double *  z__ 
)

Definition at line 14261 of file util_sparx.cpp.

Referenced by addnod_(), crlist_(), and optim_().

14263 {
14264     /* System generated locals */
14265     long int ret_val;
14266 
14267     /* Local variables */
14268     static double x4, y4, z4, dx1, dx2, dx3, dy1, dy2, dy3, dz1, dz2, dz3;
14269 
14270 
14271 /* *********************************************************** */
14272 
14273 /*                                              From STRIPACK */
14274 /*                                            Robert J. Renka */
14275 /*                                  Dept. of Computer Science */
14276 /*                                       Univ. of North Texas */
14277 /*                                           renka@cs.unt.edu */
14278 /*                                                   03/29/91 */
14279 
14280 /*   This function decides whether or not to replace a */
14281 /* diagonal arc in a quadrilateral with the other diagonal. */
14282 /* The decision will be to swap (SWPTST = TRUE) if and only */
14283 /* if N4 lies above the plane (in the half-space not contain- */
14284 /* ing the origin) defined by (N1,N2,N3), or equivalently, if */
14285 /* the projection of N4 onto this plane is interior to the */
14286 /* circumcircle of (N1,N2,N3).  The decision will be for no */
14287 /* swap if the quadrilateral is not strictly convex. */
14288 
14289 
14290 /* On input: */
14291 
14292 /*       N1,N2,N3,N4 = Indexes of the four nodes defining the */
14293 /*                     quadrilateral with N1 adjacent to N2, */
14294 /*                     and (N1,N2,N3) in counterclockwise */
14295 /*                     order.  The arc connecting N1 to N2 */
14296 /*                     should be replaced by an arc connec- */
14297 /*                     ting N3 to N4 if SWPTST = TRUE.  Refer */
14298 /*                     to Subroutine SWAP. */
14299 
14300 /*       X,Y,Z = Arrays of length N containing the Cartesian */
14301 /*               coordinates of the nodes.  (X(I),Y(I),Z(I)) */
14302 /*               define node I for I = N1, N2, N3, and N4. */
14303 
14304 /* Input parameters are not altered by this routine. */
14305 
14306 /* On output: */
14307 
14308 /*       SWPTST = TRUE if and only if the arc connecting N1 */
14309 /*                and N2 should be swapped for an arc con- */
14310 /*                necting N3 and N4. */
14311 
14312 /* Modules required by SWPTST:  None */
14313 
14314 /* *********************************************************** */
14315 
14316 
14317 /* Local parameters: */
14318 
14319 /* DX1,DY1,DZ1 = Coordinates of N4->N1 */
14320 /* DX2,DY2,DZ2 = Coordinates of N4->N2 */
14321 /* DX3,DY3,DZ3 = Coordinates of N4->N3 */
14322 /* X4,Y4,Z4 =    Coordinates of N4 */
14323 
14324     /* Parameter adjustments */
14325     --z__;
14326     --y;
14327     --x;
14328 
14329     /* Function Body */
14330     x4 = x[*n4];
14331     y4 = y[*n4];
14332     z4 = z__[*n4];
14333     dx1 = x[*n1] - x4;
14334     dx2 = x[*n2] - x4;
14335     dx3 = x[*n3] - x4;
14336     dy1 = y[*n1] - y4;
14337     dy2 = y[*n2] - y4;
14338     dy3 = y[*n3] - y4;
14339     dz1 = z__[*n1] - z4;
14340     dz2 = z__[*n2] - z4;
14341     dz3 = z__[*n3] - z4;
14342 
14343 /* N4 lies above the plane of (N1,N2,N3) iff N3 lies above */
14344 /*   the plane of (N2,N1,N4) iff Det(N3-N4,N2-N4,N1-N4) = */
14345 /*   (N3-N4,N2-N4 X N1-N4) > 0. */
14346 
14347     ret_val = dx3 * (dy2 * dz1 - dy1 * dz2) - dy3 * (dx2 * dz1 - dx1 * dz2) +
14348             dz3 * (dx2 * dy1 - dx1 * dy2) > 0.;
14349     return ret_val;
14350 } /* swptst_ */

int trans_ ( int *  n,
double *  rlat,
double *  rlon,
double *  x,
double *  y,
double *  z__ 
)

Definition at line 14352 of file util_sparx.cpp.

References nn(), phi, and theta.

14354 {
14355     /* System generated locals */
14356     int i__1;
14357 
14358     /* Builtin functions */
14359     //double cos(double), sin(double);
14360 
14361     /* Local variables */
14362     static int i__, nn;
14363     static double phi, theta, cosphi;
14364 
14365 
14366 /* *********************************************************** */
14367 
14368 /*                                              From STRIPACK */
14369 /*                                            Robert J. Renka */
14370 /*                                  Dept. of Computer Science */
14371 /*                                       Univ. of North Texas */
14372 /*                                           renka@cs.unt.edu */
14373 /*                                                   04/08/90 */
14374 
14375 /*   This subroutine transforms spherical coordinates into */
14376 /* Cartesian coordinates on the unit sphere for input to */
14377 /* Subroutine TRMESH.  Storage for X and Y may coincide with */
14378 /* storage for RLAT and RLON if the latter need not be saved. */
14379 
14380 
14381 /* On input: */
14382 
14383 /*       N = Number of nodes (points on the unit sphere) */
14384 /*           whose coordinates are to be transformed. */
14385 
14386 /*       RLAT = Array of length N containing latitudinal */
14387 /*              coordinates of the nodes in radians. */
14388 
14389 /*       RLON = Array of length N containing longitudinal */
14390 /*              coordinates of the nodes in radians. */
14391 
14392 /* The above parameters are not altered by this routine. */
14393 
14394 /*       X,Y,Z = Arrays of length at least N. */
14395 
14396 /* On output: */
14397 
14398 /*       X,Y,Z = Cartesian coordinates in the range -1 to 1. */
14399 /*               X(I)**2 + Y(I)**2 + Z(I)**2 = 1 for I = 1 */
14400 /*               to N. */
14401 
14402 /* Modules required by TRANS:  None */
14403 
14404 /* Intrinsic functions called by TRANS:  COS, SIN */
14405 
14406 /* *********************************************************** */
14407 
14408 
14409 /* Local parameters: */
14410 
14411 /* COSPHI = cos(PHI) */
14412 /* I =      DO-loop index */
14413 /* NN =     Local copy of N */
14414 /* PHI =    Latitude */
14415 /* THETA =  Longitude */
14416 
14417     /* Parameter adjustments */
14418     --z__;
14419     --y;
14420     --x;
14421     --rlon;
14422     --rlat;
14423 
14424     /* Function Body */
14425     nn = *n;
14426     i__1 = nn;
14427     for (i__ = 1; i__ <= i__1; ++i__) {
14428         phi = rlat[i__];
14429         theta = rlon[i__];
14430         cosphi = cos(phi);
14431         x[i__] = cosphi * cos(theta);
14432         y[i__] = cosphi * sin(theta);
14433         z__[i__] = sin(phi);
14434 /* L1: */
14435     }
14436     return 0;
14437 } /* trans_ */

int trfind_ ( int *  nst,
double *  p,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
double *  b1,
double *  b2,
double *  b3,
int *  i1,
int *  i2,
int *  i3 
)

Definition at line 14439 of file util_sparx.cpp.

References abs, jrand_(), lstptr_(), q, and store_().

Referenced by addnod_(), and nearnd_().

14443 {
14444     /* Initialized data */
14445 
14446     static int ix = 1;
14447     static int iy = 2;
14448     static int iz = 3;
14449 
14450     /* System generated locals */
14451     int i__1;
14452     double d__1, d__2;
14453 
14454     /* Local variables */
14455     static double q[3];
14456     static int n0, n1, n2, n3, n4, nf;
14457     static double s12;
14458     static int nl, lp;
14459     static double xp, yp, zp;
14460     static int n1s, n2s;
14461     static double eps, tol, ptn1, ptn2;
14462     static int next;
14463     int jrand_(int *, int *, int *, int *);
14464     double store_(double *);
14465     int lstptr_(int *, int *, int *, int *);
14466 
14467 
14468 /* *********************************************************** */
14469 
14470 /*                                              From STRIPACK */
14471 /*                                            Robert J. Renka */
14472 /*                                  Dept. of Computer Science */
14473 /*                                       Univ. of North Texas */
14474 /*                                           renka@cs.unt.edu */
14475 /*                                                   11/30/99 */
14476 
14477 /*   This subroutine locates a point P relative to a triangu- */
14478 /* lation created by Subroutine TRMESH.  If P is contained in */
14479 /* a triangle, the three vertex indexes and barycentric coor- */
14480 /* dinates are returned.  Otherwise, the indexes of the */
14481 /* visible boundary nodes are returned. */
14482 
14483 
14484 /* On input: */
14485 
14486 /*       NST = Index of a node at which TRFIND begins its */
14487 /*             search.  Search time depends on the proximity */
14488 /*             of this node to P. */
14489 
14490 /*       P = Array of length 3 containing the x, y, and z */
14491 /*           coordinates (in that order) of the point P to be */
14492 /*           located. */
14493 
14494 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
14495 
14496 /*       X,Y,Z = Arrays of length N containing the Cartesian */
14497 /*               coordinates of the triangulation nodes (unit */
14498 /*               vectors).  (X(I),Y(I),Z(I)) defines node I */
14499 /*               for I = 1 to N. */
14500 
14501 /*       LIST,LPTR,LEND = Data structure defining the trian- */
14502 /*                        gulation.  Refer to Subroutine */
14503 /*                        TRMESH. */
14504 
14505 /* Input parameters are not altered by this routine. */
14506 
14507 /* On output: */
14508 
14509 /*       B1,B2,B3 = Unnormalized barycentric coordinates of */
14510 /*                  the central projection of P onto the un- */
14511 /*                  derlying planar triangle if P is in the */
14512 /*                  convex hull of the nodes.  These parame- */
14513 /*                  ters are not altered if I1 = 0. */
14514 
14515 /*       I1,I2,I3 = Counterclockwise-ordered vertex indexes */
14516 /*                  of a triangle containing P if P is con- */
14517 /*                  tained in a triangle.  If P is not in the */
14518 /*                  convex hull of the nodes, I1 and I2 are */
14519 /*                  the rightmost and leftmost (boundary) */
14520 /*                  nodes that are visible from P, and */
14521 /*                  I3 = 0.  (If all boundary nodes are vis- */
14522 /*                  ible from P, then I1 and I2 coincide.) */
14523 /*                  I1 = I2 = I3 = 0 if P and all of the */
14524 /*                  nodes are coplanar (lie on a common great */
14525 /*                  circle. */
14526 
14527 /* Modules required by TRFIND:  JRAND, LSTPTR, STORE */
14528 
14529 /* Intrinsic function called by TRFIND:  ABS */
14530 
14531 /* *********************************************************** */
14532 
14533 
14534     /* Parameter adjustments */
14535     --p;
14536     --lend;
14537     --z__;
14538     --y;
14539     --x;
14540     --list;
14541     --lptr;
14542 
14543     /* Function Body */
14544 
14545 /* Local parameters: */
14546 
14547 /* EPS =      Machine precision */
14548 /* IX,IY,IZ = int seeds for JRAND */
14549 /* LP =       LIST pointer */
14550 /* N0,N1,N2 = Nodes in counterclockwise order defining a */
14551 /*              cone (with vertex N0) containing P, or end- */
14552 /*              points of a boundary edge such that P Right */
14553 /*              N1->N2 */
14554 /* N1S,N2S =  Initially-determined values of N1 and N2 */
14555 /* N3,N4 =    Nodes opposite N1->N2 and N2->N1, respectively */
14556 /* NEXT =     Candidate for I1 or I2 when P is exterior */
14557 /* NF,NL =    First and last neighbors of N0, or first */
14558 /*              (rightmost) and last (leftmost) nodes */
14559 /*              visible from P when P is exterior to the */
14560 /*              triangulation */
14561 /* PTN1 =     Scalar product <P,N1> */
14562 /* PTN2 =     Scalar product <P,N2> */
14563 /* Q =        (N2 X N1) X N2  or  N1 X (N2 X N1) -- used in */
14564 /*              the boundary traversal when P is exterior */
14565 /* S12 =      Scalar product <N1,N2> */
14566 /* TOL =      Tolerance (multiple of EPS) defining an upper */
14567 /*              bound on the magnitude of a negative bary- */
14568 /*              centric coordinate (B1 or B2) for P in a */
14569 /*              triangle -- used to avoid an infinite number */
14570 /*              of restarts with 0 <= B3 < EPS and B1 < 0 or */
14571 /*              B2 < 0 but small in magnitude */
14572 /* XP,YP,ZP = Local variables containing P(1), P(2), and P(3) */
14573 /* X0,Y0,Z0 = Dummy arguments for DET */
14574 /* X1,Y1,Z1 = Dummy arguments for DET */
14575 /* X2,Y2,Z2 = Dummy arguments for DET */
14576 
14577 /* Statement function: */
14578 
14579 /* DET(X1,...,Z0) .GE. 0 if and only if (X0,Y0,Z0) is in the */
14580 /*                       (closed) left hemisphere defined by */
14581 /*                       the plane containing (0,0,0), */
14582 /*                       (X1,Y1,Z1), and (X2,Y2,Z2), where */
14583 /*                       left is defined relative to an ob- */
14584 /*                       server at (X1,Y1,Z1) facing */
14585 /*                       (X2,Y2,Z2). */
14586 
14587 
14588 /* Initialize variables. */
14589 
14590     xp = p[1];
14591     yp = p[2];
14592     zp = p[3];
14593     n0 = *nst;
14594     if (n0 < 1 || n0 > *n) {
14595         n0 = jrand_(n, &ix, &iy, &iz);
14596     }
14597 
14598 /* Compute the relative machine precision EPS and TOL. */
14599 
14600     eps = 1.;
14601 L1:
14602     eps /= 2.;
14603     d__1 = eps + 1.;
14604     if (store_(&d__1) > 1.) {
14605         goto L1;
14606     }
14607     eps *= 2.;
14608     tol = eps * 4.;
14609 
14610 /* Set NF and NL to the first and last neighbors of N0, and */
14611 /*   initialize N1 = NF. */
14612 
14613 L2:
14614     lp = lend[n0];
14615     nl = list[lp];
14616     lp = lptr[lp];
14617     nf = list[lp];
14618     n1 = nf;
14619 
14620 /* Find a pair of adjacent neighbors N1,N2 of N0 that define */
14621 /*   a wedge containing P:  P LEFT N0->N1 and P RIGHT N0->N2. */
14622 
14623     if (nl > 0) {
14624 
14625 /*   N0 is an interior node.  Find N1. */
14626 
14627 L3:
14628         if (xp * (y[n0] * z__[n1] - y[n1] * z__[n0]) - yp * (x[n0] * z__[n1]
14629                 - x[n1] * z__[n0]) + zp * (x[n0] * y[n1] - x[n1] * y[n0]) <
14630                 -1e-10) {
14631             lp = lptr[lp];
14632             n1 = list[lp];
14633             if (n1 == nl) {
14634                 goto L6;
14635             }
14636             goto L3;
14637         }
14638     } else {
14639 
14640 /*   N0 is a boundary node.  Test for P exterior. */
14641 
14642         nl = -nl;
14643         if (xp * (y[n0] * z__[nf] - y[nf] * z__[n0]) - yp * (x[n0] * z__[nf]
14644                 - x[nf] * z__[n0]) + zp * (x[n0] * y[nf] - x[nf] * y[n0]) <
14645                 -1e-10) {
14646 
14647 /*   P is to the right of the boundary edge N0->NF. */
14648 
14649             n1 = n0;
14650             n2 = nf;
14651             goto L9;
14652         }
14653         if (xp * (y[nl] * z__[n0] - y[n0] * z__[nl]) - yp * (x[nl] * z__[n0]
14654                 - x[n0] * z__[nl]) + zp * (x[nl] * y[n0] - x[n0] * y[nl]) <
14655                 -1e-10) {
14656 
14657 /*   P is to the right of the boundary edge NL->N0. */
14658 
14659             n1 = nl;
14660             n2 = n0;
14661             goto L9;
14662         }
14663     }
14664 
14665 /* P is to the left of arcs N0->N1 and NL->N0.  Set N2 to the */
14666 /*   next neighbor of N0 (following N1). */
14667 
14668 L4:
14669     lp = lptr[lp];
14670     n2 = (i__1 = list[lp], abs(i__1));
14671     if (xp * (y[n0] * z__[n2] - y[n2] * z__[n0]) - yp * (x[n0] * z__[n2] - x[
14672             n2] * z__[n0]) + zp * (x[n0] * y[n2] - x[n2] * y[n0]) < -1e-10) {
14673         goto L7;
14674     }
14675     n1 = n2;
14676     if (n1 != nl) {
14677         goto L4;
14678     }
14679     if (xp * (y[n0] * z__[nf] - y[nf] * z__[n0]) - yp * (x[n0] * z__[nf] - x[
14680             nf] * z__[n0]) + zp * (x[n0] * y[nf] - x[nf] * y[n0]) < -1e-10) {
14681         goto L6;
14682     }
14683 
14684 /* P is left of or on arcs N0->NB for all neighbors NB */
14685 /*   of N0.  Test for P = +/-N0. */
14686 
14687     d__2 = (d__1 = x[n0] * xp + y[n0] * yp + z__[n0] * zp, abs(d__1));
14688     if (store_(&d__2) < 1. - eps * 4.) {
14689 
14690 /*   All points are collinear iff P Left NB->N0 for all */
14691 /*     neighbors NB of N0.  Search the neighbors of N0. */
14692 /*     Note:  N1 = NL and LP points to NL. */
14693 
14694 L5:
14695         if (xp * (y[n1] * z__[n0] - y[n0] * z__[n1]) - yp * (x[n1] * z__[n0]
14696                 - x[n0] * z__[n1]) + zp * (x[n1] * y[n0] - x[n0] * y[n1]) >
14697                 -1e-10) {
14698             lp = lptr[lp];
14699             n1 = (i__1 = list[lp], abs(i__1));
14700             if (n1 == nl) {
14701                 goto L14;
14702             }
14703             goto L5;
14704         }
14705     }
14706 
14707 /* P is to the right of N1->N0, or P = +/-N0.  Set N0 to N1 */
14708 /*   and start over. */
14709 
14710     n0 = n1;
14711     goto L2;
14712 
14713 /* P is between arcs N0->N1 and N0->NF. */
14714 
14715 L6:
14716     n2 = nf;
14717 
14718 /* P is contained in a wedge defined by geodesics N0-N1 and */
14719 /*   N0-N2, where N1 is adjacent to N2.  Save N1 and N2 to */
14720 /*   test for cycling. */
14721 
14722 L7:
14723     n3 = n0;
14724     n1s = n1;
14725     n2s = n2;
14726 
14727 /* Top of edge-hopping loop: */
14728 
14729 L8:
14730 
14731     *b3 = xp * (y[n1] * z__[n2] - y[n2] * z__[n1]) - yp * (x[n1] * z__[n2] -
14732             x[n2] * z__[n1]) + zp * (x[n1] * y[n2] - x[n2] * y[n1]);
14733      if (*b3 < -1e-10) {
14734 
14735 /*   Set N4 to the first neighbor of N2 following N1 (the */
14736 /*     node opposite N2->N1) unless N1->N2 is a boundary arc. */
14737 
14738         lp = lstptr_(&lend[n2], &n1, &list[1], &lptr[1]);
14739         if (list[lp] < 0) {
14740             goto L9;
14741         }
14742         lp = lptr[lp];
14743         n4 = (i__1 = list[lp], abs(i__1));
14744 
14745 /*   Define a new arc N1->N2 which intersects the geodesic */
14746 /*     N0-P. */
14747         if (xp * (y[n0] * z__[n4] - y[n4] * z__[n0]) - yp * (x[n0] * z__[n4]
14748                 - x[n4] * z__[n0]) + zp * (x[n0] * y[n4] - x[n4] * y[n0]) <
14749                 -1e-10) {
14750             n3 = n2;
14751             n2 = n4;
14752             n1s = n1;
14753             if (n2 != n2s && n2 != n0) {
14754                 goto L8;
14755             }
14756         } else {
14757             n3 = n1;
14758             n1 = n4;
14759             n2s = n2;
14760             if (n1 != n1s && n1 != n0) {
14761                 goto L8;
14762             }
14763         }
14764 
14765 /*   The starting node N0 or edge N1-N2 was encountered */
14766 /*     again, implying a cycle (infinite loop).  Restart */
14767 /*     with N0 randomly selected. */
14768 
14769         n0 = jrand_(n, &ix, &iy, &iz);
14770         goto L2;
14771     }
14772 
14773 /* P is in (N1,N2,N3) unless N0, N1, N2, and P are collinear */
14774 /*   or P is close to -N0. */
14775 
14776     if (*b3 >= eps) {
14777 
14778 /*   B3 .NE. 0. */
14779 
14780         *b1 = xp * (y[n2] * z__[n3] - y[n3] * z__[n2]) - yp * (x[n2] * z__[n3]
14781                  - x[n3] * z__[n2]) + zp * (x[n2] * y[n3] - x[n3] * y[n2]);
14782         *b2 = xp * (y[n3] * z__[n1] - y[n1] * z__[n3]) - yp * (x[n3] * z__[n1]
14783                  - x[n1] * z__[n3]) + zp * (x[n3] * y[n1] - x[n1] * y[n3]);
14784         if (*b1 < -tol || *b2 < -tol) {
14785 
14786 /*   Restart with N0 randomly selected. */
14787 
14788             n0 = jrand_(n, &ix, &iy, &iz);
14789             goto L2;
14790         }
14791     } else {
14792 
14793 /*   B3 = 0 and thus P lies on N1->N2. Compute */
14794 /*     B1 = Det(P,N2 X N1,N2) and B2 = Det(P,N1,N2 X N1). */
14795 
14796         *b3 = 0.;
14797         s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2];
14798         ptn1 = xp * x[n1] + yp * y[n1] + zp * z__[n1];
14799         ptn2 = xp * x[n2] + yp * y[n2] + zp * z__[n2];
14800         *b1 = ptn1 - s12 * ptn2;
14801         *b2 = ptn2 - s12 * ptn1;
14802         if (*b1 < -tol || *b2 < -tol) {
14803 
14804 /*   Restart with N0 randomly selected. */
14805 
14806             n0 = jrand_(n, &ix, &iy, &iz);
14807             goto L2;
14808         }
14809     }
14810 
14811 /* P is in (N1,N2,N3). */
14812 
14813     *i1 = n1;
14814     *i2 = n2;
14815     *i3 = n3;
14816     if (*b1 < 0.f) {
14817         *b1 = 0.f;
14818     }
14819     if (*b2 < 0.f) {
14820         *b2 = 0.f;
14821     }
14822     return 0;
14823 
14824 /* P Right N1->N2, where N1->N2 is a boundary edge. */
14825 /*   Save N1 and N2, and set NL = 0 to indicate that */
14826 /*   NL has not yet been found. */
14827 
14828 L9:
14829     n1s = n1;
14830     n2s = n2;
14831     nl = 0;
14832 
14833 /*           Counterclockwise Boundary Traversal: */
14834 
14835 L10:
14836 
14837     lp = lend[n2];
14838     lp = lptr[lp];
14839     next = list[lp];
14840      if (xp * (y[n2] * z__[next] - y[next] * z__[n2]) - yp * (x[n2] * z__[next]
14841              - x[next] * z__[n2]) + zp * (x[n2] * y[next] - x[next] * y[n2])
14842             >= -1e-10) {
14843 
14844 /*   N2 is the rightmost visible node if P Forward N2->N1 */
14845 /*     or NEXT Forward N2->N1.  Set Q to (N2 X N1) X N2. */
14846 
14847         s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2];
14848         q[0] = x[n1] - s12 * x[n2];
14849         q[1] = y[n1] - s12 * y[n2];
14850         q[2] = z__[n1] - s12 * z__[n2];
14851         if (xp * q[0] + yp * q[1] + zp * q[2] >= 0.) {
14852             goto L11;
14853         }
14854         if (x[next] * q[0] + y[next] * q[1] + z__[next] * q[2] >= 0.) {
14855             goto L11;
14856         }
14857 
14858 /*   N1, N2, NEXT, and P are nearly collinear, and N2 is */
14859 /*     the leftmost visible node. */
14860 
14861         nl = n2;
14862     }
14863 
14864 /* Bottom of counterclockwise loop: */
14865 
14866     n1 = n2;
14867     n2 = next;
14868     if (n2 != n1s) {
14869         goto L10;
14870     }
14871 
14872 /* All boundary nodes are visible from P. */
14873 
14874     *i1 = n1s;
14875     *i2 = n1s;
14876     *i3 = 0;
14877     return 0;
14878 
14879 /* N2 is the rightmost visible node. */
14880 
14881 L11:
14882     nf = n2;
14883     if (nl == 0) {
14884 
14885 /* Restore initial values of N1 and N2, and begin the search */
14886 /*   for the leftmost visible node. */
14887 
14888         n2 = n2s;
14889         n1 = n1s;
14890 
14891 /*           Clockwise Boundary Traversal: */
14892 
14893 L12:
14894         lp = lend[n1];
14895         next = -list[lp];
14896         if (xp * (y[next] * z__[n1] - y[n1] * z__[next]) - yp * (x[next] *
14897                 z__[n1] - x[n1] * z__[next]) + zp * (x[next] * y[n1] - x[n1] *
14898                  y[next]) >= -1e-10) {
14899 
14900 /*   N1 is the leftmost visible node if P or NEXT is */
14901 /*     forward of N1->N2.  Compute Q = N1 X (N2 X N1). */
14902 
14903             s12 = x[n1] * x[n2] + y[n1] * y[n2] + z__[n1] * z__[n2];
14904             q[0] = x[n2] - s12 * x[n1];
14905             q[1] = y[n2] - s12 * y[n1];
14906             q[2] = z__[n2] - s12 * z__[n1];
14907             if (xp * q[0] + yp * q[1] + zp * q[2] >= 0.) {
14908                 goto L13;
14909             }
14910             if (x[next] * q[0] + y[next] * q[1] + z__[next] * q[2] >= 0.) {
14911                 goto L13;
14912             }
14913 
14914 /*   P, NEXT, N1, and N2 are nearly collinear and N1 is the */
14915 /*     rightmost visible node. */
14916 
14917             nf = n1;
14918         }
14919 
14920 /* Bottom of clockwise loop: */
14921 
14922         n2 = n1;
14923         n1 = next;
14924         if (n1 != n1s) {
14925             goto L12;
14926         }
14927 
14928 /* All boundary nodes are visible from P. */
14929 
14930         *i1 = n1;
14931         *i2 = n1;
14932         *i3 = 0;
14933         return 0;
14934 
14935 /* N1 is the leftmost visible node. */
14936 
14937 L13:
14938         nl = n1;
14939     }
14940 
14941 /* NF and NL have been found. */
14942 
14943     *i1 = nf;
14944     *i2 = nl;
14945     *i3 = 0;
14946     return 0;
14947 
14948 /* All points are collinear (coplanar). */
14949 
14950 L14:
14951     *i1 = 0;
14952     *i2 = 0;
14953     *i3 = 0;
14954     return 0;
14955 } /* trfind_ */

int trlist_ ( int *  n,
int *  list,
int *  lptr,
int *  lend,
int *  nrow,
int *  nt,
int *  ltri,
int *  ier 
)

Definition at line 14957 of file util_sparx.cpp.

References abs.

14960 {
14961     /* System generated locals */
14962     int ltri_dim1, ltri_offset, i__1, i__2;
14963 
14964     /* Local variables */
14965     static int i__, j, i1, i2, i3, n1, n2, n3, ka, kn, lp, kt, nm2, lp2,
14966             lpl, isv;
14967     static long int arcs;
14968     static int lpln1;
14969 
14970 
14971 /* *********************************************************** */
14972 
14973 /*                                              From STRIPACK */
14974 /*                                            Robert J. Renka */
14975 /*                                  Dept. of Computer Science */
14976 /*                                       Univ. of North Texas */
14977 /*                                           renka@cs.unt.edu */
14978 /*                                                   07/20/96 */
14979 
14980 /*   This subroutine converts a triangulation data structure */
14981 /* from the linked list created by Subroutine TRMESH to a */
14982 /* triangle list. */
14983 
14984 /* On input: */
14985 
14986 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
14987 
14988 /*       LIST,LPTR,LEND = Linked list data structure defin- */
14989 /*                        ing the triangulation.  Refer to */
14990 /*                        Subroutine TRMESH. */
14991 
14992 /*       NROW = Number of rows (entries per triangle) re- */
14993 /*              served for the triangle list LTRI.  The value */
14994 /*              must be 6 if only the vertex indexes and */
14995 /*              neighboring triangle indexes are to be */
14996 /*              stored, or 9 if arc indexes are also to be */
14997 /*              assigned and stored.  Refer to LTRI. */
14998 
14999 /* The above parameters are not altered by this routine. */
15000 
15001 /*       LTRI = int array of length at least NROW*NT, */
15002 /*              where NT is at most 2N-4.  (A sufficient */
15003 /*              length is 12N if NROW=6 or 18N if NROW=9.) */
15004 
15005 /* On output: */
15006 
15007 /*       NT = Number of triangles in the triangulation unless */
15008 /*            IER .NE. 0, in which case NT = 0.  NT = 2N-NB-2 */
15009 /*            if NB .GE. 3 or 2N-4 if NB = 0, where NB is the */
15010 /*            number of boundary nodes. */
15011 
15012 /*       LTRI = NROW by NT array whose J-th column contains */
15013 /*              the vertex nodal indexes (first three rows), */
15014 /*              neighboring triangle indexes (second three */
15015 /*              rows), and, if NROW = 9, arc indexes (last */
15016 /*              three rows) associated with triangle J for */
15017 /*              J = 1,...,NT.  The vertices are ordered */
15018 /*              counterclockwise with the first vertex taken */
15019 /*              to be the one with smallest index.  Thus, */
15020 /*              LTRI(2,J) and LTRI(3,J) are larger than */
15021 /*              LTRI(1,J) and index adjacent neighbors of */
15022 /*              node LTRI(1,J).  For I = 1,2,3, LTRI(I+3,J) */
15023 /*              and LTRI(I+6,J) index the triangle and arc, */
15024 /*              respectively, which are opposite (not shared */
15025 /*              by) node LTRI(I,J), with LTRI(I+3,J) = 0 if */
15026 /*              LTRI(I+6,J) indexes a boundary arc.  Vertex */
15027 /*              indexes range from 1 to N, triangle indexes */
15028 /*              from 0 to NT, and, if included, arc indexes */
15029 /*              from 1 to NA, where NA = 3N-NB-3 if NB .GE. 3 */
15030 /*              or 3N-6 if NB = 0.  The triangles are or- */
15031 /*              dered on first (smallest) vertex indexes. */
15032 
15033 /*       IER = Error indicator. */
15034 /*             IER = 0 if no errors were encountered. */
15035 /*             IER = 1 if N or NROW is outside its valid */
15036 /*                     range on input. */
15037 /*             IER = 2 if the triangulation data structure */
15038 /*                     (LIST,LPTR,LEND) is invalid.  Note, */
15039 /*                     however, that these arrays are not */
15040 /*                     completely tested for validity. */
15041 
15042 /* Modules required by TRLIST:  None */
15043 
15044 /* Intrinsic function called by TRLIST:  ABS */
15045 
15046 /* *********************************************************** */
15047 
15048 
15049 /* Local parameters: */
15050 
15051 /* ARCS =     long int variable with value TRUE iff are */
15052 /*              indexes are to be stored */
15053 /* I,J =      LTRI row indexes (1 to 3) associated with */
15054 /*              triangles KT and KN, respectively */
15055 /* I1,I2,I3 = Nodal indexes of triangle KN */
15056 /* ISV =      Variable used to permute indexes I1,I2,I3 */
15057 /* KA =       Arc index and number of currently stored arcs */
15058 /* KN =       Index of the triangle that shares arc I1-I2 */
15059 /*              with KT */
15060 /* KT =       Triangle index and number of currently stored */
15061 /*              triangles */
15062 /* LP =       LIST pointer */
15063 /* LP2 =      Pointer to N2 as a neighbor of N1 */
15064 /* LPL =      Pointer to the last neighbor of I1 */
15065 /* LPLN1 =    Pointer to the last neighbor of N1 */
15066 /* N1,N2,N3 = Nodal indexes of triangle KT */
15067 /* NM2 =      N-2 */
15068 
15069 
15070 /* Test for invalid input parameters. */
15071 
15072     /* Parameter adjustments */
15073     --lend;
15074     --list;
15075     --lptr;
15076     ltri_dim1 = *nrow;
15077     ltri_offset = 1 + ltri_dim1;
15078     ltri -= ltri_offset;
15079 
15080     /* Function Body */
15081     if (*n < 3 || (*nrow != 6 && *nrow != 9)) {
15082         goto L11;
15083     }
15084 
15085 /* Initialize parameters for loop on triangles KT = (N1,N2, */
15086 /*   N3), where N1 < N2 and N1 < N3. */
15087 
15088 /*   ARCS = TRUE iff arc indexes are to be stored. */
15089 /*   KA,KT = Numbers of currently stored arcs and triangles. */
15090 /*   NM2 = Upper bound on candidates for N1. */
15091 
15092     arcs = *nrow == 9;
15093     ka = 0;
15094     kt = 0;
15095     nm2 = *n - 2;
15096 
15097 /* Loop on nodes N1. */
15098 
15099     i__1 = nm2;
15100     for (n1 = 1; n1 <= i__1; ++n1) {
15101 
15102 /* Loop on pairs of adjacent neighbors (N2,N3).  LPLN1 points */
15103 /*   to the last neighbor of N1, and LP2 points to N2. */
15104 
15105         lpln1 = lend[n1];
15106         lp2 = lpln1;
15107 L1:
15108         lp2 = lptr[lp2];
15109         n2 = list[lp2];
15110         lp = lptr[lp2];
15111         n3 = (i__2 = list[lp], abs(i__2));
15112         if (n2 < n1 || n3 < n1) {
15113             goto L8;
15114         }
15115 
15116 /* Add a new triangle KT = (N1,N2,N3). */
15117 
15118         ++kt;
15119         ltri[kt * ltri_dim1 + 1] = n1;
15120         ltri[kt * ltri_dim1 + 2] = n2;
15121         ltri[kt * ltri_dim1 + 3] = n3;
15122 
15123 /* Loop on triangle sides (I2,I1) with neighboring triangles */
15124 /*   KN = (I1,I2,I3). */
15125 
15126         for (i__ = 1; i__ <= 3; ++i__) {
15127             if (i__ == 1) {
15128                 i1 = n3;
15129                 i2 = n2;
15130             } else if (i__ == 2) {
15131                 i1 = n1;
15132                 i2 = n3;
15133             } else {
15134                 i1 = n2;
15135                 i2 = n1;
15136             }
15137 
15138 /* Set I3 to the neighbor of I1 that follows I2 unless */
15139 /*   I2->I1 is a boundary arc. */
15140 
15141             lpl = lend[i1];
15142             lp = lptr[lpl];
15143 L2:
15144             if (list[lp] == i2) {
15145                 goto L3;
15146             }
15147             lp = lptr[lp];
15148             if (lp != lpl) {
15149                 goto L2;
15150             }
15151 
15152 /*   I2 is the last neighbor of I1 unless the data structure */
15153 /*     is invalid.  Bypass the search for a neighboring */
15154 /*     triangle if I2->I1 is a boundary arc. */
15155 
15156             if ((i__2 = list[lp], abs(i__2)) != i2) {
15157                 goto L12;
15158             }
15159             kn = 0;
15160             if (list[lp] < 0) {
15161                 goto L6;
15162             }
15163 
15164 /*   I2->I1 is not a boundary arc, and LP points to I2 as */
15165 /*     a neighbor of I1. */
15166 
15167 L3:
15168             lp = lptr[lp];
15169             i3 = (i__2 = list[lp], abs(i__2));
15170 
15171 /* Find J such that LTRI(J,KN) = I3 (not used if KN > KT), */
15172 /*   and permute the vertex indexes of KN so that I1 is */
15173 /*   smallest. */
15174 
15175             if (i1 < i2 && i1 < i3) {
15176                 j = 3;
15177             } else if (i2 < i3) {
15178                 j = 2;
15179                 isv = i1;
15180                 i1 = i2;
15181                 i2 = i3;
15182                 i3 = isv;
15183             } else {
15184                 j = 1;
15185                 isv = i1;
15186                 i1 = i3;
15187                 i3 = i2;
15188                 i2 = isv;
15189             }
15190 
15191 /* Test for KN > KT (triangle index not yet assigned). */
15192 
15193             if (i1 > n1) {
15194                 goto L7;
15195             }
15196 
15197 /* Find KN, if it exists, by searching the triangle list in */
15198 /*   reverse order. */
15199 
15200             for (kn = kt - 1; kn >= 1; --kn) {
15201                 if (ltri[kn * ltri_dim1 + 1] == i1 && ltri[kn * ltri_dim1 + 2]
15202                          == i2 && ltri[kn * ltri_dim1 + 3] == i3) {
15203                     goto L5;
15204                 }
15205 /* L4: */
15206             }
15207             goto L7;
15208 
15209 /* Store KT as a neighbor of KN. */
15210 
15211 L5:
15212             ltri[j + 3 + kn * ltri_dim1] = kt;
15213 
15214 /* Store KN as a neighbor of KT, and add a new arc KA. */
15215 
15216 L6:
15217             ltri[i__ + 3 + kt * ltri_dim1] = kn;
15218             if (arcs) {
15219                 ++ka;
15220                 ltri[i__ + 6 + kt * ltri_dim1] = ka;
15221                 if (kn != 0) {
15222                     ltri[j + 6 + kn * ltri_dim1] = ka;
15223                 }
15224             }
15225 L7:
15226             ;
15227         }
15228 
15229 /* Bottom of loop on triangles. */
15230 
15231 L8:
15232         if (lp2 != lpln1) {
15233             goto L1;
15234         }
15235 /* L9: */
15236     }
15237 
15238 /* No errors encountered. */
15239 
15240     *nt = kt;
15241     *ier = 0;
15242     return 0;
15243 
15244 /* Invalid input parameter. */
15245 
15246 L11:
15247     *nt = 0;
15248     *ier = 1;
15249     return 0;
15250 
15251 /* Invalid triangulation data structure:  I1 is a neighbor of */
15252 /*   I2, but I2 is not a neighbor of I1. */
15253 
15254 L12:
15255     *nt = 0;
15256     *ier = 2;
15257     return 0;
15258 } /* trlist_ */

int trlprt_ ( int *  n,
double *  x,
double *  y,
double *  z__,
int *  iflag,
int *  nrow,
int *  nt,
int *  ltri,
int *  lout 
)

Definition at line 15260 of file util_sparx.cpp.

15263 {
15264     /* Initialized data */
15265 
15266     static int nmax = 9999;
15267     static int nlmax = 58;
15268 
15269     /* System generated locals */
15270     int ltri_dim1, ltri_offset, i__1;
15271 
15272     /* Local variables */
15273     static int i__, k, na, nb, nl, lun;
15274 
15275 
15276 /* *********************************************************** */
15277 
15278 /*                                              From STRIPACK */
15279 /*                                            Robert J. Renka */
15280 /*                                  Dept. of Computer Science */
15281 /*                                       Univ. of North Texas */
15282 /*                                           renka@cs.unt.edu */
15283 /*                                                   07/02/98 */
15284 
15285 /*   This subroutine prints the triangle list created by Sub- */
15286 /* routine TRLIST and, optionally, the nodal coordinates */
15287 /* (either latitude and longitude or Cartesian coordinates) */
15288 /* on long int unit LOUT.  The numbers of boundary nodes, */
15289 /* triangles, and arcs are also printed. */
15290 
15291 
15292 /* On input: */
15293 
15294 /*       N = Number of nodes in the triangulation. */
15295 /*           3 .LE. N .LE. 9999. */
15296 
15297 /*       X,Y,Z = Arrays of length N containing the Cartesian */
15298 /*               coordinates of the nodes if IFLAG = 0, or */
15299 /*               (X and Y only) arrays of length N containing */
15300 /*               longitude and latitude, respectively, if */
15301 /*               IFLAG > 0, or unused dummy parameters if */
15302 /*               IFLAG < 0. */
15303 
15304 /*       IFLAG = Nodal coordinate option indicator: */
15305 /*               IFLAG = 0 if X, Y, and Z (assumed to contain */
15306 /*                         Cartesian coordinates) are to be */
15307 /*                         printed (to 6 decimal places). */
15308 /*               IFLAG > 0 if only X and Y (assumed to con- */
15309 /*                         tain longitude and latitude) are */
15310 /*                         to be printed (to 6 decimal */
15311 /*                         places). */
15312 /*               IFLAG < 0 if only the adjacency lists are to */
15313 /*                         be printed. */
15314 
15315 /*       NROW = Number of rows (entries per triangle) re- */
15316 /*              served for the triangle list LTRI.  The value */
15317 /*              must be 6 if only the vertex indexes and */
15318 /*              neighboring triangle indexes are stored, or 9 */
15319 /*              if arc indexes are also stored. */
15320 
15321 /*       NT = Number of triangles in the triangulation. */
15322 /*            1 .LE. NT .LE. 9999. */
15323 
15324 /*       LTRI = NROW by NT array whose J-th column contains */
15325 /*              the vertex nodal indexes (first three rows), */
15326 /*              neighboring triangle indexes (second three */
15327 /*              rows), and, if NROW = 9, arc indexes (last */
15328 /*              three rows) associated with triangle J for */
15329 /*              J = 1,...,NT. */
15330 
15331 /*       LOUT = long int unit number for output.  If LOUT is */
15332 /*              not in the range 0 to 99, output is written */
15333 /*              to unit 6. */
15334 
15335 /* Input parameters are not altered by this routine. */
15336 
15337 /* On output: */
15338 
15339 /*   The triangle list and nodal coordinates (as specified by */
15340 /* IFLAG) are written to unit LOUT. */
15341 
15342 /* Modules required by TRLPRT:  None */
15343 
15344 /* *********************************************************** */
15345 
15346     /* Parameter adjustments */
15347     --z__;
15348     --y;
15349     --x;
15350     ltri_dim1 = *nrow;
15351     ltri_offset = 1 + ltri_dim1;
15352     ltri -= ltri_offset;
15353 
15354     /* Function Body */
15355 
15356 /* Local parameters: */
15357 
15358 /* I =     DO-loop, nodal index, and row index for LTRI */
15359 /* K =     DO-loop and triangle index */
15360 /* LUN =   long int unit number for output */
15361 /* NA =    Number of triangulation arcs */
15362 /* NB =    Number of boundary nodes */
15363 /* NL =    Number of lines printed on the current page */
15364 /* NLMAX = Maximum number of print lines per page (except */
15365 /*           for the last page which may have two addi- */
15366 /*           tional lines) */
15367 /* NMAX =  Maximum value of N and NT (4-digit format) */
15368 
15369     lun = *lout;
15370     if (lun < 0 || lun > 99) {
15371         lun = 6;
15372     }
15373 
15374 /* Print a heading and test for invalid input. */
15375 
15376 /*      WRITE (LUN,100) N */
15377     nl = 3;
15378     if (*n < 3 || *n > nmax || (*nrow != 6 && *nrow != 9) || *nt < 1 || *nt >
15379             nmax) {
15380 
15381 /* Print an error message and exit. */
15382 
15383 /*        WRITE (LUN,110) N, NROW, NT */
15384         return 0;
15385     }
15386     if (*iflag == 0) {
15387 
15388 /* Print X, Y, and Z. */
15389 
15390 /*        WRITE (LUN,101) */
15391         nl = 6;
15392         i__1 = *n;
15393         for (i__ = 1; i__ <= i__1; ++i__) {
15394             if (nl >= nlmax) {
15395 /*            WRITE (LUN,108) */
15396                 nl = 0;
15397             }
15398 /*          WRITE (LUN,103) I, X(I), Y(I), Z(I) */
15399             ++nl;
15400 /* L1: */
15401         }
15402     } else if (*iflag > 0) {
15403 
15404 /* Print X (longitude) and Y (latitude). */
15405 
15406 /*        WRITE (LUN,102) */
15407         nl = 6;
15408         i__1 = *n;
15409         for (i__ = 1; i__ <= i__1; ++i__) {
15410             if (nl >= nlmax) {
15411 /*            WRITE (LUN,108) */
15412                 nl = 0;
15413             }
15414 /*          WRITE (LUN,104) I, X(I), Y(I) */
15415             ++nl;
15416 /* L2: */
15417         }
15418     }
15419 
15420 /* Print the triangulation LTRI. */
15421 
15422     if (nl > nlmax / 2) {
15423 /*        WRITE (LUN,108) */
15424         nl = 0;
15425     }
15426     if (*nrow == 6) {
15427 /*        WRITE (LUN,105) */
15428     } else {
15429 /*        WRITE (LUN,106) */
15430     }
15431     nl += 5;
15432     i__1 = *nt;
15433     for (k = 1; k <= i__1; ++k) {
15434         if (nl >= nlmax) {
15435 /*          WRITE (LUN,108) */
15436             nl = 0;
15437         }
15438 /*        WRITE (LUN,107) K, (LTRI(I,K), I = 1,NROW) */
15439         ++nl;
15440 /* L3: */
15441     }
15442 
15443 /* Print NB, NA, and NT (boundary nodes, arcs, and */
15444 /*   triangles). */
15445 
15446     nb = (*n << 1) - *nt - 2;
15447     if (nb < 3) {
15448         nb = 0;
15449         na = *n * 3 - 6;
15450     } else {
15451         na = *nt + *n - 1;
15452     }
15453 /*      WRITE (LUN,109) NB, NA, NT */
15454     return 0;
15455 
15456 /* Print formats: */
15457 
15458 /*  100 FORMAT (///18X,'STRIPACK (TRLIST) Output,  N = ',I4) */
15459 /*  101 FORMAT (//8X,'Node',10X,'X(Node)',10X,'Y(Node)',10X, */
15460 /*     .        'Z(Node)'//) */
15461 /*  102 FORMAT (//16X,'Node',8X,'Longitude',9X,'Latitude'//) */
15462 /*  103 FORMAT (8X,I4,3D17.6) */
15463 /*  104 FORMAT (16X,I4,2D17.6) */
15464 /*  105 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors'/ */
15465 /*     .        4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1',4X, */
15466 /*     .        'KT2',4X,'KT3'/) */
15467 /*  106 FORMAT (//1X,'Triangle',8X,'Vertices',12X,'Neighbors', */
15468 /*     .        14X,'Arcs'/ */
15469 /*     .        4X,'KT',7X,'N1',5X,'N2',5X,'N3',4X,'KT1',4X, */
15470 /*     .        'KT2',4X,'KT3',4X,'KA1',4X,'KA2',4X,'KA3'/) */
15471 /*  107 FORMAT (2X,I4,2X,6(3X,I4),3(2X,I5)) */
15472 /*  108 FORMAT (///) */
15473 /*  109 FORMAT (/1X,'NB = ',I4,' Boundary Nodes',5X, */
15474 /*     .        'NA = ',I5,' Arcs',5X,'NT = ',I5, */
15475 /*     .        ' Triangles') */
15476 /*  110 FORMAT (//1X,10X,'*** Invalid Parameter:  N =',I5, */
15477 /*     .        ', NROW =',I5,', NT =',I5,' ***') */
15478 } /* trlprt_ */

int trmesh_ ( int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
int *  lnew,
int *  near__,
int *  next,
double *  dist,
int *  ier 
)

Definition at line 15480 of file util_sparx.cpp.

References abs, addnod_(), left_(), and nn().

15483 {
15484     /* System generated locals */
15485     int i__1, i__2;
15486 
15487     /* Local variables */
15488     static double d__;
15489     static int i__, j, k;
15490     static double d1, d2, d3;
15491     static int i0, lp, nn, lpl;
15492     long int left_(double *, double *, double *, double
15493             *, double *, double *, double *, double *,
15494             double *);
15495     static int nexti;
15496 
15497 
15498 /* *********************************************************** */
15499 
15500 /*                                              From STRIPACK */
15501 /*                                            Robert J. Renka */
15502 /*                                  Dept. of Computer Science */
15503 /*                                       Univ. of North Texas */
15504 /*                                           renka@cs.unt.edu */
15505 /*                                                   03/04/03 */
15506 
15507 /*   This subroutine creates a Delaunay triangulation of a */
15508 /* set of N arbitrarily distributed points, referred to as */
15509 /* nodes, on the surface of the unit sphere.  The Delaunay */
15510 /* triangulation is defined as a set of (spherical) triangles */
15511 /* with the following five properties: */
15512 
15513 /*  1)  The triangle vertices are nodes. */
15514 /*  2)  No triangle contains a node other than its vertices. */
15515 /*  3)  The interiors of the triangles are pairwise disjoint. */
15516 /*  4)  The union of triangles is the convex hull of the set */
15517 /*        of nodes (the smallest convex set that contains */
15518 /*        the nodes).  If the nodes are not contained in a */
15519 /*        single hemisphere, their convex hull is the en- */
15520 /*        tire sphere and there are no boundary nodes. */
15521 /*        Otherwise, there are at least three boundary nodes. */
15522 /*  5)  The interior of the circumcircle of each triangle */
15523 /*        contains no node. */
15524 
15525 /* The first four properties define a triangulation, and the */
15526 /* last property results in a triangulation which is as close */
15527 /* as possible to equiangular in a certain sense and which is */
15528 /* uniquely defined unless four or more nodes lie in a common */
15529 /* plane.  This property makes the triangulation well-suited */
15530 /* for solving closest-point problems and for triangle-based */
15531 /* interpolation. */
15532 
15533 /*   The algorithm has expected time complexity O(N*log(N)) */
15534 /* for most nodal distributions. */
15535 
15536 /*   Spherical coordinates (latitude and longitude) may be */
15537 /* converted to Cartesian coordinates by Subroutine TRANS. */
15538 
15539 /*   The following is a list of the software package modules */
15540 /* which a user may wish to call directly: */
15541 
15542 /*  ADDNOD - Updates the triangulation by appending a new */
15543 /*             node. */
15544 
15545 /*  AREAS  - Returns the area of a spherical triangle. */
15546 
15547 /*  AREAV  - Returns the area of a Voronoi region associated */
15548 /*           with an interior node without requiring that the */
15549 /*           entire Voronoi diagram be computed and stored. */
15550 
15551 /*  BNODES - Returns an array containing the indexes of the */
15552 /*             boundary nodes (if any) in counterclockwise */
15553 /*             order.  Counts of boundary nodes, triangles, */
15554 /*             and arcs are also returned. */
15555 
15556 /*  CIRCLE - Computes the coordinates of a sequence of uni- */
15557 /*           formly spaced points on the unit circle centered */
15558 /*           at (0,0). */
15559 
15560 /*  CIRCUM - Returns the circumcenter of a spherical trian- */
15561 /*             gle. */
15562 
15563 /*  CRLIST - Returns the set of triangle circumcenters */
15564 /*             (Voronoi vertices) and circumradii associated */
15565 /*             with a triangulation. */
15566 
15567 /*  DELARC - Deletes a boundary arc from a triangulation. */
15568 
15569 /*  DELNOD - Updates the triangulation with a nodal deletion. */
15570 
15571 /*  EDGE   - Forces an arbitrary pair of nodes to be connec- */
15572 /*             ted by an arc in the triangulation. */
15573 
15574 /*  GETNP  - Determines the ordered sequence of L closest */
15575 /*             nodes to a given node, along with the associ- */
15576 /*             ated distances. */
15577 
15578 /*  INSIDE - Locates a point relative to a polygon on the */
15579 /*             surface of the sphere. */
15580 
15581 /*  INTRSC - Returns the point of intersection between a */
15582 /*             pair of great circle arcs. */
15583 
15584 /*  JRAND  - Generates a uniformly distributed pseudo-random */
15585 /*             int. */
15586 
15587 /*  LEFT   - Locates a point relative to a great circle. */
15588 
15589 /*  NEARND - Returns the index of the nearest node to an */
15590 /*             arbitrary point, along with its squared */
15591 /*             distance. */
15592 
15593 /*  PROJCT - Applies a perspective-depth projection to a */
15594 /*             point in 3-space. */
15595 
15596 /*  SCOORD - Converts a point from Cartesian coordinates to */
15597 /*             spherical coordinates. */
15598 
15599 /*  STORE  - Forces a value to be stored in main memory so */
15600 /*             that the precision of floating point numbers */
15601 /*             in memory locations rather than registers is */
15602 /*             computed. */
15603 
15604 /*  TRANS  - Transforms spherical coordinates into Cartesian */
15605 /*             coordinates on the unit sphere for input to */
15606 /*             Subroutine TRMESH. */
15607 
15608 /*  TRLIST - Converts the triangulation data structure to a */
15609 /*             triangle list more suitable for use in a fin- */
15610 /*             ite element code. */
15611 
15612 /*  TRLPRT - Prints the triangle list created by Subroutine */
15613 /*             TRLIST. */
15614 
15615 /*  TRMESH - Creates a Delaunay triangulation of a set of */
15616 /*             nodes. */
15617 
15618 /*  TRPLOT - Creates a level-2 Encapsulated Postscript (EPS) */
15619 /*             file containing a triangulation plot. */
15620 
15621 /*  TRPRNT - Prints the triangulation data structure and, */
15622 /*             optionally, the nodal coordinates. */
15623 
15624 /*  VRPLOT - Creates a level-2 Encapsulated Postscript (EPS) */
15625 /*             file containing a Voronoi diagram plot. */
15626 
15627 
15628 /* On input: */
15629 
15630 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
15631 
15632 /*       X,Y,Z = Arrays of length N containing the Cartesian */
15633 /*               coordinates of distinct nodes.  (X(K),Y(K), */
15634 /*               Z(K)) is referred to as node K, and K is re- */
15635 /*               ferred to as a nodal index.  It is required */
15636 /*               that X(K)**2 + Y(K)**2 + Z(K)**2 = 1 for all */
15637 /*               K.  The first three nodes must not be col- */
15638 /*               linear (lie on a common great circle). */
15639 
15640 /* The above parameters are not altered by this routine. */
15641 
15642 /*       LIST,LPTR = Arrays of length at least 6N-12. */
15643 
15644 /*       LEND = Array of length at least N. */
15645 
15646 /*       NEAR,NEXT,DIST = Work space arrays of length at */
15647 /*                        least N.  The space is used to */
15648 /*                        efficiently determine the nearest */
15649 /*                        triangulation node to each un- */
15650 /*                        processed node for use by ADDNOD. */
15651 
15652 /* On output: */
15653 
15654 /*       LIST = Set of nodal indexes which, along with LPTR, */
15655 /*              LEND, and LNEW, define the triangulation as a */
15656 /*              set of N adjacency lists -- counterclockwise- */
15657 /*              ordered sequences of neighboring nodes such */
15658 /*              that the first and last neighbors of a bound- */
15659 /*              ary node are boundary nodes (the first neigh- */
15660 /*              bor of an interior node is arbitrary).  In */
15661 /*              order to distinguish between interior and */
15662 /*              boundary nodes, the last neighbor of each */
15663 /*              boundary node is represented by the negative */
15664 /*              of its index. */
15665 
15666 /*       LPTR = Set of pointers (LIST indexes) in one-to-one */
15667 /*              correspondence with the elements of LIST. */
15668 /*              LIST(LPTR(I)) indexes the node which follows */
15669 /*              LIST(I) in cyclical counterclockwise order */
15670 /*              (the first neighbor follows the last neigh- */
15671 /*              bor). */
15672 
15673 /*       LEND = Set of pointers to adjacency lists.  LEND(K) */
15674 /*              points to the last neighbor of node K for */
15675 /*              K = 1,...,N.  Thus, LIST(LEND(K)) < 0 if and */
15676 /*              only if K is a boundary node. */
15677 
15678 /*       LNEW = Pointer to the first empty location in LIST */
15679 /*              and LPTR (list length plus one).  LIST, LPTR, */
15680 /*              LEND, and LNEW are not altered if IER < 0, */
15681 /*              and are incomplete if IER > 0. */
15682 
15683 /*       NEAR,NEXT,DIST = Garbage. */
15684 
15685 /*       IER = Error indicator: */
15686 /*             IER =  0 if no errors were encountered. */
15687 /*             IER = -1 if N < 3 on input. */
15688 /*             IER = -2 if the first three nodes are */
15689 /*                      collinear. */
15690 /*             IER =  L if nodes L and M coincide for some */
15691 /*                      M > L.  The data structure represents */
15692 /*                      a triangulation of nodes 1 to M-1 in */
15693 /*                      this case. */
15694 
15695 /* Modules required by TRMESH:  ADDNOD, BDYADD, COVSPH, */
15696 /*                                INSERT, INTADD, JRAND, */
15697 /*                                LEFT, LSTPTR, STORE, SWAP, */
15698 /*                                SWPTST, TRFIND */
15699 
15700 /* Intrinsic function called by TRMESH:  ABS */
15701 
15702 /* *********************************************************** */
15703 
15704 
15705 /* Local parameters: */
15706 
15707 /* D =        (Negative cosine of) distance from node K to */
15708 /*              node I */
15709 /* D1,D2,D3 = Distances from node K to nodes 1, 2, and 3, */
15710 /*              respectively */
15711 /* I,J =      Nodal indexes */
15712 /* I0 =       Index of the node preceding I in a sequence of */
15713 /*              unprocessed nodes:  I = NEXT(I0) */
15714 /* K =        Index of node to be added and DO-loop index: */
15715 /*              K > 3 */
15716 /* LP =       LIST index (pointer) of a neighbor of K */
15717 /* LPL =      Pointer to the last neighbor of K */
15718 /* NEXTI =    NEXT(I) */
15719 /* NN =       Local copy of N */
15720 
15721     /* Parameter adjustments */
15722     --dist;
15723     --next;
15724     --near__;
15725     --lend;
15726     --z__;
15727     --y;
15728     --x;
15729     --list;
15730     --lptr;
15731 
15732     /* Function Body */
15733     nn = *n;
15734     if (nn < 3) {
15735         *ier = -1;
15736         return 0;
15737     }
15738 
15739 /* Store the first triangle in the linked list. */
15740 
15741     if (! left_(&x[1], &y[1], &z__[1], &x[2], &y[2], &z__[2], &x[3], &y[3], &
15742             z__[3])) {
15743 
15744 /*   The first triangle is (3,2,1) = (2,1,3) = (1,3,2). */
15745 
15746         list[1] = 3;
15747         lptr[1] = 2;
15748         list[2] = -2;
15749         lptr[2] = 1;
15750         lend[1] = 2;
15751 
15752         list[3] = 1;
15753         lptr[3] = 4;
15754         list[4] = -3;
15755         lptr[4] = 3;
15756         lend[2] = 4;
15757 
15758         list[5] = 2;
15759         lptr[5] = 6;
15760         list[6] = -1;
15761         lptr[6] = 5;
15762         lend[3] = 6;
15763 
15764     } else if (! left_(&x[2], &y[2], &z__[2], &x[1], &y[1], &z__[1], &x[3], &
15765             y[3], &z__[3])) {
15766 
15767 /*   The first triangle is (1,2,3):  3 Strictly Left 1->2, */
15768 /*     i.e., node 3 lies in the left hemisphere defined by */
15769 /*     arc 1->2. */
15770 
15771         list[1] = 2;
15772         lptr[1] = 2;
15773         list[2] = -3;
15774         lptr[2] = 1;
15775         lend[1] = 2;
15776 
15777         list[3] = 3;
15778         lptr[3] = 4;
15779         list[4] = -1;
15780         lptr[4] = 3;
15781         lend[2] = 4;
15782 
15783         list[5] = 1;
15784         lptr[5] = 6;
15785         list[6] = -2;
15786         lptr[6] = 5;
15787         lend[3] = 6;
15788 
15789     } else {
15790 
15791 /*   The first three nodes are collinear. */
15792 
15793         *ier = -2;
15794         return 0;
15795     }
15796 
15797 /* Initialize LNEW and test for N = 3. */
15798 
15799     *lnew = 7;
15800     if (nn == 3) {
15801         *ier = 0;
15802         return 0;
15803     }
15804 
15805 /* A nearest-node data structure (NEAR, NEXT, and DIST) is */
15806 /*   used to obtain an expected-time (N*log(N)) incremental */
15807 /*   algorithm by enabling constant search time for locating */
15808 /*   each new node in the triangulation. */
15809 
15810 /* For each unprocessed node K, NEAR(K) is the index of the */
15811 /*   triangulation node closest to K (used as the starting */
15812 /*   point for the search in Subroutine TRFIND) and DIST(K) */
15813 /*   is an increasing function of the arc length (angular */
15814 /*   distance) between nodes K and NEAR(K):  -Cos(a) for arc */
15815 /*   length a. */
15816 
15817 /* Since it is necessary to efficiently find the subset of */
15818 /*   unprocessed nodes associated with each triangulation */
15819 /*   node J (those that have J as their NEAR entries), the */
15820 /*   subsets are stored in NEAR and NEXT as follows:  for */
15821 /*   each node J in the triangulation, I = NEAR(J) is the */
15822 /*   first unprocessed node in J's set (with I = 0 if the */
15823 /*   set is empty), L = NEXT(I) (if I > 0) is the second, */
15824 /*   NEXT(L) (if L > 0) is the third, etc.  The nodes in each */
15825 /*   set are initially ordered by increasing indexes (which */
15826 /*   maximizes efficiency) but that ordering is not main- */
15827 /*   tained as the data structure is updated. */
15828 
15829 /* Initialize the data structure for the single triangle. */
15830 
15831     near__[1] = 0;
15832     near__[2] = 0;
15833     near__[3] = 0;
15834     for (k = nn; k >= 4; --k) {
15835         d1 = -(x[k] * x[1] + y[k] * y[1] + z__[k] * z__[1]);
15836         d2 = -(x[k] * x[2] + y[k] * y[2] + z__[k] * z__[2]);
15837         d3 = -(x[k] * x[3] + y[k] * y[3] + z__[k] * z__[3]);
15838         if (d1 <= d2 && d1 <= d3) {
15839             near__[k] = 1;
15840             dist[k] = d1;
15841             next[k] = near__[1];
15842             near__[1] = k;
15843         } else if (d2 <= d1 && d2 <= d3) {
15844             near__[k] = 2;
15845             dist[k] = d2;
15846             next[k] = near__[2];
15847             near__[2] = k;
15848         } else {
15849             near__[k] = 3;
15850             dist[k] = d3;
15851             next[k] = near__[3];
15852             near__[3] = k;
15853         }
15854 /* L1: */
15855     }
15856 
15857 /* Add the remaining nodes */
15858 
15859     i__1 = nn;
15860     for (k = 4; k <= i__1; ++k) {
15861         addnod_(&near__[k], &k, &x[1], &y[1], &z__[1], &list[1], &lptr[1], &
15862                 lend[1], lnew, ier);
15863         if (*ier != 0) {
15864             return 0;
15865         }
15866 
15867 /* Remove K from the set of unprocessed nodes associated */
15868 /*   with NEAR(K). */
15869 
15870         i__ = near__[k];
15871         if (near__[i__] == k) {
15872             near__[i__] = next[k];
15873         } else {
15874             i__ = near__[i__];
15875 L2:
15876             i0 = i__;
15877             i__ = next[i0];
15878             if (i__ != k) {
15879                 goto L2;
15880             }
15881             next[i0] = next[k];
15882         }
15883         near__[k] = 0;
15884 
15885 /* Loop on neighbors J of node K. */
15886 
15887         lpl = lend[k];
15888         lp = lpl;
15889 L3:
15890         lp = lptr[lp];
15891         j = (i__2 = list[lp], abs(i__2));
15892 
15893 /* Loop on elements I in the sequence of unprocessed nodes */
15894 /*   associated with J:  K is a candidate for replacing J */
15895 /*   as the nearest triangulation node to I.  The next value */
15896 /*   of I in the sequence, NEXT(I), must be saved before I */
15897 /*   is moved because it is altered by adding I to K's set. */
15898 
15899         i__ = near__[j];
15900 L4:
15901         if (i__ == 0) {
15902             goto L5;
15903         }
15904         nexti = next[i__];
15905 
15906 /* Test for the distance from I to K less than the distance */
15907 /*   from I to J. */
15908 
15909         d__ = -(x[i__] * x[k] + y[i__] * y[k] + z__[i__] * z__[k]);
15910         if (d__ < dist[i__]) {
15911 
15912 /* Replace J by K as the nearest triangulation node to I: */
15913 /*   update NEAR(I) and DIST(I), and remove I from J's set */
15914 /*   of unprocessed nodes and add it to K's set. */
15915 
15916             near__[i__] = k;
15917             dist[i__] = d__;
15918             if (i__ == near__[j]) {
15919                 near__[j] = nexti;
15920             } else {
15921                 next[i0] = nexti;
15922             }
15923             next[i__] = near__[k];
15924             near__[k] = i__;
15925         } else {
15926             i0 = i__;
15927         }
15928 
15929 /* Bottom of loop on I. */
15930 
15931         i__ = nexti;
15932         goto L4;
15933 
15934 /* Bottom of loop on neighbors J. */
15935 
15936 L5:
15937         if (lp != lpl) {
15938             goto L3;
15939         }
15940 /* L6: */
15941     }
15942     return 0;
15943 } /* trmesh_ */

int trplot_ ( int *  lun,
double *  pltsiz,
double *  elat,
double *  elon,
double *  a,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
char *  ,
long int *  numbr,
int *  ier,
short   
)

Definition at line 15945 of file util_sparx.cpp.

References abs, drwarc_(), i_dnnt(), sqrt(), t, TRUE_, and wr.

15949 {
15950     /* Initialized data */
15951 
15952     static long int annot = TRUE_;
15953     static double fsizn = 10.;
15954     static double fsizt = 16.;
15955     static double tol = .5;
15956 
15957     /* System generated locals */
15958     int i__1, i__2;
15959     double d__1;
15960 
15961     /* Builtin functions */
15962     //double atan(double), sin(double);
15963     //int i_dnnt(double *);
15964     //double cos(double), sqrt(double);
15965 
15966     /* Local variables */
15967     static double t;
15968     static int n0, n1;
15969     static double p0[3], p1[3], cf, r11, r12, r21, ct, r22, r23, sf;
15970     static int ir, lp;
15971     static double ex, ey, ez, wr, tx, ty;
15972     static int lpl;
15973     static double wrs;
15974     static int ipx1, ipx2, ipy1, ipy2, nseg;
15975     /* Subroutine */ int drwarc_(int *, double *, double *,
15976              double *, int *);
15977 
15978 
15979 /* *********************************************************** */
15980 
15981 /*                                              From STRIPACK */
15982 /*                                            Robert J. Renka */
15983 /*                                  Dept. of Computer Science */
15984 /*                                       Univ. of North Texas */
15985 /*                                           renka@cs.unt.edu */
15986 /*                                                   03/04/03 */
15987 
15988 /*   This subroutine creates a level-2 Encapsulated Post- */
15989 /* script (EPS) file containing a graphical display of a */
15990 /* triangulation of a set of nodes on the surface of the unit */
15991 /* sphere.  The visible portion of the triangulation is */
15992 /* projected onto the plane that contains the origin and has */
15993 /* normal defined by a user-specified eye-position. */
15994 
15995 
15996 /* On input: */
15997 
15998 /*       LUN = long int unit number in the range 0 to 99. */
15999 /*             The unit should be opened with an appropriate */
16000 /*             file name before the call to this routine. */
16001 
16002 /*       PLTSIZ = Plot size in inches.  A circular window in */
16003 /*                the projection plane is mapped to a circu- */
16004 /*                lar viewport with diameter equal to .88* */
16005 /*                PLTSIZ (leaving room for labels outside the */
16006 /*                viewport).  The viewport is centered on the */
16007 /*                8.5 by 11 inch page, and its boundary is */
16008 /*                drawn.  1.0 .LE. PLTSIZ .LE. 8.5. */
16009 
16010 /*       ELAT,ELON = Latitude and longitude (in degrees) of */
16011 /*                   the center of projection E (the center */
16012 /*                   of the plot).  The projection plane is */
16013 /*                   the plane that contains the origin and */
16014 /*                   has E as unit normal.  In a rotated */
16015 /*                   coordinate system for which E is the */
16016 /*                   north pole, the projection plane con- */
16017 /*                   tains the equator, and only northern */
16018 /*                   hemisphere nodes are visible (from the */
16019 /*                   point at infinity in the direction E). */
16020 /*                   These are projected orthogonally onto */
16021 /*                   the projection plane (by zeroing the z- */
16022 /*                   component in the rotated coordinate */
16023 /*                   system).  ELAT and ELON must be in the */
16024 /*                   range -90 to 90 and -180 to 180, respec- */
16025 /*                   tively. */
16026 
16027 /*       A = Angular distance in degrees from E to the boun- */
16028 /*           dary of a circular window against which the */
16029 /*           triangulation is clipped.  The projected window */
16030 /*           is a disk of radius r = Sin(A) centered at the */
16031 /*           origin, and only visible nodes whose projections */
16032 /*           are within distance r of the origin are included */
16033 /*           in the plot.  Thus, if A = 90, the plot includes */
16034 /*           the entire hemisphere centered at E.  0 .LT. A */
16035 /*           .LE. 90. */
16036 
16037 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
16038 
16039 /*       X,Y,Z = Arrays of length N containing the Cartesian */
16040 /*               coordinates of the nodes (unit vectors). */
16041 
16042 /*       LIST,LPTR,LEND = Data structure defining the trian- */
16043 /*                        gulation.  Refer to Subroutine */
16044 /*                        TRMESH. */
16045 
16046 /*       TITLE = Type CHARACTER variable or constant contain- */
16047 /*               ing a string to be centered above the plot. */
16048 /*               The string must be enclosed in parentheses; */
16049 /*               i.e., the first and last characters must be */
16050 /*               '(' and ')', respectively, but these are not */
16051 /*               displayed.  TITLE may have at most 80 char- */
16052 /*               acters including the parentheses. */
16053 
16054 /*       NUMBR = Option indicator:  If NUMBR = TRUE, the */
16055 /*               nodal indexes are plotted next to the nodes. */
16056 
16057 /* Input parameters are not altered by this routine. */
16058 
16059 /* On output: */
16060 
16061 /*       IER = Error indicator: */
16062 /*             IER = 0 if no errors were encountered. */
16063 /*             IER = 1 if LUN, PLTSIZ, or N is outside its */
16064 /*                     valid range. */
16065 /*             IER = 2 if ELAT, ELON, or A is outside its */
16066 /*                     valid range. */
16067 /*             IER = 3 if an error was encountered in writing */
16068 /*                     to unit LUN. */
16069 
16070 /*   The values in the data statement below may be altered */
16071 /* in order to modify various plotting options. */
16072 
16073 /* Module required by TRPLOT:  DRWARC */
16074 
16075 /* Intrinsic functions called by TRPLOT:  ABS, ATAN, COS, */
16076 /*                                          DBLE, NINT, SIN, */
16077 /*                                          SQRT */
16078 
16079 /* *********************************************************** */
16080 
16081 
16082     /* Parameter adjustments */
16083     --lend;
16084     --z__;
16085     --y;
16086     --x;
16087     --list;
16088     --lptr;
16089 
16090     /* Function Body */
16091 
16092 /* Local parameters: */
16093 
16094 /* ANNOT =     long int variable with value TRUE iff the plot */
16095 /*               is to be annotated with the values of ELAT, */
16096 /*               ELON, and A */
16097 /* CF =        Conversion factor for degrees to radians */
16098 /* CT =        Cos(ELAT) */
16099 /* EX,EY,EZ =  Cartesian coordinates of the eye-position E */
16100 /* FSIZN =     Font size in points for labeling nodes with */
16101 /*               their indexes if NUMBR = TRUE */
16102 /* FSIZT =     Font size in points for the title (and */
16103 /*               annotation if ANNOT = TRUE) */
16104 /* IPX1,IPY1 = X and y coordinates (in points) of the lower */
16105 /*               left corner of the bounding box or viewport */
16106 /*               box */
16107 /* IPX2,IPY2 = X and y coordinates (in points) of the upper */
16108 /*               right corner of the bounding box or viewport */
16109 /*               box */
16110 /* IR =        Half the width (height) of the bounding box or */
16111 /*               viewport box in points -- viewport radius */
16112 /* LP =        LIST index (pointer) */
16113 /* LPL =       Pointer to the last neighbor of N0 */
16114 /* N0 =        Index of a node whose incident arcs are to be */
16115 /*               drawn */
16116 /* N1 =        Neighbor of N0 */
16117 /* NSEG =      Number of line segments used by DRWARC in a */
16118 /*               polygonal approximation to a projected edge */
16119 /* P0 =        Coordinates of N0 in the rotated coordinate */
16120 /*               system or label location (first two */
16121 /*               components) */
16122 /* P1 =        Coordinates of N1 in the rotated coordinate */
16123 /*               system or intersection of edge N0-N1 with */
16124 /*               the equator (in the rotated coordinate */
16125 /*               system) */
16126 /* R11...R23 = Components of the first two rows of a rotation */
16127 /*               that maps E to the north pole (0,0,1) */
16128 /* SF =        Scale factor for mapping world coordinates */
16129 /*               (window coordinates in [-WR,WR] X [-WR,WR]) */
16130 /*               to viewport coordinates in [IPX1,IPX2] X */
16131 /*               [IPY1,IPY2] */
16132 /* T =         Temporary variable */
16133 /* TOL =       Maximum distance in points between a projected */
16134 /*               triangulation edge and its approximation by */
16135 /*               a polygonal curve */
16136 /* TX,TY =     Translation vector for mapping world coordi- */
16137 /*               nates to viewport coordinates */
16138 /* WR =        Window radius r = Sin(A) */
16139 /* WRS =       WR**2 */
16140 
16141 
16142 /* Test for invalid parameters. */
16143 
16144     if (*lun < 0 || *lun > 99 || *pltsiz < 1. || *pltsiz > 8.5 || *n < 3) {
16145         goto L11;
16146     }
16147     if (abs(*elat) > 90. || abs(*elon) > 180. || *a > 90.) {
16148         goto L12;
16149     }
16150 
16151 /* Compute a conversion factor CF for degrees to radians */
16152 /*   and compute the window radius WR. */
16153 
16154     cf = atan(1.) / 45.;
16155     wr = sin(cf * *a);
16156     wrs = wr * wr;
16157 
16158 /* Compute the lower left (IPX1,IPY1) and upper right */
16159 /*   (IPX2,IPY2) corner coordinates of the bounding box. */
16160 /*   The coordinates, specified in default user space units */
16161 /*   (points, at 72 points/inch with origin at the lower */
16162 /*   left corner of the page), are chosen to preserve the */
16163 /*   square aspect ratio, and to center the plot on the 8.5 */
16164 /*   by 11 inch page.  The center of the page is (306,396), */
16165 /*   and IR = PLTSIZ/2 in points. */
16166 
16167     d__1 = *pltsiz * 36.;
16168     ir = i_dnnt(&d__1);
16169     ipx1 = 306 - ir;
16170     ipx2 = ir + 306;
16171     ipy1 = 396 - ir;
16172     ipy2 = ir + 396;
16173 
16174 /* Output header comments. */
16175 
16176 /*      WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 */
16177 /*  100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/ */
16178 /*     .        '%%BoundingBox:',4I4/ */
16179 /*     .        '%%Title:  Triangulation'/ */
16180 /*     .        '%%Creator:  STRIPACK'/ */
16181 /*     .        '%%EndComments') */
16182 
16183 /* Set (IPX1,IPY1) and (IPX2,IPY2) to the corner coordinates */
16184 /*   of a viewport box obtained by shrinking the bounding box */
16185 /*   by 12% in each dimension. */
16186 
16187     d__1 = (double) ir * .88;
16188     ir = i_dnnt(&d__1);
16189     ipx1 = 306 - ir;
16190     ipx2 = ir + 306;
16191     ipy1 = 396 - ir;
16192     ipy2 = ir + 396;
16193 
16194 /* Set the line thickness to 2 points, and draw the */
16195 /*   viewport boundary. */
16196 
16197     t = 2.;
16198 /*      WRITE (LUN,110,ERR=13) T */
16199 /*      WRITE (LUN,120,ERR=13) IR */
16200 /*      WRITE (LUN,130,ERR=13) */
16201 /*  110 FORMAT (F12.6,' setlinewidth') */
16202 /*  120 FORMAT ('306 396 ',I3,' 0 360 arc') */
16203 /*  130 FORMAT ('stroke') */
16204 
16205 /* Set up an affine mapping from the window box [-WR,WR] X */
16206 /*   [-WR,WR] to the viewport box. */
16207 
16208     sf = (double) ir / wr;
16209     tx = ipx1 + sf * wr;
16210     ty = ipy1 + sf * wr;
16211 /*      WRITE (LUN,140,ERR=13) TX, TY, SF, SF */
16212 /*  140 FORMAT (2F12.6,' translate'/ */
16213 /*    .        2F12.6,' scale') */
16214 
16215 /* The line thickness must be changed to reflect the new */
16216 /*   scaling which is applied to all subsequent output. */
16217 /*   Set it to 1.0 point. */
16218 
16219     t = 1. / sf;
16220 /*      WRITE (LUN,110,ERR=13) T */
16221 
16222 /* Save the current graphics state, and set the clip path to */
16223 /*   the boundary of the window. */
16224 
16225 /*      WRITE (LUN,150,ERR=13) */
16226 /*      WRITE (LUN,160,ERR=13) WR */
16227 /*      WRITE (LUN,170,ERR=13) */
16228 /*  150 FORMAT ('gsave') */
16229 /*  160 FORMAT ('0 0 ',F12.6,' 0 360 arc') */
16230 /*  170 FORMAT ('clip newpath') */
16231 
16232 /* Compute the Cartesian coordinates of E and the components */
16233 /*   of a rotation R which maps E to the north pole (0,0,1). */
16234 /*   R is taken to be a rotation about the z-axis (into the */
16235 /*   yz-plane) followed by a rotation about the x-axis chosen */
16236 /*   so that the view-up direction is (0,0,1), or (-1,0,0) if */
16237 /*   E is the north or south pole. */
16238 
16239 /*           ( R11  R12  0   ) */
16240 /*       R = ( R21  R22  R23 ) */
16241 /*           ( EX   EY   EZ  ) */
16242 
16243     t = cf * *elon;
16244     ct = cos(cf * *elat);
16245     ex = ct * cos(t);
16246     ey = ct * sin(t);
16247     ez = sin(cf * *elat);
16248     if (ct != 0.) {
16249         r11 = -ey / ct;
16250         r12 = ex / ct;
16251     } else {
16252         r11 = 0.;
16253         r12 = 1.;
16254     }
16255     r21 = -ez * r12;
16256     r22 = ez * r11;
16257     r23 = ct;
16258 
16259 /* Loop on visible nodes N0 that project to points */
16260 /*   (P0(1),P0(2)) in the window. */
16261 
16262     i__1 = *n;
16263     for (n0 = 1; n0 <= i__1; ++n0) {
16264         p0[2] = ex * x[n0] + ey * y[n0] + ez * z__[n0];
16265         if (p0[2] < 0.) {
16266             goto L3;
16267         }
16268         p0[0] = r11 * x[n0] + r12 * y[n0];
16269         p0[1] = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0];
16270         if (p0[0] * p0[0] + p0[1] * p0[1] > wrs) {
16271             goto L3;
16272         }
16273         lpl = lend[n0];
16274         lp = lpl;
16275 
16276 /* Loop on neighbors N1 of N0.  LPL points to the last */
16277 /*   neighbor of N0.  Copy the components of N1 into P. */
16278 
16279 L1:
16280         lp = lptr[lp];
16281         n1 = (i__2 = list[lp], abs(i__2));
16282         p1[0] = r11 * x[n1] + r12 * y[n1];
16283         p1[1] = r21 * x[n1] + r22 * y[n1] + r23 * z__[n1];
16284         p1[2] = ex * x[n1] + ey * y[n1] + ez * z__[n1];
16285         if (p1[2] < 0.) {
16286 
16287 /*   N1 is a 'southern hemisphere' point.  Move it to the */
16288 /*     intersection of edge N0-N1 with the equator so that */
16289 /*     the edge is clipped properly.  P1(3) is set to 0. */
16290 
16291             p1[0] = p0[2] * p1[0] - p1[2] * p0[0];
16292             p1[1] = p0[2] * p1[1] - p1[2] * p0[1];
16293             t = sqrt(p1[0] * p1[0] + p1[1] * p1[1]);
16294             p1[0] /= t;
16295             p1[1] /= t;
16296         }
16297 
16298 /*   If node N1 is in the window and N1 < N0, bypass edge */
16299 /*     N0->N1 (since edge N1->N0 has already been drawn). */
16300 
16301         if (p1[2] >= 0. && p1[0] * p1[0] + p1[1] * p1[1] <= wrs && n1 < n0) {
16302             goto L2;
16303         }
16304 
16305 /*   Add the edge to the path.  (TOL is converted to world */
16306 /*     coordinates.) */
16307 
16308         if (p1[2] < 0.) {
16309             p1[2] = 0.;
16310         }
16311         d__1 = tol / sf;
16312         drwarc_(lun, p0, p1, &d__1, &nseg);
16313 
16314 /* Bottom of loops. */
16315 
16316 L2:
16317         if (lp != lpl) {
16318             goto L1;
16319         }
16320 L3:
16321         ;
16322     }
16323 
16324 /* Paint the path and restore the saved graphics state (with */
16325 /*   no clip path). */
16326 
16327 /*      WRITE (LUN,130,ERR=13) */
16328 /*      WRITE (LUN,190,ERR=13) */
16329 /*  190 FORMAT ('grestore') */
16330     if (*numbr) {
16331 
16332 /* Nodes in the window are to be labeled with their indexes. */
16333 /*   Convert FSIZN from points to world coordinates, and */
16334 /*   output the commands to select a font and scale it. */
16335 
16336         t = fsizn / sf;
16337 /*        WRITE (LUN,200,ERR=13) T */
16338 /*  200   FORMAT ('/Helvetica findfont'/ */
16339 /*     .          F12.6,' scalefont setfont') */
16340 
16341 /* Loop on visible nodes N0 that project to points */
16342 /*   P0 = (P0(1),P0(2)) in the window. */
16343 
16344         i__1 = *n;
16345         for (n0 = 1; n0 <= i__1; ++n0) {
16346             if (ex * x[n0] + ey * y[n0] + ez * z__[n0] < 0.) {
16347                 goto L4;
16348             }
16349             p0[0] = r11 * x[n0] + r12 * y[n0];
16350             p0[1] = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0];
16351             if (p0[0] * p0[0] + p0[1] * p0[1] > wrs) {
16352                 goto L4;
16353             }
16354 
16355 /*   Move to P0 and draw the label N0.  The first character */
16356 /*     will will have its lower left corner about one */
16357 /*     character width to the right of the nodal position. */
16358 
16359 /*          WRITE (LUN,210,ERR=13) P0(1), P0(2) */
16360 /*          WRITE (LUN,220,ERR=13) N0 */
16361 /*  210     FORMAT (2F12.6,' moveto') */
16362 /*  220     FORMAT ('(',I3,') show') */
16363 L4:
16364             ;
16365         }
16366     }
16367 
16368 /* Convert FSIZT from points to world coordinates, and output */
16369 /*   the commands to select a font and scale it. */
16370 
16371     t = fsizt / sf;
16372 /*      WRITE (LUN,200,ERR=13) T */
16373 
16374 /* Display TITLE centered above the plot: */
16375 
16376     p0[1] = wr + t * 3.;
16377 /*      WRITE (LUN,230,ERR=13) TITLE, P0(2) */
16378 /*  230 FORMAT (A80/'  stringwidth pop 2 div neg ',F12.6, */
16379 /*     .        ' moveto') */
16380 /*      WRITE (LUN,240,ERR=13) TITLE */
16381 /*  240 FORMAT (A80/'  show') */
16382     if (annot) {
16383 
16384 /* Display the window center and radius below the plot. */
16385 
16386         p0[0] = -wr;
16387         p0[1] = -wr - 50. / sf;
16388 /*        WRITE (LUN,210,ERR=13) P0(1), P0(2) */
16389 /*        WRITE (LUN,250,ERR=13) ELAT, ELON */
16390         p0[1] -= t * 2.;
16391 /*        WRITE (LUN,210,ERR=13) P0(1), P0(2) */
16392 /*        WRITE (LUN,260,ERR=13) A */
16393 /*  250   FORMAT ('(Window center:  ELAT = ',F7.2, */
16394 /*     .          ',  ELON = ',F8.2,') show') */
16395 /*  260   FORMAT ('(Angular extent:  A = ',F5.2,') show') */
16396     }
16397 
16398 /* Paint the path and output the showpage command and */
16399 /*   end-of-file indicator. */
16400 
16401 /*      WRITE (LUN,270,ERR=13) */
16402 /*  270 FORMAT ('stroke'/ */
16403 /*     .        'showpage'/ */
16404 /*     .        '%%EOF') */
16405 
16406 /* HP's interpreters require a one-byte End-of-PostScript-Job */
16407 /*   indicator (to eliminate a timeout error message): */
16408 /*   ASCII 4. */
16409 
16410 /*      WRITE (LUN,280,ERR=13) CHAR(4) */
16411 /*  280 FORMAT (A1) */
16412 
16413 /* No error encountered. */
16414 
16415     *ier = 0;
16416     return 0;
16417 
16418 /* Invalid input parameter LUN, PLTSIZ, or N. */
16419 
16420 L11:
16421     *ier = 1;
16422     return 0;
16423 
16424 /* Invalid input parameter ELAT, ELON, or A. */
16425 
16426 L12:
16427     *ier = 2;
16428     return 0;
16429 
16430 /* Error writing to unit LUN. */
16431 
16432 /* L13: */
16433     *ier = 3;
16434     return 0;
16435 } /* trplot_ */

int trprnt_ ( int *  n,
double *  x,
double *  y,
double *  z__,
int *  iflag,
int *  list,
int *  lptr,
int *  lend,
int *  lout 
)

Definition at line 16437 of file util_sparx.cpp.

References nn().

16440 {
16441     /* Initialized data */
16442 
16443     static int nmax = 9999;
16444     static int nlmax = 58;
16445 
16446     /* System generated locals */
16447     int i__1;
16448 
16449     /* Local variables */
16450     static int k, na, nb, nd, nl, lp, nn, nt, inc, lpl, lun, node, nabor[
16451             400];
16452 
16453 
16454 /* *********************************************************** */
16455 
16456 /*                                              From STRIPACK */
16457 /*                                            Robert J. Renka */
16458 /*                                  Dept. of Computer Science */
16459 /*                                       Univ. of North Texas */
16460 /*                                           renka@cs.unt.edu */
16461 /*                                                   07/25/98 */
16462 
16463 /*   This subroutine prints the triangulation adjacency lists */
16464 /* created by Subroutine TRMESH and, optionally, the nodal */
16465 /* coordinates (either latitude and longitude or Cartesian */
16466 /* coordinates) on long int unit LOUT.  The list of neighbors */
16467 /* of a boundary node is followed by index 0.  The numbers of */
16468 /* boundary nodes, triangles, and arcs are also printed. */
16469 
16470 
16471 /* On input: */
16472 
16473 /*       N = Number of nodes in the triangulation.  N .GE. 3 */
16474 /*           and N .LE. 9999. */
16475 
16476 /*       X,Y,Z = Arrays of length N containing the Cartesian */
16477 /*               coordinates of the nodes if IFLAG = 0, or */
16478 /*               (X and Y only) arrays of length N containing */
16479 /*               longitude and latitude, respectively, if */
16480 /*               IFLAG > 0, or unused dummy parameters if */
16481 /*               IFLAG < 0. */
16482 
16483 /*       IFLAG = Nodal coordinate option indicator: */
16484 /*               IFLAG = 0 if X, Y, and Z (assumed to contain */
16485 /*                         Cartesian coordinates) are to be */
16486 /*                         printed (to 6 decimal places). */
16487 /*               IFLAG > 0 if only X and Y (assumed to con- */
16488 /*                         tain longitude and latitude) are */
16489 /*                         to be printed (to 6 decimal */
16490 /*                         places). */
16491 /*               IFLAG < 0 if only the adjacency lists are to */
16492 /*                         be printed. */
16493 
16494 /*       LIST,LPTR,LEND = Data structure defining the trian- */
16495 /*                        gulation.  Refer to Subroutine */
16496 /*                        TRMESH. */
16497 
16498 /*       LOUT = long int unit for output.  If LOUT is not in */
16499 /*              the range 0 to 99, output is written to */
16500 /*              long int unit 6. */
16501 
16502 /* Input parameters are not altered by this routine. */
16503 
16504 /* On output: */
16505 
16506 /*   The adjacency lists and nodal coordinates (as specified */
16507 /* by IFLAG) are written to unit LOUT. */
16508 
16509 /* Modules required by TRPRNT:  None */
16510 
16511 /* *********************************************************** */
16512 
16513     /* Parameter adjustments */
16514     --lend;
16515     --z__;
16516     --y;
16517     --x;
16518     --list;
16519     --lptr;
16520 
16521     /* Function Body */
16522 
16523 /* Local parameters: */
16524 
16525 /* I =     NABOR index (1 to K) */
16526 /* INC =   Increment for NL associated with an adjacency list */
16527 /* K =     Counter and number of neighbors of NODE */
16528 /* LP =    LIST pointer of a neighbor of NODE */
16529 /* LPL =   Pointer to the last neighbor of NODE */
16530 /* LUN =   long int unit for output (copy of LOUT) */
16531 /* NA =    Number of arcs in the triangulation */
16532 /* NABOR = Array containing the adjacency list associated */
16533 /*           with NODE, with zero appended if NODE is a */
16534 /*           boundary node */
16535 /* NB =    Number of boundary nodes encountered */
16536 /* ND =    Index of a neighbor of NODE (or negative index) */
16537 /* NL =    Number of lines that have been printed on the */
16538 /*           current page */
16539 /* NLMAX = Maximum number of print lines per page (except */
16540 /*           for the last page which may have two addi- */
16541 /*           tional lines) */
16542 /* NMAX =  Upper bound on N (allows 4-digit indexes) */
16543 /* NODE =  Index of a node and DO-loop index (1 to N) */
16544 /* NN =    Local copy of N */
16545 /* NT =    Number of triangles in the triangulation */
16546 
16547     nn = *n;
16548     lun = *lout;
16549     if (lun < 0 || lun > 99) {
16550         lun = 6;
16551     }
16552 
16553 /* Print a heading and test the range of N. */
16554 
16555 /*      WRITE (LUN,100) NN */
16556     if (nn < 3 || nn > nmax) {
16557 
16558 /* N is outside its valid range. */
16559 
16560 /*        WRITE (LUN,110) */
16561         return 0;
16562     }
16563 
16564 /* Initialize NL (the number of lines printed on the current */
16565 /*   page) and NB (the number of boundary nodes encountered). */
16566 
16567     nl = 6;
16568     nb = 0;
16569     if (*iflag < 0) {
16570 
16571 /* Print LIST only.  K is the number of neighbors of NODE */
16572 /*   that have been stored in NABOR. */
16573 
16574 /*        WRITE (LUN,101) */
16575         i__1 = nn;
16576         for (node = 1; node <= i__1; ++node) {
16577             lpl = lend[node];
16578             lp = lpl;
16579             k = 0;
16580 
16581 L1:
16582             ++k;
16583             lp = lptr[lp];
16584             nd = list[lp];
16585             nabor[k - 1] = nd;
16586             if (lp != lpl) {
16587                 goto L1;
16588             }
16589             if (nd <= 0) {
16590 
16591 /*   NODE is a boundary node.  Correct the sign of the last */
16592 /*     neighbor, add 0 to the end of the list, and increment */
16593 /*     NB. */
16594 
16595                 nabor[k - 1] = -nd;
16596                 ++k;
16597                 nabor[k - 1] = 0;
16598                 ++nb;
16599             }
16600 
16601 /*   Increment NL and print the list of neighbors. */
16602 
16603             inc = (k - 1) / 14 + 2;
16604             nl += inc;
16605             if (nl > nlmax) {
16606 /*            WRITE (LUN,108) */
16607                 nl = inc;
16608             }
16609 /*          WRITE (LUN,104) NODE, (NABOR(I), I = 1,K) */
16610 /*          IF (K .NE. 14) */
16611 /*           WRITE (LUN,107) */
16612 /* L2: */
16613         }
16614     } else if (*iflag > 0) {
16615 
16616 /* Print X (longitude), Y (latitude), and LIST. */
16617 
16618 /*        WRITE (LUN,102) */
16619         i__1 = nn;
16620         for (node = 1; node <= i__1; ++node) {
16621             lpl = lend[node];
16622             lp = lpl;
16623             k = 0;
16624 
16625 L3:
16626             ++k;
16627             lp = lptr[lp];
16628             nd = list[lp];
16629             nabor[k - 1] = nd;
16630             if (lp != lpl) {
16631                 goto L3;
16632             }
16633             if (nd <= 0) {
16634 
16635 /*   NODE is a boundary node. */
16636 
16637                 nabor[k - 1] = -nd;
16638                 ++k;
16639                 nabor[k - 1] = 0;
16640                 ++nb;
16641             }
16642 
16643 /*   Increment NL and print X, Y, and NABOR. */
16644 
16645             inc = (k - 1) / 8 + 2;
16646             nl += inc;
16647             if (nl > nlmax) {
16648 /*            WRITE (LUN,108) */
16649                 nl = inc;
16650             }
16651 /*          WRITE (LUN,105) NODE, X(NODE), Y(NODE), (NABOR(I), I = 1,K) */
16652 /*          IF (K .NE. 8) */
16653 /*           PRINT *,K */
16654 /*           WRITE (LUN,107) */
16655 /* L4: */
16656         }
16657     } else {
16658 
16659 /* Print X, Y, Z, and LIST. */
16660 
16661 /*        WRITE (LUN,103) */
16662         i__1 = nn;
16663         for (node = 1; node <= i__1; ++node) {
16664             lpl = lend[node];
16665             lp = lpl;
16666             k = 0;
16667 
16668 L5:
16669             ++k;
16670             lp = lptr[lp];
16671             nd = list[lp];
16672             nabor[k - 1] = nd;
16673             if (lp != lpl) {
16674                 goto L5;
16675             }
16676             if (nd <= 0) {
16677 
16678 /*   NODE is a boundary node. */
16679 
16680                 nabor[k - 1] = -nd;
16681                 ++k;
16682                 nabor[k - 1] = 0;
16683                 ++nb;
16684             }
16685 
16686 /*   Increment NL and print X, Y, Z, and NABOR. */
16687 
16688             inc = (k - 1) / 5 + 2;
16689             nl += inc;
16690             if (nl > nlmax) {
16691 /*            WRITE (LUN,108) */
16692                 nl = inc;
16693             }
16694 /*          WRITE (LUN,106) NODE, X(NODE), Y(NODE),Z(NODE), (NABOR(I), I = 1,K) */
16695 /*          IF (K .NE. 5) */
16696 /*           print *,K */
16697 /*           WRITE (LUN,107) */
16698 /* L6: */
16699         }
16700     }
16701 
16702 /* Print NB, NA, and NT (boundary nodes, arcs, and */
16703 /*   triangles). */
16704 
16705     if (nb != 0) {
16706         na = nn * 3 - nb - 3;
16707         nt = (nn << 1) - nb - 2;
16708     } else {
16709         na = nn * 3 - 6;
16710         nt = (nn << 1) - 4;
16711     }
16712 /*      WRITE (LUN,109) NB, NA, NT */
16713     return 0;
16714 
16715 /* Print formats: */
16716 
16717 /*  100 FORMAT (///15X,'STRIPACK Triangulation Data ', */
16718 /*     .        'Structure,  N = ',I5//) */
16719 /*  101 FORMAT (1X,'Node',31X,'Neighbors of Node'//) */
16720 /*  102 FORMAT (1X,'Node',5X,'Longitude',6X,'Latitude', */
16721 /*     .        18X,'Neighbors of Node'//) */
16722 /*  103 FORMAT (1X,'Node',5X,'X(Node)',8X,'Y(Node)',8X, */
16723 /*     .        'Z(Node)',11X,'Neighbors of Node'//) */
16724 /*  104 FORMAT (1X,I4,4X,14I5/(1X,8X,14I5)) */
16725 /*  105 FORMAT (1X,I4,2D15.6,4X,8I5/(1X,38X,8I5)) */
16726 /*  106 FORMAT (1X,I4,3D15.6,4X,5I5/(1X,53X,5I5)) */
16727 /*  107 FORMAT (1X) */
16728 /*  108 FORMAT (///) */
16729 /*  109 FORMAT (/1X,'NB = ',I4,' Boundary Nodes',5X, */
16730 /*     .        'NA = ',I5,' Arcs',5X,'NT = ',I5, */
16731 /*     .        ' Triangles') */
16732 /*  110 FORMAT (1X,10X,'*** N is outside its valid', */
16733 /*     .        ' range ***') */
16734 } /* trprnt_ */

int vrplot_ ( int *  lun,
double *  pltsiz,
double *  elat,
double *  elon,
double *  a,
int *  n,
double *  x,
double *  y,
double *  z__,
int *  nt,
int *  listc,
int *  lptr,
int *  lend,
double *  xc,
double *  yc,
double *  zc,
char *  ,
long int *  numbr,
int *  ier,
short   
)

Definition at line 16736 of file util_sparx.cpp.

References abs, drwarc_(), i_dnnt(), sqrt(), t, TRUE_, and wr.

16741 {
16742     /* Initialized data */
16743 
16744     static long int annot = TRUE_;
16745     static double fsizn = 10.;
16746     static double fsizt = 16.;
16747     static double tol = .5;
16748 
16749     /* System generated locals */
16750     int i__1;
16751     double d__1;
16752 
16753     /* Builtin functions */
16754     //double atan(double), sin(double);
16755     //int i_dnnt(double *);
16756     //double cos(double), sqrt(double);
16757 
16758     /* Local variables */
16759     static double t;
16760     static int n0;
16761     static double p1[3], p2[3], x0, y0, cf, r11, r12, r21, ct, r22, r23,
16762             sf;
16763     static int ir, lp;
16764     static double ex, ey, ez, wr, tx, ty;
16765     static long int in1, in2;
16766     static int kv1, kv2, lpl;
16767     static double wrs;
16768     static int ipx1, ipx2, ipy1, ipy2, nseg;
16769     /* Subroutine */ int drwarc_(int *, double *, double *,
16770              double *, int *);
16771 
16772 
16773 /* *********************************************************** */
16774 
16775 /*                                              From STRIPACK */
16776 /*                                            Robert J. Renka */
16777 /*                                  Dept. of Computer Science */
16778 /*                                       Univ. of North Texas */
16779 /*                                           renka@cs.unt.edu */
16780 /*                                                   03/04/03 */
16781 
16782 /*   This subroutine creates a level-2 Encapsulated Post- */
16783 /* script (EPS) file containing a graphical depiction of a */
16784 /* Voronoi diagram of a set of nodes on the unit sphere. */
16785 /* The visible portion of the diagram is projected orthog- */
16786 /* onally onto the plane that contains the origin and has */
16787 /* normal defined by a user-specified eye-position. */
16788 
16789 /*   The parameters defining the Voronoi diagram may be com- */
16790 /* puted by Subroutine CRLIST. */
16791 
16792 
16793 /* On input: */
16794 
16795 /*       LUN = long int unit number in the range 0 to 99. */
16796 /*             The unit should be opened with an appropriate */
16797 /*             file name before the call to this routine. */
16798 
16799 /*       PLTSIZ = Plot size in inches.  A circular window in */
16800 /*                the projection plane is mapped to a circu- */
16801 /*                lar viewport with diameter equal to .88* */
16802 /*                PLTSIZ (leaving room for labels outside the */
16803 /*                viewport).  The viewport is centered on the */
16804 /*                8.5 by 11 inch page, and its boundary is */
16805 /*                drawn.  1.0 .LE. PLTSIZ .LE. 8.5. */
16806 
16807 /*       ELAT,ELON = Latitude and longitude (in degrees) of */
16808 /*                   the center of projection E (the center */
16809 /*                   of the plot).  The projection plane is */
16810 /*                   the plane that contains the origin and */
16811 /*                   has E as unit normal.  In a rotated */
16812 /*                   coordinate system for which E is the */
16813 /*                   north pole, the projection plane con- */
16814 /*                   tains the equator, and only northern */
16815 /*                   hemisphere points are visible (from the */
16816 /*                   point at infinity in the direction E). */
16817 /*                   These are projected orthogonally onto */
16818 /*                   the projection plane (by zeroing the z- */
16819 /*                   component in the rotated coordinate */
16820 /*                   system).  ELAT and ELON must be in the */
16821 /*                   range -90 to 90 and -180 to 180, respec- */
16822 /*                   tively. */
16823 
16824 /*       A = Angular distance in degrees from E to the boun- */
16825 /*           dary of a circular window against which the */
16826 /*           Voronoi diagram is clipped.  The projected win- */
16827 /*           dow is a disk of radius r = Sin(A) centered at */
16828 /*           the origin, and only visible vertices whose */
16829 /*           projections are within distance r of the origin */
16830 /*           are included in the plot.  Thus, if A = 90, the */
16831 /*           plot includes the entire hemisphere centered at */
16832 /*           E.  0 .LT. A .LE. 90. */
16833 
16834 /*       N = Number of nodes (Voronoi centers) and Voronoi */
16835 /*           regions.  N .GE. 3. */
16836 
16837 /*       X,Y,Z = Arrays of length N containing the Cartesian */
16838 /*               coordinates of the nodes (unit vectors). */
16839 
16840 /*       NT = Number of Voronoi region vertices (triangles, */
16841 /*            including those in the extended triangulation */
16842 /*            if the number of boundary nodes NB is nonzero): */
16843 /*            NT = 2*N-4. */
16844 
16845 /*       LISTC = Array of length 3*NT containing triangle */
16846 /*               indexes (indexes to XC, YC, and ZC) stored */
16847 /*               in 1-1 correspondence with LIST/LPTR entries */
16848 /*               (or entries that would be stored in LIST for */
16849 /*               the extended triangulation):  the index of */
16850 /*               triangle (N1,N2,N3) is stored in LISTC(K), */
16851 /*               LISTC(L), and LISTC(M), where LIST(K), */
16852 /*               LIST(L), and LIST(M) are the indexes of N2 */
16853 /*               as a neighbor of N1, N3 as a neighbor of N2, */
16854 /*               and N1 as a neighbor of N3.  The Voronoi */
16855 /*               region associated with a node is defined by */
16856 /*               the CCW-ordered sequence of circumcenters in */
16857 /*               one-to-one correspondence with its adjacency */
16858 /*               list (in the extended triangulation). */
16859 
16860 /*       LPTR = Array of length 3*NT = 6*N-12 containing a */
16861 /*              set of pointers (LISTC indexes) in one-to-one */
16862 /*              correspondence with the elements of LISTC. */
16863 /*              LISTC(LPTR(I)) indexes the triangle which */
16864 /*              follows LISTC(I) in cyclical counterclockwise */
16865 /*              order (the first neighbor follows the last */
16866 /*              neighbor). */
16867 
16868 /*       LEND = Array of length N containing a set of */
16869 /*              pointers to triangle lists.  LP = LEND(K) */
16870 /*              points to a triangle (indexed by LISTC(LP)) */
16871 /*              containing node K for K = 1 to N. */
16872 
16873 /*       XC,YC,ZC = Arrays of length NT containing the */
16874 /*                  Cartesian coordinates of the triangle */
16875 /*                  circumcenters (Voronoi vertices). */
16876 /*                  XC(I)**2 + YC(I)**2 + ZC(I)**2 = 1. */
16877 
16878 /*       TITLE = Type CHARACTER variable or constant contain- */
16879 /*               ing a string to be centered above the plot. */
16880 /*               The string must be enclosed in parentheses; */
16881 /*               i.e., the first and last characters must be */
16882 /*               '(' and ')', respectively, but these are not */
16883 /*               displayed.  TITLE may have at most 80 char- */
16884 /*               acters including the parentheses. */
16885 
16886 /*       NUMBR = Option indicator:  If NUMBR = TRUE, the */
16887 /*               nodal indexes are plotted at the Voronoi */
16888 /*               region centers. */
16889 
16890 /* Input parameters are not altered by this routine. */
16891 
16892 /* On output: */
16893 
16894 /*       IER = Error indicator: */
16895 /*             IER = 0 if no errors were encountered. */
16896 /*             IER = 1 if LUN, PLTSIZ, N, or NT is outside */
16897 /*                     its valid range. */
16898 /*             IER = 2 if ELAT, ELON, or A is outside its */
16899 /*                     valid range. */
16900 /*             IER = 3 if an error was encountered in writing */
16901 /*                     to unit LUN. */
16902 
16903 /* Module required by VRPLOT:  DRWARC */
16904 
16905 /* Intrinsic functions called by VRPLOT:  ABS, ATAN, COS, */
16906 /*                                          DBLE, NINT, SIN, */
16907 /*                                          SQRT */
16908 
16909 /* *********************************************************** */
16910 
16911 
16912     /* Parameter adjustments */
16913     --lend;
16914     --z__;
16915     --y;
16916     --x;
16917     --zc;
16918     --yc;
16919     --xc;
16920     --listc;
16921     --lptr;
16922 
16923     /* Function Body */
16924 
16925 /* Local parameters: */
16926 
16927 /* ANNOT =     long int variable with value TRUE iff the plot */
16928 /*               is to be annotated with the values of ELAT, */
16929 /*               ELON, and A */
16930 /* CF =        Conversion factor for degrees to radians */
16931 /* CT =        Cos(ELAT) */
16932 /* EX,EY,EZ =  Cartesian coordinates of the eye-position E */
16933 /* FSIZN =     Font size in points for labeling nodes with */
16934 /*               their indexes if NUMBR = TRUE */
16935 /* FSIZT =     Font size in points for the title (and */
16936 /*               annotation if ANNOT = TRUE) */
16937 /* IN1,IN2 =   long int variables with value TRUE iff the */
16938 /*               projections of vertices KV1 and KV2, respec- */
16939 /*               tively, are inside the window */
16940 /* IPX1,IPY1 = X and y coordinates (in points) of the lower */
16941 /*               left corner of the bounding box or viewport */
16942 /*               box */
16943 /* IPX2,IPY2 = X and y coordinates (in points) of the upper */
16944 /*               right corner of the bounding box or viewport */
16945 /*               box */
16946 /* IR =        Half the width (height) of the bounding box or */
16947 /*               viewport box in points -- viewport radius */
16948 /* KV1,KV2 =   Endpoint indexes of a Voronoi edge */
16949 /* LP =        LIST index (pointer) */
16950 /* LPL =       Pointer to the last neighbor of N0 */
16951 /* N0 =        Index of a node */
16952 /* NSEG =      Number of line segments used by DRWARC in a */
16953 /*               polygonal approximation to a projected edge */
16954 /* P1 =        Coordinates of vertex KV1 in the rotated */
16955 /*               coordinate system */
16956 /* P2 =        Coordinates of vertex KV2 in the rotated */
16957 /*               coordinate system or intersection of edge */
16958 /*               KV1-KV2 with the equator (in the rotated */
16959 /*               coordinate system) */
16960 /* R11...R23 = Components of the first two rows of a rotation */
16961 /*               that maps E to the north pole (0,0,1) */
16962 /* SF =        Scale factor for mapping world coordinates */
16963 /*               (window coordinates in [-WR,WR] X [-WR,WR]) */
16964 /*               to viewport coordinates in [IPX1,IPX2] X */
16965 /*               [IPY1,IPY2] */
16966 /* T =         Temporary variable */
16967 /* TOL =       Maximum distance in points between a projected */
16968 /*               Voronoi edge and its approximation by a */
16969 /*               polygonal curve */
16970 /* TX,TY =     Translation vector for mapping world coordi- */
16971 /*               nates to viewport coordinates */
16972 /* WR =        Window radius r = Sin(A) */
16973 /* WRS =       WR**2 */
16974 /* X0,Y0 =     Projection plane coordinates of node N0 or */
16975 /*               label location */
16976 
16977 
16978 /* Test for invalid parameters. */
16979 
16980     if (*lun < 0 || *lun > 99 || *pltsiz < 1. || *pltsiz > 8.5 || *n < 3 || *
16981             nt != 2 * *n - 4) {
16982         goto L11;
16983     }
16984     if (abs(*elat) > 90. || abs(*elon) > 180. || *a > 90.) {
16985         goto L12;
16986     }
16987 
16988 /* Compute a conversion factor CF for degrees to radians */
16989 /*   and compute the window radius WR. */
16990 
16991     cf = atan(1.) / 45.;
16992     wr = sin(cf * *a);
16993     wrs = wr * wr;
16994 
16995 /* Compute the lower left (IPX1,IPY1) and upper right */
16996 /*   (IPX2,IPY2) corner coordinates of the bounding box. */
16997 /*   The coordinates, specified in default user space units */
16998 /*   (points, at 72 points/inch with origin at the lower */
16999 /*   left corner of the page), are chosen to preserve the */
17000 /*   square aspect ratio, and to center the plot on the 8.5 */
17001 /*   by 11 inch page.  The center of the page is (306,396), */
17002 /*   and IR = PLTSIZ/2 in points. */
17003 
17004     d__1 = *pltsiz * 36.;
17005     ir = i_dnnt(&d__1);
17006     ipx1 = 306 - ir;
17007     ipx2 = ir + 306;
17008     ipy1 = 396 - ir;
17009     ipy2 = ir + 396;
17010 
17011 /* Output header comments. */
17012 
17013 /*      WRITE (LUN,100,ERR=13) IPX1, IPY1, IPX2, IPY2 */
17014 /*  100 FORMAT ('%!PS-Adobe-3.0 EPSF-3.0'/ */
17015 /*     .        '%%BoundingBox:',4I4/ */
17016 /*     .        '%%Title:  Voronoi diagram'/ */
17017 /*     .        '%%Creator:  STRIPACK'/ */
17018 /*     .        '%%EndComments') */
17019 /* Set (IPX1,IPY1) and (IPX2,IPY2) to the corner coordinates */
17020 /*   of a viewport box obtained by shrinking the bounding box */
17021 /*   by 12% in each dimension. */
17022 
17023     d__1 = (double) ir * .88;
17024     ir = i_dnnt(&d__1);
17025     ipx1 = 306 - ir;
17026     ipx2 = ir + 306;
17027     ipy1 = 396 - ir;
17028     ipy2 = ir + 396;
17029 
17030 /* Set the line thickness to 2 points, and draw the */
17031 /*   viewport boundary. */
17032 
17033     t = 2.;
17034 /*      WRITE (LUN,110,ERR=13) T */
17035 /*      WRITE (LUN,120,ERR=13) IR */
17036 /*      WRITE (LUN,130,ERR=13) */
17037 /*  110 FORMAT (F12.6,' setlinewidth') */
17038 /*  120 FORMAT ('306 396 ',I3,' 0 360 arc') */
17039 /*  130 FORMAT ('stroke') */
17040 
17041 /* Set up an affine mapping from the window box [-WR,WR] X */
17042 /*   [-WR,WR] to the viewport box. */
17043 
17044     sf = (double) ir / wr;
17045     tx = ipx1 + sf * wr;
17046     ty = ipy1 + sf * wr;
17047 /*      WRITE (LUN,140,ERR=13) TX, TY, SF, SF */
17048 /*  140 FORMAT (2F12.6,' translate'/ */
17049 /*     .        2F12.6,' scale') */
17050 
17051 /* The line thickness must be changed to reflect the new */
17052 /*   scaling which is applied to all subsequent output. */
17053 /*   Set it to 1.0 point. */
17054 
17055     t = 1. / sf;
17056 /*      WRITE (LUN,110,ERR=13) T */
17057 
17058 /* Save the current graphics state, and set the clip path to */
17059 /*   the boundary of the window. */
17060 
17061 /*      WRITE (LUN,150,ERR=13) */
17062 /*      WRITE (LUN,160,ERR=13) WR */
17063 /*      WRITE (LUN,170,ERR=13) */
17064 /*  150 FORMAT ('gsave') */
17065 /*  160 FORMAT ('0 0 ',F12.6,' 0 360 arc') */
17066 /*  170 FORMAT ('clip newpath') */
17067 
17068 /* Compute the Cartesian coordinates of E and the components */
17069 /*   of a rotation R which maps E to the north pole (0,0,1). */
17070 /*   R is taken to be a rotation about the z-axis (into the */
17071 /*   yz-plane) followed by a rotation about the x-axis chosen */
17072 /*   so that the view-up direction is (0,0,1), or (-1,0,0) if */
17073 /*   E is the north or south pole. */
17074 
17075 /*           ( R11  R12  0   ) */
17076 /*       R = ( R21  R22  R23 ) */
17077 /*           ( EX   EY   EZ  ) */
17078 
17079     t = cf * *elon;
17080     ct = cos(cf * *elat);
17081     ex = ct * cos(t);
17082     ey = ct * sin(t);
17083     ez = sin(cf * *elat);
17084     if (ct != 0.) {
17085         r11 = -ey / ct;
17086         r12 = ex / ct;
17087     } else {
17088         r11 = 0.;
17089         r12 = 1.;
17090     }
17091     r21 = -ez * r12;
17092     r22 = ez * r11;
17093     r23 = ct;
17094 
17095 /* Loop on nodes (Voronoi centers) N0. */
17096 /*   LPL indexes the last neighbor of N0. */
17097 
17098     i__1 = *n;
17099     for (n0 = 1; n0 <= i__1; ++n0) {
17100         lpl = lend[n0];
17101 
17102 /* Set KV2 to the first (and last) vertex index and compute */
17103 /*   its coordinates P2 in the rotated coordinate system. */
17104 
17105         kv2 = listc[lpl];
17106         p2[0] = r11 * xc[kv2] + r12 * yc[kv2];
17107         p2[1] = r21 * xc[kv2] + r22 * yc[kv2] + r23 * zc[kv2];
17108         p2[2] = ex * xc[kv2] + ey * yc[kv2] + ez * zc[kv2];
17109 
17110 /*   IN2 = TRUE iff KV2 is in the window. */
17111 
17112         in2 = p2[2] >= 0. && p2[0] * p2[0] + p2[1] * p2[1] <= wrs;
17113 
17114 /* Loop on neighbors N1 of N0.  For each triangulation edge */
17115 /*   N0-N1, KV1-KV2 is the corresponding Voronoi edge. */
17116 
17117         lp = lpl;
17118 L1:
17119         lp = lptr[lp];
17120         kv1 = kv2;
17121         p1[0] = p2[0];
17122         p1[1] = p2[1];
17123         p1[2] = p2[2];
17124         in1 = in2;
17125         kv2 = listc[lp];
17126 
17127 /*   Compute the new values of P2 and IN2. */
17128 
17129         p2[0] = r11 * xc[kv2] + r12 * yc[kv2];
17130         p2[1] = r21 * xc[kv2] + r22 * yc[kv2] + r23 * zc[kv2];
17131         p2[2] = ex * xc[kv2] + ey * yc[kv2] + ez * zc[kv2];
17132         in2 = p2[2] >= 0. && p2[0] * p2[0] + p2[1] * p2[1] <= wrs;
17133 
17134 /* Add edge KV1-KV2 to the path iff both endpoints are inside */
17135 /*   the window and KV2 > KV1, or KV1 is inside and KV2 is */
17136 /*   outside (so that the edge is drawn only once). */
17137 
17138         if (! in1 || (in2 && kv2 <= kv1)) {
17139             goto L2;
17140         }
17141         if (p2[2] < 0.) {
17142 
17143 /*   KV2 is a 'southern hemisphere' point.  Move it to the */
17144 /*     intersection of edge KV1-KV2 with the equator so that */
17145 /*     the edge is clipped properly.  P2(3) is set to 0. */
17146 
17147             p2[0] = p1[2] * p2[0] - p2[2] * p1[0];
17148             p2[1] = p1[2] * p2[1] - p2[2] * p1[1];
17149             t = sqrt(p2[0] * p2[0] + p2[1] * p2[1]);
17150             p2[0] /= t;
17151             p2[1] /= t;
17152         }
17153 
17154 /*   Add the edge to the path.  (TOL is converted to world */
17155 /*     coordinates.) */
17156 
17157         if (p2[2] < 0.) {
17158             p2[2] = 0.f;
17159         }
17160         d__1 = tol / sf;
17161         drwarc_(lun, p1, p2, &d__1, &nseg);
17162 
17163 /* Bottom of loops. */
17164 
17165 L2:
17166         if (lp != lpl) {
17167             goto L1;
17168         }
17169 /* L3: */
17170     }
17171 
17172 /* Paint the path and restore the saved graphics state (with */
17173 /*   no clip path). */
17174 
17175 /*      WRITE (LUN,130,ERR=13) */
17176 /*      WRITE (LUN,190,ERR=13) */
17177 /*  190 FORMAT ('grestore') */
17178     if (*numbr) {
17179 
17180 /* Nodes in the window are to be labeled with their indexes. */
17181 /*   Convert FSIZN from points to world coordinates, and */
17182 /*   output the commands to select a font and scale it. */
17183 
17184         t = fsizn / sf;
17185 /*        WRITE (LUN,200,ERR=13) T */
17186 /*  200   FORMAT ('/Helvetica findfont'/ */
17187 /*     .          F12.6,' scalefont setfont') */
17188 
17189 /* Loop on visible nodes N0 that project to points (X0,Y0) in */
17190 /*   the window. */
17191 
17192         i__1 = *n;
17193         for (n0 = 1; n0 <= i__1; ++n0) {
17194             if (ex * x[n0] + ey * y[n0] + ez * z__[n0] < 0.) {
17195                 goto L4;
17196             }
17197             x0 = r11 * x[n0] + r12 * y[n0];
17198             y0 = r21 * x[n0] + r22 * y[n0] + r23 * z__[n0];
17199             if (x0 * x0 + y0 * y0 > wrs) {
17200                 goto L4;
17201             }
17202 
17203 /*   Move to (X0,Y0), and draw the label N0 with the origin */
17204 /*     of the first character at (X0,Y0). */
17205 
17206 /*          WRITE (LUN,210,ERR=13) X0, Y0 */
17207 /*          WRITE (LUN,220,ERR=13) N0 */
17208 /*  210     FORMAT (2F12.6,' moveto') */
17209 /*  220     FORMAT ('(',I3,') show') */
17210 L4:
17211             ;
17212         }
17213     }
17214 
17215 /* Convert FSIZT from points to world coordinates, and output */
17216 /*   the commands to select a font and scale it. */
17217 
17218     t = fsizt / sf;
17219 /*      WRITE (LUN,200,ERR=13) T */
17220 
17221 /* Display TITLE centered above the plot: */
17222 
17223     y0 = wr + t * 3.;
17224 /*      WRITE (LUN,230,ERR=13) TITLE, Y0 */
17225 /*  230 FORMAT (A80/'  stringwidth pop 2 div neg ',F12.6, */
17226 /*     .        ' moveto') */
17227 /*      WRITE (LUN,240,ERR=13) TITLE */
17228 /*  240 FORMAT (A80/'  show') */
17229     if (annot) {
17230 
17231 /* Display the window center and radius below the plot. */
17232 
17233         x0 = -wr;
17234         y0 = -wr - 50. / sf;
17235 /*        WRITE (LUN,210,ERR=13) X0, Y0 */
17236 /*        WRITE (LUN,250,ERR=13) ELAT, ELON */
17237         y0 -= t * 2.;
17238 /*        WRITE (LUN,210,ERR=13) X0, Y0 */
17239 /*        WRITE (LUN,260,ERR=13) A */
17240 /*  250   FORMAT ('(Window center:  ELAT = ',F7.2, */
17241 /*     .          ',  ELON = ',F8.2,') show') */
17242 /*  260   FORMAT ('(Angular extent:  A = ',F5.2,') show') */
17243     }
17244 
17245 /* Paint the path and output the showpage command and */
17246 /*   end-of-file indicator. */
17247 
17248 /*      WRITE (LUN,270,ERR=13) */
17249 /*  270 FORMAT ('stroke'/ */
17250 /*     .        'showpage'/ */
17251 /*     .        '%%EOF') */
17252 
17253 /* HP's interpreters require a one-byte End-of-PostScript-Job */
17254 /*   indicator (to eliminate a timeout error message): */
17255 /*   ASCII 4. */
17256 
17257 /*      WRITE (LUN,280,ERR=13) CHAR(4) */
17258 /*  280 FORMAT (A1) */
17259 
17260 /* No error encountered. */
17261 
17262     *ier = 0;
17263     return 0;
17264 
17265 /* Invalid input parameter LUN, PLTSIZ, N, or NT. */
17266 
17267 L11:
17268     *ier = 1;
17269     return 0;
17270 
17271 /* Invalid input parameter ELAT, ELON, or A. */
17272 
17273 L12:
17274     *ier = 2;
17275     return 0;
17276 
17277 /* Error writing to unit LUN. */
17278 
17279 /* L13: */
17280     *ier = 3;
17281     return 0;
17282 } /* vrplot_ */


Variable Documentation

int branch_all = 0

Definition at line 21177 of file util_sparx.cpp.

int* costlist_global

Definition at line 21333 of file util_sparx.cpp.

stcom_ stcom_1

Definition at line 7845 of file util_sparx.cpp.

Referenced by store_().


Generated on Thu May 3 10:08:08 2012 for EMAN2 by  doxygen 1.4.7