Main Page | Modules | Namespace List | Class Hierarchy | Alphabetical List | Class List | Directories | File List | Namespace Members | Class Members | File Members

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:

Include dependency graph

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

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

Definition at line 6015 of file util_sparx.cpp.

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

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

Definition at line 6016 of file util_sparx.cpp.

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

#define assign  )     out[i]
 

Definition at line 20250 of file util_sparx.cpp.

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

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

Definition at line 5758 of file util_sparx.cpp.

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

#define b  )     b[i-1]
 

Definition at line 3162 of file util_sparx.cpp.

#define b  )     b[i-1]
 

Definition at line 3162 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(), EMAN::Matrix3::det2x2(), dpmeps_(), dtrsl_(), EMAN::EMObject::EMObject(), EMAN::TestUtil::emobject_to_py(), 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(), matvec_mult(), matvec_multT(), max_int(), min_int(), 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(), r_sign(), s_cmp(), s_copy(), sgemm_(), slacpy_(), slae2_(), slaed4_(), slaed5_(), slaed6_(), slaev2_(), slamc1_(), slamc2_(), EMAN::Util::splint(), ssteqr_(), ssyr2k_(), strmm_(), subsm_(), swapx(), tikhonov(), tsvd(), EMAN::Util::TwoDTestFunc(), and varmx().

#define bi  )     bi[i-1]
 

Definition at line 2615 of file util_sparx.cpp.

Referenced by EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::EMData::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 2614 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 6011 of file util_sparx.cpp.

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

#define cent  )     out[i+N]
 

Definition at line 20249 of file util_sparx.cpp.

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

#define circ  )     circ[i-1]
 

Definition at line 2132 of file util_sparx.cpp.

Referenced by EMAN::Util::alrl_ms(), alrq(), alrq_ms(), 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 3158 of file util_sparx.cpp.

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

#define circ1b  )     circ1b[i-1]
 

Definition at line 4296 of file util_sparx.cpp.

#define circ1b  )     circ1b[i-1]
 

Definition at line 4296 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 3159 of file util_sparx.cpp.

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

#define circ2b  )     circ2b[i-1]
 

Definition at line 4297 of file util_sparx.cpp.

#define circ2b  )     circ2b[i-1]
 

Definition at line 4297 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 6012 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 5759 of file util_sparx.cpp.

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

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

Definition at line 20556 of file util_sparx.cpp.

Referenced by EMAN::EMData::absi(), EMAN::MeanShrinkProcessor::accrue_mean(), EMAN::MeanShrinkProcessor::accrue_mean_one_p_five(), EMAN::EMData::add(), EMAN::Gatan::TagTable::add_data(), 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::Util::ap2ri(), EMAN::EMData::apply_radial_func(), EMAN::ImageIO::become_host_endian(), EMAN::Gatan::TagTable::become_host_endian(), EMAN::BoxSVDClassifier::BoxSVDClassifier(), 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::NormalizeMaskProcessor::calc_mean(), EMAN::EMData::calc_min_location(), EMAN::EMData::calc_n_highest_locations(), EMAN::EMData::calc_radial_dist(), EMAN::NormalizeMaskProcessor::calc_sigma(), circumference(), EMAN::BoxingTools::classify(), EMAN::CustomVector< F32 >::clear(), EMAN::Util::cml_disc(), EMAN::EMData::common_lines(), EMAN::EMData::common_lines_real(), EMAN::CustomVector< F32 >::CustomVector(), EMAN::Util::cyclicshift(), EMAN::PointArray::distmx(), EMAN::EMData::div(), EMAN::EMData::do_ift_inplace(), EMAN::EMUtil::em_free(), EMAN::EMUtil::em_memset(), EMAN::EMUtil::em_realloc(), EMAN::EMData::EMData(), EMAN::Util::ener_tot(), EMAN::EMUtil::exclude_numbers_io(), EMAN::Util::find_max(), EMAN::Util::find_min_and_max(), EMAN::Util::flip_complex_phase(), EMAN::Util::flip_image(), EMAN::FloatPoint::FloatPoint(), EMAN::FloatSize::FloatSize(), EMAN::FourierPixelInserter3D::FourierPixelInserter3D(), 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::FloatSize::get_ndim(), EMAN::IntSize::get_ndim(), EMAN::Util::get_pixel_conv_new(), EMAN::Util::get_pixel_conv_new_background(), EMAN::XYData::get_size(), EMAN::Util::get_stats(), EMAN::Util::get_stats_cstyle(), EMAN::XYData::get_x(), EMAN::XYData::get_y(), EMAN::EMUtil::getRenderMinMax(), EMAN::EMData::helicise_grid(), EMAN::Util::histc(), EMAN::EMData::imag(), EMAN::ImagicIO2::init_test(), EMAN::EMData::insert_scaled_sum(), EMAN::GaussFFTProjector::interp_ft_3d(), EMAN::IntPoint::IntPoint(), EMAN::IntSize::IntSize(), 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::Df3IO::is_valid(), EMAN::XYData::is_validx(), EMAN::EMData::little_big_dot(), EMAN::EMData::log(), EMAN::EMData::log10(), main(), EMAN::TestUtil::make_image_file_by_mode(), EMAN::Util::min_dist_four(), EMAN::Util::min_dist_real(), mpi_bcast_recv(), mpi_bcast_send(), mpi_init(), mpi_recv(), mpi_send(), mpi_start(), EMAN::EMData::mult(), EMAN::CustomVector< F32 >::mult3(), EMAN::EMData::mult_complex_efficient(), EMAN::EMData::norm_pad(), EMAN::Util::Normalize_ring(), EMAN::FloatPoint::operator IntPoint(), EMAN::FloatPoint::operator vector(), EMAN::FloatSize::operator vector(), EMAN::EMData::operator=(), EMAN::CustomVector< F32 >::operator[](), EMAN::FloatPoint::operator[](), EMAN::IntPoint::operator[](), EMAN::FloatSize::operator[](), EMAN::IntSize::operator[](), EMAN::PointArray::pdb2mrc_by_nfft(), EMAN::EMData::phase(), EMAN::ConvolutionKernelProcessor::process(), EMAN::EMUtil::process_ascii_region_io(), EMAN::XYZProcessor::process_inplace(), EMAN::ClampingProcessor::process_inplace(), EMAN::MirrorProcessor::process_inplace(), EMAN::RampProcessor::process_inplace(), EMAN::SymSearchProcessor::process_inplace(), EMAN::TransposeProcessor::process_inplace(), EMAN::NormalizeProcessor::process_inplace(), EMAN::AverageXProcessor::process_inplace(), EMAN::BeamstopProcessor::process_inplace(), EMAN::VerticalStripeProcessor::process_inplace(), EMAN::GradientRemoverProcessor::process_inplace(), EMAN::CutoffBlockProcessor::process_inplace(), EMAN::DiffBlockProcessor::process_inplace(), EMAN::BoxStatProcessor::process_inplace(), EMAN::AreaProcessor::process_inplace(), EMAN::ComplexPixelProcessor::process_inplace(), EMAN::ToMinvalProcessor::process_inplace(), EMAN::CoordinateProcessor::process_inplace(), EMAN::RealPixelProcessor::process_inplace(), EMAN::ImageProcessor::process_inplace(), EMAN::EMUtil::process_lines_io(), EMAN::EMUtil::process_numbers_io(), EMAN::PeakOnlyProcessor::process_pixel(), EMAN::MinusPeakProcessor::process_pixel(), EMAN::BoxMaxProcessor::process_pixel(), EMAN::BoxSigmaProcessor::process_pixel(), EMAN::BoxMedianProcessor::process_pixel(), EMAN::GaussFFTProjector::project3d(), EMAN::PointArray::projection_by_nfft(), EMAN::CustomVector< F32 >::push_back(), EMAN::CustomVector< F32 >::push_back_3(), EMAN::Gatan::TagData::read_array_data(), EMAN::EMData::real(), EMAN::EMData::render_amp24(), EMAN::EMData::render_ap24(), EMAN::CustomVector< F32 >::resize(), 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::Util::rotate_phase_origin(), EMAN::EMData::rotate_x(), EMAN::MarchingCubes::set_data(), EMAN::XYData::set_x(), EMAN::XYData::set_y(), EMAN::BoxSVDClassifier::setDims(), EMAN::EMData::setup4slice(), EMAN::EMData::sqrt(), EMAN::EMData::sub(), EMAN::EMData::subsquare(), EMAN::Util::svdcmp(), EMAN::SpiderIO::swap_data(), EMAN::EMData::to_value(), EMAN::MrcIO::transpose(), EMAN::UnevenMatrix::UnevenMatrix(), EMAN::EMData::update_stat(), EMAN::Util::vareas(), EMAN::TestUtil::verify_image_file_by_mode(), EMAN::EMUtil::vertical_acf(), wustl_mm::SkeletonMaker::VolumeData::VolumeData(), EMAN::U3DWriter::write_clod_mesh_generator_node(), EMAN::SingleSpiderIO::write_data(), EMAN::SpiderIO::write_single_data(), EMAN::RT3DSphereAligner::xform_align_nbest(), EMAN::RT3DGridAligner::xform_align_nbest(), EMAN::CustomVector< F32 >::~CustomVector(), and EMAN::UnevenMatrix::~UnevenMatrix().

#define deg_rad   QUADPI/180.0
 

Definition at line 4677 of file util_sparx.cpp.

#define deg_to_rad   quadpi/180
 

Definition at line 7161 of file util_sparx.cpp.

#define dgr_to_rad   quadpi/180
 

Definition at line 7160 of file util_sparx.cpp.

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

#define DGR_TO_RAD   QUADPI/180
 

Definition at line 5710 of file util_sparx.cpp.

#define DM  )     DM[I-1]
 

Definition at line 5757 of file util_sparx.cpp.

#define DM  )     DM [I-1]
 

Definition at line 5757 of file util_sparx.cpp.

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

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

Definition at line 4295 of file util_sparx.cpp.

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

Definition at line 4295 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 7165 of file util_sparx.cpp.

#define FALSE_   (0)
 

Definition at line 7869 of file util_sparx.cpp.

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

Definition at line 708 of file util_sparx.cpp.

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

Definition at line 708 of file util_sparx.cpp.

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

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

Definition at line 19874 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 19873 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 19873 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 5380 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 5380 of file util_sparx.cpp.

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

#define key  )     key [i-1]
 

Definition at line 7174 of file util_sparx.cpp.

Referenced by EMAN::Util::disorder2(), EMAN::Dict::erase(), EMAN::Dict::find(), EMAN::Util::flip23(), EMAN::Dict::get(), EMAN::EMData::get_attr(), EMAN::EMData::get_attr_default(), EMAN::Dict::get_ci(), EMAN::EMUtil::getRenderMinMax(), has_attr(), EMAN::Dict::has_key(), EMAN::Dict::has_key_ci(), EMAN::Util::hsortd(), mpi_comm_split(), EMAN::EMData::set_attr(), EMAN::EMData::set_attr_python(), EMAN::Dict::set_default(), EMAN::Log::vlog(), EMAN::Util::voronoi(), and EMAN::Util::vrdg().

#define lband  )     lband [i-1]
 

Definition at line 7171 of file util_sparx.cpp.

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

Definition at line 7154 of file util_sparx.cpp.

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

Definition at line 7155 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 5276 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 2133 of file util_sparx.cpp.

Referenced by EMAN::Util::ali2d_ccf_list(), ali3d_d(), alprbs(), EMAN::Util::alrl_ms(), alrq(), alrq_ms(), apmd(), apmq(), applyws(), Applyws(), apring1(), aprings(), 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_msg_vec_p(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi_0_180(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), EMAN::Util::Crosrng_sm_psi(), EMAN::Util::ener(), EMAN::Util::ener_tot(), EMAN::Util::Frngs(), frngs(), EMAN::Util::Frngs_inv(), EMAN::Util::multiref_peaks_ali2d(), EMAN::Util::multiref_peaks_compress_ali2d(), EMAN::Util::multiref_polar_ali_2d(), EMAN::Util::multiref_polar_ali_2d_delta(), EMAN::Util::multiref_polar_ali_2d_local(), EMAN::Util::multiref_polar_ali_2d_local_psi(), EMAN::Util::multiref_polar_ali_2d_nom(), EMAN::Util::multiref_polar_ali_2d_peaklist(), EMAN::Util::multiref_polar_ali_helical(), EMAN::Util::multiref_polar_ali_helical_90(), EMAN::Util::multiref_polar_ali_helical_90_local(), EMAN::Util::multiref_polar_ali_helical_local(), EMAN::Util::Normalize_ring(), 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 5275 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 5381 of file util_sparx.cpp.

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

Definition at line 5381 of file util_sparx.cpp.

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

#define phi  )     phi [i-1]
 

Definition at line 7169 of file util_sparx.cpp.

Referenced by EMAN::file_store::add_image(), EMAN::OrientationGenerator::add_orientation(), ali3d_d(), EMAN::Refine3DAlignerGrid::align(), EMAN::PawelProjector::backproject3d(), EMAN::ChaoProjector::backproject3d(), EMAN::Util::even_angles(), fcalc(), fgcalc(), EMAN::GaussFFTProjector::GaussFFTProjector(), 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::SymAlignProcessor::process(), EMAN::TestImageSinewave::process_inplace(), EMAN::ChaoProjector::project3d(), EMAN::FourierGriddingProjector::project3d(), recons3d_4nn(), recons3d_CGLS_mpi_Cart(), recons3d_sirt_mpi(), recons3d_sirt_mpi_Cart(), EMAN::EMData::rot_scale_conv_new_3D(), EMAN::EMData::rot_scale_conv_new_background_3D(), EMAN::EMData::rotate_translate(), EMAN::GaussFFTProjector::set_params(), EMAN::Transform::set_rotation(), EMAN::ChaoProjector::setdm(), slaed4_(), trans_(), EMAN::Util::twoD_to_3D_ali(), EMAN::Util::voronoi(), EMAN::Util::vrdg(), EMAN::RT3DSphereAligner::xform_align_nbest(), and EMAN::RT3DGridAligner::xform_align_nbest().

#define PI2   QUADPI*2
 

Definition at line 4676 of file util_sparx.cpp.

#define PI2   2*QUADPI
 

Definition at line 4676 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 6008 of file util_sparx.cpp.

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

Definition at line 6008 of file util_sparx.cpp.

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

#define q  )     q[i-1]
 

Definition at line 3161 of file util_sparx.cpp.

Referenced by EMAN::Util::call_cl1(), EMAN::Util::cl1(), EMAN::Util::cluster_pairwise(), EMAN::Quaternion::create_inverse(), EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_s(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_ns(), EMAN::Util::Crosrng_psi_0_180(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), EMAN::Util::Crosrng_sm_psi(), dcstep_(), drwarc_(), GCVmin_Tik(), EMAN::EMData::get_pixel_conv(), EMAN::EMData::get_pixel_filtered(), EMAN::Util::getBaldwinGridWeights(), inside_(), EMAN::Quaternion::interpolate(), EMAN::Util::list_mutation(), EMAN::Util::lsfit(), 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(), slaed0_(), slaed1_(), slaed2_(), slaed3_(), slaed7_(), slaed8_(), slaed9_(), slaeda_(), EMAN::Quaternion::to_angle(), EMAN::Quaternion::to_axis(), trfind_(), EMAN::Util::TwoDTestFunc(), and EMAN::Util::WTF().

#define quadpi   3.141592653589793238462643383279502884197
 

Definition at line 7159 of file util_sparx.cpp.

Referenced by apmq(), and aprq2d().

#define QUADPI   3.141592653589793238462643383279502884197
 

Definition at line 5709 of file util_sparx.cpp.

#define QUADPI   3.141592653589793238462643383279502884197
 

Definition at line 5709 of file util_sparx.cpp.

#define QUADPI   3.141592653589793238462643383279502884197
 

Definition at line 5709 of file util_sparx.cpp.

#define rad_deg   180.0/QUADPI
 

Definition at line 4678 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 7162 of file util_sparx.cpp.

#define rad_to_dgr   180/quadpi
 

Definition at line 7163 of file util_sparx.cpp.

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

Definition at line 6010 of file util_sparx.cpp.

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

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

Definition at line 7156 of file util_sparx.cpp.

Referenced by EMAN::Util::ctf_img(), EMAN::Processor::EMFourierFilterFunc(), EMAN::nn4_ctf_rectReconstructor::nn4_ctf_rectReconstructor(), EMAN::nn4_ctfReconstructor::nn4_ctfReconstructor(), EMAN::nnSSNR_ctfReconstructor::nnSSNR_ctfReconstructor(), 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 6009 of file util_sparx.cpp.

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

Definition at line 6009 of file util_sparx.cpp.

#define SS  )     SS [I-1]
 

Definition at line 6009 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 3160 of file util_sparx.cpp.

Referenced by EMAN::OrientationGenerator::add_orientation(), EMAN::Util::ali2d_ccf_list(), EMAN::RT3DSymmetryAligner::align(), EMAN::RT3DSphereAligner::align(), EMAN::RT3DGridAligner::align(), EMAN::Refine3DAlignerGrid::align(), EMAN::Refine3DAlignerQuaternion::align(), EMAN::RefineAligner::align(), EMAN::RTFSlowExhaustiveAligner::align(), EMAN::RTFExhaustiveAligner::align(), EMAN::RotateFlipAlignerIterative::align(), EMAN::RotateFlipAligner::align(), EMAN::RotateTranslateFlipAlignerIterative::align(), EMAN::RotateTranslateFlipAligner::align(), EMAN::RotateTranslateAligner::align(), EMAN::RotateTranslateAlignerIterative::align(), EMAN::TranslationalAligner::align(), EMAN::Util::array_mutation(), bmv_(), EMAN::Util::BPCQ(), EMAN::Symmetry3D::cache_au_planes(), EMAN::EMData::calc_max_location(), EMAN::EMData::calc_min_location(), EMAN::EMData::calc_mutual_correlation(), cauchy_(), EMAN::EMData::common_lines_real(), crlist_(), EMAN::Util::Crosrng_e(), crosrng_e(), EMAN::Util::Crosrng_ew(), EMAN::Util::Crosrng_ms(), crosrng_ms(), EMAN::Util::Crosrng_ms_delta(), EMAN::Util::Crosrng_msg(), EMAN::Util::Crosrng_msg_m(), EMAN::Util::Crosrng_msg_vec(), EMAN::Util::Crosrng_psi_0_180(), EMAN::EMData::cut_slice(), EMAN::EMData::do_radon(), EMAN::EMData::dot_rotate_translate(), dpofa_(), dtrsl_(), EMAN::EMObject::EMObject(), EMAN::TestUtil::emobject_to_py(), EMAN::TestUtil::emobject_transformarray_to_py(), EMAN::Util::fftc_d(), fftc_d(), EMAN::Util::fftc_q(), fftc_q(), EMAN::Util::fftr_d(), fftr_d(), EMAN::Util::fftr_q(), fftr_q(), formk_(), EMAN::RandomOrientationGenerator::gen_orientations(), EMAN::TetrahedralSym::get_asym_unit_points(), EMAN::PlatonicSym::get_asym_unit_points(), EMAN::EMData::get_attr(), EMAN::ImagicIO2::get_datatype_from_name(), EMAN::ImagicIO::get_datatype_from_name(), EMAN::TestUtil::get_debug_transform(), EMAN::EMObject::get_object_type_name(), EMAN::EMData::get_pixel_filtered(), EMAN::Transform::get_sym_proj(), EMAN::Util::get_time_label(), EMAN::Symmetry3D::get_touching_au_transforms(), hpsolb_(), 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::Quaternion::interpolate(), intrsc_(), EMAN::Transform::inverse(), EMAN::Vec2< Type >::length(), EMAN::Vec3< int >::length(), EMAN::Util::list_mutation(), lnsrlb_(), main(), mainlb_(), 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::SymAlignProcessor::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_(), slamc1_(), slamc2_(), slamch_(), slarfb_(), slarft_(), slasq2_(), slasq3_(), slasv2_(), sormlq_(), sormqr_(), subsm_(), EMAN::MarchingCubes::surface_face_z(), test_shared_pointer(), EMAN::Transform::tet_3_to_2(), EMAN::TransformProcessor::transform(), EMAN::EMData::translate(), EMAN::Transform::transpose(), trplot_(), EMAN::EMData::unwrap(), EMAN::EMData::unwrap_largerR(), varmx(), vrplot_(), EMAN::SpiderIO::write_single_header(), EMAN::RT3DSphereAligner::xform_align_nbest(), and EMAN::RT3DGridAligner::xform_align_nbest().

#define t7  )     t7[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_ns(), EMAN::Util::Crosrng_psi_0_180(), EMAN::Util::Crosrng_psi_0_180_no_mirror(), and EMAN::Util::Crosrng_sm_psi().

#define tab1  )     tab1[i-1]
 

Definition at line 2612 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 7168 of file util_sparx.cpp.

Referenced by ali3d_d(), EMAN::PawelProjector::backproject3d(), EMAN::ChaoProjector::backproject3d(), cauchy_(), cmprlb_(), dcstep_(), EMAN::Util::even_angles(), fcalc(), fgcalc(), formt_(), EMAN::file_store::get_image(), EMAN::Util::hsortd(), LBD_Cart(), main(), mainlb_(), matupd_(), 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_sirt_mpi(), recons3d_sirt_mpi_Cart(), EMAN::EMData::rot_scale_conv_new_3D(), EMAN::EMData::rot_scale_conv_new_background_3D(), EMAN::Transform::set_rotation(), EMAN::ChaoProjector::setdm(), subsm_(), trans_(), EMAN::Util::twoD_to_3D_ali(), EMAN::Util::voronoi(), and EMAN::Util::vrdg().

#define thetast  )     thetast [i-1]
 

Definition at line 7173 of file util_sparx.cpp.

#define TRUE   1
 

Definition at line 7164 of file util_sparx.cpp.

#define TRUE_   (1)
 

Definition at line 7868 of file util_sparx.cpp.

#define ts  )     ts [i-1]
 

Definition at line 7172 of file util_sparx.cpp.

#define VP  )     VP [i-1]
 

Definition at line 6013 of file util_sparx.cpp.

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

#define VV  )     VV [i-1]
 

Definition at line 6014 of file util_sparx.cpp.

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

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

Definition at line 6007 of file util_sparx.cpp.

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

Definition at line 6007 of file util_sparx.cpp.

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

#define weight  )     weight [i-1]
 

Definition at line 7170 of file util_sparx.cpp.

Referenced by ali3d_d(), EMAN::FRCCmp::cmp(), EMAN::WienerFourierReconstructor::determine_slice_agreement(), EMAN::FourierReconstructor::determine_slice_agreement(), EMAN::WienerFourierReconstructor::do_compare_slice_work(), EMAN::FourierReconstructor::do_compare_slice_work(), EMAN::WienerFourierReconstructor::do_insert_slice_work(), EMAN::FourierInserter3DMode5::insert_pixel(), EMAN::FourierInserter3DMode3::insert_pixel(), EMAN::FourierInserter3DMode1::insert_pixel(), EMAN::WienerFourierReconstructor::insert_slice(), EMAN::FourierReconstructor::insert_slice(), EMAN::Util::voronoi(), and EMAN::Util::vrdg().

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

Definition at line 2613 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 2134 of file util_sparx.cpp.

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


Function Documentation

int addnod_ int *  nst,
int *  k,
double *  x,
double *  y,
double *  z__,
int *  list,
int *  lptr,
int *  lend,
int *  lnew,
int *  ier
 

Definition at line 8322 of file util_sparx.cpp.

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

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

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

double angle_ double *  v1,
double *  v2,
double *  v3
 

Definition at line 8581 of file util_sparx.cpp.

References left_(), and sqrt().

Referenced by areav_new__().

08582 {
08583     /* System generated locals */
08584     double ret_val;
08585 
08586     /* Builtin functions */
08587     //double sqrt(double), acos(double);
08588 
08589     /* Local variables */
08590     static double a;
08591     static int i__;
08592     static double ca, s21, s23, u21[3], u23[3];
08593     extern long int left_(double *, double *, double *, double
08594             *, double *, double *, double *, double *,
08595             double *);
08596 
08597 
08598 /* *********************************************************** */
08599 
08600 /*                                              From STRIPACK */
08601 /*                                            Robert J. Renka */
08602 /*                                  Dept. of Computer Science */
08603 /*                                       Univ. of North Texas */
08604 /*                                           renka@cs.unt.edu */
08605 /*                                                   06/03/03 */
08606 
08607 /*   Given a sequence of three nodes (V1,V2,V3) on the sur- */
08608 /* face of the unit sphere, this function returns the */
08609 /* interior angle at V2 -- the dihedral angle between the */
08610 /* plane defined by V2 and V3 (and the origin) and the plane */
08611 /* defined by V2 and V1 or, equivalently, the angle between */
08612 /* the normals V2 X V3 and V2 X V1.  Note that the angle is */
08613 /* in the range 0 to Pi if V3 Left V1->V2, Pi to 2*Pi other- */
08614 /* wise.  The surface area of a spherical polygon with CCW- */
08615 /* ordered vertices V1, V2, ..., Vm is Asum - (m-2)*Pi, where */
08616 /* Asum is the sum of the m interior angles computed from the */
08617 /* sequences (Vm,V1,V2), (V1,V2,V3), (V2,V3,V4), ..., */
08618 /* (Vm-1,Vm,V1). */
08619 
08620 
08621 /* On input: */
08622 
08623 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
08624 /*                  sian coordinates of unit vectors.  These */
08625 /*                  vectors, if nonzero, are implicitly */
08626 /*                  scaled to have length 1. */
08627 
08628 /* Input parameters are not altered by this function. */
08629 
08630 /* On output: */
08631 
08632 /*       ANGLE = Angle defined above, or 0 if V2 X V1 = 0 or */
08633 /*               V2 X V3 = 0. */
08634 
08635 /* Module required by ANGLE:  LEFT */
08636 
08637 /* Intrinsic functions called by ANGLE:  ACOS, SQRT */
08638 
08639 /* *********************************************************** */
08640 
08641 
08642 /* Local parameters: */
08643 
08644 /* A =       Interior angle at V2 */
08645 /* CA =      cos(A) */
08646 /* I =       DO-loop index and index for U21 and U23 */
08647 /* S21,S23 = Sum of squared components of U21 and U23 */
08648 /* U21,U23 = Unit normal vectors to the planes defined by */
08649 /*             pairs of triangle vertices */
08650 
08651 
08652 /* Compute cross products U21 = V2 X V1 and U23 = V2 X V3. */
08653 
08654     /* Parameter adjustments */
08655     --v3;
08656     --v2;
08657     --v1;
08658 
08659     /* Function Body */
08660     u21[0] = v2[2] * v1[3] - v2[3] * v1[2];
08661     u21[1] = v2[3] * v1[1] - v2[1] * v1[3];
08662     u21[2] = v2[1] * v1[2] - v2[2] * v1[1];
08663 
08664     u23[0] = v2[2] * v3[3] - v2[3] * v3[2];
08665     u23[1] = v2[3] * v3[1] - v2[1] * v3[3];
08666     u23[2] = v2[1] * v3[2] - v2[2] * v3[1];
08667 
08668 /* Normalize U21 and U23 to unit vectors. */
08669 
08670     s21 = 0.;
08671     s23 = 0.;
08672     for (i__ = 1; i__ <= 3; ++i__) {
08673         s21 += u21[i__ - 1] * u21[i__ - 1];
08674         s23 += u23[i__ - 1] * u23[i__ - 1];
08675 /* L1: */
08676     }
08677 
08678 /* Test for a degenerate triangle associated with collinear */
08679 /*   vertices. */
08680 
08681     if (s21 == 0. || s23 == 0.) {
08682         ret_val = 0.;
08683         return ret_val;
08684     }
08685     s21 = sqrt(s21);
08686     s23 = sqrt(s23);
08687     for (i__ = 1; i__ <= 3; ++i__) {
08688         u21[i__ - 1] /= s21;
08689         u23[i__ - 1] /= s23;
08690 /* L2: */
08691     }
08692 
08693 /* Compute the angle A between normals: */
08694 
08695 /*   CA = cos(A) = <U21,U23> */
08696 
08697     ca = u21[0] * u23[0] + u21[1] * u23[1] + u21[2] * u23[2];
08698     if (ca < -1.) {
08699         ca = -1.;
08700     }
08701     if (ca > 1.) {
08702         ca = 1.;
08703     }
08704     a = acos(ca);
08705 
08706 /* Adjust A to the interior angle:  A > Pi iff */
08707 /*   V3 Right V1->V2. */
08708 
08709     if (! left_(&v1[1], &v1[2], &v1[3], &v2[1], &v2[2], &v2[3], &v3[1], &v3[2]
08710             , &v3[3])) {
08711         a = acos(-1.) * 2. - a;
08712     }
08713     ret_val = a;
08714     return ret_val;
08715 } /* angle_ */

double areas_ double *  v1,
double *  v2,
double *  v3
 

Definition at line 8717 of file util_sparx.cpp.

References sqrt().

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

08718 {
08719     /* System generated locals */
08720     double ret_val;
08721 
08722     /* Builtin functions */
08723     //double sqrt(double), acos(double);
08724 
08725     /* Local variables */
08726     static int i__;
08727     static double a1, a2, a3, s12, s31, s23, u12[3], u23[3], u31[3], ca1,
08728             ca2, ca3;
08729 
08730 
08731 /* *********************************************************** */
08732 
08733 /*                                              From STRIPACK */
08734 /*                                            Robert J. Renka */
08735 /*                                  Dept. of Computer Science */
08736 /*                                       Univ. of North Texas */
08737 /*                                           renka@cs.unt.edu */
08738 /*                                                   06/22/98 */
08739 
08740 /*   This function returns the area of a spherical triangle */
08741 /* on the unit sphere. */
08742 
08743 
08744 /* On input: */
08745 
08746 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
08747 /*                  sian coordinates of unit vectors (the */
08748 /*                  three triangle vertices in any order). */
08749 /*                  These vectors, if nonzero, are implicitly */
08750 /*                  scaled to have length 1. */
08751 
08752 /* Input parameters are not altered by this function. */
08753 
08754 /* On output: */
08755 
08756 /*       AREAS = Area of the spherical triangle defined by */
08757 /*               V1, V2, and V3 in the range 0 to 2*PI (the */
08758 /*               area of a hemisphere).  AREAS = 0 (or 2*PI) */
08759 /*               if and only if V1, V2, and V3 lie in (or */
08760 /*               close to) a plane containing the origin. */
08761 
08762 /* Modules required by AREAS:  None */
08763 
08764 /* Intrinsic functions called by AREAS:  ACOS, SQRT */
08765 
08766 /* *********************************************************** */
08767 
08768 
08769 /* Local parameters: */
08770 
08771 /* A1,A2,A3 =    Interior angles of the spherical triangle */
08772 /* CA1,CA2,CA3 = cos(A1), cos(A2), and cos(A3), respectively */
08773 /* I =           DO-loop index and index for Uij */
08774 /* S12,S23,S31 = Sum of squared components of U12, U23, U31 */
08775 /* U12,U23,U31 = Unit normal vectors to the planes defined by */
08776 /*                 pairs of triangle vertices */
08777 
08778 
08779 /* Compute cross products Uij = Vi X Vj. */
08780 
08781     /* Parameter adjustments */
08782     --v3;
08783     --v2;
08784     --v1;
08785 
08786     /* Function Body */
08787     u12[0] = v1[2] * v2[3] - v1[3] * v2[2];
08788     u12[1] = v1[3] * v2[1] - v1[1] * v2[3];
08789     u12[2] = v1[1] * v2[2] - v1[2] * v2[1];
08790 
08791     u23[0] = v2[2] * v3[3] - v2[3] * v3[2];
08792     u23[1] = v2[3] * v3[1] - v2[1] * v3[3];
08793     u23[2] = v2[1] * v3[2] - v2[2] * v3[1];
08794 
08795     u31[0] = v3[2] * v1[3] - v3[3] * v1[2];
08796     u31[1] = v3[3] * v1[1] - v3[1] * v1[3];
08797     u31[2] = v3[1] * v1[2] - v3[2] * v1[1];
08798 
08799 /* Normalize Uij to unit vectors. */
08800 
08801     s12 = 0.;
08802     s23 = 0.;
08803     s31 = 0.;
08804     for (i__ = 1; i__ <= 3; ++i__) {
08805         s12 += u12[i__ - 1] * u12[i__ - 1];
08806         s23 += u23[i__ - 1] * u23[i__ - 1];
08807         s31 += u31[i__ - 1] * u31[i__ - 1];
08808 /* L2: */
08809     }
08810 
08811 /* Test for a degenerate triangle associated with collinear */
08812 /*   vertices. */
08813 
08814     if (s12 == 0. || s23 == 0. || s31 == 0.) {
08815         ret_val = 0.;
08816         return ret_val;
08817     }
08818     s12 = sqrt(s12);
08819     s23 = sqrt(s23);
08820     s31 = sqrt(s31);
08821     for (i__ = 1; i__ <= 3; ++i__) {
08822         u12[i__ - 1] /= s12;
08823         u23[i__ - 1] /= s23;
08824         u31[i__ - 1] /= s31;
08825 /* L3: */
08826     }
08827 
08828 /* Compute interior angles Ai as the dihedral angles between */
08829 /*   planes: */
08830 /*           CA1 = cos(A1) = -<U12,U31> */
08831 /*           CA2 = cos(A2) = -<U23,U12> */
08832 /*           CA3 = cos(A3) = -<U31,U23> */
08833 
08834     ca1 = -u12[0] * u31[0] - u12[1] * u31[1] - u12[2] * u31[2];
08835     ca2 = -u23[0] * u12[0] - u23[1] * u12[1] - u23[2] * u12[2];
08836     ca3 = -u31[0] * u23[0] - u31[1] * u23[1] - u31[2] * u23[2];
08837     if (ca1 < -1.) {
08838         ca1 = -1.;
08839     }
08840     if (ca1 > 1.) {
08841         ca1 = 1.;
08842     }
08843     if (ca2 < -1.) {
08844         ca2 = -1.;
08845     }
08846     if (ca2 > 1.) {
08847         ca2 = 1.;
08848     }
08849     if (ca3 < -1.) {
08850         ca3 = -1.;
08851     }
08852     if (ca3 > 1.) {
08853         ca3 = 1.;
08854     }
08855     a1 = acos(ca1);
08856     a2 = acos(ca2);
08857     a3 = acos(ca3);
08858 
08859 /* Compute AREAS = A1 + A2 + A3 - PI. */
08860 
08861     ret_val = a1 + a2 + a3 - acos(-1.);
08862     if (ret_val < 0.) {
08863         ret_val = 0.;
08864     }
08865     return ret_val;
08866 } /* 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 9072 of file util_sparx.cpp.

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

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

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

Definition at line 9285 of file util_sparx.cpp.

References insert_().

Referenced by addnod_().

09287 {
09288     static int k, n1, n2, lp, lsav, nsav, next;
09289     extern /* Subroutine */ int insert_(int *, int *, int *,
09290             int *, int *);
09291 
09292 
09293 /* *********************************************************** */
09294 
09295 /*                                              From STRIPACK */
09296 /*                                            Robert J. Renka */
09297 /*                                  Dept. of Computer Science */
09298 /*                                       Univ. of North Texas */
09299 /*                                           renka@cs.unt.edu */
09300 /*                                                   07/11/96 */
09301 
09302 /*   This subroutine adds a boundary node to a triangulation */
09303 /* of a set of KK-1 points on the unit sphere.  The data */
09304 /* structure is updated with the insertion of node KK, but no */
09305 /* optimization is performed. */
09306 
09307 /*   This routine is identical to the similarly named routine */
09308 /* in TRIPACK. */
09309 
09310 
09311 /* On input: */
09312 
09313 /*       KK = Index of a node to be connected to the sequence */
09314 /*            of all visible boundary nodes.  KK .GE. 1 and */
09315 /*            KK must not be equal to I1 or I2. */
09316 
09317 /*       I1 = First (rightmost as viewed from KK) boundary */
09318 /*            node in the triangulation that is visible from */
09319 /*            node KK (the line segment KK-I1 intersects no */
09320 /*            arcs. */
09321 
09322 /*       I2 = Last (leftmost) boundary node that is visible */
09323 /*            from node KK.  I1 and I2 may be determined by */
09324 /*            Subroutine TRFIND. */
09325 
09326 /* The above parameters are not altered by this routine. */
09327 
09328 /*       LIST,LPTR,LEND,LNEW = Triangulation data structure */
09329 /*                             created by Subroutine TRMESH. */
09330 /*                             Nodes I1 and I2 must be in- */
09331 /*                             cluded in the triangulation. */
09332 
09333 /* On output: */
09334 
09335 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
09336 /*                             the addition of node KK.  Node */
09337 /*                             KK is connected to I1, I2, and */
09338 /*                             all boundary nodes in between. */
09339 
09340 /* Module required by BDYADD:  INSERT */
09341 
09342 /* *********************************************************** */
09343 
09344 
09345 /* Local parameters: */
09346 
09347 /* K =     Local copy of KK */
09348 /* LP =    LIST pointer */
09349 /* LSAV =  LIST pointer */
09350 /* N1,N2 = Local copies of I1 and I2, respectively */
09351 /* NEXT =  Boundary node visible from K */
09352 /* NSAV =  Boundary node visible from K */
09353 
09354     /* Parameter adjustments */
09355     --lend;
09356     --lptr;
09357     --list;
09358 
09359     /* Function Body */
09360     k = *kk;
09361     n1 = *i1;
09362     n2 = *i2;
09363 
09364 /* Add K as the last neighbor of N1. */
09365 
09366     lp = lend[n1];
09367     lsav = lptr[lp];
09368     lptr[lp] = *lnew;
09369     list[*lnew] = -k;
09370     lptr[*lnew] = lsav;
09371     lend[n1] = *lnew;
09372     ++(*lnew);
09373     next = -list[lp];
09374     list[lp] = next;
09375     nsav = next;
09376 
09377 /* Loop on the remaining boundary nodes between N1 and N2, */
09378 /*   adding K as the first neighbor. */
09379 
09380 L1:
09381     lp = lend[next];
09382     insert_(&k, &lp, &list[1], &lptr[1], lnew);
09383     if (next == n2) {
09384         goto L2;
09385     }
09386     next = -list[lp];
09387     list[lp] = next;
09388     goto L1;
09389 
09390 /* Add the boundary nodes between N1 and N2 as neighbors */
09391 /*   of node K. */
09392 
09393 L2:
09394     lsav = *lnew;
09395     list[*lnew] = n1;
09396     lptr[*lnew] = *lnew + 1;
09397     ++(*lnew);
09398     next = nsav;
09399 
09400 L3:
09401     if (next == n2) {
09402         goto L4;
09403     }
09404     list[*lnew] = next;
09405     lptr[*lnew] = *lnew + 1;
09406     ++(*lnew);
09407     lp = lend[next];
09408     next = list[lp];
09409     goto L3;
09410 
09411 L4:
09412     list[*lnew] = -n2;
09413     lptr[*lnew] = lsav;
09414     lend[k] = *lnew;
09415     ++(*lnew);
09416     return 0;
09417 } /* bdyadd_ */

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

Definition at line 9419 of file util_sparx.cpp.

References nn().

09421 {
09422     /* System generated locals */
09423     int i__1;
09424 
09425     /* Local variables */
09426     static int k, n0, lp, nn, nst;
09427 
09428 
09429 /* *********************************************************** */
09430 
09431 /*                                              From STRIPACK */
09432 /*                                            Robert J. Renka */
09433 /*                                  Dept. of Computer Science */
09434 /*                                       Univ. of North Texas */
09435 /*                                           renka@cs.unt.edu */
09436 /*                                                   06/26/96 */
09437 
09438 /*   Given a triangulation of N nodes on the unit sphere */
09439 /* created by Subroutine TRMESH, this subroutine returns an */
09440 /* array containing the indexes (if any) of the counterclock- */
09441 /* wise-ordered sequence of boundary nodes -- the nodes on */
09442 /* the boundary of the convex hull of the set of nodes.  (The */
09443 /* boundary is empty if the nodes do not lie in a single */
09444 /* hemisphere.)  The numbers of boundary nodes, arcs, and */
09445 /* triangles are also returned. */
09446 
09447 
09448 /* On input: */
09449 
09450 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
09451 
09452 /*       LIST,LPTR,LEND = Data structure defining the trian- */
09453 /*                        gulation.  Refer to Subroutine */
09454 /*                        TRMESH. */
09455 
09456 /* The above parameters are not altered by this routine. */
09457 
09458 /*       NODES = int array of length at least NB */
09459 /*               (NB .LE. N). */
09460 
09461 /* On output: */
09462 
09463 /*       NODES = Ordered sequence of boundary node indexes */
09464 /*               in the range 1 to N (in the first NB loca- */
09465 /*               tions). */
09466 
09467 /*       NB = Number of boundary nodes. */
09468 
09469 /*       NA,NT = Number of arcs and triangles, respectively, */
09470 /*               in the triangulation. */
09471 
09472 /* Modules required by BNODES:  None */
09473 
09474 /* *********************************************************** */
09475 
09476 
09477 /* Local parameters: */
09478 
09479 /* K =   NODES index */
09480 /* LP =  LIST pointer */
09481 /* N0 =  Boundary node to be added to NODES */
09482 /* NN =  Local copy of N */
09483 /* NST = First element of nodes (arbitrarily chosen to be */
09484 /*         the one with smallest index) */
09485 
09486     /* Parameter adjustments */
09487     --lend;
09488     --list;
09489     --lptr;
09490     --nodes;
09491 
09492     /* Function Body */
09493     nn = *n;
09494 
09495 /* Search for a boundary node. */
09496 
09497     i__1 = nn;
09498     for (nst = 1; nst <= i__1; ++nst) {
09499         lp = lend[nst];
09500         if (list[lp] < 0) {
09501             goto L2;
09502         }
09503 /* L1: */
09504     }
09505 
09506 /* The triangulation contains no boundary nodes. */
09507 
09508     *nb = 0;
09509     *na = (nn - 2) * 3;
09510     *nt = nn - (2<<1);
09511     return 0;
09512 
09513 /* NST is the first boundary node encountered.  Initialize */
09514 /*   for traversal of the boundary. */
09515 
09516 L2:
09517     nodes[1] = nst;
09518     k = 1;
09519     n0 = nst;
09520 
09521 /* Traverse the boundary in counterclockwise order. */
09522 
09523 L3:
09524     lp = lend[n0];
09525     lp = lptr[lp];
09526     n0 = list[lp];
09527     if (n0 == nst) {
09528         goto L4;
09529     }
09530     ++k;
09531     nodes[k] = n0;
09532     goto L3;
09533 
09534 /* Store the counts. */
09535 
09536 L4:
09537     *nb = k;
09538     *nt = (*n << 1) - *nb - 2;
09539     *na = *nt + *n - 1;
09540     return 0;
09541 } /* bnodes_ */

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

Definition at line 9543 of file util_sparx.cpp.

09545 {
09546     /* System generated locals */
09547     int i__1;
09548 
09549     /* Builtin functions */
09550     //double atan(double), cos(double), sin(double);
09551 
09552     /* Local variables */
09553     static double a, c__;
09554     static int i__;
09555     static double s;
09556     static int k2, k3;
09557     static double x0, y0;
09558     static int kk, np1;
09559 
09560 
09561 /* *********************************************************** */
09562 
09563 /*                                              From STRIPACK */
09564 /*                                            Robert J. Renka */
09565 /*                                  Dept. of Computer Science */
09566 /*                                       Univ. of North Texas */
09567 /*                                           renka@cs.unt.edu */
09568 /*                                                   04/06/90 */
09569 
09570 /*   This subroutine computes the coordinates of a sequence */
09571 /* of N equally spaced points on the unit circle centered at */
09572 /* (0,0).  An N-sided polygonal approximation to the circle */
09573 /* may be plotted by connecting (XC(I),YC(I)) to (XC(I+1), */
09574 /* YC(I+1)) for I = 1,...,N, where XC(N+1) = XC(1) and */
09575 /* YC(N+1) = YC(1).  A reasonable value for N in this case */
09576 /* is 2*PI*R, where R is the radius of the circle in device */
09577 /* coordinates. */
09578 
09579 
09580 /* On input: */
09581 
09582 /*       K = Number of points in each quadrant, defining N as */
09583 /*           4K.  K .GE. 1. */
09584 
09585 /*       XC,YC = Arrays of length at least N+1 = 4K+1. */
09586 
09587 /* K is not altered by this routine. */
09588 
09589 /* On output: */
09590 
09591 /*       XC,YC = Cartesian coordinates of the points on the */
09592 /*               unit circle in the first N+1 locations. */
09593 /*               XC(I) = cos(A*(I-1)), YC(I) = sin(A*(I-1)), */
09594 /*               where A = 2*PI/N.  Note that XC(N+1) = XC(1) */
09595 /*               and YC(N+1) = YC(1). */
09596 
09597 /*       IER = Error indicator: */
09598 /*             IER = 0 if no errors were encountered. */
09599 /*             IER = 1 if K < 1 on input. */
09600 
09601 /* Modules required by CIRCLE:  None */
09602 
09603 /* Intrinsic functions called by CIRCLE:  ATAN, COS, DBLE, */
09604 /*                                          SIN */
09605 
09606 /* *********************************************************** */
09607 
09608 
09609 /* Local parameters: */
09610 
09611 /* I =     DO-loop index and index for XC and YC */
09612 /* KK =    Local copy of K */
09613 /* K2 =    K*2 */
09614 /* K3 =    K*3 */
09615 /* NP1 =   N+1 = 4*K + 1 */
09616 /* A =     Angular separation between adjacent points */
09617 /* C,S =   Cos(A) and sin(A), respectively, defining a */
09618 /*           rotation through angle A */
09619 /* X0,Y0 = Cartesian coordinates of a point on the unit */
09620 /*           circle in the first quadrant */
09621 
09622     /* Parameter adjustments */
09623     --yc;
09624     --xc;
09625 
09626     /* Function Body */
09627     kk = *k;
09628     k2 = kk << 1;
09629     k3 = kk * 3;
09630     np1 = (kk << 2) + 1;
09631 
09632 /* Test for invalid input, compute A, C, and S, and */
09633 /*   initialize (X0,Y0) to (1,0). */
09634 
09635     if (kk < 1) {
09636         goto L2;
09637     }
09638     a = atan(1.) * 2. / (double) kk;
09639     c__ = cos(a);
09640     s = sin(a);
09641     x0 = 1.;
09642     y0 = 0.;
09643 
09644 /* Loop on points (X0,Y0) in the first quadrant, storing */
09645 /*   the point and its reflections about the x axis, the */
09646 /*   y axis, and the line y = -x. */
09647 
09648     i__1 = kk;
09649     for (i__ = 1; i__ <= i__1; ++i__) {
09650         xc[i__] = x0;
09651         yc[i__] = y0;
09652         xc[i__ + kk] = -y0;
09653         yc[i__ + kk] = x0;
09654         xc[i__ + k2] = -x0;
09655         yc[i__ + k2] = -y0;
09656         xc[i__ + k3] = y0;
09657         yc[i__ + k3] = -x0;
09658 
09659 /*   Rotate (X0,Y0) counterclockwise through angle A. */
09660 
09661         x0 = c__ * x0 - s * y0;
09662         y0 = s * x0 + c__ * y0;
09663 /* L1: */
09664     }
09665 
09666 /* Store the coordinates of the first point as the last */
09667 /*   point. */
09668 
09669     xc[np1] = xc[1];
09670     yc[np1] = yc[1];
09671     *ier = 0;
09672     return 0;
09673 
09674 /* K < 1. */
09675 
09676 L2:
09677     *ier = 1;
09678     return 0;
09679 } /* circle_ */

int circum_ double *  v1,
double *  v2,
double *  v3,
double *  c__,
int *  ier
 

Definition at line 9681 of file util_sparx.cpp.

References sqrt().

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

09683 {
09684     /* Builtin functions */
09685     //double sqrt(double);
09686 
09687     /* Local variables */
09688     static int i__;
09689     static double e1[3], e2[3], cu[3], cnorm;
09690 
09691 
09692 /* *********************************************************** */
09693 
09694 /*                                              From STRIPACK */
09695 /*                                            Robert J. Renka */
09696 /*                                  Dept. of Computer Science */
09697 /*                                       Univ. of North Texas */
09698 /*                                           renka@cs.unt.edu */
09699 /*                                                   10/27/02 */
09700 
09701 /*   This subroutine returns the circumcenter of a spherical */
09702 /* triangle on the unit sphere:  the point on the sphere sur- */
09703 /* face that is equally distant from the three triangle */
09704 /* vertices and lies in the same hemisphere, where distance */
09705 /* is taken to be arc-length on the sphere surface. */
09706 
09707 
09708 /* On input: */
09709 
09710 /*       V1,V2,V3 = Arrays of length 3 containing the Carte- */
09711 /*                  sian coordinates of the three triangle */
09712 /*                  vertices (unit vectors) in CCW order. */
09713 
09714 /* The above parameters are not altered by this routine. */
09715 
09716 /*       C = Array of length 3. */
09717 
09718 /* On output: */
09719 
09720 /*       C = Cartesian coordinates of the circumcenter unless */
09721 /*           IER > 0, in which case C is not defined.  C = */
09722 /*           (V2-V1) X (V3-V1) normalized to a unit vector. */
09723 
09724 /*       IER = Error indicator: */
09725 /*             IER = 0 if no errors were encountered. */
09726 /*             IER = 1 if V1, V2, and V3 lie on a common */
09727 /*                     line:  (V2-V1) X (V3-V1) = 0. */
09728 /*             (The vertices are not tested for validity.) */
09729 
09730 /* Modules required by CIRCUM:  None */
09731 
09732 /* Intrinsic function called by CIRCUM:  SQRT */
09733 
09734 /* *********************************************************** */
09735 
09736 
09737 /* Local parameters: */
09738 
09739 /* CNORM = Norm of CU:  used to compute C */
09740 /* CU =    Scalar multiple of C:  E1 X E2 */
09741 /* E1,E2 = Edges of the underlying planar triangle: */
09742 /*           V2-V1 and V3-V1, respectively */
09743 /* I =     DO-loop index */
09744 
09745     /* Parameter adjustments */
09746     --c__;
09747     --v3;
09748     --v2;
09749     --v1;
09750 
09751     /* Function Body */
09752     for (i__ = 1; i__ <= 3; ++i__) {
09753         e1[i__ - 1] = v2[i__] - v1[i__];
09754         e2[i__ - 1] = v3[i__] - v1[i__];
09755 /* L1: */
09756     }
09757 
09758 /* Compute CU = E1 X E2 and CNORM**2. */
09759 
09760     cu[0] = e1[1] * e2[2] - e1[2] * e2[1];
09761     cu[1] = e1[2] * e2[0] - e1[0] * e2[2];
09762     cu[2] = e1[0] * e2[1] - e1[1] * e2[0];
09763     cnorm = cu[0] * cu[0] + cu[1] * cu[1] + cu[2] * cu[2];
09764 
09765 /* The vertices lie on a common line if and only if CU is */
09766 /*   the zero vector. */
09767 
09768     if (cnorm != 0.) {
09769 
09770 /*   No error:  compute C. */
09771 
09772         cnorm = sqrt(cnorm);
09773         for (i__ = 1; i__ <= 3; ++i__) {
09774             c__[i__] = cu[i__ - 1] / cnorm;
09775 /* L2: */
09776         }
09777 
09778 /* If the vertices are nearly identical, the problem is */
09779 /*   ill-conditioned and it is possible for the computed */
09780 /*   value of C to be 180 degrees off:  <C,V1> near -1 */
09781 /*   when it should be positive. */
09782 
09783         if (c__[1] * v1[1] + c__[2] * v1[2] + c__[3] * v1[3] < -.5) {
09784             c__[1] = -c__[1];
09785             c__[2] = -c__[2];
09786             c__[3] = -c__[3];
09787         }
09788         *ier = 0;
09789     } else {
09790 
09791 /*   CU = 0. */
09792 
09793         *ier = 1;
09794     }
09795     return 0;
09796 } /* circum_ */

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

Definition at line 9798 of file util_sparx.cpp.

References insert_().

Referenced by addnod_().

09800 {
09801     static int k, lp, nst, lsav, next;
09802     extern /* Subroutine */ int insert_(int *, int *, int *,
09803             int *, int *);
09804 
09805 
09806 /* *********************************************************** */
09807 
09808 /*                                              From STRIPACK */
09809 /*                                            Robert J. Renka */
09810 /*                                  Dept. of Computer Science */
09811 /*                                       Univ. of North Texas */
09812 /*                                           renka@cs.unt.edu */
09813 /*                                                   07/17/96 */
09814 
09815 /*   This subroutine connects an exterior node KK to all */
09816 /* boundary nodes of a triangulation of KK-1 points on the */
09817 /* unit sphere, producing a triangulation that covers the */
09818 /* sphere.  The data structure is updated with the addition */
09819 /* of node KK, but no optimization is performed.  All boun- */
09820 /* dary nodes must be visible from node KK. */
09821 
09822 
09823 /* On input: */
09824 
09825 /*       KK = Index of the node to be connected to the set of */
09826 /*            all boundary nodes.  KK .GE. 4. */
09827 
09828 /*       N0 = Index of a boundary node (in the range 1 to */
09829 /*            KK-1).  N0 may be determined by Subroutine */
09830 /*            TRFIND. */
09831 
09832 /* The above parameters are not altered by this routine. */
09833 
09834 /*       LIST,LPTR,LEND,LNEW = Triangulation data structure */
09835 /*                             created by Subroutine TRMESH. */
09836 /*                             Node N0 must be included in */
09837 /*                             the triangulation. */
09838 
09839 /* On output: */
09840 
09841 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
09842 /*                             the addition of node KK as the */
09843 /*                             last entry.  The updated */
09844 /*                             triangulation contains no */
09845 /*                             boundary nodes. */
09846 
09847 /* Module required by COVSPH:  INSERT */
09848 
09849 /* *********************************************************** */
09850 
09851 
09852 /* Local parameters: */
09853 
09854 /* K =     Local copy of KK */
09855 /* LP =    LIST pointer */
09856 /* LSAV =  LIST pointer */
09857 /* NEXT =  Boundary node visible from K */
09858 /* NST =   Local copy of N0 */
09859 
09860     /* Parameter adjustments */
09861     --lend;
09862     --lptr;
09863     --list;
09864 
09865     /* Function Body */
09866     k = *kk;
09867     nst = *n0;
09868 
09869 /* Traverse the boundary in clockwise order, inserting K as */
09870 /*   the first neighbor of each boundary node, and converting */
09871 /*   the boundary node to an interior node. */
09872 
09873     next = nst;
09874 L1:
09875     lp = lend[next];
09876     insert_(&k, &lp, &list[1], &lptr[1], lnew);
09877     next = -list[lp];
09878     list[lp] = next;
09879     if (next != nst) {
09880         goto L1;
09881     }
09882 
09883 /* Traverse the boundary again, adding each node to K's */
09884 /*   adjacency list. */
09885 
09886     lsav = *lnew;
09887 L2:
09888     lp = lend[next];
09889     list[*lnew] = next;
09890     lptr[*lnew] = *lnew + 1;
09891     ++(*lnew);
09892     next = list[lp];
09893     if (next != nst) {
09894         goto L2;
09895     }
09896 
09897     lptr[*lnew - 1] = lsav;
09898     lend[k] = *lnew - 1;
09899     return 0;
09900 } /* 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 9902 of file util_sparx.cpp.

References abs, circum_(), ierr, lstptr_(), nn(), swptst_(), t, x, and y.

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

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

Definition at line 10532 of file util_sparx.cpp.

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

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

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

Definition at line 10687 of file util_sparx.cpp.

References abs, and nn().

Referenced by delarc_(), and delnod_().

10689 {
10690     /* System generated locals */
10691     int i__1;
10692 
10693     /* Local variables */
10694     static int i__, lp, nn, lpb, lpl, lpp, lnw;
10695 
10696 
10697 /* *********************************************************** */
10698 
10699 /*                                              From STRIPACK */
10700 /*                                            Robert J. Renka */
10701 /*                                  Dept. of Computer Science */
10702 /*                                       Univ. of North Texas */
10703 /*                                           renka@cs.unt.edu */
10704 /*                                                   07/29/98 */
10705 
10706 /*   This subroutine deletes a neighbor NB from the adjacency */
10707 /* list of node N0 (but N0 is not deleted from the adjacency */
10708 /* list of NB) and, if NB is a boundary node, makes N0 a */
10709 /* boundary node.  For pointer (LIST index) LPH to NB as a */
10710 /* neighbor of N0, the empty LIST,LPTR location LPH is filled */
10711 /* in with the values at LNEW-1, pointer LNEW-1 (in LPTR and */
10712 /* possibly in LEND) is changed to LPH, and LNEW is decremen- */
10713 /* ted.  This requires a search of LEND and LPTR entailing an */
10714 /* expected operation count of O(N). */
10715 
10716 /*   This routine is identical to the similarly named routine */
10717 /* in TRIPACK. */
10718 
10719 
10720 /* On input: */
10721 
10722 /*       N0,NB = Indexes, in the range 1 to N, of a pair of */
10723 /*               nodes such that NB is a neighbor of N0. */
10724 /*               (N0 need not be a neighbor of NB.) */
10725 
10726 /*       N = Number of nodes in the triangulation.  N .GE. 3. */
10727 
10728 /* The above parameters are not altered by this routine. */
10729 
10730 /*       LIST,LPTR,LEND,LNEW = Data structure defining the */
10731 /*                             triangulation. */
10732 
10733 /* On output: */
10734 
10735 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
10736 /*                             the removal of NB from the ad- */
10737 /*                             jacency list of N0 unless */
10738 /*                             LPH < 0. */
10739 
10740 /*       LPH = List pointer to the hole (NB as a neighbor of */
10741 /*             N0) filled in by the values at LNEW-1 or error */
10742 /*             indicator: */
10743 /*             LPH > 0 if no errors were encountered. */
10744 /*             LPH = -1 if N0, NB, or N is outside its valid */
10745 /*                      range. */
10746 /*             LPH = -2 if NB is not a neighbor of N0. */
10747 
10748 /* Modules required by DELNB:  None */
10749 
10750 /* Intrinsic function called by DELNB:  ABS */
10751 
10752 /* *********************************************************** */
10753 
10754 
10755 /* Local parameters: */
10756 
10757 /* I =   DO-loop index */
10758 /* LNW = LNEW-1 (output value of LNEW) */
10759 /* LP =  LIST pointer of the last neighbor of NB */
10760 /* LPB = Pointer to NB as a neighbor of N0 */
10761 /* LPL = Pointer to the last neighbor of N0 */
10762 /* LPP = Pointer to the neighbor of N0 that precedes NB */
10763 /* NN =  Local copy of N */
10764 
10765     /* Parameter adjustments */
10766     --lend;
10767     --list;
10768     --lptr;
10769 
10770     /* Function Body */
10771     nn = *n;
10772 
10773 /* Test for error 1. */
10774 
10775     if (*n0 < 1 || *n0 > nn || *nb < 1 || *nb > nn || nn < 3) {
10776         *lph = -1;
10777         return 0;
10778     }
10779 
10780 /*   Find pointers to neighbors of N0: */
10781 
10782 /*     LPL points to the last neighbor, */
10783 /*     LPP points to the neighbor NP preceding NB, and */
10784 /*     LPB points to NB. */
10785 
10786     lpl = lend[*n0];
10787     lpp = lpl;
10788     lpb = lptr[lpp];
10789 L1:
10790     if (list[lpb] == *nb) {
10791         goto L2;
10792     }
10793     lpp = lpb;
10794     lpb = lptr[lpp];
10795     if (lpb != lpl) {
10796         goto L1;
10797     }
10798 
10799 /*   Test for error 2 (NB not found). */
10800 
10801     if ((i__1 = list[lpb], abs(i__1)) != *nb) {
10802         *lph = -2;
10803         return 0;
10804     }
10805 
10806 /*   NB is the last neighbor of N0.  Make NP the new last */
10807 /*     neighbor and, if NB is a boundary node, then make N0 */
10808 /*     a boundary node. */
10809 
10810     lend[*n0] = lpp;
10811     lp = lend[*nb];
10812     if (list[lp] < 0) {
10813         list[lpp] = -list[lpp];
10814     }
10815     goto L3;
10816 
10817 /*   NB is not the last neighbor of N0.  If NB is a boundary */
10818 /*     node and N0 is not, then make N0 a boundary node with */
10819 /*     last neighbor NP. */
10820 
10821 L2:
10822     lp = lend[*nb];
10823     if (list[lp] < 0 && list[lpl] > 0) {
10824         lend[*n0] = lpp;
10825         list[lpp] = -list[lpp];
10826     }
10827 
10828 /*   Update LPTR so that the neighbor following NB now fol- */
10829 /*     lows NP, and fill in the hole at location LPB. */
10830 
10831 L3:
10832     lptr[lpp] = lptr[lpb];
10833     lnw = *lnew - 1;
10834     list[lpb] = list[lnw];
10835     lptr[lpb] = lptr[lnw];
10836     for (i__ = nn; i__ >= 1; --i__) {
10837         if (lend[i__] == lnw) {
10838             lend[i__] = lpb;
10839             goto L5;
10840         }
10841 /* L4: */
10842     }
10843 
10844 L5:
10845     i__1 = lnw - 1;
10846     for (i__ = 1; i__ <= i__1; ++i__) {
10847         if (lptr[i__] == lnw) {
10848             lptr[i__] = lpb;
10849         }
10850 /* L6: */
10851     }
10852 
10853 /* No errors encountered. */
10854 
10855     *lnew = lnw;
10856     *lph = lpb;
10857     return 0;
10858 } /* 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 10860 of file util_sparx.cpp.

References abs, delnb_(), ierr, left_(), lstptr_(), nbcnt_(), nn(), optim_(), swap_(), x, and y.

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

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

Definition at line 11400 of file util_sparx.cpp.

References abs, q, and sqrt().

Referenced by trplot_(), and vrplot_().

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

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

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

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

Definition at line 20020 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().

20021 {
20022         int offs[][3] = { {-1, 0, 0}, {1, 0, 0}, {0, -1, 0}, {0, 1, 0}, {0, 0, -1}, {0, 0, 1} };
20023         int noff = 6;
20024 
20025         int nx = visited->get_xsize();
20026         int ny = visited->get_ysize();
20027         int nz = visited->get_zsize();
20028 
20029         vector< point3d_t > pts;
20030         pts.push_back( point3d_t(ix, iy, iz) );
20031         visited->set_value_at( ix, iy, iz, (float)grpid );
20032 
20033         int start = 0;
20034         int end = pts.size();
20035 
20036         while( end > start ) {
20037                 for(int i=start; i < end; ++i ) {
20038                         int ix = pts[i].x;
20039                         int iy = pts[i].y;
20040                         int iz = pts[i].z;
20041 
20042                         for( int j=0; j < noff; ++j ) {
20043                                 int jx = ix + offs[j][0];
20044                                 int jy = iy + offs[j][1];
20045                                 int jz = iz + offs[j][2];
20046 
20047                                 if( jx < 0 || jx >= nx ) continue;
20048                                 if( jy < 0 || jy >= ny ) continue;
20049                                 if( jz < 0 || jz >= nz ) continue;
20050 
20051 
20052                                 if( (*mg)(jx, jy, jz)>0 && (*visited)(jx, jy, jz)==0.0 ) {
20053                                     pts.push_back( point3d_t(jx, jy, jz) );
20054                                     visited->set_value_at( jx, jy, jz, (float)grpid );
20055                                 }
20056 
20057                         }
20058                 }
20059 
20060                 start = end;
20061                 end = pts.size();
20062         }
20063         return pts.size();
20064 }

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 12240 of file util_sparx.cpp.

References abs, x, and y.

12243 {
12244     /* System generated locals */
12245     int i__1, i__2;
12246 
12247     /* Local variables */
12248     static int i__, n1;
12249     static double x1, y1, z1;
12250     static int nb, ni, lp, np, lm1;
12251     static double dnb, dnp;
12252     static int lpl;
12253 
12254 
12255 /* *********************************************************** */
12256 
12257 /*                                              From STRIPACK */
12258 /*                                            Robert J. Renka */
12259 /*                                  Dept. of Computer Science */
12260 /*                                       Univ. of North Texas */
12261 /*                                           renka@cs.unt.edu */
12262 /*                                                   07/28/98 */
12263 
12264 /*   Given a Delaunay triangulation of N nodes on the unit */
12265 /* sphere and an array NPTS containing the indexes of L-1 */
12266 /* nodes ordered by angular distance from NPTS(1), this sub- */
12267 /* routine sets NPTS(L) to the index of the next node in the */
12268 /* sequence -- the node, other than NPTS(1),...,NPTS(L-1), */
12269 /* that is closest to NPTS(1).  Thus, the ordered sequence */
12270 /* of K closest nodes to N1 (including N1) may be determined */
12271 /* by K-1 calls to GETNP with NPTS(1) = N1 and L = 2,3,...,K */
12272 /* for K .GE. 2. */
12273 
12274 /*   The algorithm uses the property of a Delaunay triangula- */
12275 /* tion that the K-th closest node to N1 is a neighbor of one */
12276 /* of the K-1 closest nodes to N1. */
12277 
12278 
12279 /* On input: */
12280 
12281 /*       X,Y,Z = Arrays of length N containing the Cartesian */
12282 /*               coordinates of the nodes. */
12283 
12284 /*       LIST,LPTR,LEND = Triangulation data structure.  Re- */
12285 /*                        fer to Subroutine TRMESH. */
12286 
12287 /*       L = Number of nodes in the sequence on output.  2 */
12288 /*           .LE. L .LE. N. */
12289 
12290 /* The above parameters are not altered by this routine. */
12291 
12292 /*       NPTS = Array of length .GE. L containing the indexes */
12293 /*              of the L-1 closest nodes to NPTS(1) in the */
12294 /*              first L-1 locations. */
12295 
12296 /* On output: */
12297 
12298 /*       NPTS = Array updated with the index of the L-th */
12299 /*              closest node to NPTS(1) in position L unless */
12300 /*              IER = 1. */
12301 
12302 /*       DF = Value of an increasing function (negative cos- */
12303 /*            ine) of the angular distance between NPTS(1) */
12304 /*            and NPTS(L) unless IER = 1. */
12305 
12306 /*       IER = Error indicator: */
12307 /*             IER = 0 if no errors were encountered. */
12308 /*             IER = 1 if L < 2. */
12309 
12310 /* Modules required by GETNP:  None */
12311 
12312 /* Intrinsic function called by GETNP:  ABS */
12313 
12314 /* *********************************************************** */
12315 
12316 
12317 /* Local parameters: */
12318 
12319 /* DNB,DNP =  Negative cosines of the angular distances from */
12320 /*              N1 to NB and to NP, respectively */
12321 /* I =        NPTS index and DO-loop index */
12322 /* LM1 =      L-1 */
12323 /* LP =       LIST pointer of a neighbor of NI */
12324 /* LPL =      Pointer to the last neighbor of NI */
12325 /* N1 =       NPTS(1) */
12326 /* NB =       Neighbor of NI and candidate for NP */
12327 /* NI =       NPTS(I) */
12328 /* NP =       Candidate for NPTS(L) */
12329 /* X1,Y1,Z1 = Coordinates of N1 */
12330 
12331     /* Parameter adjustments */
12332     --x;
12333     --y;
12334     --z__;
12335     --list;
12336     --lptr;
12337     --lend;
12338     --npts;
12339 
12340     /* Function Body */
12341     lm1 = *l - 1;
12342     if (lm1 < 1) {
12343         goto L6;
12344     }
12345     *ier = 0;
12346 
12347 /* Store N1 = NPTS(1) and mark the elements of NPTS. */
12348 
12349     n1 = npts[1];
12350     x1 = x[n1];
12351     y1 = y[n1];
12352     z1 = z__[n1];
12353     i__1 = lm1;
12354     for (i__ = 1; i__ <= i__1; ++i__) {
12355         ni = npts[i__];
12356         lend[ni] = -lend[ni];
12357 /* L1: */
12358     }
12359 
12360 /* Candidates for NP = NPTS(L) are the unmarked neighbors */
12361 /*   of nodes in NPTS.  DNP is initially greater than -cos(PI) */
12362 /*   (the maximum distance). */
12363 
12364     dnp = 2.;
12365 
12366 /* Loop on nodes NI in NPTS. */
12367 
12368     i__1 = lm1;
12369     for (i__ = 1; i__ <= i__1; ++i__) {
12370         ni = npts[i__];
12371         lpl = -lend[ni];
12372         lp = lpl;
12373 
12374 /* Loop on neighbors NB of NI. */
12375 
12376 L2:
12377         nb = (i__2 = list[lp], abs(i__2));
12378         if (lend[nb] < 0) {
12379             goto L3;
12380         }
12381 
12382 /* NB is an unmarked neighbor of NI.  Replace NP if NB is */
12383 /*   closer to N1. */
12384 
12385         dnb = -(x[nb] * x1 + y[nb] * y1 + z__[nb] * z1);
12386         if (dnb >= dnp) {
12387             goto L3;
12388         }
12389         np = nb;
12390         dnp = dnb;
12391 L3:
12392         lp = lptr[lp];
12393         if (lp != lpl) {
12394             goto L2;
12395         }
12396 /* L4: */
12397     }
12398     npts[*l] = np;
12399     *df = dnp;
12400 
12401 /* Unmark the elements of NPTS. */
12402 
12403     i__1 = lm1;
12404     for (i__ = 1; i__ <= i__1; ++i__) {
12405         ni = npts[i__];
12406         lend[ni] = -lend[ni];
12407 /* L5: */
12408     }
12409     return 0;
12410 
12411 /* L is outside its valid range. */
12412 
12413 L6:
12414     *ier = 1;
12415     return 0;
12416 } /* getnp_ */

int i_dnnt double *  x  ) 
 

Definition at line 7880 of file util_sparx.cpp.

References x.

Referenced by trplot_(), and vrplot_().

07882 {
07883         return (int)(*x >= 0. ? floor(*x + .5) : -floor(.5 - *x));
07884 }

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

Definition at line 12418 of file util_sparx.cpp.

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

12420 {
12421     static int lsav;
12422 
12423 
12424 /* *********************************************************** */
12425 
12426 /*                                              From STRIPACK */
12427 /*                                            Robert J. Renka */
12428 /*                                  Dept. of Computer Science */
12429 /*                                       Univ. of North Texas */
12430 /*                                           renka@cs.unt.edu */
12431 /*                                                   07/17/96 */
12432 
12433 /*   This subroutine inserts K as a neighbor of N1 following */
12434 /* N2, where LP is the LIST pointer of N2 as a neighbor of */
12435 /* N1.  Note that, if N2 is the last neighbor of N1, K will */
12436 /* become the first neighbor (even if N1 is a boundary node). */
12437 
12438 /*   This routine is identical to the similarly named routine */
12439 /* in TRIPACK. */
12440 
12441 
12442 /* On input: */
12443 
12444 /*       K = Index of the node to be inserted. */
12445 
12446 /*       LP = LIST pointer of N2 as a neighbor of N1. */
12447 
12448 /* The above parameters are not altered by this routine. */
12449 
12450 /*       LIST,LPTR,LNEW = Data structure defining the trian- */
12451 /*                        gulation.  Refer to Subroutine */
12452 /*                        TRMESH. */
12453 
12454 /* On output: */
12455 
12456 /*       LIST,LPTR,LNEW = Data structure updated with the */
12457 /*                        addition of node K. */
12458 
12459 /* Modules required by INSERT:  None */
12460 
12461 /* *********************************************************** */
12462 
12463 
12464     /* Parameter adjustments */
12465     --lptr;
12466     --list;
12467 
12468     /* Function Body */
12469     lsav = lptr[*lp];
12470     lptr[*lp] = *lnew;
12471     list[*lnew] = *k;
12472     lptr[*lnew] = lsav;
12473     ++(*lnew);
12474     return 0;
12475 } /* insert_ */

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

Definition at line 12477 of file util_sparx.cpp.

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

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

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

Definition at line 12838 of file util_sparx.cpp.

References insert_(), and lstptr_().

Referenced by addnod_().

12840 {
12841     static int k, n1, n2, n3, lp;
12842     extern /* Subroutine */ int insert_(int *, int *, int *,
12843             int *, int *);
12844     extern int lstptr_(int *, int *, int *, int *);
12845 
12846 
12847 /* *********************************************************** */
12848 
12849 /*                                              From STRIPACK */
12850 /*                                            Robert J. Renka */
12851 /*                                  Dept. of Computer Science */
12852 /*                                       Univ. of North Texas */
12853 /*                                           renka@cs.unt.edu */
12854 /*                                                   07/17/96 */
12855 
12856 /*   This subroutine adds an interior node to a triangulation */
12857 /* of a set of points on the unit sphere.  The data structure */
12858 /* is updated with the insertion of node KK into the triangle */
12859 /* whose vertices are I1, I2, and I3.  No optimization of the */
12860 /* triangulation is performed. */
12861 
12862 /*   This routine is identical to the similarly named routine */
12863 /* in TRIPACK. */
12864 
12865 
12866 /* On input: */
12867 
12868 /*       KK = Index of the node to be inserted.  KK .GE. 1 */
12869 /*            and KK must not be equal to I1, I2, or I3. */
12870 
12871 /*       I1,I2,I3 = Indexes of the counterclockwise-ordered */
12872 /*                  sequence of vertices of a triangle which */
12873 /*                  contains node KK. */
12874 
12875 /* The above parameters are not altered by this routine. */
12876 
12877 /*       LIST,LPTR,LEND,LNEW = Data structure defining the */
12878 /*                             triangulation.  Refer to Sub- */
12879 /*                             routine TRMESH.  Triangle */
12880 /*                             (I1,I2,I3) must be included */
12881 /*                             in the triangulation. */
12882 
12883 /* On output: */
12884 
12885 /*       LIST,LPTR,LEND,LNEW = Data structure updated with */
12886 /*                             the addition of node KK.  KK */
12887 /*                             will be connected to nodes I1, */
12888 /*                             I2, and I3. */
12889 
12890 /* Modules required by INTADD:  INSERT, LSTPTR */
12891 
12892 /* *********************************************************** */
12893 
12894 
12895 /* Local parameters: */
12896 
12897 /* K =        Local copy of KK */
12898 /* LP =       LIST pointer */
12899 /* N1,N2,N3 = Local copies of I1, I2, and I3 */
12900 
12901     /* Parameter adjustments */
12902     --lend;
12903     --lptr;
12904     --list;
12905 
12906     /* Function Body */
12907     k = *kk;
12908 
12909 /* Initialization. */
12910 
12911     n1 = *i1;
12912     n2 = *i2;
12913     n3 = *i3;
12914 
12915 /* Add K as a neighbor of I1, I2, and I3. */
12916 
12917     lp = lstptr_(&lend[n1], &n2, &list[1], &lptr[1]);
12918     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12919     lp = lstptr_(&lend[n2], &n3, &list[1], &lptr[1]);
12920     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12921     lp = lstptr_(&lend[n3], &n1, &list[1], &lptr[1]);
12922     insert_(&k, &lp, &list[1], &lptr[1], lnew);
12923 
12924 /* Add I1, I2, and I3 as neighbors of K. */
12925 
12926     list[*lnew] = n1;
12927     list[*lnew + 1] = n2;
12928     list[*lnew + 2] = n3;
12929     lptr[*lnew] = *lnew + 1;
12930     lptr[*lnew + 1] = *lnew + 2;
12931     lptr[*lnew + 2] = *lnew;
12932     lend[k] = *lnew + 2;
12933     *lnew += 3;
12934     return 0;
12935 } /* intadd_ */

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

Definition at line 12937 of file util_sparx.cpp.

References sqrt(), and t.

Referenced by inside_().

12939 {
12940     /* Builtin functions */
12941     //double sqrt(double);
12942 
12943     /* Local variables */
12944     static int i__;
12945     static double t, d1, d2, pp[3], ppn;
12946 
12947 
12948 /* *********************************************************** */
12949 
12950 /*                                              From STRIPACK */
12951 /*                                            Robert J. Renka */
12952 /*                                  Dept. of Computer Science */
12953 /*                                       Univ. of North Texas */
12954 /*                                           renka@cs.unt.edu */
12955 /*                                                   07/19/90 */
12956 
12957 /*   Given a great circle C and points P1 and P2 defining an */
12958 /* arc A on the surface of the unit sphere, where A is the */
12959 /* shorter of the two portions of the great circle C12 assoc- */
12960 /* iated with P1 and P2, this subroutine returns the point */
12961 /* of intersection P between C and C12 that is closer to A. */
12962 /* Thus, if P1 and P2 lie in opposite hemispheres defined by */
12963 /* C, P is the point of intersection of C with A. */
12964 
12965 
12966 /* On input: */
12967 
12968 /*       P1,P2 = Arrays of length 3 containing the Cartesian */
12969 /*               coordinates of unit vectors. */
12970 
12971 /*       CN = Array of length 3 containing the Cartesian */
12972 /*            coordinates of a nonzero vector which defines C */
12973 /*            as the intersection of the plane whose normal */
12974 /*            is CN with the unit sphere.  Thus, if C is to */
12975 /*            be the great circle defined by P and Q, CN */
12976 /*            should be P X Q. */
12977 
12978 /* The above parameters are not altered by this routine. */
12979 
12980 /*       P = Array of length 3. */
12981 
12982 /* On output: */
12983 
12984 /*       P = Point of intersection defined above unless IER */
12985 /*           .NE. 0, in which case P is not altered. */
12986 
12987 /*       IER = Error indicator. */
12988 /*             IER = 0 if no errors were encountered. */
12989 /*             IER = 1 if <CN,P1> = <CN,P2>.  This occurs */
12990 /*                     iff P1 = P2 or CN = 0 or there are */
12991 /*                     two intersection points at the same */
12992 /*                     distance from A. */
12993 /*             IER = 2 if P2 = -P1 and the definition of A is */
12994 /*                     therefore ambiguous. */
12995 
12996 /* Modules required by INTRSC:  None */
12997 
12998 /* Intrinsic function called by INTRSC:  SQRT */
12999 
13000 /* *********************************************************** */
13001 
13002 
13003 /* Local parameters: */
13004 
13005 /* D1 =  <CN,P1> */
13006 /* D2 =  <CN,P2> */
13007 /* I =   DO-loop index */
13008 /* PP =  P1 + T*(P2-P1) = Parametric representation of the */
13009 /*         line defined by P1 and P2 */
13010 /* PPN = Norm of PP */
13011 /* T =   D1/(D1-D2) = Parameter value chosen so that PP lies */
13012 /*         in the plane of C */
13013 
13014     /* Parameter adjustments */
13015     --p;
13016     --cn;
13017     --p2;
13018     --p1;
13019 
13020     /* Function Body */
13021     d1 = cn[1] * p1[1] + cn[2] * p1[2] + cn[3] * p1[3];
13022     d2 = cn[1] * p2[1] + cn[2] * p2[2] + cn[3] * p2[3];
13023 
13024     if (d1 == d2) {
13025         *ier = 1;
13026         return 0;
13027     }
13028 
13029 /* Solve for T such that <PP,CN> = 0 and compute PP and PPN. */
13030 
13031     t = d1 / (d1 - d2);
13032     ppn = 0.;
13033     for (i__ = 1; i__ <= 3; ++i__) {
13034         pp[i__ - 1] = p1[i__] + t * (p2[i__] - p1[i__]);
13035         ppn += pp[i__ - 1] * pp[i__ - 1];
13036 /* L1: */
13037     }
13038 
13039 /* PPN = 0 iff PP = 0 iff P2 = -P1 (and T = .5). */
13040 
13041     if (ppn == 0.) {
13042         *ier = 2;
13043         return 0;
13044     }
13045     ppn = sqrt(ppn);
13046 
13047 /* Compute P = PP/PPN. */
13048 
13049     for (i__ = 1; i__ <= 3; ++i__) {
13050         p[i__] = pp[i__ - 1] / ppn;
13051 /* L2: */
13052     }
13053     *ier = 0;
13054     return 0;
13055 } /* intrsc_ */

bool jiafunc int  i,
int  j
 

Definition at line 21310 of file util_sparx.cpp.

References costlist_global.

21310                           {
21311         return (costlist_global[j] < costlist_global[i]) ;
21312 
21313 }

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

Definition at line 13057 of file util_sparx.cpp.

References x.

Referenced by trfind_().

13058 {
13059     /* System generated locals */
13060     int ret_val;
13061 
13062     /* Local variables */
13063     static float u, x;
13064 
13065 
13066 /* *********************************************************** */
13067 
13068 /*                                              From STRIPACK */
13069 /*                                            Robert J. Renka */
13070 /*                                  Dept. of Computer Science */
13071 /*                                       Univ. of North Texas */
13072 /*                                           renka@cs.unt.edu */
13073 /*                                                   07/28/98 */
13074 
13075 /*   This function returns a uniformly distributed pseudo- */
13076 /* random int in the range 1 to N. */
13077 
13078 
13079 /* On input: */
13080 
13081 /*       N = Maximum value to be returned. */
13082 
13083 /* N is not altered by this function. */
13084 
13085 /*       IX,IY,IZ = int seeds initialized to values in */
13086 /*                  the range 1 to 30,000 before the first */
13087 /*                  call to JRAND, and not altered between */
13088 /*                  subsequent calls (unless a sequence of */
13089 /*                  random numbers is to be repeated by */
13090 /*                  reinitializing the seeds). */
13091 
13092 /* On output: */
13093 
13094 /*       IX,IY,IZ = Updated int seeds. */
13095 
13096 /*       JRAND = Random int in the range 1 to N. */
13097 
13098 /* Reference:  B. A. Wichmann and I. D. Hill, "An Efficient */
13099 /*             and Portable Pseudo-random Number Generator", */
13100 /*             Applied Statistics, Vol. 31, No. 2, 1982, */
13101 /*             pp. 188-190. */
13102 
13103 /* Modules required by JRAND:  None */
13104 
13105 /* Intrinsic functions called by JRAND:  INT, MOD, float */
13106 
13107 /* *********************************************************** */
13108 
13109 
13110 /* Local parameters: */
13111 
13112 /* U = Pseudo-random number uniformly distributed in the */
13113 /*     interval (0,1). */
13114 /* X = Pseudo-random number in the range 0 to 3 whose frac- */
13115 /*       tional part is U. */
13116 
13117     *ix = *ix * 171 % 30269;
13118     *iy = *iy * 172 % 30307;
13119     *iz = *iz * 170 % 30323;
13120     x = (float) (*ix) / 30269.f + (float) (*iy) / 30307.f + (float) (*iz) /
13121             30323.f;
13122     u = x - (int) x;
13123     ret_val = (int) ((float) (*n) * u + 1.f);
13124     return ret_val;
13125 } /* jrand_ */

long int left_ double *  x1,
double *  y1,
double *  z1,
double *  x2,
double *  y2,
double *  z2,
double *  x0,
double *  y0,
double *  z0
 

Definition at line 13127 of file util_sparx.cpp.

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

13130 {
13131     /* System generated locals */
13132     long int ret_val;
13133 
13134 
13135 /* *********************************************************** */
13136 
13137 /*                                              From STRIPACK */
13138 /*                                            Robert J. Renka */
13139 /*                                  Dept. of Computer Science */
13140 /*                                       Univ. of North Texas */
13141 /*                                           renka@cs.unt.edu */
13142 /*                                                   07/15/96 */
13143 
13144 /*   This function determines whether node N0 is in the */
13145 /* (closed) left hemisphere defined by the plane containing */
13146 /* N1, N2, and the origin, where left is defined relative to */
13147 /* an observer at N1 facing N2. */
13148 
13149 
13150 /* On input: */
13151 
13152 /*       X1,Y1,Z1 = Coordinates of N1. */
13153 
13154 /*       X2,Y2,Z2 = Coordinates of N2. */
13155 
13156 /*       X0,Y0,Z0 = Coordinates of N0. */
13157 
13158 /* Input parameters are not altered by this function. */
13159 
13160 /* On output: */
13161 
13162 /*       LEFT = TRUE if and only if N0 is in the closed */
13163 /*              left hemisphere. */
13164 
13165 /* Modules required by LEFT:  None */
13166 
13167 /* *********************************************************** */
13168 
13169 /* LEFT = TRUE iff <N0,N1 X N2> = det(N0,N1,N2) .GE. 0. */
13170 
13171     ret_val = *x0 * (*y1 * *z2 - *y2 * *z1) - *y0 * (*x1 * *z2 - *x2 * *z1) +
13172             *z0 * (*x1 * *y2 - *x2 * *y1) >= -0.000001;
13173 
13174 
13175     return ret_val;
13176 } /* left_ */

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

Definition at line 13178 of file util_sparx.cpp.

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

13179 {
13180     /* System generated locals */
13181     int ret_val;
13182 
13183     /* Local variables */
13184     static int nd, lp;
13185 
13186 
13187 /* *********************************************************** */
13188 
13189 /*                                              From STRIPACK */
13190 /*                                            Robert J. Renka */
13191 /*                                  Dept. of Computer Science */
13192 /*                                       Univ. of North Texas */
13193 /*                                           renka@cs.unt.edu */
13194 /*                                                   07/15/96 */
13195 
13196 /*   This function returns the index (LIST pointer) of NB in */
13197 /* the adjacency list for N0, where LPL = LEND(N0). */
13198 
13199 /*   This function is identical to the similarly named */
13200 /* function in TRIPACK. */
13201 
13202 
13203 /* On input: */
13204 
13205 /*       LPL = LEND(N0) */
13206 
13207 /*       NB = Index of the node whose pointer is to be re- */
13208 /*            turned.  NB must be connected to N0. */
13209 
13210 /*       LIST,LPTR = Data structure defining the triangula- */
13211 /*                   tion.  Refer to Subroutine TRMESH. */
13212 
13213 /* Input parameters are not altered by this function. */
13214 
13215 /* On output: */
13216 
13217 /*       LSTPTR = Pointer such that LIST(LSTPTR) = NB or */
13218 /*                LIST(LSTPTR) = -NB, unless NB is not a */
13219 /*                neighbor of N0, in which case LSTPTR = LPL. */
13220 
13221 /* Modules required by LSTPTR:  None */
13222 
13223 /* *********************************************************** */
13224 
13225 
13226 /* Local parameters: */
13227 
13228 /* LP = LIST pointer */
13229 /* ND = Nodal index */
13230 
13231     /* Parameter adjustments */
13232     --lptr;
13233     --list;
13234 
13235     /* Function Body */
13236     lp = lptr[*lpl];
13237 L1:
13238     nd = list[lp];
13239     if (nd == *nb) {
13240         goto L2;
13241     }
13242     lp = lptr[lp];
13243     if (lp != *lpl) {
13244         goto L1;
13245     }
13246 
13247 L2:
13248     ret_val = lp;
13249     return ret_val;
13250 } /* lstptr_ */

int nbcnt_ int *  lpl,
int *  lptr
 

Definition at line 13252 of file util_sparx.cpp.

Referenced by delnod_().

13253 {
13254     /* System generated locals */
13255     int ret_val;
13256 
13257     /* Local variables */
13258     static int k, lp;
13259 
13260 
13261 /* *********************************************************** */
13262 
13263 /*                                              From STRIPACK */
13264 /*                                            Robert J. Renka */
13265 /*                                  Dept. of Computer Science */
13266 /*                                       Univ. of North Texas */
13267 /*                                           renka@cs.unt.edu */
13268 /*                                                   07/15/96 */
13269 
13270 /*   This function returns the number of neighbors of a node */
13271 /* N0 in a triangulation created by Subroutine TRMESH. */
13272 
13273 /*   This function is identical to the similarly named */
13274 /* function in TRIPACK. */
13275 
13276 
13277 /* On input: */
13278 
13279 /*       LPL = LIST pointer to the last neighbor of N0 -- */
13280 /*             LPL = LEND(N0). */
13281 
13282 /*       LPTR = Array of pointers associated with LIST. */
13283 
13284 /* Input parameters are not altered by this function. */
13285 
13286 /* On output: */
13287 
13288 /*       NBCNT = Number of neighbors of N0. */
13289 
13290 /* Modules required by NBCNT:  None */
13291 
13292 /* *********************************************************** */
13293 
13294 
13295 /* Local parameters: */
13296 
13297 /* K =  Counter for computing the number of neighbors */
13298 /* LP = LIST pointer */
13299 
13300     /* Parameter adjustments */
13301     --lptr;
13302 
13303     /* Function Body */
13304     lp = *lpl;
13305     k = 1;
13306 
13307 L1:
13308     lp = lptr[lp];
13309     if (lp == *lpl) {
13310         goto L2;
13311     }
13312     ++k;
13313     goto L1;
13314 
13315 L2:
13316     ret_val = k;
13317     return ret_val;
13318 } /* 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 13320 of file util_sparx.cpp.

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

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

References abs, swap_(), swptst_(), x, and y.

Referenced by delnod_(), and edge_().

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

References sqrt(), x, and y.

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

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

Definition at line 17336 of file util_sparx.cpp.

References x.

17338 {
17339     static double x;
17340 
17341 
17342 /*   This routine returns pseudo-random numbers uniformly */
17343 /* distributed in the interval (0,1).  int seeds IX, IY, */
17344 /* and IZ should be initialized to values in the range 1 to */
17345 /* 30,000 before the first call to RANDOM, and should not */
17346 /* be altered between subsequent calls (unless a sequence */
17347 /* of random numbers is to be repeated by reinitializing the */
17348 /* seeds). */
17349 
17350 /* Reference:  B. A. Wichmann and I. D. Hill, An Efficient */
17351 /*             and Portable Pseudo-random Number Generator, */
17352 /*             Applied Statistics, Vol. 31, No. 2, 1982, */
17353 /*             pp. 188-190. */
17354 
17355     *ix = *ix * 171 % 30269;
17356     *iy = *iy * 172 % 30307;
17357     *iz = *iz * 170 % 30323;
17358     x = (double) (*ix) / 30269. + (double) (*iy) / 30307. + (
17359             double) (*iz) / 30323.;
17360     *rannum = x - (int) x;
17361     return 0;
17362 } /* random_ */

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

Definition at line 14082 of file util_sparx.cpp.

References sqrt().

14084 {
14085     /* Builtin functions */
14086     //double sqrt(double), atan2(double, double), asin(double);
14087 
14088 
14089 /* *********************************************************** */
14090 
14091 /*                                              From STRIPACK */
14092 /*                                            Robert J. Renka */
14093 /*                                  Dept. of Computer Science */
14094 /*                                       Univ. of North Texas */
14095 /*                                           renka@cs.unt.edu */
14096 /*                                                   08/27/90 */
14097 
14098 /*   This subroutine converts a point P from Cartesian coor- */
14099 /* dinates to spherical coordinates. */
14100 
14101 
14102 /* On input: */
14103 
14104 /*       PX,PY,PZ = Cartesian coordinates of P. */
14105 
14106 /* Input parameters are not altered by this routine. */
14107 
14108 /* On output: */
14109 
14110 /*       PLAT = Latitude of P in the range -PI/2 to PI/2, or */
14111 /*              0 if PNRM = 0.  PLAT should be scaled by */
14112 /*              180/PI to obtain the value in degrees. */
14113 
14114 /*       PLON = Longitude of P in the range -PI to PI, or 0 */
14115 /*              if P lies on the Z-axis.  PLON should be */
14116 /*              scaled by 180/PI to obtain the value in */
14117 /*              degrees. */
14118 
14119 /*       PNRM = Magnitude (Euclidean norm) of P. */
14120 
14121 /* Modules required by SCOORD:  None */
14122 
14123 /* Intrinsic functions called by SCOORD:  ASIN, ATAN2, SQRT */
14124 
14125 /* *********************************************************** */
14126 
14127     *pnrm = sqrt(*px * *px + *py * *py + *pz * *pz);
14128     if (*px != 0. || *py != 0.) {
14129         *plon = atan2(*py, *px);
14130     } else {
14131         *plon = 0.;
14132     }
14133     if (*pnrm != 0.) {
14134         *plat = asin(*pz / *pnrm);
14135     } else {
14136         *plat = 0.;
14137     }
14138     return 0;
14139 } /* scoord_ */

double store_ double *  x  ) 
 

Definition at line 14141 of file util_sparx.cpp.

References stcom_1, and stcom_::y.

Referenced by trfind_().

14142 {
14143     /* System generated locals */
14144     double ret_val;
14145 
14146 
14147 /* *********************************************************** */
14148 
14149 /*                                              From STRIPACK */
14150 /*                                            Robert J. Renka */
14151 /*                                  Dept. of Computer Science */
14152 /*                                       Univ. of North Texas */
14153 /*                                           renka@cs.unt.edu */
14154 /*                                                   05/09/92 */
14155 
14156 /*   This function forces its argument X to be stored in a */
14157 /* memory location, thus providing a means of determining */
14158 /* floating point number characteristics (such as the machine */
14159 /* precision) when it is necessary to avoid computation in */
14160 /* high precision registers. */
14161 
14162 
14163 /* On input: */
14164 
14165 /*       X = Value to be stored. */
14166 
14167 /* X is not altered by this function. */
14168 
14169 /* On output: */
14170 
14171 /*       STORE = Value of X after it has been stored and */
14172 /*               possibly truncated or rounded to the single */
14173 /*               precision word length. */
14174 
14175 /* Modules required by STORE:  None */
14176 
14177 /* *********************************************************** */
14178 
14179     stcom_1.y = *x;
14180     ret_val = stcom_1.y;
14181     return ret_val;
14182 } /* store_ */

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

Definition at line 14184 of file util_sparx.cpp.

References abs, and lstptr_().

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

14186 {
14187     /* System generated locals */
14188     int i__1;
14189 
14190     /* Local variables */
14191     static int lp, lph, lpsav;
14192     extern int lstptr_(int *, int *, int *, int *);
14193 
14194 
14195 /* *********************************************************** */
14196 
14197 /*                                              From STRIPACK */
14198 /*                                            Robert J. Renka */
14199 /*                                  Dept. of Computer Science */
14200 /*                                       Univ. of North Texas */
14201 /*                                           renka@cs.unt.edu */
14202 /*                                                   06/22/98 */
14203 
14204 /*   Given a triangulation of a set of points on the unit */
14205 /* sphere, this subroutine replaces a diagonal arc in a */
14206 /* strictly convex quadrilateral (defined by a pair of adja- */
14207 /* cent triangles) with the other diagonal.  Equivalently, a */
14208 /* pair of adjacent triangles is replaced by another pair */
14209 /* having the same union. */
14210 
14211 
14212 /* On input: */
14213 
14214 /*       IN1,IN2,IO1,IO2 = Nodal indexes of the vertices of */
14215 /*                         the quadrilateral.  IO1-IO2 is re- */
14216 /*                         placed by IN1-IN2.  (IO1,IO2,IN1) */
14217 /*                         and (IO2,IO1,IN2) must be trian- */
14218 /*                         gles on input. */
14219 
14220 /* The above parameters are not altered by this routine. */
14221 
14222 /*       LIST,LPTR,LEND = Data structure defining the trian- */
14223 /*                        gulation.  Refer to Subroutine */
14224 /*                        TRMESH. */
14225 
14226 /* On output: */
14227 
14228 /*       LIST,LPTR,LEND = Data structure updated with the */
14229 /*                        swap -- triangles (IO1,IO2,IN1) and */
14230 /*                        (IO2,IO1,IN2) are replaced by */
14231 /*                        (IN1,IN2,IO2) and (IN2,IN1,IO1) */
14232 /*                        unless LP21 = 0. */
14233 
14234 /*       LP21 = Index of IN1 as a neighbor of IN2 after the */
14235 /*              swap is performed unless IN1 and IN2 are */
14236 /*              adjacent on input, in which case LP21 = 0. */
14237 
14238 /* Module required by SWAP:  LSTPTR */
14239 
14240 /* Intrinsic function called by SWAP:  ABS */
14241 
14242 /* *********************************************************** */
14243 
14244 
14245 /* Local parameters: */
14246 
14247 /* LP,LPH,LPSAV = LIST pointers */
14248 
14249 
14250 /* Test for IN1 and IN2 adjacent. */
14251 
14252     /* Parameter adjustments */
14253     --lend;
14254     --lptr;
14255     --list;
14256 
14257     /* Function Body */
14258     lp = lstptr_(&lend[*in1], in2, &list[1], &lptr[1]);
14259     if ((i__1 = list[lp], abs(i__1)) == *in2) {
14260         *lp21 = 0;
14261         return 0;
14262     }
14263 
14264 /* Delete IO2 as a neighbor of IO1. */
14265 
14266     lp = lstptr_(&lend[*io1], in2, &list[1], &lptr[1]);
14267     lph = lptr[lp];
14268     lptr[lp] = lptr[lph];
14269 
14270 /* If IO2 is the last neighbor of IO1, make IN2 the */
14271 /*   last neighbor. */
14272 
14273     if (lend[*io1] == lph) {
14274         lend[*io1] = lp;
14275     }
14276 
14277 /* Insert IN2 as a neighbor of IN1 following IO1 */
14278 /*   using the hole created above. */
14279 
14280     lp = lstptr_(&lend[*in1], io1, &list[1], &lptr[1]);
14281     lpsav = lptr[lp];
14282     lptr[lp] = lph;
14283     list[lph] = *in2;
14284     lptr[lph] = lpsav;
14285 
14286 /* Delete IO1 as a neighbor of IO2. */
14287 
14288     lp = lstptr_(&lend[*io2], in1, &list[1], &lptr[1]);
14289     lph = lptr[lp];
14290     lptr[lp] = lptr[lph];
14291 
14292 /* If IO1 is the last neighbor of IO2, make IN1 the */
14293 /*   last neighbor. */
14294 
14295     if (lend[*io2] == lph) {
14296         lend[*io2] = lp;
14297     }
14298 
14299 /* Insert IN1 as a neighbor of IN2 following IO2. */
14300 
14301     lp = lstptr_(&lend[*in2], io2, &list[1], &lptr[1]);
14302     lpsav = lptr[lp];
14303     lptr[lp] = lph;
14304     list[lph] = *in1;
14305     lptr[lph] = lpsav;
14306     *lp21 = lph;
14307     return 0;
14308 } /* swap_ */

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

Definition at line 14310 of file util_sparx.cpp.

References x, and y.

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

14312 {
14313     /* System generated locals */
14314     long int ret_val;
14315 
14316     /* Local variables */
14317     static double x4, y4, z4, dx1, dx2, dx3, dy1, dy2, dy3, dz1, dz2, dz3;
14318 
14319 
14320 /* *********************************************************** */
14321 
14322 /*                                              From STRIPACK */
14323 /*                                            Robert J. Renka */
14324 /*                                  Dept. of Computer Science */
14325 /*                                       Univ. of North Texas */
14326 /*                                           renka@cs.unt.edu */
14327 /*                                                   03/29/91 */
14328 
14329 /*   This function decides whether or not to replace a */
14330 /* diagonal arc in a quadrilateral with the other diagonal. */
14331 /* The decision will be to swap (SWPTST = TRUE) if and only */
14332 /* if N4 lies above the plane (in the half-space not contain- */
14333 /* ing the origin) defined by (N1,N2,N3), or equivalently, if */
14334 /* the projection of N4 onto this plane is interior to the */
14335 /* circumcircle of (N1,N2,N3).  The decision will be for no */
14336 /* swap if the quadrilateral is not strictly convex. */
14337 
14338 
14339 /* On input: */
14340 
14341 /*       N1,N2,N3,N4 = Indexes of the four nodes defining the */
14342 /*                     quadrilateral with N1 adjacent to N2, */
14343 /*                     and (N1,N2,N3) in counterclockwise */
14344 /*                     order.  The arc connecting N1 to N2 */
14345 /*                     should be replaced by an arc connec- */
14346 /*                     ting N3 to N4 if SWPTST = TRUE.  Refer */
14347 /*                     to Subroutine SWAP. */
14348 
14349 /*       X,Y,Z = Arrays of length N containing the Cartesian */
14350 /*               coordinates of the nodes.  (X(I),Y(I),Z(I)) */
14351 /*               define node I for I = N1, N2, N3, and N4. */
14352 
14353 /* Input parameters are not altered by this routine. */
14354 
14355 /* On output: */
14356 
14357 /*       SWPTST = TRUE if and only if the arc connecting N1 */
14358 /*                and N2 should be swapped for an arc con- */
14359 /*                necting N3 and N4. */
14360 
14361 /* Modules required by SWPTST:  None */
14362 
14363 /* *********************************************************** */
14364 
14365 
14366 /* Local parameters: */
14367 
14368 /* DX1,DY1,DZ1 = Coordinates of N4->N1 */
14369 /* DX2,DY2,DZ2 = Coordinates of N4->N2 */
14370 /* DX3,DY3,DZ3 = Coordinates of N4->N3 */
14371 /* X4,Y4,Z4 =    Coordinates of N4 */
14372 
14373     /* Parameter adjustments */
14374     --z__;
14375     --y;
14376     --x;
14377 
14378     /* Function Body */
14379     x4 = x[*n4];
14380     y4 = y[*n4];
14381     z4 = z__[*n4];
14382     dx1 = x[*n1] - x4;
14383     dx2 = x[*n2] - x4;
14384     dx3 = x[*n3] - x4;
14385     dy1 = y[*n1] - y4;
14386     dy2 = y[*n2] - y4;
14387     dy3 = y[*n3] - y4;
14388     dz1 = z__[*n1] - z4;
14389     dz2 = z__[*n2] - z4;
14390     dz3 = z__[*n3] - z4;
14391 
14392 /* N4 lies above the plane of (N1,N2,N3) iff N3 lies above */
14393 /*   the plane of (N2,N1,N4) iff Det(N3-N4,N2-N4,N1-N4) = */
14394 /*   (N3-N4,N2-N4 X N1-N4) > 0. */
14395 
14396     ret_val = dx3 * (dy2 * dz1 - dy1 * dz2) - dy3 * (dx2 * dz1 - dx1 * dz2) +
14397             dz3 * (dx2 * dy1 - dx1 * dy2) > 0.;
14398     return ret_val;
14399 } /* swptst_ */

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

Definition at line 14401 of file util_sparx.cpp.

References nn(), phi, theta, x, and y.

14403 {
14404     /* System generated locals */
14405     int i__1;
14406 
14407     /* Builtin functions */
14408     //double cos(double), sin(double);
14409 
14410     /* Local variables */
14411     static int i__, nn;
14412     static double phi, theta, cosphi;
14413 
14414 
14415 /* *********************************************************** */
14416 
14417 /*                                              From STRIPACK */
14418 /*                                            Robert J. Renka */
14419 /*                                  Dept. of Computer Science */
14420 /*                                       Univ. of North Texas */
14421 /*                                           renka@cs.unt.edu */
14422 /*                                                   04/08/90 */
14423 
14424 /*   This subroutine transforms spherical coordinates into */
14425 /* Cartesian coordinates on the unit sphere for input to */
14426 /* Subroutine TRMESH.  Storage for X and Y may coincide with */
14427 /* storage for RLAT and RLON if the latter need not be saved. */
14428 
14429 
14430 /* On input: */
14431 
14432 /*       N = Number of nodes (points on the unit sphere) */
14433 /*           whose coordinates are to be transformed. */
14434 
14435 /*       RLAT = Array of length N containing latitudinal */
14436 /*              coordinates of the nodes in radians. */
14437 
14438 /*       RLON = Array of length N containing longitudinal */
14439 /*              coordinates of the nodes in radians. */
14440 
14441 /* The above parameters are not altered by this routine. */
14442 
14443 /*       X,Y,Z = Arrays of length at least N. */
14444 
14445 /* On output: */
14446 
14447 /*       X,Y,Z = Cartesian coordinates in the range -1 to 1. */
14448 /*               X(I)**2 + Y(I)**2 + Z(I)**2 = 1 for I = 1 */
14449 /*               to N. */
14450 
14451 /* Modules required by TRANS:  None */
14452 
14453 /* Intrinsic functions called by TRANS:  COS, SIN */
14454 
14455 /* *********************************************************** */
14456 
14457 
14458 /* Local parameters: */
14459 
14460 /* COSPHI = cos(PHI) */
14461 /* I =      DO-loop index */
14462 /* NN =     Local copy of N */
14463 /* PHI =    Latitude */
14464 /* THETA =  Longitude */
14465 
14466     /* Parameter adjustments */
14467     --z__;
14468     --y;
14469     --x;
14470     --rlon;
14471     --rlat;
14472 
14473     /* Function Body */
14474     nn = *n;
14475     i__1 = nn;
14476     for (i__ = 1; i__ <= i__1; ++i__) {
14477         phi = rlat[i__];
14478         theta = rlon[i__];
14479         cosphi = cos(phi);
14480         x[i__] = cosphi * cos(theta);
14481         y[i__] = cosphi * sin(theta);
14482         z__[i__] = sin(phi);
14483 /* L1: */
14484     }
14485     return 0;
14486 } /* 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 14488 of file util_sparx.cpp.

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

Referenced by addnod_(), and nearnd_().

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

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

Definition at line 15006 of file util_sparx.cpp.

References abs.

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

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

Definition at line 15309 of file util_sparx.cpp.

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

References abs, addnod_(), dist(), left_(), nn(), x, and y.

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

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

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

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

Definition at line 16489 of file util_sparx.cpp.

References nn().

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

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

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


Variable Documentation

int branch_all = 0
 

Definition at line 21154 of file util_sparx.cpp.

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

int* costlist_global
 

Definition at line 21307 of file util_sparx.cpp.

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

stcom_ stcom_1
 

Definition at line 7875 of file util_sparx.cpp.

Referenced by store_().


Generated on Tue Jul 12 13:50:51 2011 for EMAN2 by  doxygen 1.3.9.1