commit a0f0371126cfb690d0fab38d218d030241362730 Author: Guilhem Lavaux Date: Mon Jun 21 16:38:06 2021 +0200 Init diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b4d8d31 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.o +*.a +bin/* diff --git a/CHANGES b/CHANGES new file mode 100644 index 0000000..fa4ab4e --- /dev/null +++ b/CHANGES @@ -0,0 +1,456 @@ +5 April 2009 +MANGLE 2.2 RELEASE +Upgrades from mangle2.1: +-Added option -B to balkanize to add weights together, or take the maximum or minimum weight instead of just using the last weight in the polygon file +-Added option -W to polyid to write out the weights of the polygons containing each point rather than the id numbers +-Snap now renormalizes input vectors to ensure that all vectors are exact unit vectors +-Fixed bug in weight so that weights are not skipped in file when no midpoint is found +-Upgraded matlab plotting script to allow for an arbitrary range of weights +-Changed /dev/null paths in shell scripts to avoid bub in some linux flavors +-Increased NPOLYSMAX to 90000000 +-Added compile flags to allow mangle to write files larger than 2G + +--Molly Swanson +-------------------------------------------------------------------------------- + +25 July 2008 +MANGLE 2.1 RELEASE +Upgrades from mangle2.0: +-added versions for Mac OSX (Intel and PowerPC) +-added versions that use real*8 in fortran and double in C (as opposed to real*10 and long double) +-compiled binaries statically to allow for greater portability +-added new example scripts (including an SDSS example) +-made extensive improvements to existing scripts +-added a script to automatically set up mangle environment variables +-added "snapped" and "balkanized" keywords so polygon files can automatically track whether they've been snapped or balkanized +-fixed bug in rasterize that assigned the wrong weights to output polygons + +--Molly Swanson +-------------------------------------------------------------------------------- + +28 Nov 2007 +MANGLE 2.0 RELEASE +Upgrades from mangle1.4.1: +-pixelize functions for very speedy processing of masks +-HEALPix import and export capabilities +-loads of other new features + +Mangle 2.0 website: +http://space.mit.edu/home/tegmark/mangle/ + +--Molly Swanson, Colin Hill, Max Tegmark +-------------------------------------------------------------------------------- +26 Nov 2007 +Fixed rasterize so that it outputs polygon files, updated parse_args.c, added pixelized and snapped versions of HEALPix polygons at Nside=1 through 512 to the /masks/healpix/ directory. +--Colin Hill +-------------------------------------------------------------------------------- + +19 Nov 2007 +Assorted minor updates: fixed issue with SDSSPix pixel boundaries, added 2dF230k weight function, added rounding tolerances in rect_to_poly function +--Molly Swanson +-------------------------------------------------------------------------------- + +8 Sept 2007 +Fixed segmentation fault issue when NPOLYSMAX >~ 3000000 by allocating the main polygon arrays globally rather than locally. Also added calls to free_poly to clean up memory at the end of all programs. +--Molly Swanson +-------------------------------------------------------------------------------- + +3 Sep 2007 +Changed snap and pixelize to use -vo instead of -vn. +Updated rasterize.c to use pixelization info in the most efficient manner possible. +Removed balkanizepolys.c and snappolys.c (put this code back into balkanize.c and snap.c, respectively). +Rewrote rasterize.c in the same format as the other main programs. +--Colin Hill +-------------------------------------------------------------------------------- + +18 August 2007 +Added a script named healpixpolys.scr which constructs, pixelizes, and snaps the HEALPix pixels at any value of Nside. +--Colin Hill +-------------------------------------------------------------------------------- + +18 August 2007 +Redesigned the rasterize algorithm so that no balkanization is required. Rasterize now works by computing the area of the intersection between each input mask polygon and each rasterizer polygon, and using each of these areas in the calculation of the area-averaged weight within each rasterizer pixel. This scheme is completely general and should work for not only the HEALPix pixels, but also other sets of rasterizer pixels. +--Colin Hill +-------------------------------------------------------------------------------- + +2 June 2007 +Changed rasterize.c so that only one array of polygon pointers is used (instead of two). +--Colin Hill + +-------------------------------------------------------------------------------- +30 May 2007 +Changed the way PI is defined in pi.h to ensure it's treated as a long double in the 80 bit version - this solves some issues with pixelizing with SDSSpix in the 80 bit version. Also made minor fix in sdsspix section of get_pixel.c. +--Molly Swanson + +-------------------------------------------------------------------------------- +22 May 2007 +Added formatted versions of the unformatted fortran files defining the 2df100k and 2qz10k masks and produced unformatted versions with gfortran-compiled code that can be read with the 80-bit version of mangle. Updated READMEs and HELP.unformatted to instruct people to use the formatted version if they're having trouble. + +Also updated balkanize and pixelize to not take the snap angles at the command line since polygons are no longer self-snapped after balkanizing. +--Molly Swanson + +-------------------------------------------------------------------------------- +21 May 2007 +Added "pixelization" as a keyword so that the scheme and resolution are automatically specified in input files, e.g. +10 polygons +pixelization 3s +polygon 0 .... + +Most commands now return an error if two input files have mismatched pixelizations, and sets res_max and scheme to the values defined in the input file. Pixelize ignores any previous pixelization info, and pixelmap uses the value of res_max defined on the command line rather than in the file. + +Also took infiles out of the format structure and made it a global variable, for use with the pixelization error checking. Changed the healpix error-checking to use this global variable, and took out the "fmt.infiles = nfiles;" from all of the programs that read in files. +--Molly Swanson + +-------------------------------------------------------------------------------- +14 May 2007 +Removed small typo in rasterize.c, namely, [-B] in the usage that referred to a now-deleted option. +--Colin Hill + +-------------------------------------------------------------------------------- +2 May 2007 +Fixed memory allocation bug in pixelize - pixel loop now correctly skips over null polygons that have been pruned. +Changed initial call to pixel_loop from + n=pixel_loop(0,np,poly,npolys,polys); //np= only non-null polygons +to + n=pixel_loop(0,npoly,poly,npolys,polys); //npoly = all input polygons including null polygons +and added null-skipping code in pixel_loop: + /* skip null polygons */ + if (input[j]->np > 0 && input[j]->cm[0] == 0.){ + poly[j] = 0x0; + continue; + } + +Also added code to automatically set all polygons to be in pixel 0 before pixelizing. + +--Molly Swanson + +-------------------------------------------------------------------------------- +1 May 2007 +Fixed some formatting issues when compiling on 64-bit system by changing printf statements for size_t type variables from %d to %zd +Also changed the typedef for "logical" to be int for 64-bit and long for 32-bit (needs to be more robust in figuring out whether you're on a 64-bit system though.) + +--Molly Swanson + +-------------------------------------------------------------------------------- + +1 May 2007 +Finally committed many changes that were made during January/February: + +- snap.c: split snap up into two files (snap.c and snappolys.c) so that the snap function can be used within rasterize (i.e., had to make snap a global function, not local); similar to what was done earlier with balkanize + +- snappolys.c: new source file containing snap function, which used to be located in snap.c + +- wrmask.c: added new function wr_healpix_weight, which is used to write output files in healpix_weight format + +- manglefn.h: added new functions snap and wr_healpix_weight + +- rdmask.c: implemented ability to read healpix_weight input files in full generality, i.e., ignore comments, blank lines, etc. + +- gsubs.s.f: changed multiplicative factors in gtol subroutine in attempts to make balkanize work on dr4plus mask + +- defines.h: increased NPOLYSMAX to 1565000 + +- format.h and copy_format.c: added 'int infiles' element to format structure (needed for rasterize/healpix_weight format) + +- poly2poly.c: updated so that the old healpix2poly routine is now implemented within poly2poly (i.e., poly2poly -ih); in other words, healpix_weight input files are now processed just like any other input files + +- defaults.h: set default value for fmt.infiles to be 1 + +- parse_args.c: updated to reflect deletion of healpix2poly + +- rasterize.c: improved so that polygons are now snapped before balkanization occurs; removed redundant balkanization + +- balkanize.c, harmonize.c, pixelize.c, polyid.c, pixelmap.c, poly2poly.c, ransack.c, snap.c, weight.c, unify.c: + added line that is needed for rasterize/healpix_weight to work properly: fmt.infiles = nfiles; + +- GNUmakefile: updated to reflect changes made (deleted old healpix2poly program; added snappolys.c) + + +--Colin Hill + +-------------------------------------------------------------------------------- + +17 April 2007 +Fixed bug causing pixelize to segfault when it hits NPOLYSMAX: +replaced + if (out > out_max) { +with + if (out >= out_max) { + +-Molly Swanson + +-------------------------------------------------------------------------------- + +13 April 2007 +Assorted cleanups: + +- cleaned up warning messages in snap and unify + +- updated Sun makefile + +- fixed rdmask so reading in files in old polygon format (no pixel numbers) assigns pixel number 0 rather than reading in the steradian part + +- changed wr_poly so it doesn't crash when writing a polygon w/o a "format" structure +was if (fmt->healpix_out) fprintf(file, "healpix_weight %d\n\n", fmt->nweights); +now if (fmt && fmt->healpix_out) fprintf(file, "healpix_weight %d\n\n", fmt->nweights); + +- fixed memory allocation bug in ransack: after pruning, pointers were copied to null slots but still left in the original slots, causing problems when original slots are freed. +Rather than doing +poly[np] = poly[ipoly]; +for every polygon that isn't pruned, do + + /*copy down non-null polygons*/ + k=0; + for(ipoly = 0; ipoly < npoly; ipoly++){ + if(poly[ipoly]){ + poly[k++]=poly[ipoly]; + } + } + /*after copying non-null polygons, k should be equal to np */ + if(k!=np){ + fprintf(stderr, "ransack: should be left with %d non-null polygons, but actually have %d\n",np,k); + } + + /*nullify the rest of the array, but don't free, since pointers have been copied above*/ + for(ipoly=np; ipoly < npoly; ipoly++){ + poly[ipoly]=0x0; + } + +after pruning is done. Also made similiar change in poly2poly for consistency, although poly2poly hasn't caused any problems. + + +--Molly Swanson + +-------------------------------------------------------------------------------- + +1 April 2007 +Files for new mangle website added to website directory. +Still some work to be done: + - new title image; + - new 'manual' sections describing rasterize/pixelmap/healpix_weight/etc.; + - need shell scripts for 'scripts' section in 'download'; + - some broken links need to be fixed in the 'polygon formats' and + 'troubleshooting' sections in 'manual'; + - the links and references at the bottom of the old mangle web page need to + be added somewhere; + - the 'quickstart' section needs to be redone, and the current material can + probably be added to the 'manual' section. + +--Colin Hill + +-------------------------------------------------------------------------------- +9 March 2007 +Fixed bug in ransack.c line 80 +was rp[1] = x; +now rp[1] = y; +--Molly Swanson + +-------------------------------------------------------------------------------- +mangle1.5 +20 Oct 2006 + +Changes from Colin Hill: +Added SDSSpix pixelization scheme +Added capability to import and export healpix files + +New commands: healpix2poly, rasterize +New functions: get_healpix_poly, get_nside, healpix_verts,cmrpirpj + +healpix functions: healpix_ang2pix_nest, pix2vec_nest + +sdsspix functions: pix2ang, ang2pix, pix2ang_radec, ang2pix_radec, +csurvey2eq,eq2csurvey,superpix,subpix,pix_bound,pix_area,pix2xyz,area_index, +area_index_stripe,assign_parameters + +Put balkanize function in separate balkanizepolys.c file +Made various other minor edits + +-------------------------------------------------------------------------------- + +Changes from Molly Swanson: +Fixed bug in polyid created by pixelization stuff +Added pixelmap function +Added option to set polygon ids to their pixel numbers + +-------------------------------------------------------------------------------- + +Changes from Andrew Hamilton: +14 Sep 2006 + +Thanks to Colin Hill, working with Max Tegmark and Molly Swanson at MIT, +for finding a polygon that defeated mangle. + +1. The problem was numerical round-off, +and the immediate fix was to replace line 71 in split_poly.c + if (area != area_tot) { /* boundary intersects poly1 */ +with + if (area > area_tot) { /* boundary intersects poly1 */ +It should never happen that area < area_tot, since removing a boundary +of a polygon should never decrease its area, but thanks to numerical round-off +the area did decrease. Once that happened, mangle span its wheels. + +2. The killer polygon that was responsible for the numerical failure of item 1 +is discussed below. To improve mangle's defence against such polygons, +I changed the strategy for modifying the tolerance angle to multiple +intersections. Originally, if mangle detected an inconsistency in the +topology of the distribution of vertices around multiple intersections, +then mangle would double the tolerance angle and try again. +The new strategy is to try tightening as well as loosening the tolerance angle. +Mangle now see-saws between and tighter and looser tolerance angles +successive factors of 2 away from the original input tolerance angle. + +3. There was also a bug on line 182 of balkanize.c. + for (i = npoly; i < npolys; i++) { +should have been + for (i = 0; i < npolys; i++) { +This bug became evident as a result of a compiler change. +When tripped, the bug produces a segmentation violation, so if you never +experienced this bug before, it should never have caused an error. + +This is Colin Hill's killer polygon: +polygon 6 ( 5 caps, 1.0 weight, 0.000003265281337 str): + -0.2972995896945569 -0.5791945044073898 -0.7590432662449000 0.5786075961488696 + -0.1092635942528740 0.6422417176858356 -0.7586745303718128 0.5279437897883537 + -0.3927631897959760 -0.5199166454922474 -0.7585669110114012 -0.4794583692304901 + -0.0457867636138749 0.6498588533234551 -0.7586745303718132 -0.5279437897887224 + -0.3467216633109536 -0.5515406106135746 -0.7586745303718130 0.5279437897887302 +It is a long (4.3 degrees) thin (36 arcsec) rectangle, split by a diagonal +which is almost, but not quite, tangent at each end to the long direction. +Each near tangent end is both almost multiply intersecting, and almost kissing. + +If you balkanize the killer polygon with the default tolerance angle +for multiple intersections of 10^-5 arsec, then mangle1.4.1 will discard the +polygon as having zero area: + +% balkanize killer.poly - +---------------- balkanize ---------------- +snap angles: axis 2s latitude 2s edge 2s +multiple intersections closer than 1e-05s will be treated as coincident +... +1 polygons read from j6 +warning from balkanize: following polygons have zero area & are being discarded: + 0 +... + 0 polygons written to output + +Well, the polygon is thin, 36 arcsec wide, so maybe you don't mind losing +the polygon. But with snap tolerance angles of 2 arcsec, you'd think mangle +should keep it. It turns out that the multiple intersections at each end +of the polygon have separations that vary from 10^-8 arcsec in the thin +direction to 80 arcsec in the long direction, and this distribution of +separations conspires so that mangle finds no consistent topology +(satisfying the 64-bit check number) for tolerance angles to multiple +intersections anywhere between 10^-8 arcsec and 40 arcsec. But 40 arcsec +exceeds the 36 arcsec width of the polygon, so mangle concludes that the +area is zero. + +If the tolerance angle for multiple intersections is tightened to +5 x 10^-9 arcsec: + +% balkanize -m5e-9s killer.poly - + +then mangle does find the correct solution. That is, since the polygon +is already a valid polygon, balkanize spits back the killer polygon +unchanged. + +Thus the solution to dealing with this polygon is not to loosen the +tolerance, but to tighten it. The new mangle strategy does this. + +Max Tegmark suggests switching the entire mangle code from double (64-bit) +to quadruple (128-bit) precision. This may be a sensible thing to do +at some point. The need for high precision was always evident. +Inevitably, people are messing with masks that have arcsecond precision. +A 1 x 1 arcsec rectangle has an area of 2 x 10^-11 str, which is 2 x 10^-12 +of the whole sky. This is a factor of 10^4 larger than the effective +precision 2 x 10^-16 of 64-bit floats. The factor of 10^4 is ok, +but with ever more complicated masks appearing, it may no longer be +providing a sufficient safety margin. + +-------------------------------------------------------------------------------- +5 Sep 2005 + +Added '\r' to characters considered blank, so polygon files are dos-compatible. + +-------------------------------------------------------------------------------- + +mangle1.4.3 +9 Jan 2006 +Molly Swanson + +Added "pixel 0" to the polygon files in masks/allsky +Commented out self-snapping step in balkanize to avoid creating problematic +long skinny polygons when running on the sdss mask +Added "list" output format to be read by matlab script +Changed defaults snap angles from 2 to .2 arcseconds + + +-------------------------------------------------------------------------------- +mangle1.4.2 +4 Mar 2005 +Molly Swanson + +Added pixelization functions to speed up snap, balkanize, unify, and polyid. +New command: pixelize +New functions: get_pixel, which_pixel, get_child_pixels, get_parent_pixels, +get_res, pixel_list, pixel_start, poly_sort +Modified polygon format to include pixel number +Made a variety of other small, minor changes + +-------------------------------------------------------------------------------- + +mangle1.4.1 +30 Mar 2004 + +Many thanks to Michael Blanton, who is working on the SDSS mask, +for bringing these two problems to light. + +1. In some cases, balkanize creates long, extremely thin polygons that mangle +cannot subsequently deal with, because the polygons are simply too thin for +the numerics. The solution is to add to the balkanization routine a +penultimate step that snaps the edges of each polygon to each other. +This is not a bad idea anyway, since polygons produced by balkanization +should never need additional snapping. + +2. Connected with the above problem, in some cases and on some platforms +vmid fails to find a midpoint of a polygon. The problematic polygons +are precisely the long extremely thin polygons mentioned in 1. +In these cases the barycentre of the polygon provides a satisfactory midpoint. +Therefore the barycentre is now included as one of the points to test +as a possible midpoint of a polygon. + +In addition to the above, I added "intrinsic" declarations of abs max and min +to the fortran routines that use those functions, as required by some +fortran compilers. + +-------------------------------------------------------------------------------- +mangle1.4 +3 Sep 2003 + +Several minor improvements. +The mangle code has gotten a pretty good workout on the 2dF 230k sample, +released on 30 June 2003, and there have been no changes in mangle for about +a month now, so I'm getting pretty happy that the code has converged, +at least for the time being. + +In the future, if demand warrants, there may be an accelerated version of +mangle that replaces double do loops over polygons with code that is a little +more intelligent about deciding whether 2 polygons are close to each other. + +-------------------------------------------------------------------------------- +mangle1.3.3 +24 June 2003 + +Implemented spolygon format. + +-------------------------------------------------------------------------------- +mangle1.3.2 +17 June 2003 + +First general public release. +Major upgrade from mangle1.2; much more robust. + +-------------------------------------------------------------------------------- +mangle1.2 +8 Sep 2001 + +First limited public release. diff --git a/COPYRIGHT b/COPYRIGHT new file mode 100644 index 0000000..17e3f07 --- /dev/null +++ b/COPYRIGHT @@ -0,0 +1,18 @@ +You are free to do whatever you like with this software, +provided that, if you do use it, then you reference it. + +The correct paper references are +Swanson M E C, Tegmark M, Hamilton A J S, and Hill J C (2007) +"Methods for Rapidly Processing Angular Masks of Next-Generation Galaxy Surveys"(arXiv:0711.4352) http://arxiv.org/abs/0711.4352 + +and + +Hamilton A J S & Tegmark M (2004) +"A scheme to deal accurately and efficiently with complex angular masks +in galaxy surveys", MNRAS, 349, 115-128. +(astro-ph/0306324) http://arXiv.org/abs/astro-ph/0306324 + +The correct web reference is +http://space.mit.edu/home/tegmark/mangle/ + +Updated by mecs 28 Nov 2007 diff --git a/HELP.unformatted b/HELP.unformatted new file mode 100644 index 0000000..53cdb2d --- /dev/null +++ b/HELP.unformatted @@ -0,0 +1,51 @@ +Problem +------- +Your fortran refuses to read the unformatted fortran files made on another +system. + +Diagnosis +--------- +Your computer stores bytes with opposite endianness. + +OR + +Your version of mangle was compiled using the gfortran fortran compiler, +but you are trying to read unformatted fortran files produced with g77 +fortran code. + +Solution +-------- +Download the formatted version of the masks available in the "data" section +of the mangle website http://space.mit.edu/home/tegmark/mangle/ +and use these instead. + + +Another Solution +---------- +WARNING: The following hack works only if each number in the unformatted +fortran file is a single word, i.e. an INTEGER or REAL (not DOUBLE PRECISION). +On a 32-bit machine, each word contains 4 bytes. + +The following converts files to the opposite endianness using cpio, +a command famous for its obtuseness. + +1. Make a cpio archive file from the original files, as in + +ls -1 file1 file2 ... | cpio -o > files.cpio + +Notice that the switch -1 is a one, not an ell. + +2. Move the cpio archive to another directory where it will not overwrite +the old files + +mv files.cpio other_directory + +3. Extract the files from the cpio archive in the new directory + +cd other_directory +cpio -i -b < files.cpio + +The -b switch is the thing that does the byte-swapping in each word. + + + diff --git a/INSTALL b/INSTALL new file mode 100644 index 0000000..046dfb7 --- /dev/null +++ b/INSTALL @@ -0,0 +1,100 @@ +The mangle software is written in c and fortran, +so to compile mangle you will need both c and fortran compilers. + +To (re)compile +-------------- + +cd /src +make + +The executables will be in +/bin + +To remove unneeded object files +------------------------------- + +cd /src +make clean + +To remove a previous compilation and compile from scratch +--------------------------------------------------------- + +cd /src +make cleanest +make + +To generate a new Makefile for your local system and then compile from scratch +------------------------------------------------------------------------------ +cd /src +configure +make cleanest +make + + +To compile a statically linked version suitable for distribution +---------------------------------------------------------------- + +cd /src +make cleanest +make static + +Systems on which mangle 2.x has compiled successfully +----------------------------------------------------- + +real*10 version: +Linux + gcc + gfortran 4.1.x or later + +Mac OSX Intel + gcc + gfortran 4.1.x or later + +see http://gcc.gnu.org/wiki/GFortranBinaries for gfortran for Mac OSX +may require updated version of cctools from ftp://gcc.gnu.org/pub/gcc/infrastructure/ + +real*8 version: +Linux + gcc + g77 + +Mac OSX Intel and PowerPC + gcc + g77 + +Systems on which mangle1.x has compiled successfully +---------------------------------------------------- + +Linux + gcc versions 2 or 3 + g77 or fort77 + +Solaris + cc or gcc + f77 or g77 + +To patch mangle1.4 to mangle1.4.1 +--------------------------------- +cd +patch -p1 < ../path.to.the/mangle1.4_to_1.4.1.patch + +You will then need to recompile. + +Troubleshooting +--------------- +If the Makefile gives problems, try using gmake (the gnu version of make) +in place of make. More generally, mangle is known to compile and run +successfully with the gnu versions gcc and g77 of the c and fortran compilers, +and with the gnu version gmake of the make command. +To compile the real*10 version, you will need a compiler that supports real*10, +for example, gfortran version 4.1 or later (though not all distributions +of gfortran support real*10). + + +There are bound to be problems with compilation in early stages of the general +release of mangle, since mangle has been tested only on a limited number of +systems. If you are having problems compiling, please contact the mangle development +team via Andrew.Hamilton@colorado.edu or tegmark@mit.edu, and we will try to work +with you to get mangle to compile on your system. + +Updated by mecs 25 July 2008 diff --git a/README b/README new file mode 100644 index 0000000..a69ac4a --- /dev/null +++ b/README @@ -0,0 +1,33 @@ +Read INSTALL for instructions on compilation. + +Documentation on mangle is at + +http://space.mit.edu/home/tegmark/mangle/ + +To get started, try creating the mask for an example slice of the SDSS survey: +cd /masks/sdss +and follow the README, +or follow the QuickStart section on the website. + +Typing a command with no arguments will give you a brief summary of its usage. + +Typing a command with the -d switch will tell you what the defaults are. + +The mathematical algorithms are described by +Hamilton A J S & Tegmark M (2004) +"A scheme to deal accurately and efficiently with complex angular masks +in galaxy surveys", MNRAS, 349, 115-128 +and +Swanson M E C, Tegmark M, Hamilton A J S, and Hill J C (2008) +"Methods for rapidly processing angular masks of next-generation galaxy +surveys", MNRAS, 387, 1391-1402. + +The intention is that the probability of the mangle software failing, +once successfully compiled, should be comparable to the probability +of a piece of spacejunk falling on your head (let's hope it ain't true). +If it fails, please check out Troubleshooting at +http://space.mit.edu/home/tegmark/mangle/manual/troubleshooting.html +If you still have a problem, please contact the mangle development team via +Andrew.Hamilton@colorado.edu or tegmark@mit.edu + +Updated by mecs 24 July 2008 diff --git a/py_tools/mangleFitsToPly.py b/py_tools/mangleFitsToPly.py new file mode 100644 index 0000000..0379676 --- /dev/null +++ b/py_tools/mangleFitsToPly.py @@ -0,0 +1,42 @@ +#!/usr/bin/env python + +# takes a fits verion of a mangle file and removes unobserved sectors +# converts a mangle FITS file to a .ply file + +import numpy as np +import os +import sys +import pylab as plt +import pyfits as py + +maskFile = os.getenv("HOME")+"/workspace/Voids/catalogs/boss/boss_geometry_2011_06_10.fits" +outFile = os.getenv("HOME")+"/workspace/Voids/catalogs/boss/boss_mask.ply" + +hdulist = py.open(maskFile) +maskData = hdulist[1].data +hdulist.close() + +fp = open(len(maskData), 'w') +fp.write(str(numKeep) + " polygons\n") +fp.write("pixelization 6s\n") +fp.write("snapped\n") +fp.write("balkanized\n") +iKeep = 0 +for i in xrange(len(maskData)): + fp.write("polygon %22d ( %d caps, %20.7f weight, %d pixel, %20.16f str):\n" % + (iKeep, + maskData.field('NCAPS')[i], + maskData.field('WEIGHT')[i], + maskData.field('PIXEL')[i], + maskData.field('STR')[i] )) + + ncaps = maskData.field('NCAPS')[i] + for iCap in xrange(ncaps): + fp.write("%24.20f %24.20f %24.20f %24.20f\n" % + (maskData.field('XCAPS')[i][iCap][0], + maskData.field('XCAPS')[i][iCap][1], + maskData.field('XCAPS')[i][iCap][2], + maskData.field('CMCAPS')[i][iCap])) + iKeep += 1 + +fp.close() diff --git a/scripts/2df100k.sh b/scripts/2df100k.sh new file mode 120000 index 0000000..4dfe686 --- /dev/null +++ b/scripts/2df100k.sh @@ -0,0 +1 @@ +../masks/2df100k/2df100k.sh \ No newline at end of file diff --git a/scripts/2df230k.sh b/scripts/2df230k.sh new file mode 120000 index 0000000..2c7ca22 --- /dev/null +++ b/scripts/2df230k.sh @@ -0,0 +1 @@ +../masks/2df230k/2df230k.sh \ No newline at end of file diff --git a/scripts/2qz.sh b/scripts/2qz.sh new file mode 120000 index 0000000..9e137bf --- /dev/null +++ b/scripts/2qz.sh @@ -0,0 +1 @@ +../masks/2qz10k/2qz.sh \ No newline at end of file diff --git a/scripts/call b/scripts/call new file mode 120000 index 0000000..03eb7b1 --- /dev/null +++ b/scripts/call @@ -0,0 +1 @@ +../masks/healpix/healpix_conversion_scripts/call \ No newline at end of file diff --git a/scripts/find_complement.sh b/scripts/find_complement.sh new file mode 100755 index 0000000..91fff8f --- /dev/null +++ b/scripts/find_complement.sh @@ -0,0 +1,97 @@ +#! /bin/sh +# © M E C Swanson 2008 +#script to find the complement of a mangle mask +#USAGE: find_complement.sh +#EXAMPLE:find_complement.sh holes.pol complement.pol +#input mask can be pixelized beforehand to a fixed resolution +#if the mask is complicated, e.g. pixelize -Ps0,8 holes.pol holes_pixelized.pol + +if [ "$MANGLEBINDIR" = "" ] ; then + MANGLEBINDIR="../../bin" +fi +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi +if [ "$MANGLEDATADIR" = "" ] ; then + MANGLEDATADIR="../../masks" +fi + +mask=$1 +complement=$2 +dres=3 +dscheme="s" + +#check command line arguments +if [ "$mask" = "" ] || [ "$complement" = "" ] ; then + echo >&2 "ERROR: enter the input and output polygon files as command line arguments." + echo >&2 "" + echo >&2 "USAGE: find_complement.sh " + echo >&2 "EXAMPLE:find_complement.sh holes.pol complement.pol" + exit 1 +fi + +head -n 100 $mask > jmaskhead + +#grab pixelization info from input files +awk '/pixelization/{print $0}' < jmaskhead > jpix +res=`awk '{print substr($2, 1, length($2)-1)}' < jpix` +scheme=`awk '{print substr($2, length($2))}' < jpix` +rm jpix jmaskhead + +#if input file is unpixelized, pixelize it +#if input file is pixelized to a fixed resolution, use it as is. +if [ "$res" = "" ]; then + res=$dres + scheme=$dscheme + echo "" + echo "Pixelizing $1 ..." + $MANGLEBINDIR/pixelize -P${scheme}0,$res $mask jp || exit + echo "" +elif [ "$res" = -1 ] ; then + res=$dres + scheme=$dscheme + echo "WARNING: cannot take the complement of a mask pixelized adaptively." + echo "Pixelizing your mask using a fixed resolution:" + echo "" + echo "Pixelizing $1 ..." + $MANGLEBINDIR/pixelize -P${scheme}0,$res $mask jp || exit + echo "" +else + cp $mask jp +fi + +#check for appropriate allsky file, and generate it if it's not there: +allsky=$MANGLEDATADIR/allsky/allsky$res$scheme.pol +if [ ! -e $allsky ] ; then + $MANGLESCRIPTSDIR/make_allsky.sh $res $scheme +fi + +#check if input file is snapped +snapped=`awk '/snapped/{print $1}' < $mask` + +#if input file isn't snapped, snap it +if [ ! "$snapped" = "snapped" ]; then + echo "Snapping $1 ..." + $MANGLEBINDIR/snap jp jps || exit + rm jp +else + mv jp jps +fi + +#set weight of all polygons in mask to zero +echo 0 > jw0 +echo "$MANGLEBINDIR/weight -zjw0 $mask jw" +$MANGLEBINDIR/weight -zjw0 jps jw || exit +rm jps + +#balkanize the full sky with the zero-weighted mask to find the complement +echo "$MANGLEBINDIR/balkanize $allsky jw jb" +$MANGLEBINDIR/balkanize $allsky jw jb || exit +rm jw + +#unify to get rid of zero weight polygons +echo "$MANGLEBINDIR/unify jb $complement" +$MANGLEBINDIR/unify jb $complement || exit +rm jb + +echo "Complement of $mask written to ${complement}." diff --git a/scripts/graphmask.m b/scripts/graphmask.m new file mode 100644 index 0000000..9747e23 --- /dev/null +++ b/scripts/graphmask.m @@ -0,0 +1,192 @@ +function graphmask(infile,outfile,maprange,plottitle,outlines) +% © M E C Swanson 2008 +%function for plotting MANGLE polygon files using the Matlab mapping toolbox. +%arguments: +%infile=polygon file to be plotted, in 'list' format, i.e.created with poly2poly -ol30 mypolys.pol mypolys.list +%outfile=name of eps file to output, or use 'none' if you want to, e.g., put the resulting figure into a subplot. +%maprange=[lonmin,lonmax,latmin,latmax] are optional latitude and longitude (Dec and RA) +%limits for the mask. If not provided, default is to plot full sky. +%title=optional title for the plot +%outlines=whether to draw black outlines around polygons. default is no outlines. Use outlines='on' to draw outlines. + +%check if mapping toolbox is installed: +if ( ~exist('ispolycw') ) + fprintf(2, 'To plot mangle masks in Matlab, you must have the mapping\ntoolbox (version 2.0.3 (R14SP1) or later) installed.\n'); + exitval=1; + save('matlabexit.temp','exitval'); + exit +end + +%process input arguments +if(nargin<1) + error('graphmask requires at least one input argument: the name of the input data file to plot.'); +end +if(nargin==1) + outfile='none'; + maprange=[0 360 -90 90]; + plottitle=''; + outlines=''; + lims=0; +end +if(nargin==2) + maprange=[0 360 -90 90]; + plottitle=''; + outlines=''; + lims=0; +end +if(nargin==3) + plottitle=''; + outlines=''; + lims=1; +end +if(nargin==4) + outlines=''; + lims=1; +end +if(nargin>=5) + lims=1; +end +if(all(maprange==0)) + maprange=[0 360 -90 90]; + lims=0; +end +%check if mapping toolbox is installed: +if (~isnumeric(maprange)) + fprintf(2, 'ERROR: Non-numeric values used in maprange\n'); + exitval=1; + save('matlabexit.temp','exitval'); + exit +end + +lonmin=maprange(1); +lonmax=maprange(2); +latmin=maprange(3); +latmax=maprange(4); + +%set spacing for tickmarks +range=max(latmax-latmin, lonmax-lonmin); +avrange=mean([latmax-latmin, lonmax-lonmin]); +if(range<15) + sp=1; +else if (range<30) + sp=2; + else if (range<90) + sp=5; + else if (range<150) + sp=10; + else if (range<300) + sp=20; + else + sp=50; + end + end + end + end +end + +%read in files +weightfile=[infile '.weight']; +xymat=load(infile); +wmat=load(weightfile); +fprintf(1,'Done reading files\n'); +ra=xymat(1:end,1); +dec=xymat(1:end,2); +weight=wmat(1:end,2); +%set up map axes +axm=axesm('MapProjection', 'hammer','frame','on','FFaceColor','black','origin',180); + +if (lims) + axesm('MapProjection','mercator','frame','on','maplatlimit',[latmin latmax], 'maplonlimit',[lonmin lonmax]) + setm(gca,'ParallelLabel','on','PLabelLocation',sp,'LabelFormat','none','fontsize',10); + tightmap; + ax1=gca; + ax2=axes('Position',get(ax1,'Position')); + axesm('MapProjection','mercator','frame','on','maplatlimit',[latmin latmax], 'maplonlimit',[lonmin lonmax]) + setm(gca,'FFaceColor','black') +else + axm=axesm('MapProjection', 'hammer','frame','on','FFaceColor','black','origin',180); +end + +%plot polygons in list as patches +if (strcmp(outlines,'on')) + h=patchesm(dec,ra,'g','Edgecolor','black','Linewidth',0.3); +else + h=patchesm(dec,ra,'g','Edgecolor','none'); +end +%normalize weights +minweight=min(weight); +maxweight=max(weight); +weight=(weight-minweight)./(maxweight-minweight); +%scale weight so that the minimum isn't black unless it's actually zero +if(minweight~=0) + minscale=.1; + zeroscale=minweight-minscale./(1-minscale).*(maxweight-minweight); + if(minscale>0 && zeroscale<=0) + zeroscale=0; + minscale=minweight./maxweight; + end + weight=(1-minscale).*weight+minscale; +else + zeroscale=minweight; +end + +%set holes (polygons with points wound counterclockwise) to have weight 0 +ccw=~ispolycw(dec,ra); +weight(ccw)=0; +%create cell array of colors with each element as grayscale weight +color=[weight weight weight]; +cellcolor=num2cell(color,2); +%apply weight colors to patch objects +set(h,{'FaceColor'},cellcolor); + +%tweak map display and add labels +if (lims) + set(gca,'XDir', 'reverse') + gridm on; + setm(gca,'MeridianLabel','on','MLabelLocation',sp,'MLineLocation',sp,'PLineLocation',sp,'MLabelParallel','south',... + 'LabelFormat','none', 'MLineLimit',[latmin latmin+.01*avrange],'PLineLimit',[lonmax-.01*avrange, lonmax],... + 'glinestyle','-','gcolor',[.5 .5 .5],'fontsize',10); + tightmap; + mlabelzero22pi + xlabel('\newline Right Ascension') + ylabel('Declination\newline ') +else + tightmap; + xlims=get(gca,'XLim'); + ylims=get(gca,'YLim'); + axis([1.01*xlims 1.01*ylims]) + set(gca,'XDir', 'reverse','XColor',[1 1 1],'YColor',[1 1 1]) + xlabel('-90^{\circ}','Color','k') + ylabel('360^{\circ}','Rotation',0.0,'Color','k','VerticalAlignment','Middle','HorizontalAlignment','Right') + ax1=gca; + ax2=copyobj(ax1,gcf); + set(ax2,'XAxisLocation','top', 'YAxisLocation','right','Color','none','XColor',[1 1 1],'YColor',[1 1 1]); + axes(ax2); + xlabel('+90^{\circ}','Color','k') + ylabel('0^{\circ}','Rotation',0.0,'Color','k','VerticalAlignment','Middle','HorizontalAlignment','Left') +end +title(plottitle); + +%add colorbar +pb=pbaspect; +pos1=get(gca,'Position'); +axes('Position',pos1) +axis off +colormap('gray') +caxis([zeroscale maxweight]); +pbaspect(pb); +pos1=get(gca,'Position'); +cbar_handle=colorbar('EastOutside'); +set(gca,'Position',pos1); + +fprintf(1,'Done making mask image\n'); +%export image as eps file +if(~strcmp(outfile,'none')) + set (gcf, 'Color', [1 1 1]) + if(~lims) + set(gcf,'PaperPosition', [-1.75 .75 14 7]) + end + print('-depsc','-r600',outfile); + fprintf(1,'Done writing mask image to %s\n',outfile); + exit +end diff --git a/scripts/graphmask.sh b/scripts/graphmask.sh new file mode 100755 index 0000000..72887e9 --- /dev/null +++ b/scripts/graphmask.sh @@ -0,0 +1,69 @@ +#!/bin/sh +# © M E C Swanson 2008 +#plot the angular mask described by a polygon file in .list format +#using the matlab mapping toolbox +# +#optional 3rd-6th arguments give the RA and Dec range to plot the mask +#if no range is given, the full sky will be plotted +#To plot range that includes RA=0, use a negative number for the "low" +#end, e.g. for a 10 degree strip covering RA=355 degrees to RA=5 degrees, +#use a range of -5 5. +#Entering in "0 0 0 0" for the range will also give the default full sky behavior, +#which can be used if you also wish to, e.g., enter a title. +# +#optional 7th argument gives a title for the graph +#optional 8th argument turns on drawing black outlines around each polygon +# +#if specifying the full path to a file (rather than just running in the directory +#containing the file you want to plot), put the path in double-quotes as shown below. +# +#USAGE: graphmask.sh [ ] [] [<outlines>] +#EXAMPLES: +#fullsky, no outlines: graphmask.sh "dr4/safe0/sdss_dr4safe0_mask.list" "dr4/safe0/sdss_dr4safe0_mask.eps" +#defined range, title, no outlines: graphmask.sh sdss_slice.list sdss_slice.eps -45 35 8 21 "SDSS slice" +#defined range, no title, outlines: graphmask.sh sdss_slice.list sdss_slice.eps -45 35 8 21 "" on +#fullsky, no title, outlines: graphmask.sh sdss_slice.list sdss_slice.eps 0 0 0 0 "" on + +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi + +if [ $# -eq 2 ]; then + if [ -e $1 ]; then + if [ -e $2 ]; then + rm $2 + fi + matlab -nodisplay -r addpath\(\'$MANGLESCRIPTSDIR\'\)\;graphmask\(\'$1\',\'$2\'\) + else + echo >&2 "ERROR: file $1 not found." + exit 1 + fi +elif [ $# -ge 6 ]; then + if [ -e $1 ]; then + if [ -e $2 ]; then + rm $2 + fi + echo "addpath('$MANGLESCRIPTSDIR'); graphmask('$1','$2',[$3,$4,$5,$6],'$7','$8')" > jgraphtemp.m + matlab -nodisplay < jgraphtemp.m + rm jgraphtemp.m + else + echo >&2 "ERROR: file $1 not found." + exit 1 + fi +else + echo >&2 "USAGE: graphmask.sh <infile> <outfile> [<ramin> <ramax> <decmin> <decmax>] [<title>] [<outlines>]" + echo >&2 "EXAMPLES:" + echo >&2 "fullsky, no outlines: graphmask.sh \"dr4/safe0/sdss_dr4safe0_mask.list\" \"dr4/safe0/sdss_dr4safe0_mask.eps\"" + echo >&2 "defined range, title, no outlines: graphmask.sh sdss_slice.list sdss_slice.eps -45 35 8 21 \"SDSS slice\"" + echo >&2 "defined range, no title, outlines: graphmask.sh sdss_slice.list sdss_slice.eps -45 35 8 21 \"\" on" + echo >&2 "fullsky, no title, outlines: graphmask.sh sdss_slice.list sdss_slice.eps 0 0 0 0 \"\" on" + exit 1 +fi +if [ -e matlabexit.temp ] || [ ! -e $2 ]; then + echo >&2 "ERROR: error in matlab plotting script." + if [ -e matlabexit.temp ]; then + rm matlabexit.temp + fi + exit 1 +fi +echo all done! diff --git a/scripts/graphmask.sm b/scripts/graphmask.sm new file mode 100755 index 0000000..ede1732 --- /dev/null +++ b/scripts/graphmask.sm @@ -0,0 +1,226 @@ +graphmask 28 # © M E C Swanson 2008 + #An sm script to plot mangle graphics files + #first argument: mangle graphics file to read: *.grph + #second argument: postscript file for output graph: *.eps + #third and fourth arguments: optional range for right ascension to plot + # (use 0 0 to plot using range from data) + #fifth and sixth arguments: optional range for declination to plot + # (use 0 0 to plot with dec range adjusted to give equal scaling on x and y axes, + # centered on the range of all the data.) + #seventh argument: title of graph: "I am a title" + #eighth argument: optional switch: 0 for outlines off, 1 for outlines on (default is 0) + # + #WARNINGS: + # -This script uses the opposite color scheme than the matlab script, i.e., + # weight 1 = black, weight 0 = white + # -RA and Dec are treated as linear variables (no spherical projection). This means that + # ranges that span RA=0 won't plot properly. + # -SM can only plot square eps files, so if you define both RA and Dec range, they should + # have the same length, otherwise your plot will appear stretched. + # -SM has a line length limit of 1500 characters, which SDSS tends to have no trouble overloading. + # If you get an error reading the file, try making your graphics file with lower precision and + # fewer points per 2pi, i.e., use poly2poly -og12 -p3 instead of poly2poly -og30. + # + #USAGE: sm -m $MANGLESCRIPTSDIR/graphmask.sm <infile> <outfile> [<ramin> <ramax>] [<decmin> <decmax>] [<title>] [<outlines>] + #EXAMPLES: + #default range, no outlines: sm -m $MANGLESCRIPTSDIR/graphmask.sm sdss_slice.grph sdss_slice.eps + #defined RA range, outlines: sm -m $MANGLESCRIPTSDIR/graphmask.sm sdss_slice.grph sdss_slice.eps "SDSS slice" 0 35 0 0 1 + #defined range, no outlines: sm -m $MANGLESCRIPTSDIR/graphmask.sm sdss_slice.grph sdss_slice.eps "SDSS slice" 10 20 10 20 + #defined range, outlines: sm -m graphmask.sm sdss_slice.grph sdss_slice.eps "SDSS slice" 10 20 10 20 1 + # + data $1 + device postfilecolour $2 + #location $gx1 $gx2 $gy1 $(.77*($gx2-$gx1)) + if($?3) { define title $3 } + if($?3 && $?4) { + if(!($3==0 && $4==0)){ + define azmin $3 + define azmax $4 + } + } + if($?5 && $?6) { + if(!($5==0 && $6==0)){ + define elmin $5 + define elmax $6 + } + } + if($?7) { define title $7 } + if($?8) { define outlines $8 } else { define outlines 0 } + + define i 0 # i = current line to read in file + define in_header 1 # in_header = 1 if reading header of file + + #process header information + while{$in_header} { + define i ($i+1) + read row header $i.s + if (header[1]=='polygons'){ + define npoly (ATOF((header[0]))) + } else { if (header[0]=='unit'){ + define unit (header[1]) + } else { if (header[0]=='graphics'){ + #we've reached the body of the data file, so move on + define in_header 0 + } else { + write standard Unrecognized format in line $i of $1. + write standard Please fix the data file and try again. + write smerr.temp 1 + quit + }}} + + } + + define i_start $i #i_start = first line of data + define polycount 0 + define first_poly 1 + + #process polygon data + define numlines ($i_start+2*$npoly-1) + while { $i < $numlines } { + read row specs $i.s + if(specs[0]!='graphics' || dimen(specs)!=12){ + write standard Formatting error in line $i of $1 + write standard Your data file probably contains a line over 1500 characters long. + write standard Please try to make your data file with shorter lines: + write standard i.e., use poly2poly -og10 -p3 instead of poly2poly -og30. + write smerr.temp 1 + quit + } + set id = ATOF(specs[1]) + set n_tot = ATOF(specs[3]) + set edges = ATOF(specs[5]) + set w = ATOF(specs[7]) + set midx = ATOF(specs[9]) + set midy = ATOF(specs[10]) + + define numpoints (n_tot[0]) + + while{$numpoints>0}{ + read row polypoints $($i+1) + set n = (dimen(polypoints)/2) + define numpoints ( $numpoints - n[0]) + + #if there are still points to read in for this polygon, + #we need to read in another line + if($numpoints>0){ + write standard "extra line for disconnected polygon" + define numlines ($numlines+1) + } + + #separate list of points in x y x y x y ... format into x and y vectors + set ix = 0,2*n[0]-2,2 #even numbers + set iy = 1,2*n[0]-1,2 #odd numbers + # x = numbers with even list indices (indices start at 0) + # y = numbers with odd list indices + # tack first point on at end to close the polygon + set x=polypoints[ix] CONCAT polypoints[0] + set y=polypoints[iy] CONCAT polypoints[1] + + # if polygon is in range to be plotted, add it to plot list + if($first_poly){ + #if this is the first polygon in list, start the list + set x_all = x + set y_all = y + set numpoints = n+1 + set weight = w + define first_poly 0 + } else { + #otherwise, tack this one on to the list + set x_all = x_all CONCAT x + set y_all = y_all CONCAT y + set numpoints = numpoints CONCAT (n+1) + set weight = weight CONCAT w + } + define i ($i+1) + define polycount ($polycount+1) + } + define i ($i+1) + } + + limits x_all y_all + #adjust limits so the axes have equal scaling + if( ($fx2-$fx1)/$nx > ($fy2-$fy1)/$ny ) { + define ymid (($fy1+$fy2)/2) + define ymin ($ymid - .5*($fx2-$fx1)*$ny/$nx) + define ymax ($ymid + .5*($fx2-$fx1)*$ny/$nx) + define xmin $fx1 + define xmax $fx2 + } else { if( ($fx2-$fx1)/$nx < ($fy2-$fy1)/$ny ) { + define xmid (($fx1+$fx2)/2) + define xmin ($xmid - .5*($fy2-$fy1)*$nx/$ny) + define xmax ($xmid + .5*($fy2-$fy1)*$nx/$ny) + define ymin $fy1 + define ymax $fy2 + }} + limits $xmin $xmax $ymin $ymax + + #if limits have been specified as arguments, use them + if($?azmin && $?azmax) { + write standard using user-defined limits for RA + define scale (($azmax-$azmin)/($xmax-$xmin)) + define ymid (($fy1+$fy2)/2) + define ymin ($ymid - .5*($fy2-$fy1)*$scale) + define ymax ($ymid + .5*($fy2-$fy1)*$scale) + define xmin $azmin + define xmax $azmax + if($?elmin && $?elmax) { + write standard using user-defined limits for dec + define ymin $elmin + define ymax $elmax + } + } + limits $xmin $xmax $ymin $ymax + + expand 1.00001 + ANGLE 0 + AXIS $fx2 $fx1 0 0 $gx1 $gy1 $($gx2-$gx1) 1 $(0) + AXIS $fx2 $fx1 0 0 $gx1 $gy2 $($gx2-$gx1) 0 $(1) + ANGLE 90 + AXIS $fy1 $fy2 0 0 $gx1 $gy1 $($gy2-$gy1) 2 $(1) + AXIS $fy1 $fy2 0 0 $gx2 $gy1 $($gy2-$gy1) 0 $(0) + ANGLE 0 + + #box + xlabel Right Ascension ($unit) + ylabel Declination ($unit) + identification + if ($?title) { + define titlepos ($gy2+100) + relocate ($gx1 $titlepos) + putlabel 9 $title + } + + define j 0 + do i=0,$polycount-1 { + set k = $j, $j+numpoints[$i]-1 + set x=x_all[k] + set y=y_all[k] + #flip so that RA increases from right to left + set x = $fx1+$fx2-x + define j ($j+numpoints[$i]) + define gray (int(50+ 200*(1-weight[$i]))) + ctype = <0 $gray 255> + 256*<0 $gray 255> + 256*256*<0 $gray 255> + #check if polygon is clockwise or counterclockwise + set ii=0,numpoints[$i]-2 + set iplus=1,numpoints[$i]-1 + set cross=((x[ii]*y[iplus])-(x[iplus]*y[ii])) + #ishole should be positive if polygon is a hole + set ishole=(.5*sum(cross)) + if($outlines){ + ctype 0 + connect x y + } else { + ctype 1 + connect x y + } + if (ishole > 0){ + ctype 2 + shade 0 x y + } else { + ctype 1 + shade 0 x y + } + + } + quit + #end diff --git a/scripts/graphmasksm.sh b/scripts/graphmasksm.sh new file mode 100755 index 0000000..1e83368 --- /dev/null +++ b/scripts/graphmasksm.sh @@ -0,0 +1,86 @@ +#!/bin/sh +# © M E C Swanson 2008 +#plot the angular mask described by a polygon file in graphics format +#using sm +# +#optional 3rd-6th arguments give the RA and Dec range to plot the mask +#If no range is given, range will be calculated automatically from the data. +#If only an RA range is given, Dec range will be calculated automatically +#to give equal scaling on x and y axes, centered on the range of all the data. +# +#Entering in "0 0 0 0" for the range will also give an automatic range, +#which can be used if you also wish to, e.g., enter a title. +#Likewise entering "0 0" for the Dec range is equivalent to only specifying an RA range. +# +#optional 7th argument gives a title for the graph +#optional 8th argument turns on drawing black outlines around each polygon +# +#if specifying the full path to a file (rather than just running in the directory +#containing the file you want to plot), put the path in double-quotes as shown below. +# +#USAGE: graphmasksm.sh <infile> <outfile> [<ramin> <ramax>] [<decmin> <decmax>] [<title>] [<outlines>] +#EXAMPLES: +#default range, no outlines: graphmasksm.sh "dr4/safe0/sdss_dr4safe0_mask.grph" "dr4/safe0/sdss_dr4safe0_mask.eps" +#defined range, title, no outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps -45 35 8 21 "SDSS slice" +#defined range, no title, outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps -45 35 8 21 " " on +#default range, no title, outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps 0 0 0 0 " " on + +#WARNINGS: (a.k.a., reasons to use the matlab plotting script instead!) +# -This script uses the opposite color scheme than the matlab script, i.e., +# weight 1 = black, weight 0 = white +# -RA and Dec are treated as linear variables (no spherical projection). This means that +# ranges that span RA=0 won't plot properly. +# -SM can only plot square eps files, so if you define both RA and Dec range, they should +# have the same length, otherwise your plot will appear stretched. +# -SM has a line length limit of 1500 characters, which SDSS tends to have no trouble overloading. +# If you get an error reading the file, try making your graphics file with lower precision and +# fewer points per 2pi, i.e., use poly2poly -og12 -p3 instead of poly2poly -og30. +# + + +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi + +if [ ! "$7" = "" ] ; then + title="\"$7\"" +else + title="" +fi + +if [ "$8" = "on" ] ; then + outlines=1 +else + outlines="" +fi + +if [ $# -ge 2 ]; then + if [ -e $1 ]; then + echo "Plotting $1 using sm ..." + if [ -e $2 ]; then + rm $2 + fi + sm -m $MANGLESCRIPTSDIR/graphmask.sm $1 $2 $3 $4 $5 $6 $title $outlines > sm.temp + else + echo >&2 "ERROR: file $1 not found." + exit 1 + fi +else + echo >&2 "USAGE: graphmasksm.sh <infile> <outfile> [<ramin> <ramax>] [<decmin> <decmax>] [<title>] [<outlines>]" + echo >&2 "EXAMPLES:" + echo >&2 "default range, no outlines: graphmasksm.sh \"dr4/safe0/sdss_dr4safe0_mask.grph\" \"dr4/safe0/sdss_dr4safe0_mask.eps\"" + echo >&2 "defined range, title, no outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps -45 35 8 21 \"SDSS slice\"" + echo >&2 "defined range, no title, outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps -45 35 8 21 \" \" on" + echo >&2 "default range, no title, outlines: graphmasksm.sh sdss_slice.grph sdss_slice.eps 0 0 0 0 \" \" on" + exit 1 +fi +if [ -e smerr.temp ] || [ ! -e $2 ]; then + echo >&2 "ERROR: error in sm plotting script." + echo >&2 "See log in sm.temp for more details." + if [ -e smerr.temp ]; then + rm smerr.temp + fi + exit 1 +fi +rm sm.temp +echo all done! diff --git a/scripts/healpixpolys.sh b/scripts/healpixpolys.sh new file mode 120000 index 0000000..fa4bb50 --- /dev/null +++ b/scripts/healpixpolys.sh @@ -0,0 +1 @@ +../masks/healpix/healpixpolys.sh \ No newline at end of file diff --git a/scripts/healpixrast.sh b/scripts/healpixrast.sh new file mode 120000 index 0000000..26571b9 --- /dev/null +++ b/scripts/healpixrast.sh @@ -0,0 +1 @@ +../masks/healpix/healpixrast.sh \ No newline at end of file diff --git a/scripts/healpixrast2fits.sh b/scripts/healpixrast2fits.sh new file mode 120000 index 0000000..e26e1fb --- /dev/null +++ b/scripts/healpixrast2fits.sh @@ -0,0 +1 @@ +../masks/healpix/healpixrast2fits.sh \ No newline at end of file diff --git a/scripts/make_allsky.sh b/scripts/make_allsky.sh new file mode 120000 index 0000000..db9757b --- /dev/null +++ b/scripts/make_allsky.sh @@ -0,0 +1 @@ +../masks/allsky/make_allsky.sh \ No newline at end of file diff --git a/scripts/make_pixelmaps.sh b/scripts/make_pixelmaps.sh new file mode 100755 index 0000000..497ba64 --- /dev/null +++ b/scripts/make_pixelmaps.sh @@ -0,0 +1,146 @@ +#!/bin/sh +# © M E C Swanson 2008 +#Script to make pixelmaps of a mask at several resolutions +#Pixelmaps give the average value of the mask's weight in each pixel, +#using one of mangle's pixelization schemes. +#pixelmaps are saved as $inputmask.$res$scheme, e.g. for +#the input mask sdss_dr7safe0_res6d.pol, pixelmap files will be +#sdss_dr7safe0_res6d.pol.1d, sdss_dr7safe0_res6d.pol.2d, etc. +# +#if a galaxy file is given, this script also uses polyid to find in which pixels +#each galaxy in the list lies. The input galaxy file can have any number of columns, +#but the first 2 columns should be the RA and dec. +#output galaxy files for each resolution will attach the pixel number to the end of +#each line in the galaxy file that lies within a pixel in the pixelmap. The naming +#scheme is the same as for the pixelmap files, e.g., for the input galaxy file +#sdss_dr7safe0_galdetails1.dat, the output galaxy files will be +#sdss_dr7safe0_galdetails1.dat.1d, sdss_dr7safe0_galdetails1.dat.2d, etc. +# +#By default, this script cuts out any pixels with average weights less than 0.5 for +#resolution 1 and average weights less than 0.8 for higher resolutions. To run +#the script without these cuts, enter a 0 for the final command line argument. +# +#USAGE: make_pixelmaps.sh <input mask file> [<input galaxy file>] [<0 to turn cuts off>] +#EXAMPLES: +#make_pixelmaps.sh sdss_dr7safe0_res6d.pol +#make_pixelmaps.sh sdss_dr7safe0_res6d.pol 0 +#make_pixelmaps.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat +#make_pixelmaps.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat 0 + + +if [ "$MANGLEBINDIR" = "" ] ; then + MANGLEBINDIR="../../bin" +fi +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi +if [ "$MANGLEDATADIR" = "" ] ; then + MANGLEDATADIR="../../masks" +fi + +mask=$1 +gals=$2 +cutweights=$3 + +#check command line arguments +if [ "$mask" = "" ] ; then + echo >&2 "ERROR: enter the input polygon and galaxy files as command line arguments." + echo >&2 "" + echo >&2 "USAGE: make_pixelmaps.sh <input mask file> [<input galaxy file>] [<0 to turn cuts off>]" + echo >&2 "EXAMPLES:" + echo >&2 "make_pixelmaps.sh sdss_dr7safe0_res6d.pol" + echo >&2 "make_pixelmaps.sh sdss_dr7safe0_res6d.pol 0" + echo >&2 "make_pixelmaps.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat" + echo >&2 "make_pixelmaps.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat 0" + exit 1 +fi + +if [ "$gals" == 0 ] ; then + cutweights=0 + gals= +fi +if [ "$cutweights" = "" ] ; then + cutweights=1 +fi + +dresmax=6 +dscheme="d" + +head -n 100 $mask > jmaskhead + +#grab pixelization info from input file +awk '/pixelization/{print $0}' < jmaskhead > jpix +resmax=`awk '{print substr($2, 1, length($2)-1)}' < jpix` +scheme=`awk '{print substr($2, length($2))}' < jpix` +rm jpix + +#check if input file is snapped and balkanized +snapped=`awk '/snapped/{print $1}' < jmaskhead` +balkanized=`awk '/balkanized/{print $1}' < jmaskhead` +rm jmaskhead + +#if input file is not pixelized, snapped, and balkanized, exit. +#if input file is pixelized to a fixed resolution, use it as is. +if [ "$resmax" = "" ]; then + echo >&2 "ERROR: cannot make pixelmaps of an unpixelized mask." + echo >&2 "Pixelize your mask using the pixelize function first." + exit 1 +elif [ "$resmax" = -1 ] ; then + resmax=$dresmax + echo "WARNING: making pixelmaps of a mask pixelized adaptively." + echo "Attempting to make pixelmaps up to resolution $resmax." + echo "To guarantee that pixelmaps can be made up to a given resolution," + echo "Pixelize your mask using a fixed resolution <r> by using 'pixelize -P<scheme>0,<r>'." +fi + +#if input file isn't snapped, exit +if [ ! "$snapped" = "snapped" ]; then + echo >&2 "ERROR: cannot make pixelmaps of an unsnapped mask." + echo >&2 "Run snap on your mask before running this script," + echo >&2 "or add the 'snapped' keyword to your file if it is already snapped." + exit 1 +fi + +#if input file isn't balkanized, exit +if [ ! "$balkanized" = "balkanized" ]; then + echo >&2 "ERROR: cannot make pixelmaps of an unbalkanized mask." + echo >&2 "Run balkanize on your mask before running this script," + echo >&2 "or add the 'balkanized' keyword to your file if it already consists" + echo >&2 "of only non-overlapping polygons." + exit 1 +fi + +for (( res=1; res<=$resmax; res++ )) + do + + outmask=$mask.$res$scheme + echo "Generating pixelmap for resolution $res ..." + $MANGLEBINDIR/pixelmap -P${scheme}0,$res $mask $outmask || exit + +#cut all pixels with weights less than 0.5 for resolution 1 or 0.8 for higher resolutions + if [ $cutweights -ne 0 ] ; then + if [ $res -le 1 ] ; then + weightcut=0.5 + else + weightcut=0.8 + fi + mv $outmask jp + $MANGLEBINDIR/poly2poly -j$weightcut jp $outmask || exit + echo "Pixels in $outmask have weights in the range defined in make_pixelmaps.sh." + echo "To run make_pixelmaps.sh without these cuts, enter a 0 for the last command line argument." + echo "EXAMPLE: make_pixelmaps.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat 0" + fi + + + if [ ! "$gals" == "" ] ; then + if [ -e "$gals" ] ; then + outgals=$gals.$res$scheme + $MANGLESCRIPTSDIR/polyid_gals.sh $outmask $gals $outgals + else + echo >&2 "ERROR: input galaxy file $gals not found!" + exit 1 + fi + fi + +done + diff --git a/scripts/make_setup_script.sh b/scripts/make_setup_script.sh new file mode 100755 index 0000000..1832d13 --- /dev/null +++ b/scripts/make_setup_script.sh @@ -0,0 +1,76 @@ +#! /bin/sh +# © M E C Swanson 2008 +# +#script called by wrapper script setup_mangle_environment to set +#mangle environment variables +# +#USAGE: type 'source setup_mangle_environment' in the base mangle directory +#If environment is setup correctly, typing +#'echo $MANGLEBINDIR; echo $MANGLESCRIPTSDIR; echo $MANGLEDATADIR' +#should print out the names of the appropriate directories. +# +#If the above command doesn't work, try 'source setup_mangle_environment $PWD/' +# +# +#You can also use 'source <MANGLEDIR>setup_mangle_environment <MANGLEDIR>' +#where <MANGLEDIR> is the path to the base mangle directory, e.g., /home/username/mangle2.1/ +# +#To automatically set up the mangle environment variables when you start your shell, +#add the following line to your .bashrc (or .tcshrc, or .cshrc, or .login, or .profile) +#(replace <MANGLEDIR> with the path to your mangle installation): +# +#source <MANGLEDIR>setup_mangle_environment <MANGLEDIR> + +#If no command line argument is given, assume we're running in the mangle directory +# +#arguments to make_setup_script.sh are: +# $1: 0 if export exists in the environment shell, nonzero otherwise +# $2: name of base mangle directory <MANGLEDIR> + +if [ "$2" = "" ]; then + MANGLEDIR=$PWD/ +#otherwise use the path in the first command-line argument as $MANGLEDIR +else + MANGLEDIR=$2 +fi +MANGLEBINDIR="${MANGLEDIR}bin" +MANGLESCRIPTSDIR="${MANGLEDIR}scripts" +MANGLEDATADIR="${MANGLEDIR}masks" + +#check to make sure directories exist +if [ ! -d $MANGLEBINDIR ]; then + echo >&2 "ERROR: The directory $MANGLEBINDIR does not exist" +fi +if [ ! -d $MANGLESCRIPTSDIR ]; then + echo >&2 "ERROR: The directory $MANGLESCRIPTSDIR does not exist" +fi +if [ ! -d $MANGLEDATADIR ]; then + echo >&2 "ERROR: The directory $MANGLEDATADIR does not exist" +fi +if [ ! -d $MANGLEBINDIR ] || [ ! -d $MANGLESCRIPTSDIR ] || [ ! -d $MANGLEDATADIR ]; then + echo >&2 "" + echo >&2 "USAGE: type 'source setup_mangle_environment' in the base mangle directory" + echo >&2 "Or use 'source <MANGLEDIR>setup_mangle_environment <MANGLEDIR>'" + echo >&2 "where <MANGLEDIR> is the path to the base mangle directory," + echo >&2 "e.g., /home/username/mangle2.1/" + exit 1 +fi + +#export environment variables and put bin and scripts directories in the path +if [ "$1" = "0" ] ; then + cat <<EOF > setup_script +export MANGLEBINDIR=$MANGLEBINDIR +export MANGLESCRIPTSDIR=$MANGLESCRIPTSDIR +export MANGLEDATADIR=$MANGLEDATADIR +export PATH=$PATH:$MANGLEBINDIR:$MANGLESCRIPTSDIR +EOF +else + cat <<EOF > setup_script +setenv MANGLEBINDIR $MANGLEBINDIR +setenv MANGLESCRIPTSDIR $MANGLESCRIPTSDIR +setenv MANGLEDATADIR $MANGLEDATADIR +setenv PATH $PATH:$MANGLEBINDIR:$MANGLESCRIPTSDIR +EOF +fi + + diff --git a/scripts/mangle_sdss.sh b/scripts/mangle_sdss.sh new file mode 120000 index 0000000..d2b7768 --- /dev/null +++ b/scripts/mangle_sdss.sh @@ -0,0 +1 @@ +../masks/sdss/mangle_sdss.sh \ No newline at end of file diff --git a/scripts/mangle_testsuite.sh b/scripts/mangle_testsuite.sh new file mode 100755 index 0000000..5792e2e --- /dev/null +++ b/scripts/mangle_testsuite.sh @@ -0,0 +1,114 @@ +#!/bin/sh +# © M E C Swanson 2008 +# +#This script tests the mangle installation and creates a tarball of +#output files for further examination. +# +#USAGE: source run_mangle_testsuite > test.log +mkdir test + +echo "mangle environment variables are:" +echo "MANGLEBINDIR=$MANGLEBINDIR" +echo "MANGLESCRIPTSDIR=$MANGLESCRIPTSDIR" +echo "MANGLEDATADIR=$MANGLEDATADIR" +echo "PATH=$PATH" + +echo "Checking if unformatted fortran files are readable." +cd ../masks/2df100k +../../bin/weight -z2dF100k ngp_fields.dat jnf || exit +../../bin/weight -z2dF100k sgp_fields.dat jnf || exit +cd ../2df230k +../../bin/weight -z2dF230k ngp_fields.dat jnf || exit +../../bin/weight -z2dF230k sgp_fields.dat jnf || exit +rm jnf + +echo "Running mangle on 2qz10k mask ..." +cd ../2qz10k/ +./2qz.sh +if [ -e 2qz_res4s.eps ]; then + mv 2qz_res4s.eps ../../scripts/test + if [ -e 2qz_north_res4s.eps ]; then + mv 2qz_north_res4s.eps ../../scripts/test + fi + if [ -e 2qz_south_res4s.eps ]; then + mv 2qz_south_res4s.eps ../../scripts/test + fi +fi +mv 2qz_north_res4s.pol 2qz_south_res4s.pol ../../scripts/test + +rm 2qz_* + +samp=dr6 +echo "Running mangle on slice of SDSS $samp mask ..." +cd ../sdss +./sdss_quickstart.sh +if [ -e sdss_${samp}safe0_slice.eps ]; then + mv sdss_${samp}safe0_slice.eps ../../scripts/test +elif [ -e sdss_${samp}safe0_slice1.eps ] && [ -e sdss_${samp}safe0_slice2.eps ]; then + mv sdss_${samp}safe0_slice1.eps sdss_${samp}safe0_slice2.eps ../../scripts/test +else + mv sdss_${samp}safe0_slice.pol ../../scripts/test +fi +rm sdss_${samp}safe0_slice.* + +echo "Trimming 2qz north mask with an icosahedron polygon ..." +cd ../../scripts/test +cp ../../masks/icosahedron/icosahedron.pol . +../../bin/poly2poly -J7,7 icosahedron.pol ico7.pol +../../scripts/trim_mask.sh 2qz_north_res4s.pol ico7.pol trimmed_mask.pol +rm icosahedron.pol ico7.pol + +echo "Rasterizing 2qz north mask ... " +rm ../../masks/healpix/healpix_polys/nside16_p5s.pol +../../scripts/healpixrast.sh 2qz_north_res4s.pol 16 rasterized_mask.pol +../../scripts/healpixrast2fits.sh 2qz_north_res4s.pol 16 rasterized_mask.fits 16 rasterized_mask.gif +../../scripts/call ../../bin/fits2dat_binary.x 1 16 rasterized_mask.fits j2 +echo healpix_weight 3072 > j1 +cat j1 j2 > rasterized_mask1.dat +rm j1 j2 args.dat +../../bin/poly2poly rasterized_mask1.dat rasterized_mask1.pol + +echo "Making pixelmaps of 2qz north mask ..." +cp ../../masks/2qz10k/azel.dat jazel +tail +2 jazel > azel.dat +../../scripts/make_pixelmaps.sh 2qz_north_res4s.pol azel.dat 0 +rm azel.dat jazel + +if which matlab >/dev/null 2>&1 ; then + ../../bin/poly2poly -ol30 trimmed_mask.pol trimmed_mask.list + ../../scripts/graphmask.sh trimmed_mask.list trimmed_mask.eps + rm trimmed_mask.list* + ../../bin/poly2poly -ol30 rasterized_mask.pol rasterized_mask.list + ../../scripts/graphmask.sh rasterized_mask.list rasterized_mask.eps + rm rasterized_mask.list* + ../../bin/poly2poly -ol30 rasterized_mask1.pol rasterized_mask1.list + ../../scripts/graphmask.sh rasterized_mask1.list rasterized_mask1.eps + rm rasterized_mask1.list* + for(( i=1; i<=4; i++ )) + do + ../../bin/poly2poly -ol30 2qz_north_res4s.pol.${i}s jpix.list + graphmask.sh jpix.list pixmap${i}.eps + rm jpix.list* + done +elif which sm >/dev/null 2>&1 ; then + ../../bin/poly2poly -og30 trimmed_mask.pol trimmed_mask.grph + ../../scripts/graphmasksm.sh trimmed_mask.grph trimmed_mask.eps + rm trimmed_mask.grph + ../../bin/poly2poly -og30 rasterized_mask.pol rasterized_mask.grph + ../../scripts/graphmasksm.sh rasterized_mask.grph rasterized_mask.eps + rm rasterized_mask.grph + ../../bin/poly2poly -og30 rasterized_mask1.pol rasterized_mask1.grph + ../../scripts/graphmasksm.sh rasterized_mask1.grph rasterized_mask1.eps + rm rasterized_mask1.grph + for(( i=1; i<=4; i++ )) + do + ../../bin/poly2poly -og30 2qz_north_res4s.pol.${i}s jpix.grph + ../../scripts/graphmasksm.sh jpix.grph pixmap${i}.eps + rm jpix.grph* + done +fi +cd .. +echo >&2 "mangle test suite complete! Output files are in test.tar.gz" +mv test.log test +tar cfz test.tar.gz test + diff --git a/scripts/plotmap.sh b/scripts/plotmap.sh new file mode 120000 index 0000000..2714bca --- /dev/null +++ b/scripts/plotmap.sh @@ -0,0 +1 @@ +../masks/healpix/healpix_conversion_scripts/plotmap.sh \ No newline at end of file diff --git a/scripts/polyid_gals.sh b/scripts/polyid_gals.sh new file mode 100755 index 0000000..ce604a2 --- /dev/null +++ b/scripts/polyid_gals.sh @@ -0,0 +1,71 @@ +#!/bin/sh +# © M E C Swanson 2008 +# +#This script uses polyid to find in which polygons in the input mask +#each galaxy in the list lies. The input galaxy file can have any number of columns, +#but the first 2 columns should be the RA and dec. +#output galaxy files for each resolution will attach the polygon number to the end of +#each line in the galaxy file. +# +#By default, galaxies that are not in any polygon in the mask will be cut out of +#the output file. To keep all galaxies in the output file, enter a 0 for the final +#command line argument. +# +#USAGE: polyid_gals.sh <input mask file> <input galaxy file> <output galaxy file> [<0 to turn cuts off>] +#EXAMPLES: +#polyid_gals.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat sdss_dr7safe0_polyidgals_cut.dat +#polyid_gals.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat sdss_dr7safe0_polyidgals_uncut.dat 0 + + +if [ "$MANGLEBINDIR" = "" ] ; then + MANGLEBINDIR="../../bin" +fi +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi +if [ "$MANGLEDATADIR" = "" ] ; then + MANGLEDATADIR="../../masks" +fi + +mask=$1 +gals=$2 +outgals=$3 +cut=$4 + +#check command line arguments +if [ "$mask" = "" ] || [ "$gals" = "" ] || [ "$outgals" = "" ]; then + echo >&2 "ERROR: enter the input polygon file and input and output galaxy files as command line arguments." + echo >&2 "" + echo >&2 "USAGE: polyid_gals.sh <input mask file> <input galaxy file> <output galaxy file> [<0 to turn cuts off>]" + echo >&2 "EXAMPLES:" + echo >&2 "polyid_gals.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat sdss_dr7safe0_polyidgals_cut.dat" + echo >&2 "polyid_gals.sh sdss_dr7safe0_res6d.pol sdss_dr7safe0_galdetails1.dat sdss_dr7safe0_polyidgals_uncut.dat 0" + exit 1 +fi + +if [ "$cut" = "" ] ; then + cut=1 +fi + +#count number of columns in input galaxy file +head -n 1 $gals > jgals +numfields=`awk '{print NF}' jgals` +rm jgals + +#run polyid on galaxy file and assemble output galaxy files with polygon numbers +echo "Running polyid to find galaxies from $gals in $mask ... " +$MANGLEBINDIR/polyid $mask $gals j1 || exit +tail +2 j1 > j2 +awk '{print $3}' j2 > j3 +paste $gals j3 > j4 +if [ $cut -ne 0 ] ; then + awk "NF == ($numfields+1) {print \$0}" j4 > $outgals +else + cp j4 $outgals +fi +rm j1 j2 j3 j4 + +count=`wc -l < $outgals` +echo "" +echo "wrote $count galaxies to $outgals." + diff --git a/scripts/run_mangle_testsuite b/scripts/run_mangle_testsuite new file mode 100644 index 0000000..99f36b5 --- /dev/null +++ b/scripts/run_mangle_testsuite @@ -0,0 +1,6 @@ +#USAGE: source run_mangle_testsuite > test.log +echo "Setting mangle environment variables" +cd .. +source setup_mangle_environment $PWD/ +cd scripts +./mangle_testsuite.sh diff --git a/scripts/sdss_quickstart.sh b/scripts/sdss_quickstart.sh new file mode 120000 index 0000000..a887ad5 --- /dev/null +++ b/scripts/sdss_quickstart.sh @@ -0,0 +1 @@ +../masks/sdss/sdss_quickstart.sh \ No newline at end of file diff --git a/scripts/trim_mask.sh b/scripts/trim_mask.sh new file mode 100755 index 0000000..52755e7 --- /dev/null +++ b/scripts/trim_mask.sh @@ -0,0 +1,140 @@ +#! /bin/sh +# © M E C Swanson 2008 +#script to trim a mask so that it only includes polygons in a specified region +#USAGE: trim_mask.sh <mask> <trimmer> <outfile> [<pixelization arguments>] +#EXAMPLE:trim_mask.sh mask.pol trimmer.pol trimmed_mask.pol +# You can also optionally provide arguments to the pixelize function +# in the 4th argument: +#EXAMPLE: trim_mask.sh mask.pol trimmer.pol trimmed_mask.pol -Ps0,6 + + +if [ "$MANGLEBINDIR" = "" ] ; then + MANGLEBINDIR="../../bin" +fi +if [ "$MANGLESCRIPTSDIR" = "" ] ; then + MANGLESCRIPTSDIR="../../scripts" +fi +if [ "$MANGLEDATADIR" = "" ] ; then + MANGLEDATADIR="../../masks" +fi + +mask=$1 +trimmer=$2 +outfile=$3 +pixargs=$4 + +#check command line arguments: +if [ "$mask" = "" ] || [ "$trimmer" = "" ] || [ "$outfile" = "" ] ; then + echo >&2 "ERROR: enter the input polygon file, a polygon defining the region you" + echo >&2 "want to trim to, and the output polygon file as command line arguments." + echo >&2 "" + echo >&2 "USAGE: trim_mask.sh <mask> <trimmer> <outfile> [<pixelization arguments>]" + echo >&2 "EXAMPLE: trim_mask.sh mask.pol trimmer.pol trimmed_mask.pol" + echo >&2 "EXAMPLE w/ optional argument to pixelize: trim_mask.sh mask.pol trimmer.pol trimmed_mask.pol -Ps0,6" + exit 1 +fi + +#if no argument for pixelize is given, pixelize to resolution 6 with the simple scheme: +if [ "$pixargs" = "" ] ; then + pixargs="-Ps0,6" +fi + +head -n 100 $mask > jmaskhead +head -n 100 $trimmer > jtrimmerhead + +#grab pixelization info from input files +awk '/pixelization/{print $0}' < jmaskhead > jpix +res1=`awk '{print substr($2, 1, length($2)-1)}' < jpix` +scheme1=`awk '{print substr($2, length($2))}' < jpix` +awk '/pixelization/{print $0}' < jtrimmerhead > jpix +res2=`awk '{print substr($2, 1, length($2)-1)}' < jpix` +scheme2=`awk '{print substr($2, length($2))}' < jpix` +rm jpix jmaskhead jtrimmerhead + +#if input files are pixelized, make sure they are consistent: +if [ ! "$res1" = "" ] && [ ! "$res2" = "" ] ; then + if [ $res1 -eq -1 ] || [ $res2 -eq -1 ] ; then + echo >&2 "ERROR: cannot trim a mask pixelized adaptively." + echo >&2 "Pixelize both your mask and your trimmer polygon(s) using a fixed resolution," + echo >&2 "e.g. -Ps0,8, and try again." + exit 1 + fi + if [ $res1 -ne $res2 ] ; then + echo >&2 "ERROR: mask polygons and trimmer polygons must be pixelized to the same resolution." + echo >&2 "Pixelize both your mask and your trimmer polygon(s) using a fixed resolution," + echo >&2 "e.g. -Ps0,8, and try again." + exit 1 + fi +#if input files are unpixelized, pixelize them: +elif [ ! "$res1" = "" ] && [ "$res2" = "" ] ; then + if [ $res1 -eq -1 ] ; then + echo >&2 "ERROR: cannot trim a mask pixelized adaptively." + echo >&2 "Pixelize both your mask and your trimmer polygon(s) using a fixed resolution," + echo >&2 "e.g. -Ps0,8, and try again." + exit 1 + fi + echo "$MANGLEBINDIR/pixelize -P${scheme1}0,$res1 $trimmer trimmer_pix" + $MANGLEBINDIR/pixelize -P${scheme1}0,$res1 $trimmer trimmer_pix || exit + trimmer="trimmer_pix" +elif [ "$res1" = "" ] && [ ! "$res2" = "" ] ; then + if [ $res2 -eq -1 ] ; then + echo >&2 "ERROR: cannot trim a mask pixelized adaptively." + echo >&2 "Pixelize both your mask and your trimmer polygon(s) using a fixed resolution," + echo >&2 "e.g. -Ps0,8, and try again." + exit 1 + fi + echo "$MANGLEBINDIR/pixelize -P${scheme2}0,$res2 $mask mask_pix" + $MANGLEBINDIR/pixelize -P${scheme2}0,$res2 $mask mask_pix || exit + mask="mask_pix" +else + echo "$MANGLEBINDIR/pixelize $pixargs $trimmer trimmer_pix" + $MANGLEBINDIR/pixelize $pixargs $trimmer trimmer_pix || exit + echo "$MANGLEBINDIR/pixelize $pixargs $mask mask_pix" + $MANGLEBINDIR/pixelize $pixargs $mask mask_pix || exit + trimmer="trimmer_pix" + mask="mask_pix" +fi + +#check if input file is snapped +snapped=`awk '/snapped/{print $1}' < $mask` + +#if mask file isn't snapped, snap it +if [ ! "$snapped" = "snapped" ]; then + echo "Snapping $mask ..." + mv $mask jp + $MANGLEBINDIR/snap jp $mask || exit + rm jp +fi + +#find the complement of the trimmer polygon +echo "$MANGLESCRIPTSDIR/find_complement.sh $trimmer trimmer_comp" +$MANGLESCRIPTSDIR/find_complement.sh $trimmer trimmer_comp || exit + +#set the complement to have zero weight +echo 0 > jw0 +echo "$MANGLEBINDIR/weight -zjw0 trimmer_comp jcomp0" +$MANGLEBINDIR/weight -zjw0 trimmer_comp jcomp0 || exit +rm jw0 + +#balkanize the mask with the zero-weight complement, thereby trimming off +#everything that does not lie within the trimmer polygon +echo "$MANGLEBINDIR/balkanize $mask jcomp0 jb" +$MANGLEBINDIR/balkanize $mask jcomp0 jb || exit +rm jcomp0 + +#unify to get rid of zero weight polygons +echo "$MANGLEBINDIR/unify jb $outfile" +$MANGLEBINDIR/unify jb $outfile || exit +rm jb + +echo "Polygons of $1 trimmed by $2 written to ${outfile}." + +#clean up + +rm trimmer_comp +if [ -e trimmer_pix ] ; then + rm trimmer_pix +fi +if [ -e mask_pix ] ; then + rm mask_pix +fi diff --git a/src/A.c b/src/A.c new file mode 100644 index 0000000..ecbcba1 --- /dev/null +++ b/src/A.c @@ -0,0 +1 @@ +I foil rm *.c diff --git a/src/A.f b/src/A.f new file mode 100644 index 0000000..9c33e2a --- /dev/null +++ b/src/A.f @@ -0,0 +1 @@ +I foil rm *.f diff --git a/src/Aa.F b/src/Aa.F new file mode 100644 index 0000000..182b29a --- /dev/null +++ b/src/Aa.F @@ -0,0 +1 @@ +I foil rm *.F diff --git a/src/Makefile.in b/src/Makefile.in new file mode 100644 index 0000000..9121a99 --- /dev/null +++ b/src/Makefile.in @@ -0,0 +1,284 @@ +mangler: + $(MAKE) libmangle.a $(PROGS) + $(MAKE) install + +install: + if [ -d "$(BIN)" ] ; then mv $(PROGS) $(BIN) ; fi + +clean: + rm -f *.o core + +cleaner: + rm -f *.o core libmangle.a + +cleanest: + rm -f *.o core libmangle.a $(PROGS) + if [ -d "$(BIN)" ] ; then cd $(BIN) ; rm -f core $(PROGS) ; fi + +static: + $(MAKE) FFLAGS="$(FFLAGS) $(STATICFLAGS)" + +libmangle.a: $(COBJ) $(FOBJ) Makefile + @ if [ -r libmangle.a ] ; then echo "updating libmangle.a" ; else echo "creating libmangle.a" ; fi + ar ru libmangle.a $(COBJ) $(FOBJ) + ranlib libmangle.a + +balkanize: balkanize.o libmangle.a Makefile + $(F77) $(FFLAGS) -o balkanize balkanize.o $(ILIB) $(LLIB) + +ddcount: ddcount.o libmangle.a Makefile + $(F77) $(FFLAGS) -o ddcount ddcount.o $(ILIB) $(LLIB) + +drangle: drangle.o libmangle.a Makefile + $(F77) $(FFLAGS) -o drangle drangle.o $(ILIB) $(LLIB) + +harmonize: harmonize.o libmangle.a Makefile + $(F77) $(FFLAGS) -o harmonize harmonize.o $(ILIB) $(LLIB) + +map: map.o libmangle.a Makefile + $(F77) $(FFLAGS) -o map map.o $(ILIB) $(LLIB) + +pixelize: pixelize.o libmangle.a Makefile + $(F77) $(FFLAGS) -o pixelize pixelize.o $(ILIB) $(LLIB) + +pixelmap: pixelmap.o libmangle.a Makefile + $(F77) $(FFLAGS) -o pixelmap pixelmap.o $(ILIB) $(LLIB) + +polyid: polyid.o libmangle.a Makefile + $(F77) $(FFLAGS) -o polyid polyid.o $(ILIB) $(LLIB) + +poly2poly: poly2poly.o libmangle.a Makefile + $(F77) $(FFLAGS) -o poly2poly poly2poly.o $(ILIB) $(LLIB) + +ransack: ransack.o libmangle.a Makefile + $(F77) $(FFLAGS) -o ransack ransack.o $(ILIB) $(LLIB) + +rasterize: rasterize.o libmangle.a Makefile + $(F77) $(FFLAGS) -o rasterize rasterize.o $(ILIB) $(LLIB) + +rotate: rotate.o libmangle.a Makefile + $(F77) $(FFLAGS) -o rotate rotate.o $(ILIB) $(LLIB) $(ISLIB) $(SLIB) + +rrcoeffs: rrcoeffs.o libmangle.a Makefile + $(F77) $(FFLAGS) -o rrcoeffs rrcoeffs.o $(ILIB) $(LLIB) + +snap: snap.o libmangle.a Makefile + $(F77) $(FFLAGS) -o snap snap.o $(ILIB) $(LLIB) + +unify: unify.o libmangle.a Makefile + $(F77) $(FFLAGS) -o unify unify.o $(ILIB) $(LLIB) + +weight: weight.o libmangle.a Makefile + $(F77) $(FFLAGS) -o weight weight.o $(ILIB) $(LLIB) + +weight_dumb: weight_dumb.o weight_dumb_module.o libmangle.a Makefile + $(F77) $(FFLAGS) -o weight_dumb weight_dumb.o weight_dumb_module.o $(ILIB) $(LLIB) -lstdc++ + +poly2hpx: poly2hpx.o chealpix.o libmangle.a Makefile + $(F77) $(FFLAGS) -o poly2hpx chealpix.o poly2hpx.o $(ILIB) $(LLIB) -lcfitsio + +test: test.o libmangle.a Makefile + $(F77) $(FFLAGS) -o test test.o $(ILIB) $(LLIB) + + +weight_dumb_module.o: weight_dumb_module.cpp + $(CXX) $(CFLAGS) -c weight_dumb_module.cpp +chealpix.o: healpix/chealpix.c + $(CC) $(CFLAGS) -DENABLE_FITSIO -c healpix/chealpix.c +advise_fmt.o: angunit.h manglefn.h advise_fmt.c + $(CC) $(CFLAGS) -c advise_fmt.c +balkanize.o: parse_args.c defaults.h manglefn.h usage.h balkanize.c + $(CC) $(CFLAGS) -c balkanize.c +braktop_.o: manglefn.h braktop_.c + $(CC) $(CFLAGS) -c braktop_.c +cmminf.o: manglefn.h cmminf.c + $(CC) $(CFLAGS) -c cmminf.c +convert.o: manglefn.h convert.c + $(CC) $(CFLAGS) -c convert.c +copy_format.o: manglefn.h copy_format.c + $(CC) $(CFLAGS) -c copy_format.c +copy_poly.o: manglefn.h copy_poly.c + $(CC) $(CFLAGS) -c copy_poly.c +ddcount.o: parse_args.c angunit.h defaults.h inputfile.h manglefn.h usage.h ddcount.c + $(CC) $(CFLAGS) -c ddcount.c +drandom.o: drandom.c + $(CC) $(CFLAGS) -c drandom.c +drangle.o: parse_args.c angunit.h defaults.h inputfile.h manglefn.h usage.h drangle.c + $(CC) $(CFLAGS) -c drangle.c +drangle_polys.o: manglefn.h pi.h drangle_polys.c + $(CC) $(CFLAGS) -c drangle_polys.c +dranglepolys_.o: manglefn.h dranglepolys_.c + $(CC) $(CFLAGS) -c dranglepolys_.c +dump_poly.o: manglefn.h dump_poly.c + $(CC) $(CFLAGS) -c dump_poly.c +findtop_.o: manglefn.h findtop_.c + $(CC) $(CFLAGS) -c findtop_.c +get_pixel.o: manglefn.h get_pixel.c + $(CC) $(CFLAGS) -c get_pixel.c +garea.o: logical.h manglefn.h garea.c + $(CC) $(CFLAGS) -c garea.c +gcmlim.o: manglefn.h gcmlim.c + $(CC) $(CFLAGS) -c gcmlim.c +gphbv.o: manglefn.h gphbv.c + $(CC) $(CFLAGS) -c gphbv.c +gphi.o: manglefn.h gphi.c + $(CC) $(CFLAGS) -c gphi.c +gptin.o: manglefn.h gptin.c + $(CC) $(CFLAGS) -c gptin.c +gspher.o: manglefn.h pi.h gspher.c + $(CC) $(CFLAGS) -c gspher.c +gsphr.o: manglefn.h pi.h gsphr.c + $(CC) $(CFLAGS) -c gsphr.c +gvert.o: manglefn.h gvert.c + $(CC) $(CFLAGS) -c gvert.c +gvlim.o: manglefn.h gvlim.c + $(CC) $(CFLAGS) -c gvlim.c +gvphi.o: manglefn.h gvphi.c + $(CC) $(CFLAGS) -c gvphi.c +harmonize.o: parse_args.c defaults.h manglefn.h usage.h harmonize.c + $(CC) $(CFLAGS) -c harmonize.c +harmonize_polys.o: manglefn.h pi.h harmonize_polys.c + $(CC) $(CFLAGS) -c harmonize_polys.c +harmonizepolys_.o: manglefn.h harmonizepolys_.c + $(CC) $(CFLAGS) -c harmonizepolys_.c +healpix_ang2pix_nest.o: manglefn.h pi.h healpix_ang2pix_nest.c + $(CC) $(CFLAGS) -c healpix_ang2pix_nest.c +healpixpolys.o: manglefn.h pi.h healpixpolys.c + $(CC) $(CFLAGS) -c healpixpolys.c +ikrand.o: manglefn.h ikrand.c + $(CC) $(CFLAGS) -c ikrand.c +map.o: parse_args.c angunit.h defaults.h inputfile.h manglefn.h usage.h map.c + $(CC) $(CFLAGS) -c map.c +msg.o: manglefn.h msg.c + $(CC) $(CFLAGS) -c msg.c +new_poly.o: manglefn.h new_poly.c + $(CC) $(CFLAGS) -c new_poly.c +new_vert.o: manglefn.h new_vert.c + $(CC) $(CFLAGS) -c new_vert.c +partition_poly.o: manglefn.h partition_poly.c + $(CC) $(CFLAGS) -c partition_poly.c +pixelize.o: parse_args.c defaults.h manglefn.h usage.h pixelize.c + $(CC) $(CFLAGS) -c pixelize.c +pixelmap.o: parse_args.c defaults.h manglefn.h usage.h pixelmap.c + $(CC) $(CFLAGS) -c pixelmap.c +places.o: manglefn.h places.c + $(CC) $(CFLAGS) -c places.c +poly2poly.o: parse_args.c defaults.h manglefn.h usage.h poly2poly.c + $(CC) $(CFLAGS) -c poly2poly.c +poly_id.o: manglefn.h poly_id.c + $(CC) $(CFLAGS) -c poly_id.c +polyid.o: parse_args.c angunit.h defaults.h inputfile.h manglefn.h usage.h polyid.c + $(CC) $(CFLAGS) -c polyid.c +poly_sort.o: manglefn.h poly_sort.c + $(CC) $(CFLAGS) -c poly_sort.c +prune_poly.o: manglefn.h prune_poly.c + $(CC) $(CFLAGS) -c prune_poly.c +ransack.o: parse_args.c angunit.h defaults.h manglefn.h usage.h ransack.c + $(CC) $(CFLAGS) -c ransack.c +rasterize.o: parse_args.c pi.h defaults.h manglefn.h usage.h rasterize.c + $(CC) $(CFLAGS) -c rasterize.c +rdangle.o: manglefn.h rdangle.c + $(CC) $(CFLAGS) -c rdangle.c +rdline.o: inputfile.h rdline.c + $(CC) $(CFLAGS) -c rdline.c +rdmask_.o: defaults.h manglefn.h rdmask_.c + $(CC) $(CFLAGS) -c rdmask_.c +rdmask.o: inputfile.h manglefn.h rdmask.c + $(CC) $(CFLAGS) -c rdmask.c +rdspher.o: manglefn.h rdspher.c + $(CC) $(CFLAGS) -c rdspher.c +rotate.o: parse_args.c parse_fopt.c angunit.h defaults.h inputfile.h manglefn.h usage.h rotate.c + $(CC) $(CFLAGS) -c rotate.c +rrcoeffs.o: parse_args.c defaults.h manglefn.h usage.h rrcoeffs.c + $(CC) $(CFLAGS) -c rrcoeffs.c +scale.o: manglefn.h scale.c + $(CC) $(CFLAGS) -c scale.c +sdsspix.o: manglefn.h sdsspix.c + $(CC) $(CFLAGS) -c sdsspix.c +search.o: manglefn.h search.c + $(CC) $(CFLAGS) -c search.c +snap.o: parse_args.c defaults.h manglefn.h usage.h snap.c + $(CC) $(CFLAGS) -c snap.c +snap_poly.o: manglefn.h snap_poly.c + $(CC) $(CFLAGS) -c snap_poly.c +split_poly.o: manglefn.h split_poly.c + $(CC) $(CFLAGS) -c split_poly.c +strcmpl.o: manglefn.h strcmpl.c + $(CC) $(CFLAGS) -c strcmpl.c +strdict.o: manglefn.h strdict.c + $(CC) $(CFLAGS) -c strdict.c +test.o: manglefn.h test.c + $(CC) $(CFLAGS) -c test.c +unify.o: parse_args.c defaults.h manglefn.h usage.h unify.c + $(CC) $(CFLAGS) -c unify.c +vmid.o: manglefn.h vmid.c + $(CC) $(CFLAGS) -c vmid.c +which_pixel.o: manglefn.h which_pixel.c + $(CC) $(CFLAGS) -c which_pixel.c +weight.o: parse_args.c defaults.h manglefn.h usage.h weight.c + $(CC) $(CFLAGS) -c weight.c +weight_fn.o: inputfile.h manglefn.h weight_fn.c + $(CC) $(CFLAGS) -c weight_fn.c +wrangle.o: manglefn.h wrangle.c + $(CC) $(CFLAGS) -c wrangle.c +wrho.o: manglefn.h wrho.c + $(CC) $(CFLAGS) -c wrho.c +wrmask.o: manglefn.h wrmask.c + $(CC) $(CFLAGS) -c wrmask.c +wrrrcoeffs.o: manglefn.h wrrrcoeffs.c + $(CC) $(CFLAGS) -c wrrrcoeffs.c +wrspher.o: manglefn.h wrspher.c + $(CC) $(CFLAGS) -c wrspher.c + +azell.s.o: azell.s.f + $(F77) $(FFLAGS) -c azell.s.f +azel.s.o: azel.s.f + $(F77) $(FFLAGS) -c azel.s.f +braktop.s.o: braktop.s.f + $(F77) $(FFLAGS) -c braktop.s.f +felp.s.o: frames.par felp.s.f + $(F77) $(FFLAGS) -c felp.s.f +fframe.s.o: frames.par radian.par fframe.s.f + $(F77) $(FFLAGS) -c fframe.s.f +findtop.s.o: heapsort.inc findtop.s.f + $(F77) $(FFLAGS) -c findtop.s.f +gaream.s.o: pi.par gaream.s.f + $(F77) $(FFLAGS) -c gaream.s.f +garea.s.o: pi.par garea.s.f + $(F77) $(FFLAGS) -c garea.s.f +gcmlim.s.o: pi.par gcmlim.s.f + $(F77) $(FFLAGS) -c gcmlim.s.f +gphbv.s.o: pi.par gphbv.s.f + $(F77) $(FFLAGS) -c gphbv.s.f +gphim.s.o: pi.par gphim.s.f + $(F77) $(FFLAGS) -c gphim.s.f +gphi.s.o: pi.par gphi.s.f + $(F77) $(FFLAGS) -c gphi.s.f +gptin.s.o: gptin.s.f + $(F77) $(FFLAGS) -c gptin.s.f +gsphera.s.o: pi.par gsphera.s.f + $(F77) $(FFLAGS) -c gsphera.s.f +gspher.s.o: pi.par gspher.s.f + $(F77) $(FFLAGS) -c gspher.s.f +gsubs.s.o: pi.par gsubs.s.f + $(F77) $(FFLAGS) -c gsubs.s.f +gvert.s.o: pi.par gvert.s.f + $(F77) $(FFLAGS) -c gvert.s.f +gvlim.s.o: pi.par gvlim.s.f + $(F77) $(FFLAGS) -c gvlim.s.f +gvphi.s.o: pi.par gvphi.s.f + $(F77) $(FFLAGS) -c gvphi.s.f +iylm.s.o: pi.par iylm.s.f + $(F77) $(FFLAGS) -c iylm.s.f +pix2vec_nest.s.o: pix2vec_nest.s.f + $(F77) $(FFLAGS) -c pix2vec_nest.s.f +twodf100k.o: pi.par twodf100k.f + $(F77) $(FFLAGS) -c twodf100k.f +twodf230k.o: pi.par twodf230k.f + $(F77) $(FFLAGS) -c twodf230k.f +twoqz.o: mangdir.data mangdir.inc twoqz.f + $(F77) $(FFLAGS) -c twoqz.f +wlm.s.o: pi.par wlm.s.f + $(F77) $(FFLAGS) -c wlm.s.f +wrho.s.o: pi.par wrho.s.f + $(F77) $(FFLAGS) -c wrho.s.f diff --git a/src/advise_fmt.c b/src/advise_fmt.c new file mode 100644 index 0000000..d442278 --- /dev/null +++ b/src/advise_fmt.c @@ -0,0 +1,71 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Advise data format. + + Input: fmt = pointer to format structure. +*/ +void advise_fmt(format *fmt) +{ + int n; + char plural[] = "s"; + + /* format of input data */ + if (fmt->in) { + if (fmt->in[strlen(fmt->in) - 1] == 's') { + strcpy(plural, ""); + } else { + strcpy(plural, "s"); + } + if (fmt->single == 1) { + msg("input data format will be defined by keywords in infiles\n"); + } else { /* fmt->single == 0 */ + msg("(initial) input data format is %s with", fmt->in); + if (strcmp(fmt->in, "edges") == 0) { + msg(" %d points/edge and", fmt->innve); + n = fmt->nn * fmt->innve * fmt->n; + } else { + n = fmt->nn * fmt->n; + } + if (fmt->n == 0) { + msg(" variable no. of %s%s per line\n", fmt->in, plural); + } else { + msg(" %d %s%s (%d numbers) per line\n", fmt->n, fmt->in, plural, n); + } + } + + /* angular unit of input data */ + if (fmt->inunitp && !(strcmp(fmt->in, "polygon") == 0 || strcmp(fmt->in, "Region") == 0)) { + msg("will take units of any angles in input polygon files to be %c (", fmt->inunitp); + switch (fmt->inunitp) { +#include "angunit.h" + } + msg(")\n"); + } + + } + + /* format of output data */ + if (fmt->out) { + msg("output data format will be %s", fmt->out); + if (strcmp(fmt->out, "edges") == 0) msg(" with %d points/edge", fmt->outnve); + msg("\n"); + if (strcmp(fmt->out, "vertices") == 0 || strcmp(fmt->out, "edges") == 0) + msg("WARNING: %s output format loses information\n", fmt->out); + + /* angular unit of output data */ + if (fmt->outunitp && !(strcmp(fmt->out, "polygon") == 0 || strcmp(fmt->out, "Region") == 0)) { + msg("units of angles in output polygon files will be %c (", fmt->outunitp); + switch (fmt->outunitp) { +#include "angunit.h" + } + msg(")\n"); + } + + } + +} diff --git a/src/angunit.h b/src/angunit.h new file mode 100644 index 0000000..2365805 --- /dev/null +++ b/src/angunit.h @@ -0,0 +1,20 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +/* angular unit corresponding to character */ + case 'h': + msg("RA in hms, Dec in dms"); break; + case 'd': + case '°': + msg("degrees"); break; + case 'm': + case '\'': + case '´': + msg("arcminutes"); break; + case 's': + case '"': + case '¨': + msg("arcseconds"); break; + case 'r': + default: + msg("radians"); break; diff --git a/src/azel.s.f b/src/azel.s.f new file mode 100644 index 0000000..55a6eb7 --- /dev/null +++ b/src/azel.s.f @@ -0,0 +1,63 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine azel(ra,dec,raz,elp,azp,az,el) + real*10 ra,dec,raz,elp,azp,az,el +c +c parameters + real*10 CIRCLE,PI,RADIAN + parameter (CIRCLE = 360._10, + * PI = 3.1415926535897932384626_10, + * RADIAN = 180._10/PI) +c local (automatic) variables + integer iz + real*10 cazm,cdec,cel,celp,cra,sazm,sdec,sel,selp,sra +c * +c * Convert RA & Dec ra, dec -> azimuth & elevation. +c * To accomplish the inverse operation, az, el -> ra, dec, +c * call azel(az, el, azp, elp, raz, ra, dec); +c * To convert RA & Dec to Galactic Longitude and Latitude, use +c * raz = 192.25, elp = 27.4, azp = 123. +c * +c Input: ra = RA in degrees. +c dec = Dec in degrees. +c raz = RA of zenith in degrees. +c elp = elevation of NCP in degrees = Dec of zenith. +c azp = azimuth of NCP in degrees. +c Output: az = azimuth in degrees (0.le.az.lt.360). +c el = elevation in degrees (-90.le.el.le.90). +c +c sines and cosines of input angles + sdec=sin(dec/RADIAN) + cdec=cos(dec/RADIAN) + selp=sin(elp/RADIAN) + celp=cos(elp/RADIAN) + sra=sin((ra-raz)/RADIAN) + cra=cos((ra-raz)/RADIAN) +c sine and cosine of elevation + sel=cdec*celp*cra+sdec*selp + if (sel.gt.1._10) then + sel=1._10 + elseif (sel.lt.-1._10) then + sel=-1._10 + endif + cel=sqrt(1._10-sel**2) +c elevation in degrees + el=asin(sel)*RADIAN +c if elevation is +90 or -90 degrees, set azimuth to that of NCP + if (cel.eq.0._10) then + az=azp + elseif (cel.ne.0._10) then +c sine and cosine of azimuth relative to NCP azimuth + sazm=-cdec*sra/cel + cazm=(sdec*celp-cdec*selp*cra)/cel +c azimuth in degrees + az=atan2(sazm,cazm)*RADIAN+azp +c ensure azimuth is in interval [0,360) + iz=az/CIRCLE + if (az.lt.0._10) iz=iz-1 + az=az-iz*CIRCLE + endif + return + end +c diff --git a/src/azell.s.f b/src/azell.s.f new file mode 100644 index 0000000..90d6f42 --- /dev/null +++ b/src/azell.s.f @@ -0,0 +1,75 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine azell(rag,decg,l2p,raz,elp,azp,azg,elg,l2z) + real*10 rag,decg,l2p,raz,elp,azp,azg,elg,l2z +c +c parameters + real*10 CIRCLE,PI,RADIAN + parameter (CIRCLE = 360._10, + * PI = 3.1415926535897932384626_10, + * RADIAN = 180._10/PI) +c local (automatic) variables + integer iz + real*10 cazm,cdecg,celg,celp,cl2m,cra + real*10 sazm,sdecg,selg,selp,sl2m,sra +c * +c * Given transformations g <-> p between and z <-> p between spherical +c * frames, determine transformation g <-> z +c * (I've imagined g = galactic coordinates, p = celestial coordinates, +c * z = dome coordinates, but of course the transformation is quite +c * general). +c * +c Input: rag = RA of NGP in deg [192.25] +c decg = Dec of NGP in deg = latitude of NCP [27.4] +c l2p = longitude of NCP in deg [123] +c raz = RA of zenith in deg +c elp = elevation of NCP in deg = Dec of zenith +c azp = azimuth of NCP in deg +c Output: azg = azimuth of NGP in deg (0.le.az.lt.360) +c elg = elevation NGP in deg (-90.le.el.le.90) +c l2z = longitude of zenith in deg +c +c sines and cosines of input angles + sdecg=sin(decg/RADIAN) + cdecg=cos(decg/RADIAN) + selp=sin(elp/RADIAN) + celp=cos(elp/RADIAN) + sra=sin((rag-raz)/RADIAN) + cra=cos((rag-raz)/RADIAN) +c sine and cosine of elevation of NGP + selg=cdecg*celp*cra+sdecg*selp + if (selg.gt.1._10) then + selg=1._10 + elseif (selg.lt.-1._10) then + selg=-1._10 + endif + celg=sqrt(1._10-selg*selg) +c elevation of NGP in deg + elg=asin(selg)*RADIAN +c at NGP el +- 90 deg, set NGP az & zenith long consistently + if (celg.eq.0._10) then + azg=azp + l2z=l2p+CIRCLE/2._10 + elseif (celg.ne.0._10) then +c sine and cosine of azimuth of NGP relative to NCP azimuth + sazm=-cdecg*sra/celg + cazm=(sdecg*celp-cdecg*selp*cra)/celg +c azimuth in deg + azg=atan2(sazm,cazm)*RADIAN+azp +c sine and cosine of longitude of zenith relative to NCP longitude + sl2m=celp*sra/celg + cl2m=(selp*cdecg-celp*sdecg*cra)/celg +c longitude of zenith in deg + l2z=atan2(sl2m,cl2m)*RADIAN+l2p + endif +c ensure azimuthal angles are in interval [0,360) + iz=azg/CIRCLE + if (azg.lt.0._10) iz=iz-1 + azg=azg-iz*CIRCLE + iz=l2z/CIRCLE + if (l2z.lt.0._10) iz=iz-1 + l2z=l2z-iz*CIRCLE + return + end +c diff --git a/src/balkanize.c b/src/balkanize.c new file mode 100644 index 0000000..41bfd02 --- /dev/null +++ b/src/balkanize.c @@ -0,0 +1,525 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +/* define CARRY_ON_REGARDLESS if you want balkanize() to continue even when the number of polygons hits NPOLYSMAX; + if CARRY_ON_REGARDLESS is defined, then balkanize() will create a possibly incomplete polygon file of polygons */ +#undef CARRY_ON_REGARDLESS +//#define CARRY_ON_REGARDLESS + +/* getopt options */ +//const char *optstr = "B:dqa:b:t:y:m:s:e:v:p:i:o:"; +const char *optstr = "B:dqm:s:e:v:p:i:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int balkanize(int npoly, polygon *[npoly], int npolys, polygon *[npolys]); +#else +int balkanize(int npoly, polygon *[/*npoly*/], int npolys, polygon *[/*npolys*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys,i; + char key; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + /* default is to renumber output polygons with new id numbers */ + fmt.newid = 'n'; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- balkanize ----------------\n"); + + // snap angles + scale(&axtol, axunit, 's'); + scale(&btol, bunit, 's'); + scale(&thtol, thunit, 's'); + axunit = 's'; + bunit = 's'; + thunit = 's'; + // msg("snap angles: axis %Lg%c latitude %Lg%c edge %Lg%c\n", axtol, axunit, btol, bunit, thtol, thunit); + scale(&axtol, axunit, 'r'); + scale(&btol, bunit, 'r'); + scale(&thtol, thunit, 'r'); + axunit = 'r'; + bunit = 'r'; + thunit = 'r'; + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0) { + fprintf(stderr, "Error: input polygons must be snapped before balkanization.\n"); + fprintf(stderr, "If your polygons are already snapped, add the 'snapped' keyword\nat the beginning of each of your input polygon files.\n"); + exit(1); + } + + /* balkanize polygons */ + npolys = balkanize(npoly, polys, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + + balkanized=1; + + /* write polygons */ + ifile = argc - 1; + npolys = wrmask(argv[ifile], &fmt, npolys, &polys[npoly]); + if (npolys == -1) exit(1); + /* memmsg(); */ + + for(i=0;i<npoly+npolys;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("balkanize [-d] [-q] [-a<a>[u]] [-b<a>[u]] [-t<a>[u]] [-y<r>] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-Bl|-Ba|-Bn|-Bx] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Balkanize overlapping polygons into many disjoint connected polygons. + + Input: npoly = number of polygons. + poly = array of pointers to polygons. + npolys = maximum number of output polygons. + Output: polys = array of pointers to polygons. + Return value: number of disjoint connected polygons, + or -1 if error occurred. +*/ +int balkanize(int npoly, polygon *poly[/*npoly*/], int npolys, polygon *polys[/*npolys*/]) +{ + /* part_poly should lasso one-boundary polygons only if they have too many caps */ +#define ALL_ONEBOUNDARY 1 + /* how part_poly should tighten lasso */ +#define ADJUST_LASSO 1 + /* part_poly should force polygon to be split even if no part can be lassoed */ +#define FORCE_SPLIT 1 + /* partition_poly should overwrite all original polygons */ +#define OVERWRITE_ORIGINAL 2 +#define WARNMAX 8 + char *snapped_polys = 0x0; + int discard, dm, dn, dnp, failed, i, ier, inull, isnap, ip, iprune, j, k, m, n, nadj, np, selfsnap; + int *start; + int *total; + int begin, end, p, max_pixel; + long double tol; + + poly_sort(npoly, poly, 'p'); + + /* allocate memory for pixel info arrays start and total */ + max_pixel=poly[npoly-1]->pixel+1; + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "balkanize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "balkanize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "balkanize: error building pixel index lists\n"); + return(-1); + } + + /* start by pruning all input polygons */ + np = 0; + inull = 0; + printf("BALKAN: Pruning...\n"); + for (i = 0; i < npoly; i++) { + if ((i%100)==0) { + printf(" %d / %d \r", i, npoly); + fflush(stdout); + } + tol = mtol; + iprune = prune_poly(poly[i], tol); + /* error */ + if (iprune == -1) { + fprintf(stderr, "balkanize: initial prune failed at polygon %d\n", poly[i]->id); + return(-1); + } + /* zero area polygon */ + if (iprune >= 2) { + if (WARNMAX > 0 && inull == 0) msg("warning from balkanize: following polygons have zero area & are being discarded:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt.newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } else { + np++; + } + } + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) { + msg("balkanize: %d polygons with zero area are being discarded;\n", inull); + } + + /* number of polygons */ + msg("balkanizing %d polygons ...\n", np); + + /* nullify all output polygons */ + for (i = 0; i < npolys; i++) { + polys[i] = 0x0; + } + + /* + m = starting index of current set of fragments of i'th polygon + dm = number of current set of fragments of i'th polygon + n = starting index of new subset of fragments of i'th polygon + dn = number of new subset of fragments of i'th polygon + */ + + msg("balkanize stage 1 (fragment into non-overlapping polygons):\n"); + n = 0; + dnp = 0; + ip = 0; + /* go through each pixel and fragment each polygon against the other polygons in its pixel */ + for(p=0;p<max_pixel;p++){ + if ((p % 100) == 0) { + printf(" %d / %d \r", p, max_pixel); + fflush(stdout); + } + begin=start[p]; + end=start[p]+total[p]; + + /* too many polygons */ + if (n >= npolys) break; + + /* fragment each polygon in turn */ + + for (i = begin; i < end; i++) { + /* skip null polygons */ + if (poly[i]->np > 0 && poly[i]->cm[0] == 0.) continue; + /* update indices */ + + m = n; + dm = 1; + n = m + dm; + /* make sure output polygon has enough room */ + + ier = room_poly(&polys[m], poly[i]->np, DNP, 0); + if (ier == -1) { + fprintf(stderr, "balkanize: failed to allocate memory for polygon of %d caps\n", poly[i]->np + DNP); + return(-1); + } + + + /* copy polygon i into output polygon */ + copy_poly(poly[i], polys[m]); + + /* fragment successively against other polygons */ + for (j = begin; j < end; j++) { + + /* skip self, or null polygons */ + if (j == i || (poly[j]->np > 0 && poly[j]->cm[0] == 0.)) continue; + /* keep only one copy of the intersection of i & j */ + /* intersection inherits weight of polygon being fragmented, + so keeping later polygon ensures intersection inherits + weight of later polygon */ + if (i < j) { + discard = 1; + } else { + discard = 0; + } + + /* fragment each part of i'th polygon */ + for (k = m; k < m + dm; k++) { + /* skip null polygons */ + if (!polys[k] || (polys[k]->np > 0 && polys[k]->cm[0] == 0.)) continue; + /* fragment */ + tol = mtol; + dn = fragment_poly(&polys[k], poly[j], discard, npolys - n, &polys[n], tol, bmethod); + + /* error */ + if (dn == -1) { + fprintf(stderr, "balkanize: UHOH at polygon %d; continuing ...\n", (fmt.newid == 'o')? polys[i]->id : ip); + continue; + /* return(-1); */ + } + + /* increment index of next subset of fragments */ + n += dn; + /* increment polygon count */ + np += dn; + dnp += dn; + if (!polys[k]) { + np--; + dnp--; + } + + /* check whether exceeded maximum number of polygons */ + //printf("(1) n = %d\n", n); + if (n > npolys) { + fprintf(stderr, "(1) balkanize: total number of polygons (= %d) exceeded maximum %d\n", npoly + n, npoly + npolys); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + fprintf(stderr, "currently, dn = %d, np = %d, dnp = %d, poly[%d]->id = %d, poly[%d]->pixel = %d\n", dn, np, dnp, i, poly[i]->id, i, poly[i]->pixel); + n = npolys; +#ifdef CARRY_ON_REGARDLESS + break; +#else + return(-1); +#endif + } + } + + /* copy down non-null polygons */ + dm = 0; + for (k = m; k < n; k++) { + if (polys[k]) { + polys[m + dm] = polys[k]; + dm++; + } + } + + /* nullify but don't free, because freeing polys[k] will free polys[m + dm] */ + for (k = m + dm; k < n; k++) { + polys[k] = 0x0; + } + n = m + dm; + if (dm == 0) break; + } + /* too many polygons */ + if (n >= npolys) break; + ip++; + } + + } + + free(start); + free(total); + + msg("added %d polygons to make %d\n", dnp, np); + + // partition disconnected polygons into connected parts + msg("balkanize stage 2 (partition disconnected polygons into connected parts):\n"); + m = n; + dnp = 0; + ip = 0; + failed = 0; + for (i = 0; i < m; i++) { + if ((i%100) == 0) { + printf(" %d / %d \r", i, m); + fflush(stdout); + } + // skip null polygons + if (!polys[i] || (polys[i]->np > 0 && polys[i]->cm[0] == 0.)) continue; + // partition disconnected polygons + tol = mtol; + ier = partition_poly(&polys[i], npolys - n, &polys[n], tol, ALL_ONEBOUNDARY, ADJUST_LASSO, FORCE_SPLIT, OVERWRITE_ORIGINAL, &dn); + // error + if (ier == -1) { + fprintf(stderr, "balkanize: UHOH at polygon %d; continuing ...\n", (fmt.newid == 'o')? polys[i]->id : ip); + continue; + // return(-1); + // failed to partition polygon into desired number of parts + } else if (ier == 1) { + fprintf(stderr, "balkanize: failed to partition polygon %d fully; partitioned it into %d parts\n", (fmt.newid == 'o')? polys[i]->id : ip, dn + 1); + failed++; + } + // increment index of next subset of fragments + n += dn; + // increment polygon count + np += dn; + dnp += dn; + // check whether exceeded maximum number of polygons + //printf("(2) n = %d\n", n); + if (n > npolys) { + fprintf(stderr, "(2) balkanize: total number of polygons (= %d) exceeded maximum %d\n", n + npoly, npoly + npolys); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + n = npolys; +#ifdef CARRY_ON_REGARDLESS + break; +#else + return(-1); +#endif + } + ip++; + } + + msg("added %d polygons to make %d\n", dnp, np); + + if (failed > 0) { + msg("balkanize: failed to split %d polygons into desired number of connected parts\n", failed); + msg(".............................................................................\n"); + msg("Failure to split polygon probably means:\n"); + msg("either (1) you forgot to run snap on all your input polygon files;\n"); + msg(" or (2) the polygon is too small for the numerics to cope with;\n"); + msg(" or (3) you have a weird-shaped polygon.\n"); + msg("You may ignore this warning message if the weights of polygons in the input\n"); + msg("polygon file(s) are already correct, and you do not want to reweight them.\n"); + msg("Similarly, you may ignore this warning message if you do want to reweight the\n"); + msg("polygons, but the weights of the different parts of each unsplit polygon are\n"); + msg("the same. If you want to reweight the different parts of an unsplit polygon\n"); + msg("with different weights, then you will need to split that polygon by hand.\n"); + msg("Whatever the case, the output file of balkanized polygons constitutes\n"); + msg("a valid mask of non-overlapping polygons, which is safe to use.\n"); + msg(".............................................................................\n"); + } + + /* prune */ + j = 0; + inull = 0; + for (i = 0; i < n; i++) { + tol = mtol; + iprune = prune_poly(polys[i], tol); + if (iprune == -1) { + fprintf(stderr, "balkanize: failed to prune polygon %d; continuing ...\n", (fmt.newid == 'o')? polys[i]->id : j); + /* return(-1); */ + } + if (iprune >= 2) { + free_poly(polys[i]); + polys[i] = 0x0; + inull++; + } else { + polys[j] = polys[i]; + j++; + } + } + if (inull > 0) msg("balkanize: %d balkanized polygons have zero area, and are being discarded\n", inull); + n = j; + + /* + // allocate snapped_polys array + snapped_polys = (char *) malloc(sizeof(char) * n); + if (!snapped_polys) { + fprintf(stderr, "balkanize: failed to allocate memory for %d characters\n", n); + return(-1); + } + + //snap edges of each polygon + selfsnap = 1; + nadj = snap_polys(fmt, n, polys, selfsnap, axtol, btol, thtol, ytol, mtol, WARNMAX, snapped_polys); + if(nadj==-1){ + msg("balkanize: error snapping balkanized polygons\n"); + return(-1); + } + + // number of polygons whose edges were snapped + isnap = 0; + for (i = 0; i < n; i++) if (snapped_polys[i]) isnap++; + if (isnap > 0) msg("balkanize: edges of %d balkanized polygons were snapped\n", isnap); + + // prune snapped polygons + j = 0; + inull = 0; + for (i = 0; i < n; i++) { + if (snapped_polys[i]) { + iprune = prune_poly(polys[i], mtol); + if (iprune == -1) { + fprintf(stderr, "balkanize: failed to prune polygon %d; continuing ...\n", (fmt.newid == 'o')? polys[i]->id : j); + // return(-1); + } + if (iprune >= 2) { + free_poly(polys[i]); + polys[i] = 0x0; + inull++; + } else { + polys[j] = polys[i]; + j++; + } + } else { + polys[j] = polys[i]; + j++; + } + } + + if (inull > 0) msg("balkanize: %d snapped polygons have zero area, and are being discarded\n", inull); + n = j; + +// free snapped_polys array + free(snapped_polys); + */ + + if(n!=-1){ + /* sort polygons by pixel number */ + poly_sort(n, polys,'p'); + msg("balkanize: balkans contain %d polygons\n", n); + } + + /* assign new polygon id numbers in place of inherited ids */ + if (fmt.newid == 'n') { + for (i = 0; i < n; i++) { + polys[i]->id = i; + } + } + + if (fmt.newid == 'p') { + for (i = 0; i < n; i++) { + polys[i]->id = polys[i]->pixel; + } + } + + + return(n); +} diff --git a/src/balkanizepolys.c b/src/balkanizepolys.c new file mode 100644 index 0000000..4ccb9d0 --- /dev/null +++ b/src/balkanizepolys.c @@ -0,0 +1,381 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Balkanize overlapping polygons into many disjoint connected polygons. + + Input: npoly = number of polygons. + poly = array of pointers to polygons. + npolys = maximum number of output polygons. + mtol = tolerance angle for multiple intersections. + fmt = pointer to format structure. + axtol, btol, thtol, ytol = tolerance angles (see documentation). + Output: polys = array of pointers to polygons. + Return value: number of disjoint connected polygons, + or -1 if error occurred. +*/ +int balkanize(int npoly, polygon *poly[/*npoly*/], int npolys, polygon *polys[/*npolys*/], long double mtol, format *fmt, long double axtol, long double btol, long double thtol, long double ytol) +{ +/* part_poly should lasso one-boundary polygons only if they have too many caps */ +#define ALL_ONEBOUNDARY 1 +/* how part_poly should tighten lasso */ +#define ADJUST_LASSO 1 +/* part_poly should force polygon to be split even if no part can be lassoed */ +#define FORCE_SPLIT 1 +/* partition_poly should overwrite all original polygons */ +#define OVERWRITE_ORIGINAL 2 +#define WARNMAX 8 + char *snapped_polys = 0x0; + int discard, dm, dn, dnp, failed, i, ier, inull, isnap, ip, iprune, j, k, m, n, nadj, np, selfsnap; + int *start; + int *total; + int begin, end, p, max_pixel; + long double tol; + + poly_sort(npoly, poly, 'p'); + + /* allocate memory for pixel info arrays start and total */ + max_pixel=poly[npoly-1]->pixel+1; + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "balkanize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "balkanize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "balkanize: error building pixel index lists\n"); + return(-1); + } + + /* start by pruning all input polygons */ + np = 0; + inull = 0; + for (i = 0; i < npoly; i++) { + tol = mtol; + iprune = prune_poly(poly[i], tol); + /* error */ + if (iprune == -1) { + fprintf(stderr, "balkanize: initial prune failed at polygon %d\n", poly[i]->id); + return(-1); + } + /* zero area polygon */ + if (iprune >= 2) { + if (WARNMAX > 0 && inull == 0) msg("warning from balkanize: following polygons have zero area & are being discarded:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } else { + np++; + } + } + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) { + msg("balkanize: %d polygons with zero area are being discarded;\n", inull); + } + + /* number of polygons */ + msg("balkanizing %d polygons ...\n", np); + + /* nullify all output polygons */ + for (i = 0; i < npolys; i++) { + polys[i] = 0x0; + } + + /* + m = starting index of current set of fragments of i'th polygon + dm = number of current set of fragments of i'th polygon + n = starting index of new subset of fragments of i'th polygon + dn = number of new subset of fragments of i'th polygon + */ + + msg("balkanize stage 1 (fragment into non-overlapping polygons):\n"); + n = 0; + dnp = 0; + ip = 0; + /* go through each pixel and fragment each polygon against the other polygons in its pixel */ + for(p=0;p<max_pixel;p++){ + + begin=start[p]; + end=start[p]+total[p]; + + /* too many polygons */ + if (n >= npolys) break; + + /* fragment each polygon in turn */ + + for (i = begin; i < end; i++) { + /* skip null polygons */ + if (poly[i]->np > 0 && poly[i]->cm[0] == 0.) continue; + /* update indices */ + + m = n; + dm = 1; + n = m + dm; + /* make sure output polygon has enough room */ + + ier = room_poly(&polys[m], poly[i]->np, DNP, 0); + if (ier == -1) { + fprintf(stderr, "balkanize: failed to allocate memory for polygon of %d caps\n", poly[i]->np + DNP); + return(-1); + } + + + /* copy polygon i into output polygon */ + copy_poly(poly[i], polys[m]); + + /* fragment successively against other polygons */ + for (j = begin; j < end; j++) { + + /* skip self, or null polygons */ + if (j == i || (poly[j]->np > 0 && poly[j]->cm[0] == 0.)) continue; + /* keep only one copy of the intersection of i & j */ + /* intersection inherits weight of polygon being fragmented, + so keeping later polygon ensures intersection inherits + weight of later polygon */ + if (i < j) { + discard = 1; + } else { + discard = 0; + } + + /* fragment each part of i'th polygon */ + for (k = m; k < m + dm; k++) { + /* skip null polygons */ + if (!polys[k] || (polys[k]->np > 0 && polys[k]->cm[0] == 0.)) continue; + /* fragment */ + tol = mtol; + dn = fragment_poly(&polys[k], poly[j], discard, npolys - n, &polys[n], tol, bmethod); + + /* error */ + if (dn == -1) { + fprintf(stderr, "balkanize: UHOH at polygon %d; continuing ...\n", (fmt->newid == 'o')? polys[i]->id : ip); + continue; + /* return(-1); */ + } + + /* increment index of next subset of fragments */ + n += dn; + /* increment polygon count */ + np += dn; + dnp += dn; + if (!polys[k]) { + np--; + dnp--; + } + + /* check whether exceeded maximum number of polygons */ + //printf("(1) n = %d\n", n); + if (n > npolys) { + fprintf(stderr, "(1) balkanize: total number of polygons (= %d) exceeded maximum %d\n", npoly + n, npoly + npolys); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + fprintf(stderr, "currently, dn = %d, np = %d, dnp = %d, poly[%d]->id = %d, poly[%d]->pixel = %d\n", dn, np, dnp, i, poly[i]->id, i, poly[i]->pixel); + n = npolys; +#ifdef CARRY_ON_REGARDLESS + break; +#else + return(-1); +#endif + } + } + + /* copy down non-null polygons */ + dm = 0; + for (k = m; k < n; k++) { + if (polys[k]) { + polys[m + dm] = polys[k]; + dm++; + } + } + + /* nullify but don't free, because freeing polys[k] will free polys[m + dm] */ + for (k = m + dm; k < n; k++) { + polys[k] = 0x0; + } + n = m + dm; + if (dm == 0) break; + } + /* too many polygons */ + if (n >= npolys) break; + ip++; + } + + } + + free(start); + free(total); + + msg("added %d polygons to make %d\n", dnp, np); + + // partition disconnected polygons into connected parts + msg("balkanize stage 2 (partition disconnected polygons into connected parts):\n"); + m = n; + dnp = 0; + ip = 0; + failed = 0; + for (i = 0; i < m; i++) { + // skip null polygons + if (!polys[i] || (polys[i]->np > 0 && polys[i]->cm[0] == 0.)) continue; + // partition disconnected polygons + tol = mtol; + ier = partition_poly(&polys[i], npolys - n, &polys[n], tol, ALL_ONEBOUNDARY, ADJUST_LASSO, FORCE_SPLIT, OVERWRITE_ORIGINAL, &dn); + // error + if (ier == -1) { + fprintf(stderr, "balkanize: UHOH at polygon %d; continuing ...\n", (fmt->newid == 'o')? polys[i]->id : ip); + continue; + // return(-1); + // failed to partition polygon into desired number of parts + } else if (ier == 1) { + fprintf(stderr, "balkanize: failed to partition polygon %d fully; partitioned it into %d parts\n", (fmt->newid == 'o')? polys[i]->id : ip, dn + 1); + failed++; + } + // increment index of next subset of fragments + n += dn; + // increment polygon count + np += dn; + dnp += dn; + // check whether exceeded maximum number of polygons + //printf("(2) n = %d\n", n); + if (n > npolys) { + fprintf(stderr, "(2) balkanize: total number of polygons (= %d) exceeded maximum %d\n", n + npoly, npoly + npolys); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + n = npolys; +#ifdef CARRY_ON_REGARDLESS + break; +#else + return(-1); +#endif + } + ip++; + } + + msg("added %d polygons to make %d\n", dnp, np); + + if (failed > 0) { + msg("balkanize: failed to split %d polygons into desired number of connected parts\n", failed); + msg(".............................................................................\n"); + msg("Failure to split polygon probably means:\n"); + msg("either (1) you forgot to run snap on all your input polygon files;\n"); + msg(" or (2) the polygon is too small for the numerics to cope with;\n"); + msg(" or (3) you have a weird-shaped polygon.\n"); + msg("You may ignore this warning message if the weights of polygons in the input\n"); + msg("polygon file(s) are already correct, and you do not want to reweight them.\n"); + msg("Similarly, you may ignore this warning message if you do want to reweight the\n"); + msg("polygons, but the weights of the different parts of each unsplit polygon are\n"); + msg("the same. If you want to reweight the different parts of an unsplit polygon\n"); + msg("with different weights, then you will need to split that polygon by hand.\n"); + msg("Whatever the case, the output file of balkanized polygons constitutes\n"); + msg("a valid mask of non-overlapping polygons, which is safe to use.\n"); + msg(".............................................................................\n"); + } + + /* prune */ + j = 0; + inull = 0; + for (i = 0; i < n; i++) { + tol = mtol; + iprune = prune_poly(polys[i], tol); + if (iprune == -1) { + fprintf(stderr, "balkanize: failed to prune polygon %d; continuing ...\n", (fmt->newid == 'o')? polys[i]->id : j); + /* return(-1); */ + } + if (iprune >= 2) { + free_poly(polys[i]); + polys[i] = 0x0; + inull++; + } else { + polys[j] = polys[i]; + j++; + } + } + if (inull > 0) msg("balkanize: %d balkanized polygons have zero area, and are being discarded\n", inull); + n = j; + + /* + // allocate snapped_polys array + snapped_polys = (char *) malloc(sizeof(char) * n); + if (!snapped_polys) { + fprintf(stderr, "balkanize: failed to allocate memory for %d characters\n", n); + return(-1); + } + + //snap edges of each polygon + selfsnap = 1; + nadj = snap_polys(fmt, n, polys, selfsnap, axtol, btol, thtol, ytol, mtol, WARNMAX, snapped_polys); + if(nadj==-1){ + msg("balkanize: error snapping balkanized polygons\n"); + return(-1); + } + + // number of polygons whose edges were snapped + isnap = 0; + for (i = 0; i < n; i++) if (snapped_polys[i]) isnap++; + if (isnap > 0) msg("balkanize: edges of %d balkanized polygons were snapped\n", isnap); + + // prune snapped polygons + j = 0; + inull = 0; + for (i = 0; i < n; i++) { + if (snapped_polys[i]) { + iprune = prune_poly(polys[i], mtol); + if (iprune == -1) { + fprintf(stderr, "balkanize: failed to prune polygon %d; continuing ...\n", (fmt->newid == 'o')? polys[i]->id : j); + // return(-1); + } + if (iprune >= 2) { + free_poly(polys[i]); + polys[i] = 0x0; + inull++; + } else { + polys[j] = polys[i]; + j++; + } + } else { + polys[j] = polys[i]; + j++; + } + } + + if (inull > 0) msg("balkanize: %d snapped polygons have zero area, and are being discarded\n", inull); + n = j; + +// free snapped_polys array + free(snapped_polys); + */ + + if(n!=-1){ + /* sort polygons by pixel number */ + poly_sort(n, polys,'p'); + msg("balkanize: balkans contain %d polygons\n", n); + } + + /* assign new polygon id numbers in place of inherited ids */ + if (fmt->newid == 'n') { + for (i = 0; i < n; i++) { + polys[i]->id = i; + } + } + + if (fmt->newid == 'p') { + for (i = 0; i < n; i++) { + polys[i]->id = polys[i]->pixel; + } + } + + + return(n); +} diff --git a/src/braktop.s.f b/src/braktop.s.f new file mode 100644 index 0000000..1857963 --- /dev/null +++ b/src/braktop.s.f @@ -0,0 +1,300 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine braktop(aa,ia,a,n,l) + integer ia,n,l + real*10 aa,a(n) + integer idir,istep +c * +c * Bracket aa in table a ordered in decreasing order, +c * i.e. find ia such that +c * a(ia) >= aa > a(ia+1) (l.eq.0) +c * or a(ia) > aa >= a(ia+1) (l.eq.1). +c * Gives ia=0 if +c * aa > a(1) (l.eq.0) +c * or aa >= a(1) (l.eq.1). +c * Gives ia=n if +c * aa <= a(1) (l.eq.0) +c * or aa < a(1) (l.eq.1). +c * +c Input: aa = value to bracket +c a = ordered array of length n +c n = length of a array +c l = 0 or 1 to choose equality on lower or upper limit. +c Input/Output: ia on input = element of a to start search from; +c on output = as above. +c + if (ia.lt.1) ia=1 + if (ia.gt.n) ia=n +c idir is which way to search, up or down + if (aa.lt.a(ia)) then + idir=1 + elseif (aa.gt.a(ia)) then + idir=-1 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif +c istep is how far to leap from present position + istep=1 +c leap + 120 ia=ia+idir*istep +c keep doubling leap till you've straddled desired place + if (ia.lt.1.or.ia.gt.n) then + continue + elseif (idir*aa.lt.idir*a(ia)) then + istep=istep*2 + goto 120 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif + idir=-idir +c binary chop homes in on desired place in table + 140 if (istep.gt.1) then + istep=istep/2 + ia=ia+idir*istep + if (ia.lt.1) then + idir=1 + elseif (ia.gt.n) then + idir=-1 + elseif (aa.lt.a(ia)) then + idir=1 + elseif (aa.gt.a(ia)) then + idir=-1 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif + goto 140 + endif + if (idir.eq.-1) ia=ia-1 + 200 continue + return + end +c +c----------------------------------------------------------------------- + subroutine brakbot(aa,ia,a,n,l) + integer ia,n,l + real*10 aa,a(n) + integer idir,istep +c * +c * Bracket aa in table a ordered in increasing order, +c * i.e. find ia such that +c * a(ia) <= aa < a(ia+1) (l.eq.0) +c * or a(ia) < aa <= a(ia+1) (l.eq.1). +c * Gives ia=0 if +c * aa < a(1) (l.eq.0) +c * or aa <= a(1) (l.eq.1). +c * Gives ia=n if +c * aa <= a(1) (l.eq.0) +c * or aa < a(1) (l.eq.1). +c * +c Input: aa = value to bracket +c a = ordered array of length n +c n = length of a array +c l = 0 or 1 to choose equality on lower or upper limit. +c Input/Output: ia on input = element of a to start search from; +c on output = as above. +c + if (ia.lt.1) ia=1 + if (ia.gt.n) ia=n +c idir is which way to search, up or down + if (aa.gt.a(ia)) then + idir=1 + elseif (aa.lt.a(ia)) then + idir=-1 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif +c istep is how far to leap from present position + istep=1 +c leap + 120 ia=ia+idir*istep +c keep doubling leap till you've straddled desired place + if (ia.lt.1.or.ia.gt.n) then + continue + elseif (idir*aa.gt.idir*a(ia)) then + istep=istep*2 + goto 120 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif + idir=-idir +c binary chop homes in on desired place in table + 140 if (istep.gt.1) then + istep=istep/2 + ia=ia+idir*istep + if (ia.lt.1) then + idir=1 + elseif (ia.gt.n) then + idir=-1 + elseif (aa.gt.a(ia)) then + idir=1 + elseif (aa.lt.a(ia)) then + idir=-1 + elseif (aa.eq.a(ia)) then + ia=ia-l + goto 200 + endif + goto 140 + endif + if (idir.eq.-1) ia=ia-1 + 200 continue + return + end +c +c----------------------------------------------------------------------- + subroutine braktpa(aa,ia,a,n,l) + integer ia,n,l + real*10 aa,a(n) +c intrinsics + intrinsic abs +c local (automatic) variables + integer idir,istep +c * +c * Bracket aa in table a ordered in decreasing order of absolute value, +c * i.e. find ia such that +c * |a(ia)| >= aa > |a(ia+1)| (l.eq.0) +c * or |a(ia)| > aa >= |a(ia+1)| (l.eq.1). +c * Gives ia=0 if +c * aa > |a(1)| (l.eq.0) +c * or aa >= |a(1)| (l.eq.1). +c * Gives ia=n if +c * aa <= |a(1)| (l.eq.0) +c * or aa < |a(1)| (l.eq.1). +c * +c Input: aa = value to bracket +c a = ordered array of length n +c n = length of a array +c l = 0 or 1 to choose equality on lower or upper limit. +c Input/Output: ia on input = element of a to start search from; +c on output = as above. +c + if (ia.lt.1) ia=1 + if (ia.gt.n) ia=n +c idir is which way to search, up or down + if (aa.lt.abs(a(ia))) then + idir=1 + elseif (aa.gt.abs(a(ia))) then + idir=-1 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif +c istep is how far to leap from present position + istep=1 +c leap + 120 ia=ia+idir*istep +c keep doubling leap till you've straddled desired place + if (ia.lt.1.or.ia.gt.n) then + continue + elseif (idir*aa.lt.idir*abs(a(ia))) then + istep=istep*2 + goto 120 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif + idir=-idir +c binary chop homes in on desired place in table + 140 if (istep.gt.1) then + istep=istep/2 + ia=ia+idir*istep + if (ia.lt.1) then + idir=1 + elseif (ia.gt.n) then + idir=-1 + elseif (aa.lt.abs(a(ia))) then + idir=1 + elseif (aa.gt.abs(a(ia))) then + idir=-1 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif + goto 140 + endif + if (idir.eq.-1) ia=ia-1 + 200 continue + return + end +c +c----------------------------------------------------------------------- + subroutine brakbta(aa,ia,a,n,l) + integer ia,n,l + real*10 aa,a(n) +c intrinsics + intrinsic abs +c local (automatic) variables + integer idir,istep +c * +c * Bracket aa in table a ordered in increasing order of absolute value, +c * i.e. find ia such that +c * |a(ia)| <= aa < |a(ia+1)| (l.eq.0) +c * or |a(ia)| < aa <= |a(ia+1)| (l.eq.1). +c * Gives ia=0 if +c * aa < |a(1)| (l.eq.0) +c * or aa <= |a(1)| (l.eq.1). +c * Gives ia=n if +c * aa <= |a(1)| (l.eq.0) +c * or aa < |a(1)| (l.eq.1). +c * +c Input: aa = value to bracket +c a = ordered array of length n +c n = length of a array +c l = 0 or 1 to choose equality on lower or upper limit. +c Input/Output: ia on input = element of a to start search from; +c on output = as above. +c + if (ia.lt.1) ia=1 + if (ia.gt.n) ia=n +c idir is which way to search, up or down + if (aa.gt.abs(a(ia))) then + idir=1 + elseif (aa.lt.abs(a(ia))) then + idir=-1 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif +c istep is how far to leap from present position + istep=1 +c leap + 120 ia=ia+idir*istep +c keep doubling leap till you've straddled desired place + if (ia.lt.1.or.ia.gt.n) then + continue + elseif (idir*aa.gt.idir*abs(a(ia))) then + istep=istep*2 + goto 120 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif + idir=-idir +c binary chop homes in on desired place in table + 140 if (istep.gt.1) then + istep=istep/2 + ia=ia+idir*istep + if (ia.lt.1) then + idir=1 + elseif (ia.gt.n) then + idir=-1 + elseif (aa.gt.abs(a(ia))) then + idir=1 + elseif (aa.lt.abs(a(ia))) then + idir=-1 + elseif (aa.eq.abs(a(ia))) then + ia=ia-l + goto 200 + endif + goto 140 + endif + if (idir.eq.-1) ia=ia-1 + 200 continue + return + end +c diff --git a/src/braktop_.c b/src/braktop_.c new file mode 100644 index 0000000..52e6e20 --- /dev/null +++ b/src/braktop_.c @@ -0,0 +1,27 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + c interface to fortran subroutines in braktop.s.f +*/ +void braktop(long double aa, int *ia, long double a[], int n, int l) +{ + braktop_(&aa, ia, a, &n, &l); +} + +void brakbot(long double aa, int *ia, long double a[], int n, int l) +{ + brakbot_(&aa, ia, a, &n, &l); +} + +void braktpa(long double aa, int *ia, long double a[], int n, int l) +{ + braktpa_(&aa, ia, a, &n, &l); +} + +void brakbta(long double aa, int *ia, long double a[], int n, int l) +{ + brakbta_(&aa, ia, a, &n, &l); +} diff --git a/src/cmminf.c b/src/cmminf.c new file mode 100644 index 0000000..0703fa2 --- /dev/null +++ b/src/cmminf.c @@ -0,0 +1,22 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Find smallest cap of polygon. +*/ +void cmminf(polygon *poly, int *ipmin, long double *cmmin) +{ + int ip; + long double cmi; + + *cmmin = 2.; + for (ip = 0; ip < poly->np; ip++) { + cmi = (poly->cm[ip] >= 0.)? poly->cm[ip] : 2. + poly->cm[ip]; + if (cmi <= *cmmin) { + *ipmin = ip; + *cmmin = cmi; + } + } +} diff --git a/src/convert.c b/src/convert.c new file mode 100644 index 0000000..dd03900 --- /dev/null +++ b/src/convert.c @@ -0,0 +1,594 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include "manglefn.h" + +/* initial angular tolerance within which to merge multiple intersections */ +extern long double mtol; + +/*------------------------------------------------------------------------------ + Convert vertices structure to polygon. + Assume that vertices are joined by great circles. + + Polygon poly should contain enough room to contain the vertices, + namely poly->npmax >= vert->nv. +*/ +void vert_to_poly(vertices *vert, polygon *poly) +{ + int iv; + + /* number of boundaries of polygon equals number of vertices */ + poly->np = vert->nv; + + /* convert each pair of adjacent vertices to a great circle */ + for (iv = 0; iv < vert->nv; iv++) { + azel_to_gc(&vert->v[iv], &vert->v[(iv+1) % vert->nv], + poly->rp[iv], &poly->cm[iv]); + } +} + +/*------------------------------------------------------------------------------ + Convert edges, stored in vertices structure, to polygon. + + Input: vert = pointer to vertices structure. + nve = number of points per edge. + ev = cumulative number of points on each connected boundary. + Output: poly = pointer to polygon structure. +*/ +void edge_to_poly(vertices *vert, int nve, int *ev, polygon *poly) +{ + int dev, i, evo, iedge, iv, iv0, iv1, iv2, jv, nedge; + + /* number of edges */ + nedge = vert->nv / nve; + + /* number of boundaries of polygon equals number of edges */ + poly->np = nedge; + + evo = 0; + iv = 0; + iedge = 0; + /* do each connected boundary */ + for (jv = 0; evo < vert->nv; jv++) { + dev = ev[jv] - evo; + /* points on connected boundary */ + while (iv < ev[jv]) { + i = iv - evo; + iv0 = evo + i; + iv1 = evo + (i + 1) % dev; + iv2 = evo + (i + 2) % dev; + if (nve == 1) { + /* convert pair of adjacent vertices to a great circle */ + azel_to_gc(&vert->v[iv0], &vert->v[iv1], + poly->rp[iedge], &poly->cm[iedge]); + } else { + /* convert triple of vertices to circle */ + edge_to_rpcm(&vert->v[iv0], &vert->v[iv1], &vert->v[iv2], + poly->rp[iedge], &poly->cm[iedge]); + } + iv += nve; + iedge++; + } + evo = ev[jv]; + } +} + +/*------------------------------------------------------------------------------ + Convert rectangle to polygon. + Input: angle [4] = list of angles defining the rectangle, + in the order azmin, azmax, elmin, elmax + Output: poly = pointer to polygon structure + Polygon poly should contain enough room for the 4 caps of the rectangle +*/ +void rect_to_poly(long double angle[4], polygon *poly){ +#define ROUND 1.e-5 + long double daz; + int i; + int ip =0; + /* + angle[0]=azmin; + angle[1]=azmax; + angle[2]=elmin; + angle[3]=elmax; + */ + /* azimuthal extent */ + daz = angle[1] - angle[0]; + /* skip azimuth if it goes full circle */ + if (fabsl(daz - TWOPI) > ROUND) { + /* phase daz into interval [0, 2 pi) */ + daz = daz - floorl(daz / TWOPI) * TWOPI; + /* azimuth covers half circle: one cap will do */ + if (fabsl(daz - PI) <= ROUND) { + i = 0; + az_to_rpcm(angle[i], i % 2, poly->rp[ip], &poly->cm[ip]); + ip++; + /* need two caps */ + } else { + /* convert azmin, azmax to rp, cm */ + for (i = 0; i < 2; i++) { + az_to_rpcm(angle[i], i % 2, poly->rp[ip], &poly->cm[ip]); + ip++; + + } + /* check azimuthal extent is in interval [0, pi] */ + if (daz > PI) { + fprintf(stderr, " warning:"); + fprintf(stderr, " rectangle has azimuthal extent %.16Lg deg > 180 deg\n", + places(daz * 180./PI, 14)); + } + } + } + + /* convert elmin, elmax to rp, cm */ + for (i = 2; i < 4; i++) { + /*if one of the el limits is a pole, make a tiny circle around the pole.*/ + /* + if(fabsl(angle[i] - ((i==2) ? -PIBYTWO : PIBYTWO)) < ROUND){ + angle[i]+= (i==2)? (5*ROUND) : (-5*ROUND); + } + */ + if ((i == 2)? (angle[i] > - PIBYTWO+ROUND) : (angle[i] < PIBYTWO-ROUND)) { + el_to_rpcm(angle[i], i % 2, poly->rp[ip], &poly->cm[ip]); + ip++; + } + } + poly->np = ip; +} + +/*------------------------------------------------------------------------------ + Convert unit vectors to vertices structure. + + Input: rp = array of nv unit vectors. + nv = number of unit vectors. + Output: pointer to a vertices structure. +*/ +void rps_to_vert(int nv, vec rp[/*nv*/], vertices *vert) +{ + int iv; + + /* number of vertices */ + vert->nv = nv; + + /* convert vectors to vertices */ + for (iv = 0; iv < nv; iv++) { + rp_to_azel(rp[iv], &vert->v[iv]); + } + + /* phase each vertex to the previous */ + for (iv = 1; iv < nv; iv++) { + vert->v[iv].az -= rint((vert->v[iv].az - vert->v[iv-1].az) / TWOPI) * TWOPI; + } +} + +/*------------------------------------------------------------------------------ + Convert unit vector to az-el. +*/ +void rp_to_azel(vec rp, azel *v) +{ + v->az = atan2l(rp[1], rp[0]); + v->el = atan2l(rp[2], sqrtl(rp[0] * rp[0] + rp[1] * rp[1])); +} + +/*------------------------------------------------------------------------------ + Convert vertex to unit vector. +*/ +void azel_to_rp(azel *v, vec rp) +{ + rp[0] = cosl(v->el) * cosl(v->az); + rp[1] = cosl(v->el) * sinl(v->az); + rp[2] = sinl(v->el); +} + +/*------------------------------------------------------------------------------ + Determine rp, cm for great circle passing through two az-el vertices. + The great circle goes right-handedly from v0 to v1. +*/ +void azel_to_gc(azel *v0, azel *v1, vec rp, long double *cm) +{ + azel *v; + int iv; + vec rpv[2]; + + for (iv = 0; iv < 2; iv++) { + v = (iv == 0)? v0: v1; + rpv[iv][0] = cosl(v->el) * cosl(v->az); + rpv[iv][1] = cosl(v->el) * sinl(v->az); + rpv[iv][2] = sinl(v->el); + } + + rp_to_gc(rpv[0], rpv[1], rp, cm); +} + +/*------------------------------------------------------------------------------ + Determine rp, cm for great circle passing through two unit vectors. + The great circle goes right-handedly from rp0 to rp1. + If the two unit vectors coincide, suppress the boundary, + on the assumption that coincident points are redundant + (for example, a mask-maker may specify a triangle with 4 vertices, + with 2 vertices being coincident). +*/ +void rp_to_gc(vec rp0, vec rp1, vec rp, long double *cm) +{ + int i; + long double rpa; + + /* cofactors */ + rp[0] = rp0[1]*rp1[2] - rp1[1]*rp0[2]; + rp[1] = rp1[0]*rp0[2] - rp0[0]*rp1[2]; + rp[2] = rp0[0]*rp1[1] - rp1[0]*rp0[1]; + + rpa = sqrtl(rp[0]*rp[0] + rp[1]*rp[1] + rp[2]*rp[2]); + + /* indeterminate solution (rp0 and rp1 are same or antipodeal points) */ + if (rpa == 0.) { + /* suppress boundary, on assumption that coincident points are redundant */ + *cm = 2.; + /* normalize rp to 1 */ + } else { + for (i = 0; i < 3; i++) rp[i] /= rpa; + /* cm = 1 for great circle */ + *cm = 1.; + } +} + +/*------------------------------------------------------------------------------ + Determine rp, cm for circle passing through three az-el points. + The circle goes right-handedly from v0 to v1 to v2. +*/ +void edge_to_rpcm(azel *v0, azel *v1, azel *v2, vec rp, long double *cm) +{ + azel *v=0x0; + int iv; + vec rpv[3]; + + for (iv = 0; iv < 3; iv++) { + switch (iv) { + case 0: v = v0; break; + case 1: v = v1; break; + case 2: v = v2; break; + } + rpv[iv][0] = cosl(v->el) * cosl(v->az); + rpv[iv][1] = cosl(v->el) * sinl(v->az); + rpv[iv][2] = sinl(v->el); + } + + rp_to_rpcm(rpv[0], rpv[1], rpv[2], rp, cm); +} + +/*------------------------------------------------------------------------------ + Determine rp, cm for circle passing through three unit vectors. + The circle goes right-handedly from rp0 to rp1 to rp2. + If two of the unit vectors coincide, join with a great circle. + If three of the unit vectors coincide, suppress the boundary. +*/ +void rp_to_rpcm(vec rp0, vec rp1, vec rp2, vec rp, long double *cm) +{ + int coincide, i, j; + long double det, rpa; + long double *rpi, *rpj; + rpi=0x0; + rpj=0x0; + + /* check whether any two of the three unit vectors coincide */ + coincide = 0; + for (j = 0; j < 3; j++) { + switch (j) { + case 0: rpj = rp0; break; + case 1: rpj = rp1; break; + case 2: rpj = rp2; break; + } + for (i = 0; i < j; i++) { + switch (i) { + case 0: rpi = rp0; break; + case 1: rpi = rp1; break; + case 2: rpi = rp2; break; + } + /* vector coincide */ + if (rpi[0] == rpj[0] && rpi[1] == rpj[1] && rpi[2] == rpj[2]) { + coincide = 1; + /* set rpj equal to the third vector */ + if (i == 0 && j == 1) { + rpj = rp2; + } else if (i == 0 && j == 2) { + rpj = rp1; + } else if (i == 1 && j == 2) { + rpj = rp0; + } + } + if (coincide) break; + } + if (coincide) break; + } + + /* if any two vectors coincide, join with great circle */ + if (coincide) { + rp_to_gc(rpi, rpj, rp, cm); + + /* non-coincident vectors */ + } else { + /* cofactors, arranged to reduce roundoff */ + rp[0] = rp0[1] * (rp1[2] - rp2[2]) + + rp1[1] * (rp2[2] - rp0[2]) + + rp2[1] * (rp0[2] - rp1[2]); + rp[1] = rp0[0] * (rp2[2] - rp1[2]) + + rp1[0] * (rp0[2] - rp2[2]) + + rp2[0] * (rp1[2] - rp0[2]); + rp[2] = (rp0[0] * rp1[1] - rp1[0] * rp0[1]) + + (rp1[0] * rp2[1] - rp2[0] * rp1[1]) + + (rp2[0] * rp0[1] - rp0[0] * rp2[1]); + + /* |rp| */ + rpa = sqrtl(rp[0]*rp[0] + rp[1]*rp[1] + rp[2]*rp[2]); + + /* indeterminate solution (2 of 3 unit vectors coincide: shouldn't happen) */ + if (rpa == 0.) { + /* suppress boundary, not knowing what to do with it */ + *cm = 2.; + /* normal solution */ + } else { + /* determinant */ + det = (rp0[0] * rp1[1] - rp1[0] * rp0[1]) * rp2[2] + + (rp1[0] * rp2[1] - rp2[0] * rp1[1]) * rp0[2] + + (rp2[0] * rp0[1] - rp0[0] * rp2[1]) * rp1[2]; + if (det >= 0.) { + /* cosl(th) = det / |rp| */ + *cm = 1. - det / rpa; + } else { + /* cosl(th) = - det / |rp| */ + rpa = - rpa; + *cm = - (1. - det / rpa); + } + /* normalize rp to 1 */ + for (i = 0; i < 3; i++) rp[i] /= rpa; + } + } +} + +/*------------------------------------------------------------------------------ + Convert circle to rp, cm. + + Input: angle = (azimuth, elevation, radius) in radians. + Output: rp, cm as used by garea, gspher et al. +*/ +void circ_to_rpcm(long double angle[3], vec rp, long double *cm) +{ + long double s; + + /* Cartesian coordinates of azimuth, elevation */ + rp[0] = cosl(angle[1]) * cosl(angle[0]); + rp[1] = cosl(angle[1]) * sinl(angle[0]); + rp[2] = sinl(angle[1]); + /* 1 - cosl(radius) = 2 sin^2(radius/2) */ + s = sinl(angle[2] / 2.); + *cm = s * s * 2.; + *cm = (angle[2] >= 0.)? *cm : -*cm; +} + +/*------------------------------------------------------------------------------ + Convert rp, cm to circle. + + Input: rp, cm as used by garea, gspher et al. + Output: angle = (azimuth, elevation, radius) in radians. +*/ +void rpcm_to_circ(vec rp, long double *cm, long double angle[3]) +{ + long double s; + + angle[0] = atan2l(rp[1], rp[0]); + angle[1] = atan2l(rp[2], sqrtl(rp[0] * rp[0] + rp[1] * rp[1])); + s = sqrtl(fabsl(*cm) / 2.); + if (s > 1.) s = 1.; + angle[2] = 2. * asinl(s); + angle[2] = (*cm >= 0.)? angle[2] : -angle[2]; +} + +/*------------------------------------------------------------------------------ + Convert line of constant azimuth to rp, cm. + + Input: az = azimuth in radians. + m = 0 for minimum elevation; + = 1 for maximum elevation. + Output: rp, cm as used by garea, gspher et al. +*/ +void az_to_rpcm(long double az, int m, vec rp, long double *cm) +{ + /* axis along equator */ + rp[0] = - sinl(az); + rp[1] = cosl(az); + rp[2] = 0.; + /* 1 - cosl(th) = 1 for great circle */ + *cm = 1.; + /* min, max */ + *cm = (m == 0)? *cm : - *cm; +} + +/*------------------------------------------------------------------------------ + Convert line of constant elevation to rp, cm. + + Input: el = elevation in radians. + m = 0 for minimum elevation; + = 1 for maximum elevation. + Output: rp, cm as used by garea, gspher et al. +*/ +void el_to_rpcm(long double el, int m, vec rp, long double *cm) +{ + /* north pole */ + rp[0] = 0.; + rp[1] = 0.; + rp[2] = 1.; + /* 1 - cosl(th) = 1 - sinl(el) */ + *cm = 1 - sinl(el); + /* min, max */ + *cm = (m == 0)? *cm : - *cm; +} + +/*------------------------------------------------------------------------------ + theta_ij = angle in radians between two unit vectors. +*/ +long double thij(vec rpi, vec rpj) +{ + long double cm, th; + + cm = cmij(rpi, rpj); + th = 2. * asinl(cm / 2.); + + return(th); +} + +/*------------------------------------------------------------------------------ + 1-cosl(theta_ij) = 2 sin^2(theta_ij/2) between two unit vectors. +*/ +long double cmij(vec rpi, vec rpj) +{ + long double cm, dx, dy, dz; + + dx = rpi[0] - rpj[0]; + dy = rpi[1] - rpj[1]; + dz = rpi[2] - rpj[2]; + cm = (dx*dx + dy*dy + dz*dz) / 2.; + if (cm > 2.) cm = 2.; + + return(cm); +} + +/*------------------------------------------------------------------------------ + Determine whether a polygon is a rectangle, + and if so return <azmin> <azmax> <elmin> <elmax>. + + Input: poly = pointer to polygon. + Output: *azmin, *azmax, *elmin, *elmax; + if *azmin >= *azmax, or *elmin >= *elmax, the rectangle is empty; + if *azmin = *azmax + 2*pi, there is no azimuthal constraint. + Return value: 0 if polygon is not a rectangle, + 1 if polygon is a rectangle, + 2 if polygon is a rectangle with superfluous boundaries. +*/ +int poly_to_rect(polygon *poly, long double *azmin, long double *azmax, long double *elmin, long double *elmax) +{ + int iaz, ielmin, ielmax, ip; + long double az, el; + + *azmin = -TWOPI; + *azmax = TWOPI; + *elmin = -PIBYTWO; + *elmax = PIBYTWO; + iaz = 0; + ielmin = 0; + ielmax = 0; + for (ip = 0; ip < poly->np; ip++) { + /* null polygon */ + if (poly->cm[ip] == 0. || poly->cm[ip] <= -2.) return(0); + /* skip superfluous cap */ + if (poly->cm[ip] >= 2.) continue; + /* line of constant azimuth */ + if (poly->rp[ip][2] == 0. + && (poly->cm[ip] == 1. || poly->cm[ip] == -1.)) { + /* az is in (-pi,pi] */ + az = atan2l(-poly->rp[ip][0], poly->rp[ip][1]); + if (poly->cm[ip] == -1.) az += (az <= 0.)? PI : -PI; + /* shift azmin, azmax to phase of az, az+pi */ + if (az >= *azmax) { + while (az >= *azmax) { + *azmin += TWOPI; + *azmax += TWOPI; + } + } else if (az + PI <= *azmin) { + while (az + PI <= *azmin) { + *azmin -= TWOPI; + *azmax -= TWOPI; + } + } + /* revise azmin, azmax */ + if (az > *azmin) *azmin = az; + if (az + PI < *azmax) *azmax = az + PI; + iaz++; + /* line of constant elevation */ + } else if (poly->rp[ip][0] == 0. && poly->rp[ip][1] == 0.) { + el = asinl(1. - fabsl(poly->cm[ip])); + if (poly->rp[ip][2] < 0.) el = -el; + if ((poly->rp[ip][2] > 0. && poly->cm[ip] >= 0.) + || (poly->rp[ip][2] < 0. && poly->cm[ip] < 0.)) { + if (el > *elmin) *elmin = el; + ielmin++; + } else { + if (el < *elmax) *elmax = el; + ielmax++; + } + } else { + return(0); + } + } + + /* azimuthal constraints include nothing */ + if (*azmin > *azmax) { + *azmin = *azmax = 0.; + /* azimuthal constraints include everything */ + } else if (*azmin + TWOPI <= *azmax) { + *azmin = -PI; + *azmax = PI; + /* phase azmin to (-pi,pi] */ + } else if (*azmin > PI) { + *azmin -= TWOPI; + *azmax -= TWOPI; + } + + /* should not happen */ + if (iaz > 2 || ielmin > 1 || ielmax > 1) { + msg("poly_to_rect: polygon contains"); + if (iaz > 2) msg(" %d az boundaries", iaz); + if (ielmin > 1) msg(" %d elmin boundaries", ielmin); + if (ielmax > 1) msg(" %d elmax boundaries", ielmax); + msg("\n"); + return(2); + } + + return(1); +} + +/*------------------------------------------------------------------------------ + Determine whether the first vertex in vert + is closer to the nearest vertex or to the nearest antivertex of poly. + + Return value: 0 or 1 as first vertex of vert is closer to the nearest + vertex or antivertex of poly; + -1 if error. +*/ +int antivert(vertices *vert, polygon *poly) +{ + const int do_vcirc = 0, nve = 1, per = 0; + int anti, ier, iv, nev, nev0, nv; + int *ipv, *gp, *ev; + long double cm, cmmax, cmmin, tol; + long double *angle; + vec rp; + vec *ve; + + /* vert has no vertices */ + if (vert->nv == 0) return(0); + + /* vertices of polygon */ + tol = mtol; + ier = gverts(poly, do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + + /* error */ + if (ier) return(-1); + + /* poly has less than 3 vertices */ + if (nv < 3) return(0); + + /* convert first vertex to unit vector */ + azel_to_rp(&vert->v[0], rp); + + cmmin = 2.; + cmmax = 0.; + for (iv = 0; iv < nv; iv++) { + cm = cmij(rp, ve[iv]); + if (cm < cmmin) cmmin = cm; + if (cm > cmmax) cmmax = cm; + } + anti = ((cmmin + cmmax <= 2.)? 0 : 1); + + return(anti); +} diff --git a/src/copy_format.c b/src/copy_format.c new file mode 100644 index 0000000..399304a --- /dev/null +++ b/src/copy_format.c @@ -0,0 +1,40 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Copy format structure from fmt1 to fmt2, except fmt->nweights (this is used + as a sort of flag in rdmask as to whether rd_hpix has been called or not). +*/ +void copy_format(format *fmt1, format *fmt2) +{ + fmt2->in = fmt1->in; + fmt2->out = fmt1->out; + fmt2->skip = fmt1->skip; + fmt2->end = fmt1->end; + fmt2->single = fmt1->single; + fmt2->n = fmt1->n; + fmt2->nn = fmt1->nn; + fmt2->innve = fmt1->innve; + fmt2->outper = fmt1->outper; + fmt2->outnve = fmt1->outnve; + fmt2->id = fmt1->id; + fmt2->newid = fmt1->newid; + fmt2->pixel = fmt1->pixel; + fmt2->weight = fmt1->weight; + fmt2->inunitp = fmt1->inunitp; + fmt2->outunitp = fmt1->outunitp; + fmt2->inframe = fmt1->inframe; + fmt2->outframe = fmt1->outframe; + fmt2->inunit = fmt1->inunit; + fmt2->outunit = fmt1->outunit; + fmt2->outprecision = fmt1->outprecision; + fmt2->outphase = fmt1->outphase; + fmt2->azn = fmt1->azn; + fmt2->eln = fmt1->eln; + fmt2->azp = fmt1->azp; + fmt2->trunit = fmt1->trunit; + fmt2->nweights = fmt2->nweights; +} diff --git a/src/copy_poly.c b/src/copy_poly.c new file mode 100644 index 0000000..bfa9e05 --- /dev/null +++ b/src/copy_poly.c @@ -0,0 +1,155 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Copy poly1. + poly may be the same polygon as poly1. + + Input: poly1 is a polygon. + Output: poly is a copy of poly1. +*/ +void copy_poly(polygon *poly1, polygon *poly) +{ + int i, ip; + + for (ip = 0; ip < poly1->np; ip++) { + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly1->rp[ip][i]; + } + poly->cm[ip] = poly1->cm[ip]; + } + poly->np = poly1->np; + poly->id = poly1->id; + poly->pixel = poly1->pixel; + poly->weight = poly1->weight; +} + +/*------------------------------------------------------------------------------ + Copy first np caps of poly1 into poly. + poly may be the same polygon as poly1. + + Input: poly1 is a polygon. + np = number of caps of poly1 to copy into poly. + Output: poly is a copy of the first np caps of poly1. +*/ +void copy_polyn(polygon *poly1, int np, polygon *poly) +{ + int i, ip; + + for (ip = 0; ip < np; ip++) { + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly1->rp[ip][i]; + } + poly->cm[ip] = poly1->cm[ip]; + } + poly->np = np; + poly->id = poly1->id; + poly->pixel = poly1->pixel; + poly->weight = poly1->weight; +} + +/*------------------------------------------------------------------------------ + Intersection of two polygons. + poly may be the same polygon as poly1, but not the same polygon as poly2. + + Input: poly1, poly2 are two polygons. + Ouptput: poly is the intersection of poly1 and poly2, + The id number and weight of poly are taken equal to those of poly1. +*/ +void poly_poly(polygon *poly1, polygon *poly2, polygon *poly) +{ + int i, ip; + + for (ip = 0; ip < poly1->np; ip++) { + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly1->rp[ip][i]; + } + poly->cm[ip] = poly1->cm[ip]; + } + + for (ip = 0; ip < poly2->np; ip++) { + for (i = 0; i < 3; i++) { + poly->rp[ip + poly1->np][i] = poly2->rp[ip][i]; + } + poly->cm[ip + poly1->np] = poly2->cm[ip]; + } + + poly->np = poly1->np + poly2->np; + poly->id = poly1->id; + poly->pixel = poly1->pixel; + poly->weight = poly1->weight; +} + +/*------------------------------------------------------------------------------ + Intersection of a polygon + with the n'th cap, or the complement of the n'th cap, of another polygon. + poly may be the same polygon as poly1, but not the same polygon as poly2. + + Input: poly1, poly2 are polygons. + n = intersect poly1 with n'th cap of poly2. + scm = 1 to intersect with n'th cap of poly2; + -1 to intersect with complement of n'th cap of poly2. + Output: poly is the intersection of poly1 and n'th cap of poly2. + The id number and weight of poly are taken equal to those of poly1. +*/ +void poly_polyn(polygon *poly1, polygon *poly2, int n, int scm, polygon *poly) +{ + int i, ip; + + for (ip = 0; ip < poly1->np; ip++) { + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly1->rp[ip][i]; + } + poly->cm[ip] = poly1->cm[ip]; + } + ip = poly1->np; + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly2->rp[n][i]; + } + poly->cm[ip] = scm * poly2->cm[n]; + + poly->np = poly1->np + 1; + poly->id = poly1->id; + poly->pixel = poly1->pixel; + poly->weight = poly1->weight; +} + +/*------------------------------------------------------------------------------ + Make group polygon gpoly. + gpoly may be the same polygon as poly. + + Input: poly = pointer to polygon. + gp[ip], ip=1,np = group number of cap ip. + gpg = group to put in gpoly. + gpoly = pointer to group polygon. +*/ +void group_poly(polygon *poly, int gp[/*poly->np*/], int gpg, polygon *gpoly) +{ + int i, ip, np; + + /* number of caps of group polygon */ + np = 0; + for (ip = 0; ip < poly->np; ip++) { + if (gp[ip] == gpg) { + np++; + } + } + + /* make group polygon */ + np = 0; + for (ip = 0; ip < poly->np; ip++) { + if (gp[ip] == gpg) { + for (i = 0; i < 3; i++) { + gpoly->rp[np][i] = poly->rp[ip][i]; + } + gpoly->cm[np] = poly->cm[ip]; + np++; + } + } + gpoly->np = np; + gpoly->id = poly->id; + gpoly->pixel = poly->pixel; + gpoly->weight = poly->weight; +} diff --git a/src/copy_structure.c b/src/copy_structure.c new file mode 100644 index 0000000..bca2e73 --- /dev/null +++ b/src/copy_structure.c @@ -0,0 +1,19 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +/*------------------------------------------------------------------------------ + Copy structure from struct1 to struct2. + + Input: n = sizeof(struct1). + struct1, structure = pointers to structures of same size. + Output: revised contents of struct2. +*/ +void copy_structure(int n, char *struct1, char *struct2) +{ + char *p1, *p2; + int i; + + p1 = (char *) struct1; + p2 = (char *) struct2; + for (i = 0; i < n; i++) *p2++ = *p1++; +} diff --git a/src/ddcount.c b/src/ddcount.c new file mode 100644 index 0000000..f77f935 --- /dev/null +++ b/src/ddcount.c @@ -0,0 +1,448 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#ifdef TIME +#include <time.h> +#endif +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqs:e:u:p:i:"; + +/* allocate polygons as a global array */ +polygon *poly_global[NPOLYSMAX]; + +/* declared in rdmask */ +extern inputfile file; + +/* local functions */ +void usage(void); +#ifdef GCC +long ddcount(char *, char *, char *, format *, int npoly, polygon *[npoly]); +#else +long ddcount(char *, char *, char *, format *, int npoly, polygon *[/*npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly,i; + long np; + polygon **poly; + poly=poly_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* three input and one output filename required as arguments */ + nfiles = argc - optind; + if (nfiles != 4) { + if (optind > 1 || nfiles >= 1) { + fprintf(stderr, "%s requires 4 arguments: polygon_infile, azel_infile, th_infile, and dd_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- ddcount ----------------\n"); + + /* advise data format */ + advise_fmt(&fmt); + + + /* read polygons */ + ifile = optind; + npoly = rdmask(argv[optind], &fmt, NPOLYSMAX, poly); + if (npoly == -1) exit(1); + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* pair counts */ + np = ddcount(argv[optind + 1], argv[optind + 2], argv[optind + 3], &fmt, npoly, poly); + if (np == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(poly[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("ddcount [-d] [-q] [-s<n>] [-e<n>] [-u<inunit>] [-p[+|-][<n>]] [-i<f>[<n>][u]] polygon_infile azel_infile th_infile dd_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Counts of pairs in bins bounded by radii th, centred at az el. + + Anglar positions az, el are read from azel_in_filename, + angular radii th are read from th_in_filename, + or from azel_in_filename if th_in_filename is null, + and the results are written to out_filename. + + Implemented as interpretive read/write, to permit interactive behaviour. + + Input: azel_in_filename = name of file to read az, el from; + "" or "-" means read from standard input. + th_in_filename = name of file to read th from; + "" or "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + npoly = number of polygons in poly array. + poly = array of pointers to polygons. + Return value: number of distinct pairs counted, + or -1 if error occurred. +*/ +long ddcount(char *azel_in_filename, char *th_in_filename, char *out_filename, format *fmt, int npoly, polygon *poly[/*npoly*/]) +{ +#define AZEL_STR_LEN 32 + char input[] = "input", output[] = "output"; + /* maximum number of angular angular radii: will expand as necessary */ + static int nthmax = 0; + /* maximum number of az-el points: will expand as necessary */ + static int nazelmax = 0; + static int *dd = 0x0, *id = 0x0, *iord = 0x0; + static long double *cm = 0x0, *th = 0x0; + static azel *v = 0x0; + static vec *rp = 0x0; + +#ifdef TIME + clock_t time; +#endif + char inunit; + char *word, *next; + char th_str[AZEL_STR_LEN]; + int i, iazel, idi, ird, ith, j, jazel, manyid, nazel, nid, noid, nth; + int *id_p; + long np; + long double az, cmm, el, s, t; + char *out_fn; + FILE *outfile; + + /* open th_in_filename for reading */ + if (strcmp(th_in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(th_in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", th_in_filename); + return(-1); + } + file.name = th_in_filename; + } + file.line_number = 0; + + inunit = (fmt->inunit == 'h')? 'd' : fmt->inunit; + msg("will take units of input th angles in %s to be ", file.name); + switch (inunit) { +#include "angunit.h" + } + msg("\n"); + + /* read angular radii th from th_in_filename */ + nth = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + /* read angular radius from line */ + ird = rdangle(file.line, &next, inunit, &t); + /* error */ + if (ird < 1) { + /* retry if nothing read, otherwise break */ + if (nth > 0) break; + /* ok */ + } else if (ird == 1) { + if (nth >= nthmax) { + if (nthmax == 0) { + nthmax = 64; + } else { + nthmax *= 2; + } + /* (re)allocate memory for th array */ + th = (long double *) realloc(th, sizeof(long double) * nthmax); + if (!th) { + fprintf(stderr, "ddcount: failed to allocate memory for %d long doubles\n", nthmax); + return(-1); + } + } + /* store th */ + th[nth] = t; + nth++; + } + } + + if (file.file != stdin) { + /* close th_in_filename */ + fclose(file.file); + /* advise */ + msg("%d angular radii read from %s\n", nth, file.name); + } + + if (nth == 0) return(nth); + + /* open azel_in_filename for reading */ + if (!azel_in_filename || strcmp(azel_in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(azel_in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", azel_in_filename); + return(-1); + } + file.name = azel_in_filename; + } + file.line_number = 0; + + /* advise input angular units */ + msg("will take units of input az, el angles in %s to be ", file.name); + switch (fmt->inunit) { +#include "angunit.h" + } + msg("\n"); + + /* read angular positions az, el from azel_in_filename */ + nazel = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + + /* read <az> */ + word = file.line; + ird = rdangle(word, &next, fmt->inunit, &az); + /* skip header */ + if (ird != 1 && nazel == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* read <el> */ + word = next; + ird = rdangle(word, &next, fmt->inunit, &el); + /* skip header */ + if (ird != 1 && nazel == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* (re)allocate memory for array of az-el points */ + if (nazel >= nazelmax) { + if (nazelmax == 0) { + nazelmax = 64; + } else { + nazelmax *= 2; + } + v = (azel *) realloc(v, sizeof(azel) * nazelmax); + if (!v) { + fprintf(stderr, "ddcount: failed to allocate memory for %d az-el points\n", nazelmax); + return(-1); + } + } + + /* record az-el */ + v[nazel].az = az; + v[nazel].el = el; + + /* increment number of az-el points */ + nazel++; + } + + if (file.file != stdin) { + /* close azel_in_filename */ + fclose(file.file); + /* advise */ + msg("%d angular positions az, el read from %s\n", nazel, file.name); + } + + if (nazel == 0) return(nazel); + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "cannot open %s for writing\n", out_filename); + return(-1); + } + out_fn = out_filename; + } + + /* (re)allocate memory */ + cm = (long double *) realloc(dd, sizeof(long double) * nth); + if (!cm) { + fprintf(stderr, "ddcount: failed to allocate memory for %d long doubles\n", nth); + return(-1); + } + dd = (int *) realloc(dd, sizeof(int) * nth); + if (!dd) { + fprintf(stderr, "ddcount: failed to allocate memory for %d ints\n", nth); + return(-1); + } + id = (int *) realloc(id, sizeof(int) * nazel); + if (!id) { + fprintf(stderr, "ddcount: failed to allocate memory for %d ints\n", nazel); + return(-1); + } + rp = (vec *) realloc(rp, sizeof(vec) * nazel); + if (!rp) { + fprintf(stderr, "ddcount: failed to allocate memory for %d unit vectors\n", nazel); + return(-1); + } + iord = (int *) realloc(iord, sizeof(int) * nazel); + if (!iord) { + fprintf(stderr, "ddcount: failed to allocate memory for %d ints\n", nazel); + return(-1); + } + + /* store 1 - cosl(th) in cm array */ + for (ith = 0; ith < nth; ith++) { + t = th[ith]; + scale(&t, inunit, 'r'); + s = sinl(t / 2.); + cm[ith] = 2. * s * s; + } + + /* convert az-el angles to radians */ + for (iazel = 0; iazel < nazel; iazel++) { + scale_azel(&v[iazel], fmt->inunit, 'r'); + } + + /* convert az-el points to unit vectors */ + for (iazel = 0; iazel < nazel; iazel++) { + azel_to_rp(&v[iazel], rp[iazel]); + } + + /* polygon id number(s) of az-el points */ + msg("figuring polygon id number(s) of each az-el point ..."); + noid = 0; + manyid = 0; + for (iazel = 0; iazel < nazel; iazel++) { + nid = poly_id(npoly, poly, v[iazel].az, v[iazel].el, &id_p); + if (nid == 0) { + noid++; + } else if (nid > 1) { + manyid++; + } + /* store first polygon id of point */ + if (nid == 0) { + id[iazel] = -1; + } else { + id[iazel] = id_p[0]; + } + } + msg(" done\n"); + if (noid > 0) { + msg("%d az-el points lie outside the angular mask: discard them\n", noid); + } + if (manyid > 0) { + msg("%d az-el points lie inside more than one polygon: use only first polygon\n", manyid); + } + + /* order az-el points in increasing order of polygon id */ + finibot(id, nazel, iord, nazel); + + /* write header */ + fprintf(outfile, "th(%c):", inunit); + for (ith = 0; ith < nth; ith++) { + wrangle(th[ith], inunit, fmt->outprecision, AZEL_STR_LEN, th_str); + fprintf(outfile, "\t%s", th_str); + } + fprintf(outfile, "\n"); + + msg("counting pairs ..."); + +#ifdef TIME + printf(" timing ... "); + fflush(stdout); + time = clock(); +#endif + + /* loop over az-el points */ + idi = -1; + nid = 0; + np = 0; + for (iazel = 0; iazel < nazel; iazel++) { + i = iord[iazel]; + /* skip points outside mask */ + if (id[i] == -1) continue; + /* new polygon */ + if (id[i] != idi) { + idi = id[i]; + /* reset pair counts to zero */ + for (ith = 0; ith < nth; ith++) dd[ith] = 0; + } +//printf(" %d", idi); + /* az-el neighbours within same polygon */ + for (jazel = iazel + 1; jazel < nazel; jazel++) { + j = iord[jazel]; + /* exit at new polygon */ + if (id[j] != idi) break; + /* 1 - cosl(th_ij) */ + cmm = cmij(rp[i], rp[j]); + /* ith such that cm[ith-1] <= cmm < cm[ith] */ + ith = search(nth, cm, cmm); + /* increment count in this bin */ + if (ith < nth) dd[ith]++; + /* increment total pair count */ + np++; + } + /* write counts for this polygon */ + if (iazel + 1 == nazel || id[iord[iazel + 1]] != idi) { + fprintf(outfile, "%d", idi); + for (ith = 0; ith < nth; ith++) { + fprintf(outfile, "\t%d", dd[ith]); + } + fprintf(outfile, "\n"); + fflush(outfile); + nid++; +//printf("\n"); + } + } + +#ifdef TIME + time = clock() - time; + printf("done in %Lg sec\n", (float)time / (float)CLOCKS_PER_SEC); +#else + msg("\n"); +#endif + + /* advise */ + if (outfile != stdout) { + fclose(outfile); + msg("%d distinct pairs in %d th-bins x %d polygons written to %s\n", np, nth, nid, out_fn); + } + + return(np); +} diff --git a/src/defaults.h b/src/defaults.h new file mode 100644 index 0000000..2d063ef --- /dev/null +++ b/src/defaults.h @@ -0,0 +1,184 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "defines.h" + +/* LOCAL VARIABLES */ + +/* maximum harmonic */ +static int lmax = LMAX; +/* smoothing parameters */ +static long double lsmooth = LSMOOTH, esmooth = ESMOOTH; + +/* name of file containing harmonics */ +static char *Wlm_filename = 0x0; + +/* name of survey */ +static char *survey = 0x0; + +/* option in -f<fopt> command line switch */ +static char *fopt = 0x0; + +/* seed for random number generator */ +static unsigned int seed = SEED; +/* whether seed was read */ +static int seed_read = 0; + +/* number of random points to generate */ +static int nrandom = NRANDOM; + +/* write only summary to output */ +static int summary = 0; + +/* selfsnap = 0 snaps edges of polygons against edges of all other polygons; + selfsnap = 1 snaps edges of polygons only against edges of the same polygon */ +static int selfsnap = 0; + +/* data format */ +static format fmt = { + 0x0, /* keyword defining the input data format */ + 0x0, /* default format of the output data */ + SKIP, /* skip first skip characters of each line of data */ + END, /* last character to read from line of data */ + 0, /* keyword does not define precisely one polygon */ + 0, /* the number of thingys defined by keyword */ + 0, /* the number of numbers per thingy */ + NVE, /* the input number of points per edge */ + 0, /* controls interpetation of nve */ + NVE, /* the output number of points per edge */ + 0, /* id number of current polygon */ + 'o', /* whether to use old or new id number */ + 0, /* default pixel number */ + 1., /* weight of current polygon */ + INUNITP, /* default unit of angles in input polygon data */ + OUTUNITP, /* default unit of angles in output polygon data */ + 0, /* angular frame of input az, el data */ + 0, /* angular frame of output az, el data */ + INUNIT, /* default unit of input az, el data */ + OUTUNIT, /* default unit of output az, el data */ + -1, /* digits after decimal point in output angles (-1 = automatic) */ + OUTPHASE, /* '-' or '+' to make output azimuth in interval (-pi, pi] or [0, 2 pi) */ + AZN, /* default */ + ELN, /* transformation */ + AZP, /* between angular frames */ + TRUNIT, /* unit of transformation angles */ + 0, /* default number of weights in healpix_weight input file */ + 0, -1 /* by default, healpix weights are not autogenerated. */ +}; + +/* GLOBAL VARIABLES */ + +/* default is to be verbose */ +#ifdef DEBUG +int verbose = 2; +#else +int verbose = 1; +#endif + +/* counter for input files read */ +int infiles = 0; + +/* tolerances */ +long double axtol = AXTOL; /* snap angle for axis */ +char axunit = AXUNIT; /* unit of snap angle for axis */ +long double btol = BTOL; /* snap angle for latitude */ +char bunit = BUNIT; /* unit of snap angle for latitude */ +long double thtol = THTOL; /* snap angle for edge */ +char thunit = THUNIT; /* unit of snap angle for edge */ +long double ytol = YTOL; /* edge to length tolerance */ +long double mtol = MTOL; /* tolerance angle for multiple intersections */ +char munit = MUNIT; /* unit of tolerance angle for multiple intersections */ + +/* whether min, max weight are turned on */ +int is_weight_min = 0; +int is_weight_max = 0; +/* min, max weight to keep */ +long double weight_min; +long double weight_max; + +/* whether min, max area are turned on */ +int is_area_min = 0; +int is_area_max = 0; +/* min, max area to keep */ +long double area_min; +long double area_max; + +/* whether min, max id are turned on */ +int is_id_min = 0; +int is_id_max = 0; +/* min, max id to keep */ +int id_min; +int id_max; + +/* whether min, max pixel are turned on */ +int is_pixel_min = 0; +int is_pixel_max = 0; +/* min, max pixel to keep */ +int pixel_min; +int pixel_max; + +/* whether to take intersection of polygons in input files */ +int intersect = 0; + +/* dictionary of keywords */ +/* THE NAMES OF FORMATS MUST AGREE WITH THE INDICES IN defines.h */ +char *keywords[] = { + "area", + "circle", + "edges", + "graphics", + "healpix_weight", + "id", + "midpoint", + "polygon", + "rectangle", + "Region", + "spolygon", + "vertices", + "weight", + "list", + "pixelization", + "skip", + "end", + "unit", + "balkanized", + "snapped", + "binary_polygon", + '\0' +}; + +/* dictionary of frames */ +/* THE ORDER OF FRAMES MUST AGREE WITH THAT IN frames.par ! */ +char *frames[] = { + "unknown", + "eqB1950", + "eqJ2000", + "galactic", + "ecliptic", + "ecliptic2k", + "sdss", + '\0' +}; + +/*pixelization info*/ +int res_max=RES_MAX; /*maximum resolution allowed for pixelization*/ +int polys_per_pixel=POLYS_PER_PIXEL; /*level of pixelization: number of polygons allowed per pixel*/ + /*set polys_per_pixel=0 to pixelize everything to max resolution*/ +char scheme=SCHEME; /*default pixelization scheme*/ +int unpixelize=0; /*switch for whether unify should unpixelize or not*/ +int pixelized=0; /*counter for pixelized input files */ + +int snapped=0; /*flag for whether files have been snapped */ +int balkanized=0; /*flag for whether files have been balkanized */ + +/*balkanization method*/ +char bmethod=BMETHOD; +//Default is for a balkanized polygon to inherit the weight of +//the last overlapping polygon in the input polygons. other options +//are to add them together (bmethod=a), or to take the minimum +//(bmethod=n) or the maximum (bmethod=x) of the weights + +int polyid_weight=0; /*0= polyid prints id numbers, 1= polyid prints weights*/ +int weight_is_area=0; + +int machine_output=0; diff --git a/src/defines.h b/src/defines.h new file mode 100644 index 0000000..f3471e7 --- /dev/null +++ b/src/defines.h @@ -0,0 +1,118 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef DEFINES_H +#define DEFINES_H + +#define MAXINT (((unsigned int)-1) / 2) + +/* maximum number of polygons */ +/* + This is the only hard limit built into mangle. + It's supposed to be a feature, not a bug. + If you are making zillions of polygons, chances are it's a silly mistake. +*/ + +#define NPOLYSMAX 90000000 + + +/* number of extra caps to allocate to polygon, to allow for later splitting */ +#define DNP 4 + +#include "pi.h" +#define TWOPI (2. * PI) +#define PIBYTWO (PI / 2.) + +/* list of possible units */ +#define UNITS "rdmsh" +/* #define UNITS "rd°m'´s\"¨h" */ + +/* angular units in arcseconds */ +#define RADIAN (648000. / PI) +#define HOUR 54000. +#define DEGREE 3600. +#define MINUTE 60. +#define SECOND 1. + +/* default maximum harmonic */ +#define LMAX 0 +/* default smoothing harmonic (0. = no smooth) */ +#define LSMOOTH 0. +/* default smoothing exponent (2. = gaussian) */ +#define ESMOOTH 2. +/* default snap angles for axis, latitude, and edge */ +#define AXTOL 2.0e-9 +#define BTOL 2.0e-9 +#define THTOL 2.0e-9 +/* default value of ytol */ +#define YTOL .01 +/* default snap angle for multiple intersections */ +#define MTOL 1.0e-11 +/* default input units of snap angles */ +#define AXUNIT 's' +#define BUNIT 's' +#define THUNIT 's' +#define MUNIT 's' +/* default seed for random number generator */ +#define SEED 1 +/* default number of random points to generate */ +#define NRANDOM 1 +/* default number of points per edge */ +#define NVE 2 +/* default input unit of polygon data is degrees */ +#define INUNITP 'd' +/* default output unit of polygon data is degrees */ +#define OUTUNITP 'd' +/* default input unit of az, el data is degrees */ +#define INUNIT 'd' +/* default output unit of az, el data is degrees */ +#define OUTUNIT 'd' +/* default output phase: '-' or '+' to make output azimuth in interval (-pi, pi] or [0, 2 pi) */ +#define OUTPHASE '+' +/* identity transformation between angular frames */ +#define AZN 0. +#define ELN 90. +#define AZP 180. +/* unit of transformation between angular frames + must be 'd', since degrees is hard-wired into transformation routines */ +#define TRUNIT 'd' +/* default number of characters of line of input data to skip */ +#define SKIP 0 +/* default last character to read from line of input data */ +#define END 0 + +/* list of possible input formats */ +#define RFMTS "cehprRsv" +/* list of possible output formats */ +#define WFMTS "acegimprRsvwl" + +/* possible polygon file formats */ +#define AREA 0 +#define CIRCLE 1 +#define EDGES 2 +#define GRAPHICS 3 +#define HEALPIX_WEIGHT 4 +#define ID 5 +#define MIDPOINT 6 +#define POLYGON 7 +#define RECTANGLE 8 +#define REGION 9 +#define SPOLYGON 10 +#define VERTICES 11 +#define WEIGHT 12 +#define LIST 13 +#define BINARY_POLYGON 20 + +/*list of allowed pixelization schemes*/ +#define SCHEMES "sd" +/*pixelization defaults*/ +#define SCHEME 's' +#define POLYS_PER_PIXEL 40 +#define RES_MAX 10 + +/*list of balkanize methods */ +#define BMETHODS "lanx" /*last, add, min, max */ +/*default balkanize method */ +#define BMETHOD 'l' + +#endif /* DEFINES_H */ diff --git a/src/drandom.c b/src/drandom.c new file mode 100644 index 0000000..79ded6d --- /dev/null +++ b/src/drandom.c @@ -0,0 +1,12 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> + +/*------------------------------------------------------------------------------ + Random long double in interval [0., 1.) +*/ +long double drandom(void) +{ + return((long double)random() / ((long double)RAND_MAX + 1.)); +} diff --git a/src/drangle.c b/src/drangle.c new file mode 100644 index 0000000..08d617e --- /dev/null +++ b/src/drangle.c @@ -0,0 +1,538 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#ifdef TIME +#include <time.h> +#endif +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" + +/* redefine default angular unit for output DR angles to radians */ +#undef OUTUNIT +#define OUTUNIT 'r' + +/* getopt options */ +const char *optstr = "dqm:hs:e:u:p:i:"; + +/* allocate polygons as a global array */ +polygon *poly_global[NPOLYSMAX]; + +/* declared in rdmask */ +extern inputfile file; + +/* local functions */ +void usage(void); +#ifdef GCC +int drangle(char *, char *, char *, format *, int npoly, polygon *[npoly]); +#else +int drangle(char *, char *, char *, format *, int npoly, polygon *[/*npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + char *th_in_filename; + int nfiles, np, npoly,i; + polygon **poly; + poly=poly_global; + + /* set angular unit for output DR angles to default */ + fmt.outunit = OUTUNIT; + + /* parse arguments */ + parse_args(argc, argv); + + /* two or three input and one output filename required as arguments */ + nfiles = argc - optind; + if (!(nfiles == 3 || nfiles == 4)) { + if (optind > 1 || nfiles >= 1) { + fprintf(stderr, "%s requires 3 arguments: polygon_infile, azel+th_infile, and dr_outfile\n", argv[0]); + fprintf(stderr, "%*s or 4 arguments: polygon_infile, azel_infile, th_infile, and dr_outfile\n", (int)strlen(argv[0]), " "); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + /* summary option only possible with 3 input and 1 output files */ + if (summary && nfiles != 4) { + fprintf(stderr, "%s with summary option -h requires 3 input files and 1 output file:\n", argv[0]); + fprintf(stderr, "%*s polygon_infile azel_infile th_infile dr_outfile\n", (int)strlen(argv[0]), " "); + usage(); + exit(1); + } + + msg("---------------- drangle ----------------\n"); + + /* advise data format */ + advise_fmt(&fmt); + + + /* read polygons */ + npoly = rdmask(argv[optind], &fmt, NPOLYSMAX, poly); + if (npoly == -1) exit(1); + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + if (snapped==0 || balkanized==0) { + fprintf(stderr, "Error: input polygons must be snapped and balkanized before using drangle.\n"); + fprintf(stderr, "If your polygons are already snapped and balkanized, add the 'snapped' and\n'balkanized' keywords at the beginning of each of your input polygon files.\n"); + exit(1); + } + + /* name of file containing angular radii th, if present */ + th_in_filename = (nfiles == 3)? 0x0 : argv[optind + 2]; + + /* angles */ + np = drangle(argv[optind + 1], th_in_filename, argv[argc - 1], &fmt, npoly, poly); + if (np == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(poly[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("drangle [-d] [-q] [-h] [-m<a>[u]] [-s<n>] [-e<n>] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] [-i<f>[<n>][u]] polygon_infile azel[th]_infile [th_infile] dr_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Angles within mask along circles centred at az el, radii th. + + Anglar positions az, el are read from azel_in_filename, + angular radii th are read from th_in_filename, + or from azel_in_filename if th_in_filename is null, + and the results are written to out_filename. + + Implemented as interpretive read/write, to permit interactive behaviour. + + Input: azel_in_filename = name of file to read az, el from; + "" or "-" means read from standard input. + th_in_filename = name of file to read th from; + null means read from azel_in_filename; + "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + npoly = number of polygons in poly array. + poly = array of pointers to polygons. + Return value: number of lines written, + or -1 if error occurred. +*/ +int drangle(char *azel_in_filename, char *th_in_filename, char *out_filename, format *fmt, int npoly, polygon *poly[/*npoly*/]) +{ +#define AZEL_STR_LEN 32 + char input[] = "input", output[] = "output"; + /* maximum number of angular angular radii: will expand as necessary */ + static int nthmax = 0; + static int ndrmax = 0; + static long double *th = 0x0, *cm = 0x0, *drsum = 0x0; + static long double *dr = 0x0; + +#ifdef TIME + clock_t time; +#endif + char inunit, outunit; + char *word, *next; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN], th_str[AZEL_STR_LEN], dr_str[AZEL_STR_LEN]; + int ier, ird, ith, len, lenth, np, nt, nth; + long double rp[3], s, t; + azel v; + char *out_fn; + FILE *outfile; + + inunit = (fmt->inunit == 'h')? 'd' : fmt->inunit; + + /* read angular radii from th_in_filename */ + if (th_in_filename) { + + /* open th_in_filename for reading */ + if (strcmp(th_in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(th_in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", th_in_filename); + return(-1); + } + file.name = th_in_filename; + } + file.line_number = 0; + + msg("will take units of input th angles in %s to be ", file.name); + switch (inunit) { +#include "angunit.h" + } + msg("\n"); + + /* read angular radii from th_in_filename */ + nth = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + /* read angular radius from line */ + ird = rdangle(file.line, &next, inunit, &t); + /* error */ + if (ird < 1) { + /* retry if nothing read, otherwise break */ + if (nth > 0) break; + /* ok */ + } else if (ird == 1) { + if (nth >= nthmax) { + if (nthmax == 0) { + nthmax = 64; + } else { + nthmax *= 2; + } + /* (re)allocate memory for th array */ + th = (long double *) realloc(th, sizeof(long double) * nthmax); + if (!th) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nthmax); + return(-1); + } + } + /* copy angular radius into th array */ + th[nth] = t; + nth++; + } + } + + if (file.file != stdin) { + /* close th_in_filename */ + fclose(file.file); + /* advise */ + msg("%d angular radii read from %s\n", nth, file.name); + } + + if (nth == 0) return(nth); + + /* (re)allocate memory for th array */ + th = (long double *) realloc(th, sizeof(long double) * nth); + if (!th) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nth); + return(-1); + } + /* (re)allocate memory for cm array */ + cm = (long double *) realloc(cm, sizeof(long double) * nth); + if (!cm) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nth); + return(-1); + } + /* (re)allocate memory for drsum array */ + drsum = (long double *) realloc(drsum, sizeof(long double) * nth); + if (!drsum) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nth); + return(-1); + } + nthmax = nth; + } + + /* open azel_in_filename for reading */ + if (!azel_in_filename || strcmp(azel_in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(azel_in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", azel_in_filename); + return(-1); + } + file.name = azel_in_filename; + } + file.line_number = 0; + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "cannot open %s for writing\n", out_filename); + return(-1); + } + out_fn = out_filename; + } + + /* advise input angular units */ + if (th_in_filename) { + msg("will take units of input az, el angles in %s to be ", file.name); + } else { + msg("will take units of input az, el, and th angles in %s to be ", file.name); + } + switch (fmt->inunit) { +#include "angunit.h" + } + if (!th_in_filename && fmt->inunit == 'h') { + msg(", th in deg"); + } + msg("\n"); + + /* advise output angular unit */ + outunit = (fmt->outunit == 'h')? 'd' : fmt->outunit; + msg("units of output DR angles will be "); + switch (outunit) { +#include "angunit.h" + } + msg("\n"); + +#ifdef TIME + printf("timing ... "); + fflush(stdout); + time = clock(); +#endif + + /* length of az, el and th, dr strings to be written to output */ + t = 0.; + wrangle(t, fmt->inunit, fmt->outprecision, AZEL_STR_LEN, az_str); + len = strlen(az_str); + t = 0.; + wrangle(t, inunit, fmt->outprecision, AZEL_STR_LEN, th_str); + lenth = strlen(th_str); + + /* write header */ + if (!summary) { + if (fmt->inunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + sprintf(th_str, "th(d):"); + } else { + sprintf(az_str, "az(%c)", fmt->inunit); + sprintf(el_str, "el(%c)", fmt->inunit); + sprintf(th_str, "th(%c):", fmt->inunit); + } + if (th_in_filename) { + fprintf(outfile, "%*s %*s %*s\n", len, " ", len, " ", lenth, th_str); + } + fprintf(outfile, "%*s %*s", len, az_str, len, el_str); + if (th_in_filename) { + for (ith = 0; ith < nth; ith++) { + wrangle(th[ith], inunit, fmt->outprecision, AZEL_STR_LEN, th_str); + fprintf(outfile, " %s", th_str); + } + fprintf(outfile, "\n"); + } else { + fprintf(outfile, " %*s\n", lenth, th_str); + } + } + + /* initialize th and drsum */ + if (th_in_filename) { + /* convert th from input units to radians */ + for (ith = 0; ith < nth; ith++) { + scale(&th[ith], inunit, 'r'); + } + + /* initialize sum of dr to zero */ + for (ith = 0; ith < nth; ith++) { + drsum[ith] = 0.; + } + } + + /* interpretive read/write loop */ + np = 0; + nt = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + + /* read <az> */ + word = file.line; + ird = rdangle(word, &next, fmt->inunit, &v.az); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* read <el> */ + word = next; + ird = rdangle(word, &next, fmt->inunit, &v.el); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* convert az and el from input units to radians */ + scale_azel(&v, fmt->inunit, 'r'); + + /* read th */ + if (!th_in_filename) { + nth = 0; + while (1) { + word = next; + ird = rdangle(word, &next, inunit, &t); + /* done */ + if (ird < 1) break; + /* ok */ + if (nth >= nthmax) { + if (nthmax == 0) { + nthmax = 64; + } else { + nthmax *= 2; + } + th = (long double *) realloc(th, sizeof(long double) * nthmax); + if (!th) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nthmax); + return(-1); + } + /* (re)allocate memory for cm array */ + cm = (long double *) realloc(cm, sizeof(long double) * nthmax); + if (!cm) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", nthmax); + return(-1); + } + } + th[nth] = t; + /* increment count of angular radii */ + nth++; + } + /* convert th from input units to radians */ + for (ith = 0; ith < nth; ith++) { + scale(&th[nth], inunit, 'r'); + } + } + + /* allocate memory for dr */ + if (nth > ndrmax) { + ndrmax = nth; + dr = (long double *) realloc(dr, sizeof(long double) * ndrmax); + if (!dr) { + fprintf(stderr, "drangle: failed to allocate memory for %d long doubles\n", ndrmax); + return(-1); + } + } + + /* unit vector corresponding to angular position az, el */ + azel_to_rp(&v, rp); + + /* limiting cm = 1-cosl(th) values to each polygon */ + ier = cmlim_polys(npoly, poly, mtol, rp); + if (ier == -1) return(-1); + + /* cm = 1 - cosl(th) */ + for (ith = 0; ith < nth; ith++) { + s = sinl(th[ith] / 2.); + cm[ith] = 2. * s * s; + } + + /* angles about rp direction at radii th */ + ier = drangle_polys(npoly, poly, mtol, rp, nth, cm, dr); + if (ier == -1) return(-1); + + /* sum of dr at radii th */ + if (th_in_filename) { + for (ith = 0; ith < nth; ith++) { + drsum[ith] += dr[ith]; + } + } + + /* convert az and el from radians to original input units */ + scale_azel(&v, 'r', fmt->inunit); + + /* write result */ + if (!summary) { + wrangle(v.az, fmt->inunit, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->inunit, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(outfile, "%s %s", az_str, el_str); + for (ith = 0; ith < nth; ith++) { + scale(&dr[ith], 'r', outunit); + wrangle(dr[ith], outunit, fmt->outprecision, AZEL_STR_LEN, dr_str); + fprintf(outfile, " %s", dr_str); + } + fprintf(outfile, "\n"); + fflush(outfile); + } + + /* increment counters of results */ + np++; + nt += nth; + + /* warn about a potentially huge output file */ + if (np == 100 && !summary && th_in_filename && outfile != stdout) { + msg("hmm, looks like %s could grow pretty large ...\n", out_fn); + msg("try using the -h switch if you only want a summary in the output file\n"); + } + } + + /* write sum of dr */ + if (summary) { + sprintf(th_str, "th(%c)", inunit); + sprintf(dr_str, "DR(%c)", outunit); + fprintf(outfile, "%*s %*s\n", lenth, th_str, lenth, dr_str); + for (ith = 0; ith < nth; ith++) { + scale(&th[ith], 'r', inunit); + wrangle(th[ith], inunit, fmt->outprecision, AZEL_STR_LEN, th_str); + scale(&drsum[ith], 'r', outunit); + wrangle(drsum[ith] / (long double)np, outunit, fmt->outprecision, AZEL_STR_LEN, dr_str); + fprintf(outfile, "%s %s\n", th_str, dr_str); + } + fflush(outfile); + } else if (th_in_filename) { + fprintf(outfile, "%*s", 2 * len + 1, "Average:"); + for (ith = 0; ith < nth; ith++) { + scale(&drsum[ith], 'r', outunit); + wrangle(drsum[ith] / (long double)np, outunit, fmt->outprecision, AZEL_STR_LEN, dr_str); + fprintf(outfile, " %s", dr_str); + } + fprintf(outfile, "\n"); + fflush(outfile); + } + + /* close azel_in_filename */ + if (file.file != stdin) { + fclose(file.file); + } + +#ifdef TIME + time = clock() - time; + printf("done in %Lg sec\n", (float)time / (float)CLOCKS_PER_SEC); +#endif + + /* advise */ + if (outfile != stdout) { + fclose(outfile); + if (summary) { + msg("drangle: header + %d lines written to %s\n", nth, out_fn); + } else { + if (th_in_filename) { + msg("drangle: %d x %d = ", nth, np); + } else { + msg("drangle: total of "); + } + msg("%d angles at %d positions written to %s\n", nt, np, out_fn); + } + } + + return(nt); +} diff --git a/src/drangle_polys.c b/src/drangle_polys.c new file mode 100644 index 0000000..92f9660 --- /dev/null +++ b/src/drangle_polys.c @@ -0,0 +1,131 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" +#include "pi.h" + +#define TWOPI (2. * PI) + +static int *iord = 0x0; +static long double *cmmin = 0x0, *cmmax = 0x0; + +/*------------------------------------------------------------------------------ + Minimum and maximum values of cm = 1-cosl(th) between each of npoly polygons + and a unit vector rp. + + Input: poly = array of pointers to npoly polygons. + npoly = number of polygons in poly array. + mtol = initial angular tolerance in radians within which to merge multiple intersections. + rp = unit vector. + Return value: number of polygons done; + -1 if error. +*/ +int cmlim_polys(int npoly, polygon *poly[/*npoly*/], long double mtol, long double rp[3]) +{ + int ier, ipoly; + long double tol; + + /* allocate memory for cmmin, cmmax, iord */ + if (!cmmin) { + cmmin = (long double *) malloc(sizeof(long double) * npoly); + } else { + cmmin = (long double *) realloc(cmmin, sizeof(long double) * npoly); + } + if (!cmmin) { + fprintf(stderr, "cmlim_polys: failed to allocate memory for %d long doubles\n", npoly); + return(-1); + } + if (!cmmax) { + cmmax = (long double *) malloc(sizeof(long double) * npoly); + } else { + cmmax = (long double *) realloc(cmmax, sizeof(long double) * npoly); + } + if (!cmmax) { + fprintf(stderr, "cmlim_polys: failed to allocate memory for %d long doubles\n", npoly); + return(-1); + } + if (!iord) { + iord = (int *) malloc(sizeof(int) * npoly); + } else { + iord = (int *) realloc(iord, sizeof(int) * npoly); + } + if (!iord) { + fprintf(stderr, "cmlim_polys: failed to allocate memory for %d ints\n", npoly); + return(-1); + } + + /* min, max distances between rp and each polygon */ + for (ipoly = 0; ipoly < npoly; ipoly++) { + if (poly[ipoly]->weight == 0.) continue; + tol = mtol; + ier = gcmlim(poly[ipoly], &tol, rp, &cmmin[ipoly], &cmmax[ipoly]); + if (ier) return(-1); + } + + /* order polygons in increasing order of cmmin */ + findbot(cmmin, npoly, iord, npoly); + + /* number of polygons done */ + return(npoly); +} + +/*------------------------------------------------------------------------------ + Angles within mask along circle centred in unit direction rp, with radii th. + + Input: poly = array of pointers to npoly polygons. + npoly = number of polygons in poly array. + mtol = initial angular tolerance in radians within which to merge multiple intersections. + rp = unit vector. + nth = number of angular radii. + cm = array of 1-cosl(angular radii). + Output: dr = array containing angles in radians. + Return value: number of angular radii done; + -1 if error. +*/ +int drangle_polys(int npoly, polygon *poly[/*npoly*/], long double mtol, long double rp[3], int nth, long double cm[/*nth*/], long double dr[/*nth*/]) +{ + int ier, ip, ipoly, ith; + long double angle, tol; + + /* angle within mask at each angular radius */ + for (ith = 0; ith < nth; ith++) { + /* accumulate angle within each polygon */ + dr[ith] = 0.; + for (ip = 0; ip < npoly; ip++) { + ipoly = iord[ip]; + /* zero weight polygon contributes nothing */ + if (poly[ipoly]->weight == 0.) continue; + if (cm[ith] <= fabsl(cmmin[ipoly])) { + /* polygon encloses circle */ + if (cmmin[ipoly] < 0.) { + angle = TWOPI; + /* polygon excludes circle */ + } else if (cmmin[ipoly] >= 0.) { + angle = 0.; + /* done, given that cmmin are in increasing order */ + break; + } + } else if (cm[ith] >= fabsl(cmmax[ipoly])) { + /* circle and polygon enclose each other */ + if (cmmax[ipoly] < 0.) { + angle = TWOPI; + /* circle encloses polygon */ + } else if (cmmax[ipoly] >= 0.) { + angle = 0.; + } + } else { + /* circle intersects boundary of region */ + tol = mtol; + ier = gphi(poly[ipoly], &tol, rp, cm[ith], &angle); + if (ier) return(-1); + } + dr[ith] += poly[ipoly]->weight * angle; + } + } + + /* number of angular radii done */ + return(nth); +} diff --git a/src/dranglepolys_.c b/src/dranglepolys_.c new file mode 100644 index 0000000..d69ecbe --- /dev/null +++ b/src/dranglepolys_.c @@ -0,0 +1,39 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include "manglefn.h" + +/* polygons declared in rdmask_() */ +extern int npolys; +extern polygon *polys[]; + +/*------------------------------------------------------------------------------ + Simplified fortran interface to cmlim_polys routine. + real*8 mtol + real*8 rp(3) + call cmlimpolys(mtol, rp) +*/ +void cmlimpolys_(long double *mtol, vec rp) +{ + int ndone; + + ndone = cmlim_polys(npolys, polys, *mtol, rp); + if (ndone == -1) exit(1); +} + +/*------------------------------------------------------------------------------ + Simplified fortran interface to drangle_polys routine. + real*8 mtol + real*8 rp(3) + integer nth + real*8 cm(nth),dr(nth) + call dranglepolys(mtol, rp, nth, cm, dr) +*/ +void dranglepolys_(long double *mtol, vec rp, int *nth, long double cm[/**nth*/], long double dr[/**nth*/]) +{ + int ndone; + + ndone = drangle_polys(npolys, polys, *mtol, rp, *nth, cm, dr); + if (ndone == -1) exit(1); +} diff --git a/src/dump_poly.c b/src/dump_poly.c new file mode 100644 index 0000000..292ba77 --- /dev/null +++ b/src/dump_poly.c @@ -0,0 +1,14 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Dump polygon. +*/ +void dump_poly(int npoly, polygon *poly[/*npoly*/]) +{ + char outfile[] = "jpoly"; + + wrmask(outfile, 0x0, npoly, poly); +} diff --git a/src/felp.s.f b/src/felp.s.f new file mode 100644 index 0000000..9057276 --- /dev/null +++ b/src/felp.s.f @@ -0,0 +1,21 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + real*10 function felp(epoch) + real*10 epoch +c +c parameters + include 'frames.par' +c local (automatic) variables + real*10 t +c * +c * Ecliptic latitude of NCP = Dec of ecliptic NP +c * as a function of epoch (e.g. 1950, 2000). +c * +c RA & Dec epoch in centuries since 1900 + t=(epoch-1900._10)/100._10 +c ecliptic latitude of NCP = Dec of ecliptic NP + felp=90._10-(E1+t*(E2+t*(E3+t*E4))) + return + end +c diff --git a/src/fframe.s.f b/src/fframe.s.f new file mode 100644 index 0000000..260289a --- /dev/null +++ b/src/fframe.s.f @@ -0,0 +1,185 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine fframe(framei,azi,eli,framef,azf,elf) + integer framei,framef + real*10 azi,eli,azf,elf +c +c parameters + real*10 BEPOCH,JEPOCH + parameter (BEPOCH=1950._10,JEPOCH=2000._10) + include 'frames.par' + include 'radian.par' +c externals + real*10 felp,SLA_epj2d +c data variables + logical init +c saved local variables + real*10 azg,elg,elp,l2z + save azg,elg,elp,l2z +c local (automatic) variables + integer iaz + real*10 date,dd,dec2k,dr,ra2k +c * +c * Transform azimuth (phi) and elevation (90-theta) in degrees +c * from one frame to another frame. +c * +c * Subroutines beginning SLA_ are from the STARLINK SLA library. +c * Please respect their copyright. +c * +c * WARNING: +c * The 2000 transformations are done consistently with the SLA +c * library, while the 1950 transformations are done consistently +c * using the transformations actually used by the catalogue makers +c * (notably, IRAS mask is in 1950 ecliptic coordinates). +c * The 1950 and 2000 transformations do not commute exactly, +c * but the residuals are < 1 arcsec. +c * +c * WARNING: +c * The SDSS eta, lambda system is unconventional +c * (latitude <-> longitude, and longitude goes backwards). +c * This subroutine returns conventional quantities +c * azimuth = -eta +c * elevation = lambda. +c * +c Input: framei = initial frame, as defined in frames.par . +c azi = azimuth (longitude) in degrees wrt framei . +c eli = elevation (latitude) in degrees wrt framei . +c Output: framef = final frame, as defined in frames.par . +c azf = azimuth (longitude) in degrees wrt framef +c in interval [0,360). +c elf = elevation (latitude) in degrees wrt framef +c in interval [-90,90]. +c + data init /.true./ +c +c--------initialize + if (init) then +c ecliptic latitude of North Celestial Pole (1950 FK4) + elp=felp(BEPOCH) +c angles to transform between ecliptic and galactic coordinates + call azell(RAG,DECG,L2P,RAEZ,elp,EAZP,azg,elg,l2z) + init=.false. + endif + +c--------initial and final frames identical + if (framei.eq.framef) then + azf=azi + elf=eli + +c--------1950 frames -> + elseif (framei.eq.EQUATORIAL.or.framei.eq.ECLIPTIC) then +c........RA & Dec B1950.0 FK4 -> + if (framei.eq.EQUATORIAL) then + if (framef.eq.ECLIPTIC) then + call azel(azi,eli,RAEZ,elp,EAZP,azf,elf) + elseif (framef.eq.GALACTIC) then + call azel(azi,eli,RAG,DECG,L2P,azf,elf) + else + call SLA_fk45z(azi/RADIAN,eli/RADIAN,BEPOCH,ra2k,dec2k) + ra2k=ra2k*RADIAN + dec2k=dec2k*RADIAN + endif +c........Ecliptic 1950 -> + elseif (framei.eq.ECLIPTIC) then + if (framef.eq.EQUATORIAL) then + call azel(azi,eli,EAZP,elp,RAEZ,azf,elf) + elseif (framef.eq.GALACTIC) then + call azel(azi,eli,azg,elg,l2z,azf,elf) + else + date=SLA_epj2d(BEPOCH) + call SLA_ecleq(azi/RADIAN,eli/RADIAN,date,ra2k,dec2k) + ra2k=ra2k*RADIAN + dec2k=dec2k*RADIAN + endif + endif +c........-> 2000 frames + if (framef.eq.EQUATORIAL2K) then + azf=ra2k + elf=dec2k + elseif (framef.eq.ECLIPTIC2K) then + date=SLA_epj2d(JEPOCH) + call SLA_eqecl(ra2k/RADIAN,dec2k/RADIAN,date,azf,elf) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.SDSS) then + call azel(ra2k,dec2k,RASDNP,DECSDNP,-ETANCP,azf,elf) + endif + +c--------2000 frames -> + elseif (framei.eq.EQUATORIAL2K.or.framei.eq.ECLIPTIC2K + * .or.framei.eq.SDSS) then +c........initial frame -> RA & Dec 2000 FK5 + if (framei.eq.EQUATORIAL2K) then + ra2k=azi + dec2k=eli + elseif (framei.eq.ECLIPTIC2K) then + date=SLA_epj2d(JEPOCH) + call SLA_ecleq(azi/RADIAN,eli/RADIAN,date,ra2k,dec2k) + ra2k=ra2k*RADIAN + dec2k=dec2k*RADIAN + elseif (framei.eq.SDSS) then + call azel(azi,eli,-ETANCP,DECSDNP,RASDNP,ra2k,dec2k) + endif +c........RA & Dec 2000 FK5 -> final frame + if (framef.eq.EQUATORIAL) then + call SLA_fk54z(ra2k/RADIAN,dec2k/RADIAN,BEPOCH,azf,elf,dr,dd) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.ECLIPTIC) then + date=SLA_epj2d(BEPOCH) + call SLA_eqecl(ra2k/RADIAN,dec2k/RADIAN,date,azf,elf) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.GALACTIC) then + call SLA_eqgal(ra2k/RADIAN,dec2k/RADIAN,azf,elf) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.EQUATORIAL2K) then + azf=ra2k + elf=dec2k + elseif (framef.eq.ECLIPTIC2K) then + date=SLA_epj2d(JEPOCH) + call SLA_eqecl(ra2k/RADIAN,dec2k/RADIAN,date,azf,elf) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.SDSS) then + call azel(ra2k,dec2k,RASDNP,DECSDNP,-ETANCP,azf,elf) + endif + +c--------Galactic frame -> + elseif (framei.eq.GALACTIC) then + if (framef.eq.EQUATORIAL) then +c call SLA_ge50(azi/RADIAN,eli/RADIAN,azf,elf) +c azf=azf*RADIAN +c elf=elf*RADIAN + call azel(azi,eli,L2P,DECG,RAG,azf,elf) + elseif (framef.eq.ECLIPTIC) then + call azel(azi,eli,l2z,elg,azg,azf,elf) + else + call SLA_galeq(azi/RADIAN,eli/RADIAN,ra2k,dec2k) + if (framef.eq.EQUATORIAL2K) then + azf=ra2k*RADIAN + elf=dec2k*RADIAN + elseif (framef.eq.ECLIPTIC2K) then + date=SLA_epj2d(JEPOCH) + call SLA_eqecl(ra2k,dec2k,date,azf,elf) + azf=azf*RADIAN + elf=elf*RADIAN + elseif (framef.eq.SDSS) then + ra2k=ra2k*RADIAN + dec2k=dec2k*RADIAN + call azel(ra2k,dec2k,RASDNP,DECSDNP,-ETANCP,azf,elf) + endif + endif + + endif +c--------put azf in interval [0,360) + + iaz=azf/360._10 + if (azf.lt.0._10) iaz=iaz-1 + azf=azf-iaz*360._10 + + return + end +c diff --git a/src/findtop.s.f b/src/findtop.s.f new file mode 100644 index 0000000..ef7cea5 --- /dev/null +++ b/src/findtop.s.f @@ -0,0 +1,174 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine findtop(a,na,iord,nb) + integer na,nb,iord(nb) + real*10 a(na) +c +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of real*10 a having the largest value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having largest value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a that are equal are left in their original order. +c * + order(ia,ja)=a(ia).gt.a(ja).or.(a(ia).eq.a(ja).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine findbot(a,na,iord,nb) + integer na,nb,iord(nb) + real*10 a(na) +c +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of real*10 a having the smallest value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having smallest value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a that are equal are left in their original order. +c * + order(ia,ja)=a(ia).lt.a(ja).or.(a(ia).eq.a(ja).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine findtpa(a,na,iord,nb) + integer na,nb,iord(nb) + real*10 a(na) +c +c intrinsics + intrinsic abs +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of real*10 a having the largest absolute value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having largest absolute value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a equal in abs value are left in their original order. +c * + order(ia,ja)=abs(a(ia)).gt.abs(a(ja)) + * .or.(abs(a(ia)).eq.abs(a(ja)).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine findbta(a,na,iord,nb) + integer na,nb,iord(nb) + real*10 a(na) +c +c intrinsics + intrinsic abs +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of real*10 a having the smallest absolute value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having smallest absolute value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a equal in abs value are left in their original order. +c * + order(ia,ja)=abs(a(ia)).lt.abs(a(ja)) + * .or.(abs(a(ia)).eq.abs(a(ja)).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine finitop(a,na,iord,nb) + integer na,nb,iord(nb) + integer a(na) +c +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of integer a having the largest value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having largest value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a that are equal are left in their original order. +c * + order(ia,ja)=a(ia).gt.a(ja).or.(a(ia).eq.a(ja).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine finibot(a,na,iord,nb) + integer na,nb,iord(nb) + integer a(na) +c +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of integer a having the smallest value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having smallest value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a that are equal are left in their original order. +c * + order(ia,ja)=a(ia).lt.a(ja).or.(a(ia).eq.a(ja).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine finitpa(a,na,iord,nb) + integer na,nb,iord(nb) + integer a(na) +c +c intrinsics + intrinsic abs +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of integer a having the largest absolute value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having largest absolute value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a equal in abs value are left in their original order. +c * + order(ia,ja)=abs(a(ia)).gt.abs(a(ja)) + * .or.(abs(a(ia)).eq.abs(a(ja)).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c +c----------------------------------------------------------------------- + subroutine finibta(a,na,iord,nb) + integer na,nb,iord(nb) + integer a(na) +c +c intrinsics + intrinsic abs +c local (automatic) variables + integer i,ia,ib,it,n,ja + logical order +c * +c * Find nb elements of integer a having the smallest absolute value. +c * Returns index iord of these elements, ordered so iord(1) corresponds +c * to element a(iord(1)) having smallest absolute value. +c * If nb .gt. na, last nb-na elements of iord are undefined. +c * Elements of a equal in abs value are left in their original order. +c * + order(ia,ja)=abs(a(ia)).lt.abs(a(ja)) + * .or.(abs(a(ia)).eq.abs(a(ja)).and.ia.lt.ja) + include 'heapsort.inc' + return + end +c diff --git a/src/findtop_.c b/src/findtop_.c new file mode 100644 index 0000000..8dde38b --- /dev/null +++ b/src/findtop_.c @@ -0,0 +1,79 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + c interface to fortran subroutines in findtop.s.f +*/ +void findtop(long double a[], int na, int iord[], int nb) +{ + int i; + + findtop_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void findbot(long double a[], int na, int iord[], int nb) +{ + int i; + + findbot_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void findtpa(long double a[], int na, int iord[], int nb) +{ + int i; + + findtpa_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void findbta(long double a[], int na, int iord[], int nb) +{ + int i; + + findbta_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void finitop(int a[], int na, int iord[], int nb) +{ + int i; + + finitop_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void finibot(int a[], int na, int iord[], int nb) +{ + int i; + + finibot_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void finitpa(int a[], int na, int iord[], int nb) +{ + int i; + + finitpa_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} + +void finibta(int a[], int na, int iord[], int nb) +{ + int i; + + finibta_(a, &na, iord, &nb); + /* convert from fortran to c convention */ + for (i = 0; i < nb; i++) iord[i]--; +} diff --git a/src/format.h b/src/format.h new file mode 100644 index 0000000..1b384b7 --- /dev/null +++ b/src/format.h @@ -0,0 +1,48 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef FORMAT_H +#define FORMAT_H + +#include <stdio.h> + +/* + Structure defining format of data. + If your format needs more descriptives, shove 'em in here. + DON'T FORGET TO SET THE DEFAULT VALUES IN defaults.h, + AND TO UPDATE copy_format(). +*/ +typedef struct format_ { + char *in; /* keyword defining the input data format */ + char *out; /* keyword defining the output data format */ + size_t skip; /* skip first skip characters of each line */ + size_t end; /* read only up to end'th character of each line */ + char single; /* keyword defines precisely one polygon */ + int n; /* the number of thingys defined by keyword */ + int nn; /* the number of thingys per thingy */ + int innve; /* the input number of points per edge */ + int outper; /* controls interpretation of outnve */ + int outnve; /* the output number of points per edge */ + int id; /* id number of current polygon */ + char newid; /* whether to use old or new id number */ + int pixel; /* pixel that current polygon is in */ + long double weight; /* weight of current polygon */ + char inunitp; /* angular units of input polygon data */ + char outunitp; /* angular units of output polygon data */ + int inframe; /* angular frame of input az, el data */ + int outframe; /* angular frame of output az, el data */ + char inunit; /* angular units of input az, el data */ + char outunit; /* angular units of output az, el data */ + int outprecision; /* digits after decimal point in output angles */ + char outphase; /* '-' or '+' to make output azimuth in interval (-pi, pi] or [0, 2 pi) */ + long double azn; /* azimuth of new pole wrt original frame */ + long double eln; /* elevation of new pole wrt original frame + = elevation of original pole wrt new frame */ + long double azp; /* azimuth of original pole wrt new frame */ + char trunit; /* angular units of transformation angles */ + int nweights; /* the total number of weights/polygons, for use with healpix_weight input files and rasterize */ + struct polygon_ *(*rd_poly_function)(struct format_ *, struct _inputfile *thisfile); + int auto_healpix; +} format; + +#endif /* FORMAT_H */ diff --git a/src/frames.par b/src/frames.par new file mode 100644 index 0000000..eb7835d --- /dev/null +++ b/src/frames.par @@ -0,0 +1,48 @@ +c----------------------------------------------------------------------- +c * Basic data relating angular reference frames + +c........index to angular reference frame + integer UNKNOWN, + * EQUATORIAL,EQUATORIAL2K,GALACTIC,ECLIPTIC,ECLIPTIC2K,SDSS + parameter ( + * UNKNOWN=0, + * EQUATORIAL=1, + * EQUATORIAL2K=2, + * GALACTIC=3, + * ECLIPTIC=4, + * ECLIPTIC2K=5, + * SDSS=6 + * ) + +c........equatorial (RA & Dec) 1950 <-> galactic + real*10 RAG,DECG,L2P + parameter ( +c RA & Dec of galactic north pole in deg + * RAG=192.25_10,DECG=27.4_10, +c galactic longitude of NCP in deg; note b2p=decg + * L2P=123._10) + +c........equatorial <-> ecliptic +c Ecliptic latitude of NCP depends on epoch (e.g. 1950, 2000); +c real*10 function felp(epoch) gives ecliptic latitude of NCP. +c coefficients of expansion of ecliptic latitude of NCP + real*10 E1,E2,E3,E4 + parameter (E1=23.452294_10,E2=-1.30125e-2_10, + * E3=-1.64e-6_10,E4=5.03e-7_10) + real*10 EAZP,RAEZ + parameter ( +c ecliptic longitude of NCP in deg + * EAZP=90._10, +c RA of ecliptic NP in deg + * RAEZ=270._10) + +c........equatorial 2000 <-> SDSS + real*10 RASDNP,DECSDNP,ETANCP + parameter ( +c RA, Dec J2000 FK5 of SDSS NP (lambda=90 deg) in deg + * RASDNP=275._10,DECSDNP=0._10, +c SDSS longitude (eta) of North Celestial Pole in deg +c ETANCP is per the SDSS convention, which is minus the normal +c convention for longitudes! + * ETANCP=57.2_10) + diff --git a/src/garea.c b/src/garea.c new file mode 100644 index 0000000..df3a5d1 --- /dev/null +++ b/src/garea.c @@ -0,0 +1,103 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "logical.h" +#include "manglefn.h" + +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + +/*------------------------------------------------------------------------------ + Area of polygon. + + This is a c interface to fortran subroutine garea. + + Input: poly is a polygon. + verb = 0 to suppress messages from garea, even fatal ones; + 1 to allow messages from garea. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *area = area of polygon. + Return value: 0 if ok; + 1 if fatal error; + -1 if failed to allocate memory. +*/ +int garea(polygon *poly, long double *tol, int verb, long double *area) +{ + polygon *dpoly = 0x0; + logical ldegen; + int ier, ipmin, ipoly, np; + long double cmmin, darea; + /* work arrays */ + int *iord; + long double *phi; + + /* smallest cap of polygon */ + cmminf(poly, &ipmin, &cmmin); + + /* number of caps in polygon to be passed to garea_ */ + np = (poly->np >= 2 && cmmin > 1.)? poly->np + 1 : poly->np; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * np * 2); + if (!iord) { + fprintf(stderr, "garea: failed to allocate memory for %d ints\n", np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * np * 2); + if (!phi) { + fprintf(stderr, "garea: failed to allocate memory for %d long doubles\n", np * 2); + return(-1); + } + + /* <= 1 caps, or smallest cap has area <= pi */ + if (np == poly->np) { + /* fortran routine */ + garea_(area, poly->rp, poly->cm, &poly->np, tol, &verb, phi, iord, &ldegen); + + /* >= 2 caps, and smallest cap has area > pi */ + } else { + /* make sure dpoly contains enough space */ + ier = room_poly(&dpoly, np, DNP, 0); + if (ier == -1) { + fprintf(stderr, "garea: failed to allocate memory for polygon of %d caps\n", np + DNP); + return(-1); + } + + /* make polygon dpoly with extra cap */ + poly_polyn(poly, poly, ipmin, 1, dpoly); + + /* make the extra cap 1/2 the area of the smallest cap */ + dpoly->cm[poly->np] = cmmin / 2.; + + /* zero area */ + *area = 0.; + + for (ipoly = 0; ipoly < 2; ipoly++) { + /* fortran routine */ + garea_(&darea, dpoly->rp, dpoly->cm, &dpoly->np, tol, &verb, phi, iord, &ldegen); + + /* accumulate area */ + *area += darea; + + /* fatal error */ + if (ldegen) break; + + /* the complement of the extra cap */ + dpoly->cm[poly->np] = - dpoly->cm[poly->np]; + } + + } + + /* free work arrays */ + free(iord); + free(phi); + + /* fatal error */ + if (ldegen){ + fprintf(stderr,"garea: fatal error in polygon %d, pixel %d\n", poly->id,poly->pixel); + return(1); + } + return(0); +} diff --git a/src/garea.s.f b/src/garea.s.f new file mode 100644 index 0000000..00c04b3 --- /dev/null +++ b/src/garea.s.f @@ -0,0 +1,287 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine garea(area,rp,cm,np,tol,verb,phi,iord,ldegen) + integer np,verb + logical ldegen + real*10 area,rp(3,np),cm(np),tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np) + real*10 phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c externals + integer garpi,gsegij,gzeroar +c data variables + real*10 big + real*10 dphmin +c local variables + integer i,iarea,ik,iseg,j,jm,jml,jmu,jp,jpl,jpu,k,km,kp,l, + * nbd,nbd0m,nbd0p,ni,nmult,retry,scmi +C logical warn + logical whole + real*10 bik,cmi,cmik,cmk,d,darea,dph,ikchk,ikran, + * ph,phm,php,psi,si,tolin,xi(3),yi(3) +c * +c * Area of surface of sphere of unit radius bounded by +c * 1 - r.rp(i) < cm(i) (if cm(i).ge.0) +c * 1 - r.rp(i) > -cm(i) (if cm(i).lt.0) +c * for i=1,np where rp(i) are unit directions. +c * See AJSH notes Multfn C115. +c * Cautions: +c * (1) This subroutine underestimates the area by 2*pi +c * if 2*pi <= area < 4*pi +c * and the area is bounded by more than one arc. +c * (2) This subroutine will usually work correctly when there are near +c * multiple (.ge. 3) intersections of boundaries, but in rare +c * instances it may fail. If so, it should flag the failure with +c * ldegen=.true. This error condition should NOT be ignored. +c * +c Input: rp(3,i),i=1,np +c cm(i),i=1,np +c np +c verb +c Output: area +c ldegen = .true. means there's a problem with multiply +c intersecting boundary. +c Input/Output: tol +c Work arrays: phi and iord should be dimensioned at least 2*np +c +c set azimuthal angle of non-intersection to big + data big /1.e6_10/ +c possible multiple intersection when dph < dphmin + data dphmin /1.e-8_10/ +c +c input tolerance to multiple intersections + tolin=tol +C print *,'--------------------' +c come here with modified tolerance to multiple intersections + 100 continue +C write (*,'(a3,a20,4a24)') +C * ' ','x','y','z', +c * 'r', +C * '1-c' +C do j=1,np +C write (*,'(i3,5g24.16)') +C * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), +C * cm(j) +C enddo +c initialise error flag to no error + ldegen=.false. +C warn=.false. +c initialize count of near multiple intersections to zero + nmult=0 +c zero area + area=0._10 +c check for zero area because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c no constraints at all will mean area is whole sphere + whole=.true. +c number of intersecting arc segments bounding area + nbd=0 +c number of non-intersecting circles bounding area + nbd0m=0 + nbd0p=0 +c error check on evaluation of vertex terms + ikchk=0._10 +c--------identify boundary segments around each circle i in turn + do 280 i=1,np +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) goto 280 +c there is a constraint, so area is not whole sphere + whole=.false. +c scmi * cmi = 1-cos th(i) + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) +c si = sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c........construct cartesian axes with z-axis along rp(i) + call gaxisi(rp(1,i),xi,yi) +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside polygon + if (ni.eq.-1) goto 280 +c area of polygon is zero + if (ni.eq.-2) then +c area can be non-zero from psi at multiple intersections + area=0._10 + goto 410 + endif +c........i circle has no intersections + if (ni.eq.0) then + if (scmi.ge.0) then + nbd0p=nbd0p+1 + else + nbd0m=nbd0m+1 + endif + darea=cm(i)*TWOPI + area=area+darea +C print *,'at',i,': full circle area +=',darea,' =',area +c........i circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around i circle + call findbot(phi,2*np,iord,ni) +C write (*,'("phi")') +C write (*,'(i4,2g24.16)') (j,(phi(k,j),k=1,2),j=1,np) +c........contribution to area from each segment of i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rp(1,i),scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +C print *,'at',i,': iseg =',iseg +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c near multiple intersection + if (dph.lt.dphmin) then +c increment count of near multiple intersections + nmult=nmult+1 +C warn=.true. +C print *, +C * '*** warning from garea: near multiple intersection at', +C * i,': edge',km,kp,' dph =',dph + endif +c........segment satisfies conditions + nbd=nbd+1 +c there's a contribution to area from the segment... + if (scmi.lt.0) dph=-dph + darea=cmi*dph-dph + area=area+darea +C print *,'at',i,': edge',km,kp, +C * ' (',jm,' in',jml,jmu,',',jp,' in',jpl,jpu,' of',ni,')' +C print *,'dph =',dph,' area +=',darea,' =',area +c ...and from the end points of the segment + do 240 l=1,2 +c end point is intersection of i circle with k circle + if (l.eq.1) then + k=km + elseif (l.eq.2) then + k=kp + endif +c only do ik intersection once, +c but check both ik and ki intersections made it here +c from segment k to segment i right-handedly through vertex + if ((l.eq.1.and.scmi.ge.0).or.(l.eq.2.and.scmi.lt.0)) then + ik=k+np*i + if (k.lt.i) ik=ik+1 +c from segment i to segment k right-handedly through vertex + else + ik=i+np*k + if (i.lt.k) ik=ik+1 + endif +c pseudo-random number from ik + call ikrand(ik,ikran) + if (i.gt.k) then +c ikchk = ikchk - ikran, subtracted as unsigned long long's + call ikrandm(ikchk,ikran) +C print *,' (intersect',i,k,')' + goto 240 + endif +c ikchk = ikchk + ikran, added as unsigned long long's + call ikrandp(ikchk,ikran) + cmk=abs(cm(k)) +c cmik = 1-cos th(ik) + cmik=((rp(1,i)-rp(1,k))**2+(rp(2,i)-rp(2,k))**2 + * +(rp(3,i)-rp(3,k))**2)/2._10 +c bik = cik-ci*ck +c d = 1-ci^2-ck^2-cik^2+2*ci*ck*cik +c cos psi = bik/(si*sk) +c sin psi = sqrt(d)/(si*sk) +c psi = atan(sqrt(d)/bik) is exterior angle at intersection + bik=(cmi+cmk)-cmi*cmk-cmik + if ((scmi.ge.0.and.cm(k).lt.0._10) + * .or.(scmi.lt.0.and.cm(k).ge.0._10)) bik=-bik +c i and k circles kiss + if (phi(1,k).eq.phi(2,k)) then + d=0._10 + else + d=-(cmi-cmk)**2+cmik*(2._10*((cmi+cmk)-cmi*cmk)-cmik) +c assert that circles at least touch + if (d.lt.0._10) d=0._10 + d=sqrt(d) + endif + psi=atan2(d,bik) + area=area-psi +C print *,' intersect',i,k,' area +=',-psi,' =',area + 240 continue +c do another segment + goto 220 + endif + 280 continue +c--------check on whether ik endpoints matched ki endpoints + if (ikchk.ne.0._10) then +C warn=.true. +C print *,'*** from garea: at tol =',tol, +C * ', ikchk=',ikchk,' should be 0' +c write (*,'(a3,a20,3a24)') +c * ' ','x','y','z','1-c' +c write (*,'(i3,4g24.16)') +c * (j,(rp(i,j),i=1,3), +c * cm(j),j=1,np) +c retry with modified tolerance + call gtol(tol,tolin) + goto 100 + elseif (tol.gt.0._10) then +C print *,'... from garea: success at tol =',tol + endif +c--------add/subtract 2*pi's to area + retry=garpi(area,iarea,rp,cm,np,whole,nbd0m,nbd0p,nbd,nmult) +c retry with modified tolerance + if (retry.eq.1) then +C warn=.true. + call gtol(tol,tolin) + goto 100 + endif +c--------done + 410 continue +C if (warn) then +C write (*,'(a3,a20,4a24)') +C * ' ','x','y','z', +c * 'r', +C * '1-c' +C do j=1,np +C write (*,'(i3,5g24.16)') +C * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), +C * cm(j) +C enddo +C endif +C print *,'final area =',area +C print *,'....................' + return +c + 420 continue +c if (verb.ge.1) then + print *,'*** from garea: total failure at tol =',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo +c endif +C print *,'....................' + ldegen=.true. + return +c + end +c diff --git a/src/gaream.s.f b/src/gaream.s.f new file mode 100644 index 0000000..6ffb714 --- /dev/null +++ b/src/gaream.s.f @@ -0,0 +1,100 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gaream(area,areat,rp,cm,np,tol,verb,npg,npp, + * cmimin,cmimax,phi,iord,ldegen) + integer np,verb,npg,npp,iord(np) + logical ldegen + real*10 area,areat,rp(3,np),cm(np),tol,cmimin,cmimax,phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c * +c * Same as garea, but speed up matters by checking first whether +c * cm(npg) or cm(npp) lie outside |cmimin| and |cmimax|, +c * giving simpler result. +c * cmimin and cmimax are gotten from prior call to gcmlim. +c * +c * Note this subroutine assumes, without checking, that: +c * if np.eq.npg, +c * then cm(npg).ge.0; +c * elseif np.eq.npp, +c * then cm(npg).ge.0 & cm(npp).lt.0 & rp(.,npg)=rp(.,npp). +c * +c sphere + if (np.eq.npg) then + if (cm(npg).le.abs(cmimin)) then +c region excludes sphere + if (cmimin.ge.0._10) then + area=0._10 +c region encloses sphere + elseif (cmimin.lt.0._10) then + area=TWOPI*cm(npg) + endif + elseif (cm(npg).ge.abs(cmimax)) then +c sphere encloses region + if (cmimax.ge.0._10) then + area=areat +c sphere and region enclose each other + elseif (cmimax.lt.0._10) then + area=areat-TWOPI*(2._10-cm(npg)) + endif +c sphere intersects boundary of region + else + call garea(area,rp,cm,np,tol,verb,phi,iord,ldegen) + endif +c annulus + elseif (np.eq.npp) then +c region is null + if (cm(npg).le.-cm(npp)) then + area=0._10 + elseif (cm(npg).le.abs(cmimin)) then +c region excludes annulus + if (cmimin.ge.0._10) then + area=0._10 +c region encloses annulus + elseif (cmimin.lt.0._10) then + area=TWOPI*(cm(npg)+cm(npp)) + endif + elseif (-cm(npp).ge.abs(cmimax)) then +c annulus encloses region + if (cmimax.ge.0._10) then + area=0._10 +c annulus and region enclose each other + elseif (cmimax.lt.0._10) then + area=TWOPI*(cm(npg)+cm(npp)) + endif + elseif (cm(npg).ge.abs(cmimax) + * .and.-cm(npp).le.abs(cmimin)) then + if (cmimin.ge.0._10) then +c annulus contains region + if (cmimax.ge.0._10) then + area=areat +c outer ring of annulus and region enclose each other + elseif (cmimax.lt.0._10) then + area=areat-TWOPI*(2._10-cm(npg)) + endif + elseif (cmimin.lt.0._10) then +c inner ring of annulus and region enclose each other + if (cmimax.ge.0._10) then + area=areat-TWOPI*(2._10+cm(npp)) +c annulus and region enclose each other + elseif (cmimax.lt.0._10) then + area=areat-TWOPI*(2._10-cm(npg)-cm(npp)) + endif + endif +c annulus intersects boundary of region + else + call garea(area,rp,cm,np,tol,verb,phi,iord,ldegen) + endif +c np .ne. npg or npp + else + call garea(area,rp,cm,np,tol,verb,phi,iord,ldegen) + endif + return + end +c diff --git a/src/gcmlim.c b/src/gcmlim.c new file mode 100644 index 0000000..8653d04 --- /dev/null +++ b/src/gcmlim.c @@ -0,0 +1,47 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Minimum and maximum values of cm = 1-cosl(th) between polygon + and a unit vector rp. + + This is a c interface to fortran subroutine gcmlim. + + Input: poly is a polygon. + *tol = angle within which to merge multiple intersections. + rp = unit vector. + Output: minimum and maximum values of cm = 1-cosl(th). + Return value: 0 if ok; + -1 if failed to allocate memory. +*/ +int gcmlim(polygon *poly, long double *tol, vec rp, long double *cmmin, long double *cmmax) +{ + /* work arrays */ + int *iord; + long double *phi; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gcmlim: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gcmlim: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + + /* fortran routine */ + gcmlim_(poly->rp, poly->cm, &poly->np, rp, cmmin, cmmax, tol, phi, iord); + + /* free work arrays */ + free(iord); + free(phi); + + return(0); +} diff --git a/src/gcmlim.s.f b/src/gcmlim.s.f new file mode 100644 index 0000000..86f1d9f --- /dev/null +++ b/src/gcmlim.s.f @@ -0,0 +1,155 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gcmlim(rp,cm,np,rpi,cmimin,cmimax,tol,phi,iord) + integer np + real*10 rp(3,np),cm(np),rpi(3),cmimin,cmimax,tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np) + real*10 phi(2,np) +c +c parameters + include 'pi.par' +c intrinsics + intrinsic abs +c externals + integer gsegij,gzeroar +c data variables + real*10 big +c local variables + integer i,iseg,jm,jml,jmu,jp,jpl,jpu,ni,scmi + integer km,kp + logical inmax,inmin + real*10 cmi,cmik,cmim,dph,ph,phm,php,phimax,phimin, + * si,sik,xi(3),yi(3) +c * +c * Minimum and maximum values of cmi = 1-cos(th) +c * between unit direction rpi +c * and surface of sphere of unit radius bounded by +c * 1 - r.rp(i) < cm(i) (if cm(i).ge.0) +c * 1 - r.rp(i) > -cm(i) (if cm(i).lt.0) +c * for i=1,np where rp(i) are unit directions. +c * +c Input: rp(3,i),i=1,np +c cm(i),i=1,np +c np +c rpi(3) +c tol +c Output: cmimin, cmimax = min, max values of cmi +c < 0 means region encloses limiting circle +c > 0 means region excludes limiting circle +c Work arrays: phi and iord should be dimensioned at least 2*np +c + data big /1.e6_10/ +c +c check for zero area because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 + cmimin=2._10 + cmimax=0._10 + inmin=.true. + inmax=.true. +c--------identify boundary segments around each circle i in turn + do 280 i=1,np +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) goto 280 +c scmi * cmi = 1-cos th(i) + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) +c si = sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c cmik = 1-cos th(ik), th(ik)=angle twixt rpi & rp(i) + cmik=((rpi(1)-rp(1,i))**2+(rpi(2)-rp(2,i))**2 + * +(rpi(3)-rp(3,i))**2)/2._10 +c sik = sin th(ik) + sik=sqrt(cmik*(2._10-cmik)) +c min circle is outside area + if ((cm(i).ge.0._10.and.cmik.ge.cmi) + * .or.(cm(i).lt.0._10.and.cmik.le.cmi)) inmin=.false. +c max circle is outside area + if ((cm(i).ge.0._10.and.cmik.le.2._10-cmi) + * .or.(cm(i).lt.0._10.and.cmik.ge.2._10-cmi)) inmax=.false. +c........cartesian axes with z-axis along rp(i), x-axis towards rpi + call gaxisii(rpi,rp(1,i),xi,yi) +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside polygon + if (ni.eq.-1) goto 280 +c area of polygon is zero + if (ni.eq.-2) goto 410 +c........i circle has no intersections + if (ni.eq.0) then +c reduce cmimin? + cmim=cmi+cmik-cmi*cmik-si*sik + if (cmim.lt.cmimin) cmimin=cmim +c increase cmimax? + cmim=cmi+cmik-cmi*cmik+si*sik + if (cmim.gt.cmimax) cmimax=cmim +c........i circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around i circle + call findbot(phi,2*np,iord,ni) +c phimin, max are nearest, furthest points from rpi + phimin=big + phimax=big +c........vertices around i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rp(1,i),scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 240 + if (php.ge.phm) then +c segment contains nearest point in i circle, phi=0 + if (phm.le.0._10.and.php.ge.0._10) phimin=0._10 + elseif (php.lt.phm) then +c segment contains nearest point in i circle, phi=0 + if (phm.le.0._10.or.php.ge.0._10) phimin=0._10 +c segment contains furthest point in i circle, phi=pi + phimax=0._10 + endif +c check if segment endpoints tighten limits + phm=abs(phm) + php=abs(php) + if (phm.lt.phimin) phimin=phm + if (php.lt.phimin) phimin=php + if (PI-phm.lt.phimax) phimax=PI-phm + if (PI-php.lt.phimax) phimax=PI-php +c do another segment + goto 220 +c reduce cmimin? + 240 if (phimin.ne.big) then + cmim=cmi+cmik-cmi*cmik-si*sik*cos(phimin) + if (cmim.lt.cmimin) cmimin=cmim + endif +c increase cmimax? + if (phimax.ne.big) then + cmim=cmi+cmik-cmi*cmik+si*sik*cos(phimax) + if (cmim.gt.cmimax) cmimax=cmim + endif + endif + 280 continue +c region encloses limiting circle + if (inmin) cmimin=-cmimin + if (inmax) cmimax=-cmimax + return +c +c null area + 410 cmimin=2._10 + cmimax=2._10 + return +c + 420 print *,'*** from gmclim: total failure at tol =',tol + return +c + end +c diff --git a/src/get_pixel.c b/src/get_pixel.c new file mode 100644 index 0000000..82fb722 --- /dev/null +++ b/src/get_pixel.c @@ -0,0 +1,350 @@ +/*------------------------------------------------------------------------------ +© M E C Swanson 2005 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include "pi.h" +#include "manglefn.h" + + +/* Function get_pixel takes a pixel number and returns a pointer to a polygon + containing that pixel. + inputs: + pix: pixel number + scheme: pixelization scheme + returns pointer to polygon containing pixel, or 0x0 if an error occurs +*/ + +polygon *get_pixel(int pix, char scheme){ + int m,n,res,base_pix,i,ier,pix_c[4]; + long double azmax, azmin, elmax, elmin; + long double lammin, lammax, etamin, etamax; + long double angle[4], lammin_c[4], lammax_c[4], etamin_c[4], etamax_c[4]; + azel v[4],v_r[4]; + polygon *pixel; + + if(pix<0){ + fprintf(stderr, "error in get_pixel: %d not a valid pixel number.\n", pix); + return(0x0); + } + + res=get_res(pix,scheme); + if(res==-1) return (0x0); + + if(scheme=='s'){ + // this scheme divides up the sphere by rectangles in az and el, and is numbered + // such that the resolution is encoded in each pixel number. The whole sky is pixel 0, + // pixels 1, 2, 3, and 4 are each 1/4 of the sky (resolution 1), pixels 5-20 are each + // 1/16 of the sky (resolution 2), etc. + + base_pix=pix-pixel_start(res,scheme); + + m=base_pix % (int)(powl(2,res)); + n=(base_pix-m)/powl(2,res); + azmin=TWOPI/powl(2,res)*m; + azmax=TWOPI/powl(2,res)*(m+1); + elmin=asinl(1-2.0/powl(2,res)*(n+1)); + elmax=asinl(1-2.0/powl(2,res)*n); + + angle[0]=azmin; + angle[1]=azmax; + angle[2]=elmin; + angle[3]=elmax; + + pixel=new_poly(4); + if (!pixel) { + fprintf(stderr, "error in get_pixel: failed to allocate memory for polygon of 4 caps\n"); + return(0x0); + } + + // printf("az range: %Lf - %Lf, el range: %Lf - %Lf\n", azmin, azmax, elmin,elmax); + rect_to_poly(angle,pixel); + pixel->pixel=pix; + + if(!pixel){ + fprintf(stderr, "error in get_pixel: polygon is NULL.\n"); + } + + return(pixel); + + } + else if(scheme=='d'){ + //this is the SDSSPix pixelization scheme; see http://lahmu.phyast.pitt.edu/~scranton/SDSSPix/ + //for more details + + assign_parameters(); + + if(res==0){ + pixel=new_poly(0); + pixel->weight=1.; + pixel->pixel=0; + + return(pixel); + } + + else if(res==1){ + ier = get_child_pixels(pix, pix_c, scheme); + if(ier==1){ + fprintf(stderr, "error in get_pixel: get_child_pixels failed\n"); + return(0x0); + } + + for(i=0;i<=3;i++){ + pix_bound(1, (unsigned long)pix_c[i] - (unsigned long)pixel_start(2, scheme), &lammin_c[i], &lammax_c[i], &etamin_c[i], &etamax_c[i]); + } + + for(i=0;i<=3;i++){ + if(lammin_c[i]<=lammin_c[(i+1)%4] && lammin_c[i]<=lammin_c[(i+2)%4] && lammin_c[i]<=lammin_c[(i+3)%4]) lammin=lammin_c[i]; + if(lammax_c[i]>=lammax_c[(i+1)%4] && lammax_c[i]>=lammax_c[(i+2)%4] && lammax_c[i]>=lammax_c[(i+3)%4]) lammax=lammax_c[i]; + if(etamin_c[i]<=etamin_c[(i+1)%4] && etamin_c[i]<=etamin_c[(i+2)%4] && etamin_c[i]<=etamin_c[(i+3)%4]) etamin=etamin_c[i]; + if(etamax_c[i]>=etamax_c[(i+1)%4] && etamax_c[i]>=etamax_c[(i+2)%4] && etamax_c[i]>=etamax_c[(i+3)%4]) etamax=etamax_c[i]; + } + + /* fix pixels which span eta=0 */ + for(i=0;i<=5;i++){ + if(pix==9+18*i || pix==113){ + etamin=etamin_c[0]; + etamax=etamax_c[3]; + } + } + + if(lammin < -90.) lammin = -90.; + if(lammax > 90.) lammax = 90.; + if(etamin < 0.) etamin += 360.; + if(etamax > 360.) etamax -= 360.; + lammin *= (PI/180.0); + lammax *= (PI/180.0); + etamin *= (PI/180.0); + etamax *= (PI/180.0); + + angle[0]=etamin; + angle[1]=etamax; + angle[2]=lammin; + angle[3]=lammax; + + pixel=new_poly(4); + if (!pixel) { + fprintf(stderr, "error in get_pixel: failed to allocate memory for polygon of 4 caps\n"); + return(0x0); + } + + rect_to_poly(angle,pixel); + pixel->pixel=pix; + + if(!pixel){ + fprintf(stderr, "error in get_pixel: polygon is NULL.\n"); + return(0x0); + } + + for(i=0;i<pixel->np;i++){ + rp_to_azel(pixel->rp[i], &(v[i])); + v[i].az *= (180./PI); + v[i].el *= (180./PI); + if(v[i].az < -180.) v[i].az += 360.; + if(v[i].az > 180.) v[i].az -= 360.; + if(v[i].el < -90.) v[i].el = -90.; + if(v[i].el > 90.) v[i].el = 90.; + csurvey2eq(v[i].el, v[i].az, &(v_r[i].az), &(v_r[i].el)); + if(v_r[i].az < 0.) v_r[i].az += 360.; + if(v_r[i].az > 360.) v_r[i].az -= 360.; + if(v_r[i].el < -90.) v_r[i].el = -90.; + if(v_r[i].el > 90.) v_r[i].el = 90.; + v_r[i].az *= (PI/180.); + v_r[i].el *= (PI/180.); + azel_to_rp(&(v_r[i]), pixel->rp[i]); + } + + return(pixel); + } + + else{ + pix_bound((int)powl(2,res-2), (unsigned long)pix - (unsigned long)pixel_start(res, scheme), &lammin, &lammax, &etamin, &etamax); + + if(lammin < -90.) lammin = -90.; + if(lammax > 90.) lammax = 90.; + if(etamin < 0.) etamin += 360.; + if(etamax > 360.) etamax -= 360.; + lammin *= (PI/180.0); + lammax *= (PI/180.0); + etamin *= (PI/180.0); + etamax *= (PI/180.0); + + angle[0]=etamin; + angle[1]=etamax; + angle[2]=lammin; + angle[3]=lammax; + + pixel=new_poly(4); + if (!pixel) { + fprintf(stderr, "error in get_pixel: failed to allocate memory for polygon of 4 caps\n"); + return(0x0); + } + + rect_to_poly(angle,pixel); + pixel->pixel=pix; + + if(!pixel){ + fprintf(stderr, "error in get_pixel: polygon is NULL.\n"); + return(0x0); + } + + for(i=0;i<pixel->np;i++){ + rp_to_azel(pixel->rp[i], &(v[i])); + v[i].az *= (180./PI); + v[i].el *= (180./PI); + if(v[i].az < -180.) v[i].az += 360.; + if(v[i].az > 180.) v[i].az -= 360.; + if(v[i].el < -90.) v[i].el = -90.; + if(v[i].el > 90.) v[i].el = 90.; + csurvey2eq(v[i].el, v[i].az, &(v_r[i].az), &(v_r[i].el)); + if(v_r[i].az < 0.) v_r[i].az += 360.; + if(v_r[i].az > 360.) v_r[i].az -= 360.; + if(v_r[i].el < -90.) v_r[i].el = -90.; + if(v_r[i].el > 90.) v_r[i].el = 90.; + v_r[i].az *= (PI/180.); + v_r[i].el *= (PI/180.); + azel_to_rp(&(v_r[i]), pixel->rp[i]); + } + + return(pixel); + } + } + else{ + fprintf(stderr, "error in get_pixel: pixel scheme %c not recognized.\n", scheme); + return(0x0); + } +} + +/* Function get_child_pixels takes a pixel number and calculates the numbers of the + child pixels of that pixel + inputs: + pix_p: parent pixel number + scheme: pixelization scheme + outputs: + pix_c[4]: array containing the pixel numbers of the 4 child pixels + returns 0 on success, 1 if an error occurs +*/ + +int get_child_pixels(int pix_p, int pix_c[], char scheme){ + int mp,np,res,base_pix,i; + unsigned long pix_c0, pix_c1, pix_c2, pix_c3; + + if(pix_p<0){ + fprintf(stderr, "error in get_child_pixels: %d is not a valid pixel number\n",pix_p); + return(1); + } + + res=get_res(pix_p, scheme); + //printf("get_res(pix_p = %d) = %d\n", pix_p, res); + if(res==-1) return (1); + + if(scheme=='s'){ + // this scheme divides up the sphere by rectangles in az and el, and is numbered + // such that the resolution is encoded in each pixel number. The whole sky is pixel 0, + // pixels 1, 2, 3, and 4 are each 1/4 of the sky (resolution 1), pixels 5-20 are each + // 1/16 of the sky (resolution 2), etc. + + base_pix=pix_p-pixel_start(res,scheme); + mp=base_pix % (int)(powl(2,res)); + np=(base_pix-mp)/powl(2,res); + + //child pixels will have nc=2*np or 2*np+1, mc=2*mp or 2*mp+1, res_c=res+1 + //for first child pixel (nc=2*np, mc=2*mp), the base pixel number is given by + //base_pix_c = 2^res_c*nc+mc = 2^(res+1)*2*np+2*mp=2^res*4*np+2*mp + //combine this with base_pix_p=2^res*np+mp and extra resolution term 4^res + //to get formula for the number for the first child pixel number below + + pix_c[0]=pix_p+powl(4,res)+powl(2,res)*3*np+mp; + pix_c[1]=pix_c[0]+1; + pix_c[2]=pix_c[0]+powl(2,res+1); + pix_c[3]=pix_c[2]+1; + return(0); + } + else if(scheme=='d'){ + assign_parameters(); + if (pix_p==0){ + for(i=0;i<=116;i++) pix_c[i]=i+1; + return(0); + } + else if (pix_p>=1 && pix_p<=108){ + for(i=1;i<=91;i+=18){ + if(pix_p>=i && pix_p<=i+17) { + pix_c[0]=4*(i-1)+2*(pix_p-i)+pixel_start(res+1,scheme); + break; + } + } + pix_c[1]=pix_c[0]+1; + pix_c[2]=pix_c[0]+36; + pix_c[3]=pix_c[0]+37; + return(0); + } + else if (pix_p>=109 && pix_p<=117){ + pix_c[0]=5*pix_p+(114-pix_p); + for(i=1;i<=3;i++) pix_c[i]=pix_c[0]+i; + return(0); + } + else { + subpix((int)powl(2,res-2), (unsigned long)(pix_p-pixel_start(res, scheme)), &pix_c0, &pix_c1, &pix_c2, &pix_c3); + pix_c[0] = (int)pix_c0 + pixel_start(res+1, scheme); + pix_c[1] = (int)pix_c1 + pixel_start(res+1, scheme); + pix_c[2] = (int)pix_c2 + pixel_start(res+1, scheme); + pix_c[3] = (int)pix_c3 + pixel_start(res+1, scheme); + return(0); + } + } + else{ + fprintf(stderr, "error in get_child_pixels: pixel scheme %c not recognized.\n", scheme); + return(1); + } +} + +/* Function get_res takes a pixel number and returns the resolution + implied by that pixel number. + inputs: + pix: pixel number + scheme: pixelization scheme + returns the resolution of the pixel, or -1 if an error occurs +*/ + +int get_res(int pix, char scheme){ + int res; + + if(pix<0){ + fprintf(stderr, "error in get_res: %d not a valid pixel number.\n", pix); + return(-1); + } + + if(scheme=='s'){ + for(res=0;pix>=powl(4,res);res++){ + pix-=(int)powl(4,res); + } + return(res); + } + /* else if(scheme=='h'){ + if(pix==0){ + res=0; + return(res); + } + else if(pix>0){ + for(res=2;pix>(int)(12*(powl(4,res)-4)/12);res++){ + } + return((int)(res-1)); + } + } */ + else if(scheme=='d'){ + if(pix==0) return(0); + else if(pix>=1 && pix <=117) return(1); + else pix-=117; + for(res=2;pix>(int)powl(4,res-2)*468;res++){ + pix-=(int)powl(4,res-2)*468; + } + // sdss_res increases by factors of 2 instead of increments of 1 + // sdss_res = (int)powl(2,res-1); + return(res); + } + else{ + fprintf(stderr, "error in get_res: pixel scheme %c not recognized.\n", scheme); + return(-1); + } + return(-1); +} diff --git a/src/gphbv.c b/src/gphbv.c new file mode 100644 index 0000000..2b3939d --- /dev/null +++ b/src/gphbv.c @@ -0,0 +1,52 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include <stdio.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Correction to boundary and vertex terms per subroutine gspher + arising from disjoint polygons which abut along a circle. + + This is a c interface to fortran subroutine gphbv. + + Input: poly is a polygon. + np = number of caps of 1st polygon. + bnd = which cap of the polygon is the abutting boundary. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: bound, vert = as described in comments to gspher.s.f . + Return value: 0 if ok; + -1 if could not allocate temporary memory. +*/ +int gphbv(polygon *poly, int np, int bnd, long double *tol, long double bound[2], long double vert[2]) +{ + int i; + /* work arrays */ + int *iord; + long double *phi; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gphbv: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gphbv: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + + /* translate from c to fortran convention */ + i = bnd + 1; + + /* the fortran routine */ + gphbv_(bound, vert, poly->rp, poly->cm, &poly->np, &np, &poly->np, &i, tol, phi, iord); + + /* free work arrays */ + free(iord); + free(phi); + + return(0); +} diff --git a/src/gphbv.s.f b/src/gphbv.s.f new file mode 100644 index 0000000..f003fc5 --- /dev/null +++ b/src/gphbv.s.f @@ -0,0 +1,422 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- +c * This routine needs upgrading to the same level of robustness +c * as the rest of the mangle software: +c * 1. Should check consistency of multiple intersections, +c * and increase tol and repeat if an inconsistency is detected. +c * 2. As a corollary of 1., need to go around all edges, +c * not just the particular edge i. +c * 3. If 2. is done, then the routine should be able to deal +c * with point abuts in addition to abutments of finite extent. +c * +c * Currently, the routine deals correctly with multiple intersections, +c * albeit without checking for consistency. +c * However, it deals only with abutments of finite extent, +c * NOT with point abutments, where polygons abut at a single point +c * or at a set of isolated points. +c * This is enough to get bound right, +c * but vert is missing contributions from point abuts. +c----------------------------------------------------------------------- + subroutine gphbv(bound,vert,rp,cm,np,npb,npc,i,tol,phi,iord) + integer np,npb,npc,i,iord(2*np) + real*10 bound(2),vert(2),rp(3,np),cm(np),tol,phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c externals + integer gsegij,gzeroar +c data variables + real*10 big,bndtol,psitol + real*10 dphmin +c local (automatic) variables + integer iphbv,iseg,j,jm(2),jml,jmu,jp(2),jpl,jpu,k,km(2),kp(2), + * l,ni,nmult + logical warn + real*10 bik,cmi,cmik,cmk,cti(3),ctk(3),ctpsi(3), + * d,dbound(2),dph,dvert(2),p,ph,phm,php,psi(3), + * scmi,si,sk,t(3),xi(3),yi(3) +c * +c * Correction to boundary and vertex terms per subroutine gspher +c * arising from disjoint regions W12 and W13 which abut along circle i +c * defined by 1 - r.rp(i) = cm(i). +c * W12 (W13) is the intersection of W2 (W3) with global region W1. +c * Regions are bounded by +c * 1 - r.rp(j) < cm(j) (if cm(j).ge.0) +c * 1 - r.rp(j) > -cm(j) (if cm(j).lt.0) +c * for j=1,np where rp(j) are unit directions. +c * The boundary of W2 is in j = 1 to npb +c * W3 npb+1 to npc +c * W1 npc+1 to np. +c * If circle i belongs to W2 (i.e. i=1 to npb) then +c * W2 (W3) is north (south) of circle i if cm(i).ge.0, +c * south (north) of circle i if cm(i).lt.0. +c * Conversely, if circle i belongs to W3 (i.e. i=npb+1 to npc) then +c * W3 (W2) is north (south) of circle i if cm(i).ge.0, +c * south (north) of circle i if cm(i).lt.0. +c * The abutting boundary i' of W3 (W2) which coincides with +c * boundary i of W2 (W3) should be suppressed by setting cm(i')=2. +c * Boundaries j that are duplicates of boundary i +c * or j' of the abutting boundary i' +c * should be suppressed by setting cm(j)=2 and cm(j')=2. +c * +c * Boundary and vertex terms are evaluated for -<W12 W13>. +c * +c * To get bound & vert for correlation <(W1-W12-W13)^2> +c * of region W1 less its intersection with disjoint regions W2 and W3, +c * follow instructions in gspher, i.e. basically +c * call gspher(area,bound,vert,parameters of W1,ibv=0,...) +c * call gspher(darea,dbound,dvert,parameters of W2 & W1,ibv=2,...) +c * area=area-darea, etc. +c * call gspher(darea,dbound,dvert,parameters of W3 & W1,ibv=2,...) +c * area=area-darea, etc. +c * and then, if W2 and W3 abut, +c * call gphbv(dbound,dvert,parameters of W2 W3 & W1,...) +c * bound=bound-2*dbound +c * vert=vert-2*dvert +c * +c * To get bound & vert for cross-correlation <W12(W1-W13)> +c * between W12 +c * and region W1 less its intersection with W3 outside W2, +c * follow instructions in gspher, i.e. +c * call gspher(area,bound,vert,parameters of W2 & W1,ibv=1,...) +c * and then, if W2 and W3 abut, +c * call gphbv(dbound,dvert,parameters of W2 W3 & W1,...) +c * bound=bound+dbound +c * vert=vert+dvert +c * +c * To get bound & vert for cross-correlation <(W12-W13)(W1-W13)> +c * between W12 less its intersection with W3 inside W2, +c * and region W1 less its intersection with W3, +c * follow instructions in gspher, i.e. +c * call gspher(area,bound,vert,parameters of W2 & W1,ibv=1,...) +c * call gspher(darea,dbound,dvert,parameters of W3 & W12,ibv=2,...) +c * area=area-darea, etc. +c * and then, if W2' and W3 abut, where W2' denotes complement of W2, +c * call gphbv(dbound,dvert,parameters of W2' W3 & W1,...) +c * bound=bound-dbound +c * vert=vert-dvert +c * Note that usually all W2' constraints should be null. +c * If however W2' abuts W3 along two distinct boundaries, then W2' +c * should be split into two regions W2'a and W2'b which each have a +c * single abutment with W3, and two calls to gphbv should be made +c * call gphbv(dbound,dvert,parameters of W2'a W3 & W1,...) +c * bound=bound-dbound +c * vert=vert-dvert +c * call gphbv(dbound,dvert,parameters of W2'b W3 & W1,...) +c * bound=bound-dbound, etc. +c * +c * In general, to get bound & vert for cross-correlation +c * <(W12-W13-...)(W1-W13-W14-...)> +c * between region W12 less its intersection W13 with a +c * bunch of disjoint W3 lying inside W2, +c * and W1 less its intersections W13 and W14 with that bunch of W3 and +c * another bunch of disjoint W4 lying outside W2, +c * call gspher(area,bound,vert,parameters of W2 & W1,ibv=1,...) +c * then chop out all the W13s by calls +c * call gspher(darea,dbound,dvert,parameters of W3 & W12,ibv=2,...) +c * area=area-darea, etc. +c * then for each W3 (inside W2) abutting the edge of W2 +c * call gphbv(dbound,dvert,parameters of W2' W3 & W1,...) +c * bound=bound-dbound, etc. +c * for each W4 (outside W2) abutting W2 +c * call gphbv(dbound,dvert,parameters of W2 W4 & W1,...) +c * bound=bound+dbound, etc. +c * for each pair W3a & W3b (inside W2) which abut each other +c * call gphbv(dbound,dvert,parameters of W3a W3b & W1,...) +c * bound=bound-2*dbound, etc. +c * for each pair W3 (inside W2) & W4 (outside W2) abutting each other +c * call gphbv(dbound,dvert,parameters of W3 W4 & W1,...) +c * bound=bound-dbound, etc. +c * +c Input: rp(3,j),j=1,np +c cm(j),j=1,np +c np, npb, npc: W2 1 to npb +c W3 npb+1 to npc +c W1 npc+1 to np. +c i = abutting boundary of W2 (or W3); +c the abutting boundary i' of W3 (or W2) which coincides +c with boundary i of W2 (or W3) should be suppressed +c by setting cm(i')=2. +c Output: bound(2) +c vert(2) +c Work arrays: phi and iord should be dimensioned at least 2*np +c +c set azimuthal angle of non-intersection to big + data big /1.e6_10/ +c set vertex term to zero if |psi| < psitol + data psitol /1.e-10_10/ +c ok if bound(1) tests not too far outside [0,max] + data bndtol /1.e-10_10/ +c warn about multiple intersection when dph < dphmin + data dphmin /1.e-8_10/ +c +C print *,'--------------------' +c abutting boundary must belong to W2 or W3 + if (i.gt.npc) then + print *,'*** from gphbv: i =',i,' should be .le.',npc + goto 410 + endif +c zero stuff + bound(1)=0._10 + bound(2)=0._10 + vert(1)=0._10 + vert(2)=0._10 + warn=.false. +c check for zero angle because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) goto 410 +c--------identify boundary segments around circle i + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) + si=sqrt(cmi*(2._10-cmi)) +c........construct cartesian axes with z-axis along rp(i) + call gaxisi(rp(1,i),xi,yi) +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside polygon + if (ni.eq.-1) goto 410 +c area of polygon is zero + if (ni.eq.-2) goto 410 +c........i circle has no intersections + if (ni.eq.0) then + dph=TWOPI + dbound(1)=si*dph + dbound(2)=(1._10/si-2._10*si)*dph + bound(1)=bound(1)+dbound(1) + bound(2)=bound(2)+dbound(2) +C print *,'full circle' +C print *,'dbound =',dbound(1),dbound(2), +C * ' bound =',bound(1),bound(2) +c........i circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around i circle + call findbot(phi,2*np,iord,ni) +c........contribution from each segment of i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,npb,npc,i,rp(1,i),scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,2,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c near multiple intersection + if (dph.lt.dphmin) then +c increment count of near multiple intersections + nmult=nmult+1 +c warn=.true. +c print *, +c * '*** warning from gspher: near multiple intersection at' +c * ,i,': segment',km(1),kp(1),' &',km(2),kp(2),' dph=',dph + endif +c........segment satisfies conditions +c. . . . boundary terms + dbound(1)=si*dph + dbound(2)=(1._10/si-2._10*si)*dph + bound(1)=bound(1)+dbound(1) + bound(2)=bound(2)+dbound(2) +C print *,'at',i,': edge',km(1),kp(1),' &',km(2),kp(2), +C * ' (',jm(1),' &',jm(2),' in',jml,jmu,',', +C * jp(1),' &',jp(2),' in',jpl,jpu,' of',ni,')' +C print *,'dph/(2*pi)=',dph/TWOPI +C print *,'dbound =',dbound(1),dbound(2), +C * ' bound =',bound(1),bound(2) +c. . . . vertex terms + do l=1,2 + do iphbv=1,2 +c end point is intersection of i circle with k circle + if (l.eq.1) then + k=km(iphbv) + elseif (l.eq.2) then + k=kp(iphbv) + endif + if (k.eq.0) then + psi(iphbv)=0._10 + ctpsi(iphbv)=1._10/psi(iphbv) + t(iphbv)=0._10 +c cti = cot th(i) + cti(iphbv)=(1._10-cmi)/si + if (scmi.lt.0) cti(iphbv)=-cti(iphbv) + if (iphbv.eq.2) cti(iphbv)=-cti(iphbv) +c ctk = cot th(k) + ctk(iphbv)=cti(iphbv) + else + cmk=abs(cm(k)) + sk=sqrt(cmk*(2._10-cmk)) +c cmik = 1-cos th(ik) + cmik=((rp(1,i)-rp(1,k))**2+(rp(2,i)-rp(2,k))**2 + * +(rp(3,i)-rp(3,k))**2)/2._10 +c bik = cik-ci*ck +c d = 1-ci^2-ck^2-cik^2+2*ci*ck*cik +c cos psi = bik/(si*sk) +c sin psi = sqrt(d)/(si*sk) +c psi = atan(sqrt(d)/bik) is exterior angle at intersection + bik=(cmi+cmk)-cmi*cmk-cmik + if ((scmi.ge.0.and.cm(k).lt.0._10) + * .or.(scmi.le.0.and.cm(k).ge.0._10)) bik=-bik + if (iphbv.eq.2) bik=-bik +c i and k circles kiss + if (phi(1,k).eq.phi(2,k)) then + d=0._10 + else + d=-(cmi-cmk)**2+cmik*(2._10*((cmi+cmk)-cmi*cmk)-cmik) +c assert that circles at least touch + if (d.lt.0._10) d=0._10 + d=sqrt(d) + endif + ctpsi(iphbv)=bik/d + psi(iphbv)=atan2(d,bik) +c t=tan psi/2 + if (bik.gt.0._10) then + t(iphbv)=d/(bik+sqrt(bik**2+d**2)) + elseif (bik.lt.0._10) then + t(iphbv)=(-bik+sqrt(bik**2+d**2))/d + elseif (bik.eq.0._10) then + t(iphbv)=1._10 + endif +c cti = cot th(i) + cti(iphbv)=(1._10-cmi)/si + if (scmi.lt.0) cti(iphbv)=-cti(iphbv) + if (iphbv.eq.2) cti(iphbv)=-cti(iphbv) +c ctk = cot th(k) + ctk(iphbv)=(1._10-cmk)/sk + if (cm(k).lt.0._10) ctk(iphbv)=-ctk(iphbv) + endif + enddo +c psi(3) = psi(1) + psi(2) - pi + psi(3)=psi(1)+psi(2)-PI +c cot psi(3) + if (abs(ctpsi(1)).le.1._10) then + if (abs(ctpsi(2)).le.1._10) then + ctpsi(3)=(ctpsi(1)*ctpsi(2)-1._10) + * /(ctpsi(1)+ctpsi(2)) + else + ctpsi(3)=(ctpsi(1)-1._10/ctpsi(2)) + * /(ctpsi(1)/ctpsi(2)+1._10) + endif + else + if (abs(ctpsi(2)).le.1._10) then + ctpsi(3)=(ctpsi(2)-1._10/ctpsi(1)) + * /(1._10+ctpsi(2)/ctpsi(1)) + else + ctpsi(3)=(1._10-1._10/ctpsi(1)/ctpsi(2)) + * /(1._10/ctpsi(2)+1._10/ctpsi(1)) + endif + endif +c tan psi(3)/2 + if (abs(t(1)).le.1._10) then + if (abs(t(2)).le.1._10) then + t(3)=(t(1)*t(2)-1._10)/(t(1)+t(2)) + else + t(3)=(t(1)-1._10/t(2))/(t(1)/t(2)+1._10) + endif + else + if (abs(t(2)).le.1._10) then + t(3)=(t(2)-1._10/t(1))/(1._10+t(2)/t(1)) + else + t(3)=(1._10-1._10/t(1)/t(2))/(1._10/t(2)+1._10/t(1)) + endif + endif + cti(3)=ctk(1) + ctk(3)=ctk(2) + do iphbv=1,3 + if (abs(psi(iphbv)).le.psitol) then + dvert(1)=0._10 + dvert(2)=0._10 + else + dvert(1)=1._10-psi(iphbv)*ctpsi(iphbv) + dvert(2)=t(iphbv)*(3._10+t(iphbv)**2) + * *(cti(iphbv)+ctk(iphbv))/2._10 + dvert(1)=dvert(1)/2._10 + dvert(2)=dvert(2)/2._10 + endif + if (iphbv.le.2) then + vert(1)=vert(1)+dvert(1) + vert(2)=vert(2)+dvert(2) + else + vert(1)=vert(1)-dvert(1) + vert(2)=vert(2)-dvert(2) + endif +C print *,'vertex',i,k,' part ',iphbv, +C * ' psi =',psi(iphbv) +C print *,' dvert =',dvert(1),dvert(2), +C * ' vert =',vert(1),vert(2) +C print *,' cot(',psi(iphbv),') =',1._10/tan(psi(iphbv)), +C * ' should =',ctpsi(iphbv) +C print *,' tan(',psi(iphbv),'/2) =',tan(psi(iphbv)/2._10), +C * ' should =',t(iphbv) +C print *,' cot(th_i) =',cti(iphbv), +C * ' cot(th_k) =',ctk(iphbv) + enddo + enddo +c do another segment + goto 220 + endif + 280 continue +c--------finish off +c check angle is between 0 and 2*pi + p=bound(1)/si/TWOPI +c print *,rp(1,i),rp(2,i),rp(3,i),'angle/(2*pi)=',p + if (p.lt.0._10) then + print *,'*** from gphbv: angle/(2*pi)=',p, + * ' should be .ge. 0' + warn=.true. + elseif (p.gt.1._10) then + if (bound(1)/si.le.TWOPI+bndtol) then + continue + else + print *,'*** from gphbv: angle/(2*pi)=',p, + * ' should be .le. 1' + warn=.true. + endif + endif + if (warn) then + print *,'boundary',i + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo + endif + 410 continue +C print *,'final bound =',bound(1),bound(2), +C * ' vert =',vert(1),vert(2) +C print *,'....................' + return +c + 420 continue + print *,'*** from gphbv: total failure at tol =',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo +C print *,'....................' + return +c + end +c diff --git a/src/gphi.c b/src/gphi.c new file mode 100644 index 0000000..5a5617b --- /dev/null +++ b/src/gphi.c @@ -0,0 +1,50 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Angle along circle centred at unit vector rp, + with radius th given by cm = 1 - cosl(th), + lying inside polygon poly. + The angle is 2 pi if the circle lies entirely inside the polygon. + + This is a c interface to fortran subroutine gphi. + + Input: poly is a polygon. + *tol = angle within which to merge multiple intersections. + rp = unit vector at the centre of the circle. + cm = 1 - cosl(th), where th is the angular radius of the circle. + Output: *angle = angle along circle, in radians. + Return value: 0 if ok; + -1 if failed to allocate memory. +*/ +int gphi(polygon *poly, long double *tol, vec rp, long double cm, long double *angle) +{ + /* work arrays */ + int *iord; + long double *phi; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gphi: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gphi: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + + /* fortran routine */ + gphi_(angle, poly->rp, poly->cm, &poly->np, rp, &cm, tol, phi, iord); + + /* free work arrays */ + free(iord); + free(phi); + + return(0); +} diff --git a/src/gphi.s.f b/src/gphi.s.f new file mode 100644 index 0000000..29baddc --- /dev/null +++ b/src/gphi.s.f @@ -0,0 +1,131 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gphi(angle,rp,cm,np,rpi,cmi,tol,phi,iord) + integer np + real*10 angle,rp(3,np),cm(np),rpi(3),cmi,tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np) + real*10 phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c externals + integer gsegij,gzeroar +c data variables + real*10 angtol,big +c local variables + integer i,iseg,j,jm,jml,jmu,jp,jpl,jpu,km,kp,ni,scmi + real*10 dph,p,ph,phm,php,xi(3),yi(3) +c * +c * Angle along circle about unit direction rpi satisfying +c * 1 - r.rpi = cmi +c * and bounded by +c * 1 - r.rp(j) <= cm(j) (if cm(j).ge.0) +c * 1 - r.rp(j) > -cm(j) (if cm(j).lt.0) +c * for j=1,np where rp(j) are unit directions. +c * If the circle lies along a border of the polygon, +c * then the returned angle is zero. +c * +c Input: rp(3,j),j=1,np +c cm(j),j=1,np +c np +c rpi(3) +c cmi +c tol +c Output: angle +c Work arrays: phi and iord should be dimensioned at least 2*np +c +c set azimuthal angle of non-intersection to big + data big /1.e6_10/ +c ok if angle tests not too far outside [0,max] + data angtol /1.e-10_10/ +c +c initialise angle to zero + angle=0._10 +c check for null circle + if (cmi.lt.0._10) goto 410 + if (cmi.gt.2._10) goto 410 +c check for zero angle because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 + scmi=1 +c........construct cartesian axes with z-axis along rpi + call gaxisi(rpi,xi,yi) +c........angles phi about z-axis rp(i) of intersection of i & j circles +c passing i=0 means circle at edge is considered outside polygon + call gphij(rp,cm,np,0,rpi,scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside (or at edge of) polygon + if (ni.le.-1) goto 410 +c........order angles around circle +c circle has no intersections + if (ni.eq.0) then + angle=TWOPI +c circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around circle + call findbot(phi,2*np,iord,ni) +c........vertices around i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rpi,scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c........segment satisfies conditions +c print *,'segment',km,kp,' dph/(2*pi)=',dph/TWOPI + angle=angle+dph +c do another segment + goto 220 + endif + 280 continue +c........check angle is between 0 and 2*pi + p=angle/TWOPI +c print *,rpi(1),rpi(2),rpi(3),'angle/(2*pi) =',p + if (p.lt.0._10) then + write (*,'(" *** from gphi: angle/(2*pi) = ",g24.16, + * " should be >= 0")') p + goto 420 + elseif (p.gt.1._10) then +c check if discrepancy is from numerical roundoff + if (angle.le.TWOPI+angtol) then + angle=TWOPI + else + write (*,'(" *** from gphi: angle/(2*pi) = ",g24.16, + * " should be <= 1")') p + goto 420 + endif + endif +c........done + return +c +c zero angle + 410 continue + return +c + 420 print *,'*** from gphi: total failure at tol =',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo + write (*,'(i3,5g24.16)') + * 0,(rpi(i),i=1,3), +c * sqrt(rpi(1)**2+rpi(2)**2+rpi(3)**2), + * cmi + return +c + end +c diff --git a/src/gphim.s.f b/src/gphim.s.f new file mode 100644 index 0000000..cf78ca8 --- /dev/null +++ b/src/gphim.s.f @@ -0,0 +1,43 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gphim(angle,rp,cm,np,rpi,cmi,cmimin,cmimax,tol, + * phi,iord) + integer np,iord(2*np) + real*10 angle,rp(3,np),cm(np),rpi(3),cmi,cmimin,cmimax,tol, + * phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c * +c * Same as gphi, but speed up matters by checking first whether cmi +c * lies outside |cmimin| and |cmimax|, giving angle of 0 or 2*pi. +c * cmimin and cmimax are gotten from prior call to gcmlim. +c * + if (cmi.le.abs(cmimin)) then +c region excludes circle + if (cmimin.ge.0._10) then + angle=0._10 +c region encloses circle + elseif (cmimin.lt.0._10) then + angle=TWOPI + endif + elseif (cmi.ge.abs(cmimax)) then +c circle encloses region + if (cmimax.ge.0._10) then + angle=0._10 +c circle and region enclose each other + elseif (cmimax.lt.0._10) then + angle=TWOPI + endif + else +c circle intersects boundary of region + call gphi(angle,rp,cm,np,rpi,cmi,phi,tol,iord) + endif + return + end +c diff --git a/src/gptin.c b/src/gptin.c new file mode 100644 index 0000000..ec9ad91 --- /dev/null +++ b/src/gptin.c @@ -0,0 +1,21 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Determine whether unit vector lies inside polygon. + + This is a c interface to fortran logical function gptin. + + Input: poly is a polygon. + rp = unit vector. + Return value: 1 if in; + 0 if not in. +*/ +int gptin(polygon *poly, vec rp) +{ + /* fortran routine */ + if (gptin_(poly->rp, poly->cm, &poly->np, rp)) return(1); + return(0); +} diff --git a/src/gptin.s.f b/src/gptin.s.f new file mode 100644 index 0000000..57d4b25 --- /dev/null +++ b/src/gptin.s.f @@ -0,0 +1,52 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + logical function gptin(rp,cm,np,rpi) + integer np + real*10 rp(3,np),cm(np),rpi(3) +c +c intrinsics + intrinsic abs +c externals + integer gzeroar +c local (automatic) variables + integer j + real*10 cmij,cmj +c * +c * Determine whether unit direction rpi lies within region bounded by +c * 1 - r.rp(j) <= cm(j) (if cm(j).ge.0) +c * 1 - r.rp(j) > -cm(j) (if cm(j).lt.0) +c * for j=1,np where rp(j) are unit directions. +c * +c Input: rp(3,j),j=1,np +c cm(j),j=1,np +c np +c rpi(3) +c Output: gptin = .true. if point lies within region +c .false. if outside. +c + gptin=.false. +c check for point outside because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c check each boundary + do 140 j=1,np +c null boundary means no constraint + if (cm(j).ge.2._10) goto 140 + cmj=abs(cm(j)) +c 1-cos of angle between point and rp(j) direction + cmij=((rpi(1)-rp(1,j))**2+(rpi(2)-rp(2,j))**2 + * +(rpi(3)-rp(3,j))**2)/2._10 +c check if point is outside rp(j) boundary + if (cm(j).ge.0._10) then + if (cmij.gt.cmj) goto 410 + elseif (cm(j).lt.0._10) then + if (cmij.le.cmj) goto 410 + endif + 140 continue +c point survived all assails + gptin=.true. +c done + 410 continue + return + end +c diff --git a/src/gspher.c b/src/gspher.c new file mode 100644 index 0000000..05de171 --- /dev/null +++ b/src/gspher.c @@ -0,0 +1,152 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <stdio.h> +#include "manglefn.h" +#include "pi.h" + +/*------------------------------------------------------------------------------ + Spherical harmonics of polygon. + + This is a c interface to fortran subroutine gspher. + It is the full version, that returns area, bound and vert + in addition to the spherical harmonics. + + Input: poly is a polygon. + lmax = maximum harmonic number. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *area = area of polygon. + bound, vert = as described in comments to gspher.s.f . + w = array containing spherical harmonics of polygon; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: 0 if ok; + 1 if fatal error; + -1 if could not allocate temporary memory. +*/ +int gspher(polygon *poly, int lmax, long double *tol, long double *area, long double bound[2], long double vert[2], harmonic w[/*NW*/]) +{ + logical ldegen; + int i, ibv, ier, im, iphi, iw, lmax1, nw, verb; + long double darea; + /* work arrays */ + int *iord; + long double *v, *phw; + + /* determine area without 2 pi ambiguity, and a good value for tol */ + verb = 1; + ier = garea(poly, tol, verb, area); + if (ier) return(ier); + + /* trivial case of zero area */ + if (*area == 0.) { + bound[0] = 0.; + bound[1] = 0.; + vert[0] = 0.; + vert[1] = 0.; + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) w[iw][i] = 0.; + } + + return(0); + } + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gspher: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phw = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phw) { + fprintf(stderr, "gspher: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + v = (long double *) malloc(sizeof(long double) * (lmax + 1)); + if (!v) { + fprintf(stderr, "gspher: failed to allocate memory for %d long doubles\n", lmax + 1); + return(-1); + } + + /* parameters */ + lmax1 = lmax + 1; + im = IM; + nw = NW; + ibv = 0; + iphi = 0; + + /* the fortran routine */ + gspher_(&darea, bound, vert, w, &lmax1, &im, &nw, poly->rp, poly->cm, &poly->np, &poly->np, &ibv, &iphi, tol, phw, iord, v, &ldegen); + + /* monopole harmonic without 2 pi/sqrtl(4 pi) ambiguity */ + w[0][0] = *area / sqrtl(4. * PI); + + /* free work arrays */ + free(iord); + free(phw); + free(v); + + /* fatal error */ + if (ldegen) return(1); + + return(0); +} + +/*------------------------------------------------------------------------------ + Accelerated computation of spherical harmonics of rectangle. + + This is a c interface to fortran subroutine gsphera. + It is the full version, that returns area, bound and vert + in addition to the spherical harmonics. + + The acceleration involves some overhead, and works only if two or more + rectangles with the same elmin & elmax are computed in succession. + The overhead means that the accelerated computation is actually slightly + slower for just a single rectangle. + + Input: lmax = maximum harmonic number. + Output: w = array containing spherical harmonics of polygon; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: 0 if ok; + -1 if could not allocate temporary memory. +*/ +int gsphera(long double azmin, long double azmax, long double elmin, long double elmax, int lmax, long double *area, long double bound[2], long double vert[2], harmonic w[/*NW*/]) +{ + /* array used for acceleration */ + static long double *dw = 0x0; + + int ibv, im, lmax1, nw; + /* work array */ + long double *v; + + /* allocate memory for work arrays */ + v = (long double *) malloc(sizeof(long double) * (lmax + 1)); + if (!v) { + fprintf(stderr, "gsphera: failed to allocate memory for %d long doubles\n", lmax + 1); + return(-1); + } + + /* parameters */ + lmax1 = lmax + 1; + im = IM; + nw = NW; + ibv = 0; + + /* dw contains array that is pre-computed, then used by all rects with same elmin, elmax */ + if (!dw) { + dw = (long double *) malloc(sizeof(long double) * NW); + if (!dw) { + fprintf(stderr, "gsphera: failed to allocate memory for %d long doubles\n", NW); + return(-1); + } + } + + /* fortran routine */ + gsphera_(area, bound, vert, w, &lmax1, &im, &nw, &ibv, &azmin, &azmax, &elmin, &elmax, v, dw); + + /* free work array */ + free(v); + + return(0); +} diff --git a/src/gspher.s.f b/src/gspher.s.f new file mode 100644 index 0000000..7420058 --- /dev/null +++ b/src/gspher.s.f @@ -0,0 +1,592 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gspher(area,bound,vert,w,lmax1,im,nw,rp,cm,np,npc,ibv, + * iphi,tol,phw,iord,v,ldegen) + integer lmax1,im,nw,np,npc,ibv,iphi + logical ldegen + real*10 area,bound(2),vert(2),w(im,nw),rp(3,np),cm(np),tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np) + real*10 phw(2,np),v(lmax1) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c externals + integer garpi,gsegij,gzeroar +c data variables + real*10 big + real*10 dphmin +c local (automatic) variables + integer i,iarea,ik,iseg,j,jm,jml,jmu,jp,jpl,jpu,k,km,kp,l, + * nbd,nbd0m,nbd0p,ni,nmult,retry,scmi +C logical warn + logical whole + real*10 bik,ci,cmi,cmik,cmk,cti,ctk,ctpsi, + * d,darea,dbound(2),dph,dvert(2),ikchk,ikran, + * ph,phi,phii,phm,php,psi,psip,ri,rii,si,sk,sqrt4pi,t,tolin, + * xi(3),yi(3) +c * +c * Spherical transform of region W of sphere of unit radius bounded by +c * 1 - r.rp(i) < cm(i) (if cm(i).ge.0) +c * 1 - r.rp(i) > -cm(i) (if cm(i).lt.0) +c * for i=1,np where rp(i) are unit directions. +c * See AJSH notes Multfn C115. +c * +c * bound (boundary) and vert (vertex) are related to the coefficients +c * of the 1st & 2nd order terms of the power series expansion +c * in sin(th/2) of the correlation <WW> at angular separation th: +c * <WW> = sum(lm) |W_lm|^2 P_l(cos th) +c * = 2*pi*area - 4*bound*sin(th/2) + 2*vert*sin^2(th/2) + ... +c * In fact bound is just the total length of the boundary in radians, +c * and vert is the sum over vertex terms of 1-psi/tan(psi), where +c * psi is the exterior angle (=pi-interior angle) at the vertex. +c * The range of validity of the power series expansion in sin(th/2) +c * depends on the tortuousness of the boundary: the more convoluted the +c * boundary, and the sharper the vertex angles, the shorter the range. +c * +c * Oct 1992: next order term incorporated +c * <WW> = 2*pi*area - 4*bound(1)*sin(th/2) + 2*vert(1)*sin^2(th/2) +c * + [2/3*bound(2) + 8/9*vert(2)]*sin^3(th/2) + ... +c * +c * The option ibv modifies the evaluation of bound and vert, +c * and determines the sign of the returned harmonics. +c * ibv = 0: standard option, for <WW>. +c * The code returns the harmonics of W in the array w. +c * ibv = 1: to take the cross-correlation between a region W1 and +c * its intersection W12 with region W2. +c * Here <W12 W1> = <W12^2> + <W12(W1-W12)> +c * and this is what the code evaluates bound and vert for. +c * The code returns the harmonics of W12 in the array w. +c * ibv = 2: to take region W1 less its intersection W12 with region W2. +c * Here <WW> = <(W1-W12)(W1-W12)> +c * = <W1^2> - <W12^2> - 2<W12(W1-W12)> +c * The code evaluates bound and vert for +c * <W12^2> + 2<W12(W1-W12)>. +c * The code returns MINUS the harmonics of W12 in the array w. +c * ibv = 3: to take the union of regions W1 and W2. +c * Here <WW> = <(W1+W2-W12)(W1+W2-W12)> +c * = <W1^2> + <W2^2> - <W12^2> + 2<(W1-W12)(W2-W12)> +c * The code evaluates bound and vert for +c * <W12^2> - 2<(W1-W12)(W2-W12)>. +c * The code returns MINUS the harmonics of W12 in the array w. +c * The correct calling procedure in each case is exampled below. +c * +c * Complement of a region: +c * area -> 4*pi-area, w(1,1) -> sqrt(4*pi)-w(1,1) +c * bound -> bound +c * vert -> vert +c * w -> -w except monopole term w(1,1) as above +c * +c * To get intersection W12 of regions W1 & W2, +c * but evaluate bound & vert for cross-correlation between W12 and W1: +c * put the np2 constraints of region W2 in 1 to npc +c * & the np1 constraints of region W1 in npc+1 to np +c * call gspher(area,bound,vert,w,parameters of W1,npc=np2,1,...) +c * +c * To get region W1 less its intersection with region W2: +c * call gspher(area,bound,vert,w,parameters of W1,npc=0,0,...) +c * put the np2 constraints of region W2 in 1 to npc +c * & the np1 constraints of region W1 in npc+1 to np +c * call gspher(darea,dbound,dvert,w,params of W1 & W2,npc=np2,2,...) +c * area=area-darea +c * bound=bound-dbound +c * vert=vert-dvert +c * +c * To get the union of two regions W1 & W2: +c * call gspher(area,bound,vert,w,parameters of W1,npc=0,0,...) +c * call gspher(darea,dbound,dvert,w,parameters of W2,npc=0,0,...) +c * area=area+darea +c * bound=bound+dbound +c * vert=dvert+dvert +c * put the np2 constraints of region W2 in 1 to npc +c * & the np1 constraints of region W1 in npc+1 to np +c * call gspher(darea,dbound,dvert,w,params of W1 & W2,npc=np2,3,...) +c * area=area-darea +c * bound=bound-dbound +c * vert=dvert-dvert +c * +c * Cautions: +c * (1) This subroutine underestimates the area (monopole harmonic) +c * by 2*pi (sqrt(pi)) if 2*pi <= area < 4*pi +c * and the area is bounded by more than one arc. +c * (2) This subroutine will usually work correctly when there are near +c * multiple (.ge. 3) intersections of boundaries, but in rare +c * instances it may fail. If so, it should flag the failure with +c * ldegen=.true. This error condition should NOT be ignored. +c * (3) There is a mathematical ambiguity in the boundary term bound +c * whenever two (or more) boundaries coincide. To resolve the +c * ambiguity correctly, perturb the boundaries slightly. +c * Likewise there is a mathematical ambiguity in the vertex term +c * vert whenever there are multiple (.ge. 3) intersections. +c * Again, to resolve the ambiguity correctly, perturb the +c * boundaries slightly. +c * It should be noted that if these problems exist, then the series +c * expansion of <WW>, whose coefficients involve bound and vert, +c * probably breaks down already at tiny values of the separation +c * angle th. +c * +c Input: lmax1 = lmax+1 where lmax is maximum desired l of transform. +c im = 1 means compute only real part of harmonics; +c 2 means compute both real and imaginary parts. +c Note harmonics are real if region possesses reflection +c symmetry through plane defined by z-axis and direction +c rp(iphi). +c nw = [(lmax+1)*(lmax+2)]/2 +c rp(3,i),i=1,np = x, y, z coordinates of a set of unit +c directions defining the region. +c It is assumed without checking that +c rp(1)^2 + rp(2)^2 + rp(3)^2 = 1 . +c cm(i),i=1,np = set of 1-cos's defining the region. +c np = number of directions. +c npc = part number of directions, used in conjunction with ibv; +c see above for more details; +c npc is irrelevant if ibv = 0. +c ibv = 0 to 3 controls evaluation of bound & vert; +c see above for more details. +c iphi > 0 means compute harmonics in frame of reference where +c y-axis is along z x rp(iphi); +c = 0 means use the input frame of reference. +c Output: area = area of region in steradians. +c bound = length of boundary of region in radians if ibv=0, +c or as explained above if ibv>0. +c vert = sum over vertices of 1-psi/tan(psi) if ibv=0, +c where psi is exterior angle (=pi-interior angle) +c at vertex, or as explained above if ibv>0. +c ldegen = .true. signals an error: the code dealt incorrectly +c with a multiply intersecting boundary. +c Input/Output: w(i,lm) = spherical transform, dimensioned w(im,nw) +c w(i,lm), i=1,im, lm=l*(l+1)/2+m+1, l=0,lmax, m=0,l; +c w(1,lm) is real part, w(2,lm) is imaginary part (if im=2). +c Note w(l,-m)=(-)**m*[Complex conjugate of w(l,m)], just as +c Y(l,-m)=(-)**m*[Complex conjugate of Y(l,m)]. +c tol +c Work arrays: phw and iord should be dimensioned at least 2*np. +c v should be dimensioned at least lmax1. +c +c set azimuthal angle of non-intersection to big + data big /1.e6_10/ +c possible multiple intersection when dph < dphmin + data dphmin /1.e-8_10/ +c +c input tolerance to multiple intersections + tolin=tol +C print *,'--------------------' +c come here with modified tolerance + 100 continue +c initialise error flag to no error + ldegen=.false. +C warn=.false. +c zero stuff + area=0._10 + bound(1)=0._10 + bound(2)=0._10 + vert(1)=0._10 + vert(2)=0._10 + do j=1,nw + do i=1,im + w(i,j)=0._10 + enddo + enddo +c check for zero area because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c no constraints at all will mean area is whole sphere + whole=.true. +c number of intersecting arc segments bounding area + nbd=0 +c number of non-intersecting circles bounding area + nbd0m=0 + nbd0p=0 +c error check on evaluation of vertex terms + ikchk=0._10 +c area=sqrt(4pi)*monopole + sqrt4pi=sqrt(4._10*PI) +c harmonics defined so point iphi is at zero azimuthal angle + rii=0._10 + if (iphi.ge.1) rii=sqrt(rp(1,iphi)**2+rp(2,iphi)**2) + phii=0._10 + if (rii.gt.0._10) phii=atan2(rp(2,iphi),rp(1,iphi)) +c--------identify boundary segments around each circle i in turn + do 280 i=1,np +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) goto 280 +c there is a constraint, so area is not whole sphere + whole=.false. +c scmi * cmi = 1-cos th(i) + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) +c ci = cos th(i) + ci=1._10-cmi +c si = sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c........ri, phi, rp(3,i) are cylindrical coordinates of rp(i) + ri=sqrt(rp(1,i)**2+rp(2,i)**2) + if (ri.eq.0._10.or.i.eq.iphi) then + phi=0._10 + else + phi=atan2(rp(2,i),rp(1,i))-phii + endif +c........construct cartesian axes with z-axis along rp(i) +c The direction of yi is important here, +c unlike some other subroutines (gphi, garea, gphbv, gvlim, gvphi) +c where yi can point in any abitrary direction. +c set yi in direction z x rp(i) + if (ri.gt.0._10) then + yi(1)=-rp(2,i)/ri + yi(2)=rp(1,i)/ri + yi(3)=0._10 +c if rp(i) is along z-axis, set yi in direction z x rp(iphi) + elseif (rii.gt.0._10) then + yi(1)=-rp(2,iphi)/rii + yi(2)=rp(1,iphi)/rii + yi(3)=0._10 +c if rp(iphi) is also along z-axis, set yi along y-axis + elseif (ri.eq.0._10.and.rii.eq.0._10) then + yi(1)=0._10 + yi(2)=1._10 + yi(3)=0._10 + endif +c xi in direction yi x rp(i) + xi(1)=yi(2)*rp(3,i)-yi(3)*rp(2,i) + xi(2)=yi(3)*rp(1,i)-yi(1)*rp(3,i) + xi(3)=yi(1)*rp(2,i)-yi(2)*rp(1,i) +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phw) +c i circle lies outside polygon + if (ni.eq.-1) goto 280 +c area of polygon is zero + if (ni.eq.-2) then +c area can be non-zero from psi at multiple intersections + area=0._10 + bound(1)=0._10 + bound(2)=0._10 + vert(1)=0._10 + vert(2)=0._10 + do l=1,nw + do k=1,im + w(k,l)=0._10 + enddo + enddo + goto 410 + endif +c........i circle has no intersections + if (ni.eq.0) then + if (scmi.ge.0) then + nbd0p=nbd0p+1 + else + nbd0m=nbd0m+1 + endif + dph=TWOPI + if (scmi.lt.0) dph=-dph + ph=0._10 +c increment area + darea=cmi*dph + area=area+darea +c bound(1) term is length of boundary + dbound(1)=si*abs(dph) + dbound(2)=(1._10/si-2._10*si)*abs(dph) +c standard + if (ibv.eq.0 +c cross + * .or.(ibv.eq.1.and.i.gt.npc) +c intersection + * .or.(ibv.eq.2.and.i.gt.npc) +c union + * .or.(ibv.eq.3)) then + bound(1)=bound(1)+dbound(1) + bound(2)=bound(2)+dbound(2) +c intersection + elseif (ibv.eq.2.and.i.le.npc) then + bound(1)=bound(1)-dbound(1) + bound(2)=bound(2)-dbound(2) + endif +C print *,'at',i,': full circle area +=',darea,' =',area +C print *,'dbound =',dbound(1),dbound(2), +C * ' bound =',bound(1),bound(2) +c increment spherical transform + if (ibv.ge.2) dph=-dph + call wlm(w,lmax1,im,nw,ri,phi,0,rp(3,i),ci,si,ph,dph,v) +c........i circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around i circle + call findbot(phw,2*np,iord,ni) +c........contribution from each segment of i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rp(1,i),scmi,cmi,tol,ni, + * phw,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c near multiple intersection + if (dph.lt.dphmin) then +c increment count of near multiple intersections + nmult=nmult+1 +c warn=.true. +c print *, +c * '*** warning from gspher: near multiple intersection at' +c * ,i,': segment',km,kp,' dph=',dph + endif +c........segment satisfies conditions + nbd=nbd+1 +c contribution to area from the boundary segment + if (scmi.lt.0) dph=-dph + darea=cmi*dph-dph + area=area+darea +c bound(1) term is length of boundary + dbound(1)=si*abs(dph) + dbound(2)=(1._10/si-2._10*si)*abs(dph) +c standard + if (ibv.eq.0 +c cross + * .or.(ibv.eq.1.and.i.gt.npc) +c intersection + * .or.(ibv.eq.2.and.i.gt.npc) +c union + * .or.(ibv.eq.3)) then + bound(1)=bound(1)+dbound(1) + bound(2)=bound(2)+dbound(2) +c intersection + elseif (ibv.eq.2.and.i.le.npc) then + bound(1)=bound(1)-dbound(1) + bound(2)=bound(2)-dbound(2) + endif +C print *,'at',i,': edge',km,kp, +C * ' (',jm,' in',jml,jmu,',',jp,' in',jpl,jpu,' of',ni,')' +C print *,'dph =',dph,' area +=',darea,' =',area +C print *,'dbound =',dbound(1),dbound(2), +C * ' bound =',bound(1),bound(2) +c contribution to area and vert from end points of the segment + do 240 l=1,2 +c end point is intersection of i circle with k circle + if (l.eq.1) then + k=km + elseif (l.eq.2) then + k=kp + endif +c only do ik intersection once, +c but check both ik and ki intersections made it here +c from segment k to segment i right-handedly through vertex + if ((l.eq.1.and.scmi.ge.0).or.(l.eq.2.and.scmi.lt.0)) then + ik=k+np*i + if (k.lt.i) ik=ik+1 +c from segment i to segment k right-handedly through vertex + else + ik=i+np*k + if (i.lt.k) ik=ik+1 + endif +c pseudo-random number from ik + call ikrand(ik,ikran) + if (i.gt.k) then +c ikchk = ikchk - ikran, subtracted as unsigned long long's + call ikrandm(ikchk,ikran) + goto 240 + endif +c ikchk = ikchk + ikran, added as unsigned long long's + call ikrandp(ikchk,ikran) + cmk=abs(cm(k)) + sk=sqrt(cmk*(2._10-cmk)) +c cmik = 1-cos th(ik) + cmik=((rp(1,i)-rp(1,k))**2+(rp(2,i)-rp(2,k))**2 + * +(rp(3,i)-rp(3,k))**2)/2._10 +c bik = cik-ci*ck +c d = 1-ci^2-ck^2-cik^2+2*ci*ck*cik +c cos psi = bik/(si*sk) +c sin psi = sqrt(d)/(si*sk) +c psi = atan(sqrt(d)/bik) is exterior angle at intersection + bik=(cmi+cmk)-cmi*cmk-cmik + if ((scmi.ge.0.and.cm(k).lt.0._10) + * .or.(scmi.lt.0.and.cm(k).ge.0._10)) bik=-bik +c i and k circles kiss + if (phw(1,k).eq.phw(2,k)) then + d=0._10 + else + d=-(cmi-cmk)**2+cmik*(2._10*((cmi+cmk)-cmi*cmk)-cmik) +c assert that circles at least touch + if (d.lt.0._10) d=0._10 + d=sqrt(d) + endif + ctpsi=bik/d + psi=atan2(d,bik) +c increment area + area=area-psi +c t=tan psi/2 + if (bik.gt.0._10) then + t=d/(bik+sqrt(bik**2+d**2)) + elseif (bik.lt.0._10) then + t=(-bik+sqrt(bik**2+d**2))/d + elseif (bik.eq.0._10) then + t=1._10 + endif +c cti = cot th(i) + cti=(1._10-cmi)/si + if (scmi.lt.0) cti=-cti +c ctk = cot th(k) + ctk=(1._10-cmk)/sk + if (cm(k).lt.0._10) ctk=-ctk +c standard + if (ibv.eq.0 + * .or.(ibv.eq.1.and.i.gt.npc.and.k.gt.npc) + * .or.(ibv.eq.2.and.i.gt.npc.and.k.gt.npc) + * .or.(ibv.eq.3.and.((i.gt.npc.and.k.gt.npc) + * .or.(i.le.npc.and.k.le.npc)))) then + if (psi.eq.0._10) then + dvert(1)=0._10 + dvert(2)=0._10 + else + dvert(1)=1._10-psi*ctpsi + dvert(2)=t*(3._10+t**2)*(cti+ctk)/2._10 + endif + vert(1)=vert(1)+dvert(1) + vert(2)=vert(2)+dvert(2) +c cross + elseif (ibv.eq.1) then + if (i.le.npc.and.k.le.npc) then + continue + else + dvert(1)=PI/2._10*ctpsi + dvert(2)=t*(3._10+t**2)*(cti+ctk)/2._10 + vert(1)=vert(1)-dvert(1) + vert(2)=vert(2)+dvert(2)/2._10 + t=1._10/t + dvert(2)=t*(3._10+t**2)*(cti-ctk)/2._10 + if (i.gt.npc) then + vert(2)=vert(2)-dvert(2)/2._10 + elseif (k.gt.npc) then + vert(2)=vert(2)+dvert(2)/2._10 + endif + endif +c intersection + elseif (ibv.eq.2) then + if (i.le.npc.and.k.le.npc) then + if (psi.eq.0._10) then + dvert(1)=0._10 + dvert(2)=0._10 + else + dvert(1)=1._10-psi*ctpsi + dvert(2)=t*(3._10+t**2)*(cti+ctk)/2._10 + endif + vert(1)=vert(1)-dvert(1) + vert(2)=vert(2)-dvert(2) + else +c psip = pi - psi + psip=atan2(d,-bik) + if (psip.eq.0._10) then + dvert(1)=0._10 + dvert(2)=0._10 + else + dvert(1)=1._10+psip*ctpsi + t=1._10/t + dvert(2)=t*(3._10+t**2)*(cti-ctk)/2._10 + endif + vert(1)=vert(1)-dvert(1) + if (i.gt.npc) then + vert(2)=vert(2)-dvert(2) + elseif (k.gt.npc) then + vert(2)=vert(2)+dvert(2) + endif + endif +c union + elseif (ibv.eq.3) then + if (psi.eq.0._10) then + dvert(1)=0._10 + dvert(2)=0._10 + else + dvert(1)=1._10-psi*ctpsi + dvert(2)=t*(3._10+t**2)*(cti+ctk)/2._10 + endif + vert(1)=vert(1)-dvert(1) + vert(2)=vert(2)+dvert(2) + endif +C print *,' intersect',i,k,' area +=',-psi,' =',area +C print *,' dvert =',dvert(1),dvert(2), +C * ' vert =',vert(1),vert(2) +C print *,' cot(',psi,') =',1._10/tan(psi), +C * ' should =',ctpsi +C print *,' tan(',psi,'/2) =',tan(psi/2._10), +C * ' should =',t +C print *,' cot(th_i) =',cti,' cot(th_k) =',ctk +c peculiar monopole term + if (ibv.ge.2) psi=-psi + w(1,1)=w(1,1)-psi/sqrt4pi + 240 continue +c increment spherical transform + if (ibv.ge.2) dph=-dph + call wlm(w,lmax1,im,nw,ri,phi,0,rp(3,i),ci,si,ph,dph,v) +c do another segment + goto 220 + endif + 280 continue +c--------check on whether ik endpoints matched ki endpoints + if (ikchk.ne.0._10) then +C warn=.true. +c print *,'*** from gspher: at tol =',tol, +c * ', ikchk=',ikchk,' should be 0' +c retry with enlarged tolerance + call gtol(tol,tolin) + goto 100 + endif +c--------add/subtract 2*pi's to area + retry=garpi(area,iarea,rp,cm,np,whole,nbd0m,nbd0p,nbd,nmult) +c adjust monopole harmonic by corresponding 2*pi/sqrt(4*pi) + if (ibv.eq.0.or.ibv.eq.1) then + i=nint((w(1,1)*sqrt4pi-area)/TWOPI) + elseif (ibv.eq.2.or.ibv.eq.3) then + i=nint((w(1,1)*sqrt4pi+area)/TWOPI) + endif + w(1,1)=w(1,1)-i*TWOPI/sqrt4pi +c retry with modified tolerance + if (retry.eq.1) then +C warn=.true. + call gtol(tol,tolin) + goto 100 + endif +c--------done + 410 continue +C if (warn) then +C write (*,'(a3,a20,4a24)') +C * ' ','x','y','z', +c * 'r', +C * '1-c' +C do j=1,np +C write (*,'(i3,5g24.16)') +C * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), +C * cm(j) +C enddo +C endif +C print *,'final area =',area,' bound =',bound(1),bound(2), +C * ' vert =',vert(1),vert(2) +C print *,'....................' + return +c + 420 print *,'*** from gspher: total failure at tol =',tol + ldegen=.true. + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo +C print *,'....................' + return +c + end +c diff --git a/src/gsphera.s.f b/src/gsphera.s.f new file mode 100644 index 0000000..9c89541 --- /dev/null +++ b/src/gsphera.s.f @@ -0,0 +1,144 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gsphera(area,bound,vert,w,lmax1,im,nw,ibv, + * azmin,azmax,elmin,elmax,v,dw) + integer lmax1,im,nw,ibv + real*10 area,bound(2),vert(2),w(im,nw), + * azmin,azmax,elmin,elmax,dw(nw) +c work array (could be automatic if compiler supports it) + real*10 v(lmax1) +c +c parameters + include 'pi.par' + real*10 TWOPI,PIBYTWO + parameter (TWOPI=2._10*PI,PIBYTWO=PI/2._10) +c data variables + real*10 elmino,elmaxo +c saved variables + real*10 cl,cu,dth,sl,su + save cl,cu,dth,sl,su +c local (automatic) variables + integer i,l,m,lm,lmax,mmax + real*10 azmx,cmph,d,dph,ph,smph,thmin,thmax +c * +c * Accelerated computation of spherical transform +c * of rectangle bounded by lines of constant latitude & longitude. +c * +c Input: lmax1 = lmax+1 where lmax is maximum desired l of transform. +c im = 1 means compute only real part of harmonics; +c 2 means compute both real and imaginary parts. +c Note harmonics are real if region possesses reflection +c symmetry through plane defined by x- and z-axes. +c nw = [(lmax+1)*(lmax+2)]/2 +c ibv = 0 to 3 controls evaluation of bound & vert, +c and determines the sign of the returned harmonics, +c same as in gspher; +c see comments in gspher for more details. +c azmin, azmax = minimum, maximum azimuth of rectangle in radians; +c if azmin > azmax, it is assumed that the rectangle +c runs from azmin to azmax + 2*pi . +c To cover an entire strip of latitude, use +c azmin, azmax = 0, 2*pi . +c elmin, elmax = minimum, maximum elevation of rectangle in radians; +c South pole is at elevation -pi/2, North at +pi/2. +c Output: area = area of rectangle in steradians. +c bound = length of boundary of rectangle in radians if ibv=0, +c or as explained in gspher ibv>0. +c vert = sum over vertices of 1-psi/tan(psi) if ibv=0, +c where psi is exterior angle (=pi-interior angle) +c at vertex, or as explained in gspher if ibv>0. +c dw = integral_thmin^thmax Y_lm(th,0) sin th d th, +c which should be saved between calls. +c Input/Output: w(i,lm) = spherical transform, dimensioned w(im,nw) +c w(i,lm), i=1,im, lm=l*(l+1)/2+m+1, l=0,lmax, m=0,l; +c w(1,lm) is real part, w(2,lm) is imaginary part (if im=2). +c Note w(l,-m)=(-)**m*[Complex conjugate of w(l,m)], just as +c Y(l,-m)=(-)**m*[Complex conjugate of Y(l,m)]. +c Work arrays: v should be dimensioned at least lmax1. +c + data elmino,elmaxo /2*0._10/ +c +c zero stuff + area=0._10 + bound(1)=0._10 + bound(2)=0._10 + vert(1)=0._10 + vert(2)=0._10 + do lm=1,nw + do i=1,im + w(i,lm)=0._10 + enddo + enddo +c check input parameters OK + if (lmax1.le.0) goto 200 + if (elmin.ge.PIBYTWO.or.elmax.le.-PIBYTWO) goto 200 + if (elmin.ge.elmax) goto 200 + azmx=azmax +c assume azmax.lt.azmin means need to add 2*pi to azmax + if (azmx.lt.azmin) azmx=azmx+TWOPI +c--------compute integrals of harmonics if elmin and elmax changed + if (elmino.ne.elmin.or.elmaxo.ne.elmax) then + if (elmax.ge.PIBYTWO) then + thmin=0._10 + cu=1._10 + su=0._10 + else + thmin=PIBYTWO-elmax + cu=cos(thmin) + su=sin(thmin) + endif + if (elmin.le.-PIBYTWO) then + thmax=PI + cl=-1._10 + sl=0._10 + else + thmax=PIBYTWO-elmin + cl=cos(thmax) + sl=sin(thmax) + endif + dth=thmax-thmin +c integrals of harmonics: this takes most time + call iylm(thmin,thmax,dw,lmax1,nw,v) + elmaxo=elmax + elmino=elmin + endif +c--------fast computation of harmonics + dph=azmx-azmin + area=(cu-cl)*dph + if (ibv.eq.0.or.ibv.eq.2.or.ibv.eq.3) then + bound(1)=(sl+su)*dph+2._10*dth + bound(2)=(1._10/sl-2._10*sl+1._10/su-2._10*su)*dph-2._10*dth + vert(1)=4._10 + vert(2)=4._10*(cl/sl-cu/su) + if (ibv.eq.2) then + bound(1)=-bound(1) + bound(2)=-bound(2) + vert(1)=-vert(1) + vert(2)=-vert(2) + endif + endif + ph=(azmx+azmin)/2._10 + if (ibv.ge.2) dph=-dph + lmax=lmax1-1 + mmax=lmax + if (dph-nint(dph/TWOPI)*TWOPI.eq.0._10) mmax=0 + do m=0,mmax + if (m.eq.0) then + d=dph + elseif (m.gt.0) then + d=sin(m*dph/2._10)*2._10/dble(m) + endif + cmph=cos(m*ph) + smph=sin(m*ph) + lm=(m*(m+1))/2+1 + do l=m,lmax + lm=lm+l + w(1,lm)=w(1,lm)+cmph*d*dw(lm) + if (im.eq.2) w(2,lm)=w(2,lm)-smph*d*dw(lm) + enddo + enddo + 200 continue + return + end +c diff --git a/src/gsphr.c b/src/gsphr.c new file mode 100644 index 0000000..eae5be2 --- /dev/null +++ b/src/gsphr.c @@ -0,0 +1,146 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <stdio.h> +#include "manglefn.h" +#include "pi.h" + +/*------------------------------------------------------------------------------ + Spherical harmonics of polygon. + + This is a simplified c interface to fortran subroutine gspher. + It returns the spherical harmonics, and does not worry about bound and vert. + + Input: poly is a polygon. + lmax = maximum harmonic number. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: w = array containing spherical harmonics of polygon; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: 0 if ok; + 1 if fatal error; + -1 if could not allocate temporary memory. +*/ +int gsphr(polygon *poly, int lmax, long double *tol, harmonic w[/*NW*/]) +{ + logical ldegen; + int i, ibv, ier, im, iphi, iw, lmax1, npc, nw, verb; + long double area, bound[2], darea, vert[2]; + /* work arrays */ + int *iord; + long double *v, *phw; + + /* determine area without 2 pi ambiguity, and a good value for tol */ + verb = 1; + ier = garea(poly, tol, verb, &area); + if (ier) return(ier); + + /* trivial case of zero area */ + if (area == 0.) { + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) w[iw][i] = 0.; + } + + return(0); + } + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gsphr: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phw = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phw) { + fprintf(stderr, "gsphr: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + v = (long double *) malloc(sizeof(long double) * (lmax + 1)); + if (!v) { + fprintf(stderr, "gsphr: failed to allocate memory for %d long doubles\n", lmax + 1); + return(-1); + } + + /* parameters */ + lmax1 = lmax + 1; + im = IM; + nw = NW; + npc = 0; + ibv = 0; + iphi = 0; + + /* the fortran routine */ + gspher_(&darea, bound, vert, w, &lmax1, &im, &nw, poly->rp, poly->cm, &poly->np, &npc, &ibv, &iphi, tol, phw, iord, v, &ldegen); + + /* monopole harmonic without 2 pi/sqrtl(4 pi) ambiguity */ + w[0][0] = area / sqrtl(4. * PI); + + /* free work arrays */ + free(iord); + free(phw); + free(v); + + /* fatal error */ + if (ldegen) return(1); + + return(0); +} + +/*------------------------------------------------------------------------------ + Accelerated computation of spherical harmonics of rectangle. + + This is a simplified c interface to fortran subroutine gsphera. + It returns the spherical harmonics, and does not worry about bound and vert. + + The acceleration involves some overhead, and works only if two or more + rectangles with the same elmin & elmax are computed in succession. + The overhead means that the accelerated computation is actually slightly + slower for just a single rectangle. + + Input: lmax = maximum harmonic number. + Output: w = array containing spherical harmonics of polygon; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: 0 if ok; + -1 if could not allocate temporary memory. +*/ +int gsphra(long double azmin, long double azmax, long double elmin, long double elmax, int lmax, harmonic w[/*NW*/]) +{ + /* array used for acceleration */ + static long double *dw = 0x0; + + int ibv, im, lmax1, nw; + long double area, bound[2], vert[2]; + /* work array */ + long double *v; + + /* allocate memory for work arrays */ + v = (long double *) malloc(sizeof(long double) * (lmax + 1)); + if (!v) { + fprintf(stderr, "gsphra: failed to allocate memory for %d long doubles\n", lmax + 1); + return(-1); + } + + /* parameters */ + lmax1 = lmax + 1; + im = IM; + nw = NW; + ibv = 0; + + /* dw contains array that is pre-computed, then used by all rects with same elmin, elmax */ + if (!dw) { + dw = (long double *) malloc(sizeof(long double) * NW); + if (!dw) { + fprintf(stderr, "gsphra: failed to allocate memory for %d long doubles\n", NW); + return(-1); + } + } + + /* fortran routine */ + gsphera_(&area, bound, vert, w, &lmax1, &im, &nw, &ibv, &azmin, &azmax, &elmin, &elmax, v, dw); + + /* free work array */ + free(v); + + return(0); +} diff --git a/src/gsubs.s.f b/src/gsubs.s.f new file mode 100644 index 0000000..7690194 --- /dev/null +++ b/src/gsubs.s.f @@ -0,0 +1,1304 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + integer function gzeroar(cm,np) + integer np + real*10 cm(np) +c +c local (automatic) variables + integer i +c * +c * Check for zero area because one circle is null. +c * +c Input: cm +c np +c Return value: 0 if area is zero because one circle is null, +c 1 otherwise +c + do i=1,np + if (cm(i).eq.0._10) goto 200 + if (cm(i).le.-2._10) goto 200 + enddo + gzeroar=1 + return +c + 200 gzeroar=0 + return +c + end +c +c----------------------------------------------------------------------- + subroutine gaxisi(rp,xi,yi) + real*10 rp(3),xi(3),yi(3) +c +c local (automatic) variables + real*10 sx +c * +c * Cartesian axes with z-axis along rp. +c * +c Input: rp +c Output: xi, yi forming right-handed orthonormal system with rp +c + sx=rp(1)**2+rp(3)**2 + if (sx.gt..5_10) then + sx=sqrt(sx) +c xi in direction y x rp (= x direction if rp is along z) + xi(1)=rp(3)/sx + xi(2)=0._10 + xi(3)=-rp(1)/sx + else + sx=sqrt(rp(1)**2+rp(2)**2) +c xi in direction rp x z + xi(1)=rp(2)/sx + xi(2)=-rp(1)/sx + xi(3)=0._10 + endif +c yi in direction rp x xi (= y direction if rp is along z) + yi(1)=xi(3)*rp(2)-xi(2)*rp(3) + yi(2)=xi(1)*rp(3)-xi(3)*rp(1) + yi(3)=xi(2)*rp(1)-xi(1)*rp(2) + return +c + end +c +c----------------------------------------------------------------------- + subroutine gaxisii(rpi,rp,xi,yi) + real*10 rpi(3),rp(3),xi(3),yi(3) +c +c local (automatic) variables + real*10 ri,sik +c * +c * Cartesian axes with z-axis along rp, x-axis towards rpi. +c * +c Input: rpi +c Output: xi, yi forming right-handed orthonormal system with rpi +c +c set yi in direction rp x rpi + yi(1)=rpi(3)*rp(2)-rpi(2)*rp(3) + yi(2)=rpi(1)*rp(3)-rpi(3)*rp(1) + yi(3)=rpi(2)*rp(1)-rpi(1)*rp(2) +c project yi orthogonal to rp, to avoid problems near yi=0 + ri=yi(1)*rp(1)+yi(2)*rp(2)+yi(3)*rp(3) + yi(1)=yi(1)-ri*rp(1) + yi(2)=yi(2)-ri*rp(2) + yi(3)=yi(3)-ri*rp(3) + sik=yi(1)**2+yi(2)**2+yi(3)**2 + if (sik.gt.0._10) then +c sik = sin th(ik) + sik=sqrt(sik) + yi(1)=yi(1)/sik + yi(2)=yi(2)/sik + yi(3)=yi(3)/sik +c rpi is same/opposite direction to rp: set yi along z x rp + else + ri=sqrt(rp(1)**2+rp(2)**2) + if (ri.gt.0._10) then + yi(1)=-rp(2)/ri + yi(2)=rp(1)/ri + yi(3)=0._10 +c if rp is also along z-axis, set yi along y-axis + else + yi(1)=0._10 + yi(2)=1._10 + yi(3)=0._10 + endif + endif +c xi in direction yi x rp + xi(1)=yi(2)*rp(3)-yi(3)*rp(2) + xi(2)=yi(3)*rp(1)-yi(1)*rp(3) + xi(3)=yi(1)*rp(2)-yi(2)*rp(1) + return +c + end +c +c----------------------------------------------------------------------- + subroutine gphij(rp,cm,np,i,rpi,scmi,cmi,xi,yi,big,tol,ni,phi) + integer np,i,scmi,ni + real*10 rp(3,np),cm(np),rpi(3),cmi,xi(3),yi(3),big,tol,phi(2,np) +c +c intrinsics + intrinsic abs +c local (automatic) variables + integer j + real*10 bi,bj,cmij,cmj,d,dc,xj,yj +c * +c * angles phi about z-axis rp(i) of intersection of i & j circles +c * phi = big means no intersection +c * +c Input: rp, cm +c np = number of caps +c i +c rpi = rp(i) +c scmi = sign(cm(i)) +c cmi = abs(cm(i)) +c xi, yi form orthonormal axes with rp(i) +c big +c tol = great circle angle closer than which +c i & j circles are considered coincident +c Output: ni = number of intersections of i circle with j circles +c = -1 if circle i is entirely outside another circle +c = -2 if area of polygon is zero +c phi(1,j), phi(2,j) = azimuthal angle about rpi +c of intersection of j circle with i circle; +c zero azimuthal angle is in direction xi. +c +c--------initialise phi to big, meaning no intersection + do j=1,np + phi(1,j)=big + phi(2,j)=big + enddo +c set count of number of intersections with i circle to zero + ni=0 +c--------find intersection of i circle with each j circle in turn + do 150 j=1,np +c skip self + if (j.eq.i) goto 150 +c cm(j).ge.2 means include whole sphere, so no intersection + if (cm(j).ge.2._10) goto 150 +c cmij = 2 sin^2[th(ij)/2] = 1-cos th(ij) + cmij=((rpi(1)-rp(1,j))**2+(rpi(2)-rp(2,j))**2 + * +(rpi(3)-rp(3,j))**2)/2._10 +c cmj = 1-cos th(j) +c bj = cj-ci*cij +c d = 1-ci^2-cj^2-cij^2+2*ci*cj*cij +c dph = atan(sqrt(d)/bj) is angle from rp(j) to intersection + cmj=abs(cm(j)) + bj=(cmi-cmj)+cmij*(1._10-cmi) + d=-(cmi-cmj)**2+cmij*(2._10*((cmi+cmj)-cmi*cmj)-cmij) +c if i and j circles are angle e apart at closest approach, then +c d approx 2 sin th(i) sin th(j) sin th(ij) * e for small e + dc=2._10*sqrt(cmi*cmj*cmij*(2._10-cmi)*(2._10-cmj)*(2._10-cmij)) +c........positive d means i and j circles intersect +c if i and j circles are <= tol apart, treat d as zero + if (d.gt.tol*dc) then + d=sqrt(d) +c ph = atan(yj/xj) is angle from xi to rp(j) + xj=xi(1)*rp(1,j)+xi(2)*rp(2,j)+xi(3)*rp(3,j) + yj=yi(1)*rp(1,j)+yi(2)*rp(2,j)+yi(3)*rp(3,j) +c order intersection angles so segment from first to second angle +c is inside j circle +c Notice order of evaluation of RHS of phi(1,j) and phi(2,j) is same; +c this ensures that gcc evaluates identically for identical arguments. + if (cm(j).ge.0._10) then +c phi(1,j)=ph-dph , phi(2,j)=ph+dph + phi(1,j)=atan2(yj*bj-xj*d,xj*bj+yj*d) + phi(2,j)=atan2(yj*bj+xj*d,xj*bj-yj*d) + elseif (cm(j).lt.0._10) then +c phi(1,j)=ph+dph , phi(2,j)=ph-dph + phi(2,j)=atan2(yj*bj-xj*d,xj*bj+yj*d) + phi(1,j)=atan2(yj*bj+xj*d,xj*bj-yj*d) + endif +c increment count of number of intersections + ni=ni+2 +c........zero d means i and j circles just touch; +c negative d means i and j circles don't intersect + else +c bi = ci-cj*cij + bi=(cmj-cmi)+cmij*(1._10-cmj) +c. . . . bi=0 means i and j circles coincide, implying also bj=0 and d=0 +c but test both bi and bj to guard against numerics + if (bi.eq.0._10.or.bj.eq.0._10) then +c null intersection of areas: +c rp(i) and rp(j) point in same direction + if (cmij.lt.1._10) then +c cm(i) and cm(j) have opposite sign + if ((scmi.ge.0.and.cm(j).lt.0._10) + * .or.(scmi.lt.0.and.cm(j).ge.0._10)) goto 220 +c rp(i) and rp(j) point in opposite directions + elseif (cmij.gt.1._10) then +c cm(i) and cm(j) have same sign + if ((scmi.ge.0.and.cm(j).ge.0._10) + * .or.(scmi.lt.0.and.cm(j).lt.0._10)) goto 220 + endif +c only do later of the two degenerate circles + if (i.lt.j) goto 210 +c. . . . i circle does not coincide with j circle + else +c. . . . i circle is outside j circle + if ((cm(j).ge.0._10.and.bj.gt.0._10) + * .or.(cm(j).lt.0._10.and.bj.lt.0._10)) then +c j circle also outside i circle means null intersection area + if ((scmi.ge.0.and.bi.gt.0._10) + * .or.(scmi.lt.0.and.bi.lt.0._10)) goto 220 +c skip i circle since it's entirely outside j circle + goto 210 + endif +c. . . . i circle is inside j circle, and just touches it + if (d.ge.-tol*dc) then +c. . . . j circle is also inside i circle, and just touches it + if ((scmi.ge.0.and.bi.lt.0._10) + * .or.(scmi.lt.0.and.bi.gt.0._10)) then +c ph = atan(yj/xj) is angle from xi to rp(j) + xj=xi(1)*rp(1,j)+xi(2)*rp(2,j)+xi(3)*rp(3,j) + yj=yi(1)*rp(1,j)+yi(2)*rp(2,j)+yi(3)*rp(3,j) +c phi(1,j)=phi(2,j)=ph + phi(1,j)=atan2(yj*bj,xj*bj) + phi(2,j)=phi(1,j) +c increment count of number of intersections + ni=ni+2 + endif + endif + endif + endif + 150 continue +c--------normal return + return +c +c--------circle lies entirely outside another circle + 210 ni=-1 + return +c +c--------area is zero + 220 ni=-2 + return +c + end +c +c----------------------------------------------------------------------- + subroutine ggpij(np,gp,i,big,phi) + integer np,gp(np),i + real*10 big,phi(2,np) +c +c local (automatic) variables + integer j +c * +c * Called after gphij(). +c * Identify friends: +c * if circle j intersects circle i, then i and j are friends. +c * +c Input: np = number of caps. +c i = circle +c big = value of phi if i and j do not intersect. +c phi(1,j), phi(2,j) = azimuthal angle about rp(i) +c of intersection of j circle with i circle. +c Input/Output: +c gp(j),j=1,np = which group of friends circle j belongs to: +c i and j are friends +c if i and j circles intersect (anywhere). +c + do j=1,np +c j circle intersects i circle + if (phi(1,j).ne.big) then +c make j group same as i group + if (gp(i).lt.gp(j)) then + gp(j)=gp(i) +c make i group same as j group + elseif (gp(j).lt.gp(i)) then + gp(i)=gp(j) + endif + endif + enddo + return + end +c +c----------------------------------------------------------------------- + subroutine ggp(np,gp) + integer np,gp(np) +c +c local (automatic) variables + integer j +c * +c * Called after all friends have been identified. +c * Consolidate groups by letting friends of friends be friends. +c * +c Input: np = number of caps. +c Input/Output: +c gp(j),j=1,np = which group of friends circle j belongs to: +c i and j are friends +c if i and j circles intersect (anywhere), +c and friends of friends are friends. +c + do j=1,np + 200 if (gp(j).ne.gp(gp(j))) then + gp(j)=gp(gp(j)) + goto 200 + endif + enddo + return + end +c +c----------------------------------------------------------------------- + integer function gsegij(rp,cm,np,npb,npc,i,rpi,scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,nphbv,jm,jp,km,kp,phm,php,ph,dph) + integer np,npb,npc,i,scmi,ni,iord(2*np), + * jml,jmu,jpl,jpu,nphbv,jm(nphbv),jp(nphbv),km(nphbv),kp(nphbv) + real*10 rp(3,np),cm(np),rpi(3),cmi,tol,phi(2,np),phm,php,ph,dph +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c local (automatic) variables + integer iphbv,j,jj,k,kk + logical ismax + real*10 bik,cmik,cmk,d,psi,psim(2),dphc,si +c local variables to be saved + integer jl,ju + save jl,ju +c * +c * Determine whether next segment of i circle +c * is an edge of the polygon. +c * The thing that complicates this subroutine is the need +c * to deal with near multiple intersections, where several +c * j circles intersect the i circle at almost the same point. +c * Intersections closer than angle tol (great circle separation) +c * are considered coincident. +c * +c * If the segment is an edge, then km and kp are the circles +c * crossing at the lower and upper limits of the edge, +c * with multiple intersections correctly taken into account. +c * The values of phm and php are those corresponding to the +c * intersection with the km and kp circles. +c * +c * Normally nphbv = 1, but nphbv = 2 when called from gphbv. +c * If nphbv = 2, then the intersections of the i circle +c * are collected into two sets, those from the same polygon +c * as the i circle, and those from the abutting polygon. +c * +c Input: rp +c cm +c npb +c npc +c i +c rpi = rp(i) +c scmi = sign(cm(i)) +c cmi = abs(cm(i)) +c np +c tol = great circle angle closer than which +c points on i circle are considered coincident +c ni = number of intersections of j circles with i circle +c phi = angles of j circles about i circle +c iord = order of j circles about i circle +c jpl = 0 on first call +c = per output of previous call subsequently +c Output: jml, jmu = points jml to jmu are at lower point +c jpl, jpu = points jpl to jpu are at upper point +c jml <= jmu < jpl <= jpu +c 1 <= jmu <= ni +c jml may be <= 0, and jpl & jpu may be >= ni +c nphbv = number of elements of arrays jm, jp, km, kp +c jm = lower point to use +c jp = upper point to use +c km = circle at lower limit of segment +c kp = circle at upper limit of segment +c phm = azimuthal angle at lower limit of segment +c php = azimuthal angle at upper limit of segment +c ph = azimuthal angle at centre of segment +c dph = azimuthal length of segment between limits +c Return value: -1 = error (tol is too large) +c 0 = segment is not edge of polygon +c 1 = segment is edge of polygon +c 2 = done all segments +c + if (jpl.ne.0) then +c done + if (jpl.eq.jl+ni) goto 220 + endif +c sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c dphc = azimuthal angle corresponding to great circle angle tol + if (tol.gt.PI) goto 300 + dphc=sin(tol/2._10)/si +c abort if tol/2 exceeds th(i) + if (dphc.gt.1._10) goto 300 + dphc=2._10*asin(dphc) +c--------first segment: jml <= 1 <= jmu < jpl <= jpu < jml+ni + if (jpl.eq.0) then +c lower point: jml to jmu are all at the same azimuth phi + jml=1 + do j=jml,ni + jmu=j + jp(1)=mod(j,ni)+1 + km(1)=(iord(j)+1)/2 + kp(1)=(iord(jp(1))+1)/2 +c lower and upper angles of segment + phm=phi(1+mod(iord(j)+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + dph=php-phm + if (dph.lt.0._10) dph=dph+TWOPI + if (dph.gt.dphc) goto 110 + enddo + 110 continue +c check if lower point goes lower than 1 + do j=ni,jmu+1,-1 + jp(1)=mod(j,ni)+1 + km(1)=(iord(j)+1)/2 + kp(1)=(iord(jp(1))+1)/2 +c lower and upper angles of segment + phm=phi(1+mod(iord(j)+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + dph=php-phm + if (dph.lt.0._10) dph=dph+TWOPI + if (dph.gt.dphc) goto 120 + jml=j + enddo + 120 continue + if (jml.gt.jmu) jml=jml-ni +c record range jl to ju of lower point of first segment + jl=jml + ju=jmu +c segment is entire circle + if (jmu-jml+1.ge.ni) then +c print *,'gsegij: segment',jml,' to',jmu, +c * ' includes all',ni,' intersections' + jpl=jmu+1 + jpu=jmu+ni + else +c upper point: jpl to jpu are all at the same azimuth phi + jpl=jmu+1 + do j=jpl,jl-1+ni + jpu=j + jp(1)=mod(j,ni)+1 + km(1)=(iord(j)+1)/2 + kp(1)=(iord(jp(1))+1)/2 +c lower and upper angles of segment + phm=phi(1+mod(iord(j)+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + dph=php-phm + if (dph.lt.0._10) dph=dph+TWOPI + if (dph.gt.dphc) goto 130 + enddo + 130 continue +c first segment: jml <= 1 <= jmu < jpl <= jpu < jl+ni + if (jml.gt.1.or.jml.gt.jmu.or.jmu.lt.1.or.jmu.gt.ni + * .or.jmu.ge.jpl.or.jpl.gt.jpu.or.jpu.ge.jl+ni) then +c shouldn't happen + print *,'*** error from gsegij: 1st segment,', + * ni,' intersections:',jml,jmu,jpl,jpu + endif + endif +c--------subsequent segments: jml <= jmu < jpl <= jpu <= ju+ni + elseif (jpl.ne.0) then +c lower point: jml to jmu are all at the same azimuth phi + jml=jpl + do j=jml,jl-1+ni + jmu=j + jp(1)=mod(j,ni)+1 + km(1)=(iord(j)+1)/2 + kp(1)=(iord(jp(1))+1)/2 +c lower and upper angles of segment + phm=phi(1+mod(iord(j)+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + dph=php-phm + if (dph.lt.0._10) dph=dph+TWOPI + if (dph.gt.dphc) goto 140 + enddo + 140 continue +c upper point: jpl to jpu are all at the same azimuth phi + jpl=jmu+1 + do j=jpl,ni+ju + jpu=j + jm(1)=mod(j-1+ni,ni)+1 + jp(1)=mod(j,ni)+1 + km(1)=(iord(jm(1))+1)/2 + kp(1)=(iord(jp(1))+1)/2 +c lower and upper angles of segment + phm=phi(1+mod(iord(jm(1))+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + dph=php-phm + if (dph.lt.0._10) dph=dph+TWOPI + if (dph.gt.dphc) goto 150 + enddo + 150 continue +c subsequent segments: 1 < jml <= jmu < jpl <= jpu <= ju+ni + if (jml.le.1.or.jml.gt.jmu.or.jmu.lt.1.or.jmu.gt.ni + * .or.jmu.ge.jpl.or.jpl.gt.jpu.or.jpu.gt.ju+ni) then +c shouldn't happen + print *,'*** error from gsegij: >= 2nd segment,', + * ni,' intersections:',jml,jmu,jpl,jpu + endif + endif +c--------process segment +c lower angle(s) must be lower limit of segments jml to jmu + do j=jml,jmu + jm(1)=mod(j-1+ni,ni)+1 +c lower angle is an upper limit + if (mod(iord(jm(1)),2).eq.0) then + km(1)=(iord(jm(1))+1)/2 +c lower angle is not a lower limit + if (phi(1,km(1)).ne.phi(2,km(1))) goto 210 + endif + enddo +c upper angle(s) must be upper limit of segments jpl to jpu + do j=jpl,jpu + jp(1)=mod(j-1+ni,ni)+1 +c upper angle is a lower limit + if (mod(iord(jp(1)),2).eq.1) then + kp(1)=(iord(jp(1))+1)/2 +c upper angle is not an upper limit + if (phi(1,kp(1)).ne.phi(2,kp(1))) goto 210 + endif + enddo + jm(1)=mod(jml-1+ni,ni)+1 + jp(1)=mod(jpu-1+ni,ni)+1 + km(1)=(iord(jm(1))+1)/2 + kp(1)=(iord(jp(1))+1)/2 + phm=phi(1+mod(iord(jm(1))+1,2),km(1)) + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) +c check segment satisfies all conditions + if (php.gt.phm) then + do j=1,ni +c need to check against k circle only once, at lower limit + if (mod(iord(j),2).eq.1) then + k=(iord(j)+1)/2 +c require order k- ...ph- ph+... k+ + if (phi(2,k).gt.phi(1,k)) then + if (php.le.phi(1,k).or.phm.ge.phi(2,k)) goto 210 +c or k+ k- ...ph- ph+... or ...ph- ph+... k+ k- + elseif (phi(2,k).lt.phi(1,k)) then + if (php.le.phi(1,k).and.phm.ge.phi(2,k)) goto 210 + endif + endif + enddo + elseif (php.lt.phm) then + do j=1,ni +c need to check against k circle only once, at lower limit + if (mod(iord(j),2).eq.1) then + k=(iord(j)+1)/2 +c require order ph+... k+ k- ...ph- + if (phi(2,k).gt.phi(1,k)) then + if (php.le.phi(1,k).and.phm.ge.phi(2,k)) goto 210 + endif + endif + enddo + endif +c........point at lower limit is one with largest exterior angle psi + if (jml.eq.jmu) then + if (nphbv.eq.2) then + jj=jm(1) + kk=km(1) + do iphbv=1,nphbv + if ((iphbv.eq.1 + * .and.((i.le.npb.and.kk.le.npb) + * .or.(i.gt.npb.and.kk.gt.npb) + * .or.kk.gt.npc)) + * .or.(iphbv.eq.2 + * .and.((i.le.npb.and.kk.gt.npb) + * .or.(i.gt.npb.and.kk.le.npb) + * .or.kk.gt.npc))) then + jm(iphbv)=jj + km(iphbv)=kk + else + jm(iphbv)=0 + km(iphbv)=0 + endif + enddo + endif + else + do iphbv=1,nphbv + psim(iphbv)=-1._10-2._10*tol + enddo + if (nphbv.eq.2) then + do iphbv=1,nphbv + jm(iphbv)=0 + km(iphbv)=0 + enddo + endif + do j=jml,jmu + jj=mod(j-1+ni,ni)+1 +c lower angle is a lower limit + if (mod(iord(jj),2).eq.1) then + kk=(iord(jj)+1)/2 + cmk=abs(cm(kk)) +c cmik = 1-cos th(ik) + cmik=((rpi(1)-rp(1,kk))**2+(rpi(2)-rp(2,kk))**2 + * +(rpi(3)-rp(3,kk))**2)/2._10 +c bik = cik-ci*ck +c d = 1-ci^2-ck^2-cik^2+2*ci*ck*cik +c cos psi = bik/(si*sk) +c sin psi = sqrt(d)/(si*sk) +c psi = atan(sqrt(d)/bik) is exterior angle at intersection + bik=(cmi+cmk)-cmi*cmk-cmik + d=-(cmi-cmk)**2+cmik*(2._10*((cmi+cmk)-cmi*cmk)-cmik) + if (d.lt.0._10) d=0._10 + if ((scmi.ge.0.and.cm(kk).lt.0._10) + * .or.(scmi.lt.0.and.cm(kk).ge.0._10)) bik=-bik + do iphbv=1,nphbv + if (iphbv.eq.2) bik=-bik + psi=atan2(sqrt(d),bik) + ismax=.false. + if (nphbv.eq.1 + * .or.(iphbv.eq.1 + * .and.((i.le.npb.and.kk.le.npb) + * .or.(i.gt.npb.and.kk.gt.npb) + * .or.kk.gt.npc)) + * .or.(iphbv.eq.2 + * .and.((i.le.npb.and.kk.gt.npb) + * .or.(i.gt.npb.and.kk.le.npb) + * .or.kk.gt.npc))) then +c choose largest exterior angle psi + if (psi.gt.psim(iphbv)+tol) then + ismax=.true. + elseif (psi.ge.psim(iphbv)-tol) then + if (cm(kk).ge.0._10) then + if (cm(km(iphbv)).ge.0._10) then +c only do tighter of two circles with same exterior angle + if (cm(kk).lt.cm(km(iphbv))) then + ismax=.true. +c or later of two degenerate circles + elseif (cm(kk).eq.cm(km(iphbv)) + * .and.kk.gt.km(iphbv)) then + ismax=.true. + endif + else + if (cm(kk)-1._10.lt.cm(km(iphbv))+1._10) then + ismax=.true. + elseif (cm(kk)-1._10.eq.cm(km(iphbv))+1._10 + * .and.kk.gt.km(iphbv)) then + ismax=.true. + endif + endif + else + if (cm(km(iphbv)).lt.0._10) then + if (cm(kk).lt.cm(km(iphbv))) then + ismax=.true. + elseif (cm(kk).eq.cm(km(iphbv)) + * .and.kk.gt.km(iphbv)) then + ismax=.true. + endif + else + if (cm(kk)+1._10.lt.cm(km(iphbv))-1._10) then + ismax=.true. + elseif (cm(kk)+1._10.eq.cm(km(iphbv))-1._10 + * .and.kk.gt.km(iphbv)) then + ismax=.true. + endif + endif + endif + endif + endif + if (ismax) then + jm(iphbv)=jj + km(iphbv)=kk + psim(iphbv)=psi + endif + enddo + endif + enddo + endif +c........point at upper limit is one with largest exterior angle psi + if (jpl.eq.jpu) then + if (nphbv.eq.2) then + jj=jp(1) + kk=kp(1) + do iphbv=1,nphbv + if ((iphbv.eq.1 + * .and.((i.le.npb.and.kk.le.npb) + * .or.(i.gt.npb.and.kk.gt.npb) + * .or.kk.gt.npc)) + * .or.(iphbv.eq.2 + * .and.((i.le.npb.and.kk.gt.npb) + * .or.(i.gt.npb.and.kk.le.npb) + * .or.kk.gt.npc))) then + jp(iphbv)=jj + kp(iphbv)=kk + else + jp(iphbv)=0 + kp(iphbv)=0 + endif + enddo + endif + else + do iphbv=1,nphbv + psim(iphbv)=-1._10-2._10*tol + enddo + if (nphbv.eq.2) then + do iphbv=1,nphbv + jp(iphbv)=0 + kp(iphbv)=0 + enddo + endif + do j=jpl,jpu + jj=mod(j-1+ni,ni)+1 +c upper angle is an upper limit + if (mod(iord(jj),2).eq.0) then + kk=(iord(jj)+1)/2 + cmk=abs(cm(kk)) +c cmik = 1-cos th(ik) + cmik=((rpi(1)-rp(1,kk))**2+(rpi(2)-rp(2,kk))**2 + * +(rpi(3)-rp(3,kk))**2)/2._10 +c bik = cik-ci*ck +c d = 1-ci^2-ck^2-cik^2+2*ci*ck*cik +c cos psi = bik/(si*sk) +c sin psi = sqrt(d)/(si*sk) +c psi = atan(sqrt(d)/bik) is exterior angle at intersection + bik=(cmi+cmk)-cmi*cmk-cmik + d=-(cmi-cmk)**2+cmik*(2._10*((cmi+cmk)-cmi*cmk)-cmik) + if (d.lt.0._10) d=0._10 + if ((scmi.ge.0.and.cm(kk).lt.0._10) + * .or.(scmi.lt.0.and.cm(kk).ge.0._10)) bik=-bik + do iphbv=1,nphbv + if (iphbv.eq.2) bik=-bik + psi=atan2(sqrt(d),bik) + ismax=.false. + if (nphbv.eq.1 + * .or.(iphbv.eq.1 + * .and.((i.le.npb.and.kk.le.npb) + * .or.(i.gt.npb.and.kk.gt.npb) + * .or.kk.gt.npc)) + * .or.(iphbv.eq.2 + * .and.((i.le.npb.and.kk.gt.npb) + * .or.(i.gt.npb.and.kk.le.npb) + * .or.kk.gt.npc))) then +c choose largest exterior angle psi + if (psi.gt.psim(iphbv)+tol) then + ismax=.true. + elseif (psi.ge.psim(iphbv)-tol) then + if (cm(kk).ge.0._10) then + if (cm(kp(iphbv)).ge.0._10) then +c only do tighter of two circles with same exterior angle + if (cm(kk).lt.cm(kp(iphbv))) then + ismax=.true. +c or later of two degenerate circles + elseif (cm(kk).eq.cm(kp(iphbv)) + * .and.kk.gt.kp(iphbv)) then + ismax=.true. + endif + else + if (cm(kk)-1._10.lt.cm(kp(iphbv))+1._10) then + ismax=.true. + elseif (cm(kk)-1._10.eq.cm(kp(iphbv))+1._10 + * .and.kk.gt.kp(iphbv)) then + ismax=.true. + endif + endif + else + if (cm(kp(iphbv)).lt.0._10) then + if (cm(kk).lt.cm(kp(iphbv))) then + ismax=.true. + elseif (cm(kk).eq.cm(kp(iphbv)) + * .and.kk.gt.kp(iphbv)) then + ismax=.true. + endif + else + if (cm(kk)+1._10.lt.cm(kp(iphbv))-1._10) then + ismax=.true. + elseif (cm(kk)+1._10.eq.cm(kp(iphbv))-1._10 + * .and.kk.gt.kp(iphbv)) then + ismax=.true. + endif + endif + endif + endif + endif + if (ismax) then + jp(iphbv)=jj + kp(iphbv)=kk + psim(iphbv)=psi + endif + enddo + endif + enddo + endif +c circles at upper and lower limits + if (km(1).ne.0) then + phm=phi(1+mod(iord(jm(1))+1,2),km(1)) + else + phm=phi(1+mod(iord(jm(2))+1,2),km(2)) + endif + if (kp(1).ne.0) then + php=phi(1+mod(iord(jp(1))+1,2),kp(1)) + else + php=phi(1+mod(iord(jp(2))+1,2),kp(2)) + endif +c angular length, centre point of segment + if (php.gt.phm) then + dph=php-phm + ph=(php+phm)/2._10 + elseif (php.le.phm) then + ph=(php+phm)/2._10 + if (ph.le.0._10) then + ph=ph+PI + php=php+TWOPI + elseif (ph.gt.0._10) then + ph=ph-PI + phm=phm-TWOPI + endif + dph=php-phm + endif +c segment is edge of polygon + 200 gsegij=1 + return +c +c------segment is not edge of polygon + 210 gsegij=0 + return +c +c------done full circle + 220 gsegij=2 + return +c +c------tol is too large + 300 gsegij=-1 + return +c + end +c +c----------------------------------------------------------------------- + subroutine gvtrail(scmi,np,i,km,kp,vtrail,vik,nvmax,nv,ik,ikchk) + integer scmi,np,i,km,kp,nvmax,vtrail(nvmax),vik(nvmax,2),nv,ik + real*10 ikchk +c +c externals + integer ik2ik +c integer ik2i,ik2k +c local (automatic) variables + integer iv,k,l + real*10 ikran +c * +c * Record endpoints of edge. +c * +c Input: scmi +c np +c i +c km, kp +c nvmax +c nv +c Output: vtrail +c vik +c ik +c Input/Output: ikchk +c +c two end points of the edge, going right-handedly around edge + do l=1,2 +c end point is intersection of i circle with k circle + if ((l.eq.1.and.scmi.ge.0).or.(l.eq.2.and.scmi.lt.0)) then + k=km + else + k=kp + endif +c print *,' intersect',i,k +c from edge k to edge i right-handedly through vertex + if (l.eq.1) then + ik=ik2ik(np,k,i) +c from edge i to edge k right-handedly through vertex + else + ik=ik2ik(np,i,k) + endif + if (nv.le.nvmax) then + vik(nv,l)=ik + endif +c pseudo-random number from ik + call ikrand(ik,ikran) +c new intersection + if (i.lt.k) then +c ikchk = ikchk + ikran, added as unsigned long long's + call ikrandp(ikchk,ikran) +c intersection already met + else +c ikchk = ikchk - ikran, subtracted as unsigned long long's + call ikrandm(ikchk,ikran) + if (nv.le.nvmax) then +c index of vertex already met + if (l.eq.1) then + do iv=1,nv + if (vik(iv,2).eq.ik) then +c vertex after iv is nv + vtrail(iv)=nv + goto 240 + endif + enddo + elseif (l.eq.2) then + do iv=1,nv + if (vik(iv,1).eq.ik) then +c vertex after nv is iv + vtrail(nv)=iv + goto 240 + endif + enddo + endif +c can happen if near multiple intersection is inconsistent +c print *,'*** from gvtrail: no vertex', +c * ' (',ik2i(np,ik),ik2k(np,ik),')', +c * ' found at',i,', edge',km,kp,'???' +c write (*,'(" vertices so far are:",$)') +c do iv=1,nv +c write (*,'(" (",i2,i3,") (",i2,i3,")",$)') +c * ik2k(np,vik(iv,1)),ik2i(np,vik(iv,1)), +c * ik2i(np,vik(iv,2)),ik2k(np,vik(iv,2)) +c enddo +c write (*,'(/$)') + 240 continue + endif + endif + enddo + return + end +c +c----------------------------------------------------------------------- + integer function ik2ik(np,i,k) + integer np,i,k +c + integer ik +c +c gives ik = 1,2,...,np(np-1) for i,k = 0,1,...,np with i != k + ik=i+np*k + if (i.lt.k) ik=ik+1 + ik2ik=ik + return + end +c +c----------------------------------------------------------------------- + integer function ik2i(np,ik) + integer np,ik +c + integer i,k +c + i=mod(ik-1,np) + k=(ik-1)/np + if (i.ge.k) i=i+1 + ik2i=i + return + end +c +c----------------------------------------------------------------------- + integer function ik2k(np,ik) + integer np,ik +c + integer k +c + k=(ik-1)/np + ik2k=k + return + end +c +c----------------------------------------------------------------------- + subroutine gvord(np,nv,ipv,gp,ev,nev,vtrail,vord,vik,gord) + integer np,nv,ipv(nv),gp(np),ev(nv),nev, + * vtrail(nv),vord(nv),vik(nv),gord(nv) +c +c externals + integer ik2i,ik2k +c local (automatic) variables + integer iev,inter,iv,ivm,jv,kv,nvm +c * +c * Order of vertices around polygon. +c * +c Input: np = number of caps +c nv = number of vertices +c ipv(iv) = circle number of vertex iv +c gp(i) = group to which circle i belongs +c vtrail = vertex trail +c vik(iv) = value of ik at iv'th vertex +c Output: vord = vertex order +c ev = end indices of each connected sequence of vertices +c nev = number of connected sequences of vertices +c + nev=0 + if (nv.gt.0) then +c print *,'gvord: vertex trail:',(vtrail(iv),iv=1,nv) +c print *,'gvord: vik_1 on input:',(vord(iv),iv=1,nv) +c print *,'gvord: vik_2 on input:',(vik(iv),iv=1,nv) +c group vertex belongs to + do iv=1,nv + vord(iv)=gp(ipv(iv)) + enddo +c order vertices by group + call finibot(vord,nv,gord,nv) +c initialize vord to zero + do iv=1,nv + vord(iv)=0 + enddo + jv=0 + iev=0 +c do intersecting, then non-intersecting circles + do inter=1,2 + do 320 ivm=1,nv +c order connected sequences by group + nvm=gord(ivm) +c find first vertex not already traversed + do iv=1,nv + if (vord(iv).eq.nvm) goto 320 + enddo + if (inter.eq.1) then + if (ik2i(np,vik(nvm)).eq.0.or.ik2k(np,vik(nvm)).eq.0) + * goto 320 + else + if (ik2i(np,vik(nvm)).ne.0.and.ik2k(np,vik(nvm)).ne.0) + * goto 320 + endif +c index of first vertex of this boundary + jv=jv+1 + vord(jv)=nvm +c circulate + kv=jv+1 + do jv=kv,nv +c next vertex of this boundary + vord(jv)=vtrail(vord(jv-1)) +c gone full circle + if (vtrail(vord(jv)).eq.nvm) then +c record cumulative length + iev=iev+1 + ev(iev)=jv + nev=nev+1 + if (jv.eq.nv) goto 330 + goto 320 + endif + enddo + 320 continue + enddo + 330 continue +c print *,'vertex order:',(vord(iv),iv=1,nv) +c print *,'vertex groups:',(gp(ipv(iv)),iv=1,nv) +c should not happen + if (vtrail(vord(nv)).ne.nvm) then + print *,'*** from gvord: last vertex',vord(nv), + * ' should connect to',nvm,'???' + endif + endif + return +c + end +c +c----------------------------------------------------------------------- + real*10 function cmijf(rpi,rpj) + real*10 rpi(3),rpj(3) +c * +c * 1 - cos th(ij) +c * where th(ij) is angle between unit vectors rpi and rpj. +c * +c * Input: rpi, rpj = unit vectors +c Output: cmij = 1 - cos th(ij) +c + cmijf=((rpi(1)-rpj(1))**2+(rpi(2)-rpj(2))**2 + * +(rpi(3)-rpj(3))**2)/2._10 +c + return + end +c +c----------------------------------------------------------------------- + subroutine vpermi(ix,n,iperm,iwk) + integer n,iperm(n) + integer ix(n),iwk(n) +c +c local (automatic) variables + integer i,j +c * +c * Permutes elements of integer array ix(n) by permutation iperm(n). +c * +c Input: n = dimension of array ix +c iperm = array of dimension n specifying permutation of ix +c Input/Output: ix = integer array of dimension n +c Work array: wk of dimension n +c + do i=1,n + iwk(i)=ix(i) + enddo + do i=1,n + j=iperm(i) + ix(i)=iwk(j) + enddo + return + end +c +c----------------------------------------------------------------------- + subroutine vpermd(x,n,iperm,wk) + integer n,iperm(n) + real*10 x(n),wk(n) +c +c local (automatic) variables + integer i,j +c * +c * Permutes elements of real*10 array x(n) by permutation iperm(n). +c * +c Input: n = dimension of array x +c iperm = array of dimension n specifying permutation of x +c Input/Output: x = real*10 array of dimension n +c Work array: wk of dimension n +c + do i=1,n + wk(i)=x(i) + enddo + do i=1,n + j=iperm(i) + x(i)=wk(j) + enddo + return + end +c +c----------------------------------------------------------------------- + subroutine vpermdd(x,m,n,iperm,wk) + integer m,n,iperm(n) + real*10 x(m,n),wk(n) +c +c local (automatic) variables + integer i,j,k +c * +c * Permutes each column of real*10 array x(m,n) by permutation iperm(n). +c * +c Input: m,n = dimensions of array x +c iperm = array of dimension n specifying permutation +c of each column x +c Input/Output: x = real*10 array of dimension m,n +c Work array: wk of dimension n +c + do k=1,m + do i=1,n + wk(i)=x(k,i) + enddo + do i=1,n + j=iperm(i) + x(k,i)=wk(j) + enddo + enddo + return + end +c +c----------------------------------------------------------------------- + integer function garpi(area,iarea,rp,cm,np, + * whole,nbd0m,nbd0p,nbd,nmult,tol) + integer iarea,np,nbd0m,nbd0p,nbd,nmult + logical whole + real*10 area,rp(3,np),cm(np),tol +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c data variables + real*10 areatol +c local (automatic) variables + integer i,icmmin + real*10 cmmin,darea,p +c * +c * Add iarea*2*pi to area. +c * +c Input: rp +c cm +c np +c whole = whether region is whole sphere. +c nbd0m = number of non-intersecting circles bounding polygon +c with cm < 0. +c nbd0p = number of non-intersecting circles bounding polygon +c with cm >= 0. +c nbd = number of edges bounding polygon, +c excluding non-intersecting circles. +c nmult = number of near multiply-intersecting circles +c on boundary of polygon. +c Output: iarea = number of 2*pi's by which area was adjusted. +c Input/Output: area -> area+iarea*2*pi. +c Return value: 0 = ok; +c 1 = recommend retry with enlarged tol. +c +c ok if area tests not too far outside [0,max] + data areatol /1.e-10_10/ +c + if (whole) then + iarea=2 + area=area+iarea*TWOPI +c all boundaries are non-intersecting circles + elseif (nbd.eq.0) then + if (nbd0m.eq.0.and.nbd0p.eq.0) then + iarea=0 + else +c from area formula involving the Euler characteristic + iarea=2*(1-nbd0p) + area=area+iarea*TWOPI + endif +c some boundaries are intersecting circles + else +c add/subtract 2*pi's to area to ensure 0.le.area.lt.2*pi + iarea=area/TWOPI + area=area-iarea*TWOPI +C if (iarea.ne.0) print *,'area +=',iarea,' * TWOPI =',area + if (area.lt.0._10) then + iarea=iarea+1 + area=area+TWOPI +C print *,'area += TWOPI =',area + endif +c there were near multiple intersections + if (nmult.ge.1) then +c chances are area just less than 2*pi is actually zero + if (area.ge.TWOPI-areatol) then + iarea=iarea-1 + area=0._10 + goto 400 + endif + endif +c check area does not exceed area within any one circle + cmmin=2._10 + do i=1,np + if (cm(i).ge.0._10) then + if (cm(i).lt.cmmin) then + cmmin=cm(i) + icmmin=i + endif + elseif (cm(i).lt.0._10) then + if (2._10+cm(i).lt.cmmin) then + cmmin=2._10+cm(i) + icmmin=i + endif + endif + enddo + darea=TWOPI*cmmin + p=area/darea +C print *,'area/area(',icmmin,')=',area,' /',darea,' =',p + if (p.gt.1._10) then +c check if discrepancy is from numerical roundoff + if (abs(area-TWOPI).le.areatol) then + area=0._10 + elseif (area.le.darea+areatol) then + area=darea +c problem is genuine: can happen with nearly kissing circles + else +C print *,'*** from garpi: at tol =',tol, +C * ' area/area(',icmmin,')=',area,' /',darea, +C * ' =',p,' should be .le. 1' + goto 410 + endif + endif + endif +c done + 400 garpi=0 + return +c +c return with recommendation to retry with enlarged tol + 410 garpi=1 + return + end +c +c----------------------------------------------------------------------- + subroutine gtol(tol,tolin) + real*10 tol,tolin +c * +c * Modify tolerance tol to multiple intersections. +c * The tolerance tol is changed by successive factors of 2 +c * from the original input tolerance tolin, +c * see-sawing between smaller and larger values. +c * + if (tolin.le.0._10) then +c write(*,*) 'tolin =', tolin + if (tol.le.0._10) then + tol=1.e-15_10 +c write(*,*) 'tol =', tol + else + tol=tol*4._10 +c write(*,*) 'tol =', tol + endif +c see-saw tolerance between smaller and larger values + else + if (tol.ge.tolin) then +c write(*,*) '(GE) before: TOL=', tol +c write(*,*) '(ge) before: tolin=', tolin + tol=tolin*tolin/tol/6._10 +c if (tol.gt.0.00001) then +c write(*,*) '(ge) after: tol=', tol +c endif +c write(*,*) '(ge) after: tolin=', tolin + else +c write(*,*) '(lt) before: tol=', tol +c write(*,*) '(lt) before: tolin=', tolin + tol=tolin*tolin/tol +c if (tol.ge.1.e-5_10) then +c write(*,*) '(lt) after: tol=', tol +c endif +c write(*,*) '(lt) after: tolin=', tolin + endif + endif + return + end +c diff --git a/src/gvert.c b/src/gvert.c new file mode 100644 index 0000000..511becf --- /dev/null +++ b/src/gvert.c @@ -0,0 +1,215 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/* number of extra vertices to allocate, to allow for expansion */ +#define DNV 4 + +/*------------------------------------------------------------------------------ + Points on edges of polygon. + + This is a wrapper around gvert, + that calls gvert until the arrays are large enough. + + Input: poly is a polygon. + vcirc = 1 to return vertices and midpoints also for bounding circles + which have no intersections; + = 0 not so. + per = 0 or 1 controls meaning of nve. + if per = 0: + nve = desired number of points on each edge, including vertex; + if per = 1: + nve = desired number of points per (2 pi) on each edge. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *nv = number of vertices. + *ve_p = pointer to array ve[nv][nve] of points on edges; + memory for the array is allocated. + *angle_p = pointer to array angle[nv] of lengths of edges; + memory for the array is allocated. + *ipv_p = pointer to array ipv[nv] containing cap number of iv'th edge; + that is, ve[iv] lie on cap number ipv; + memory for the array is allocated. + *gp_p = pointer to array gp[np] giving group circle belongs to; + memory for the array is allocated. + *nev = number of connected sequences of vertices. + *nev0 = number of bounding circles which have no intersections. + *ev_p = pointer to array ev[nv] of end indices; + memory for the array is allocated. + Return value: 0 if ok; + 1 if fatal degenerate intersection of boundaries; + -1 if could not allocate memory. +*/ +int gverts(polygon *poly, int vcirc, long double *tol, int per, int nve, int *nv, vec **ve_p, long double **angle_p, int **ipv_p, int **gp_p, int *nev, int *nev0, int **ev_p) +{ + static int nvmax = 0, nvemax = 0, npmax = 0; + static int *ipv = 0x0, *gp = 0x0, *ev = 0x0; + static long double *angle = 0x0; + static vec *ve = 0x0; + + int ier; + + /* putative maximum number of vertices */ + if (poly->np <= 1) { + *nv = poly->np; + } else if (poly->np <= 4) { + *nv = poly->np * (poly->np - 1); + } else { + *nv = 6 * (poly->np - 2); + } + + /* keep trying till the arrays are big enough */ + do { + /* make sure that allocated arrays contain enough space */ + if (!ve || !angle || !ipv || !ev || *nv > nvmax) { + if (ve) free(ve); + if (angle) free(angle); + if (ipv) free(ipv); + if (ev) free(ev); + if (nve > nvemax) nvemax = nve + DNV; + ve = (vec *) malloc(sizeof(vec) * (*nv + DNV) * nvemax); + if (!ve) { + fprintf(stderr, "gverts: failed to allocate memory for %d x %d vecs\n", *nv + DNV, nvemax); + return(-1); + } + angle = (long double *) malloc(sizeof(long double) * (*nv + DNV)); + if (!angle) { + fprintf(stderr, "gverts: failed to allocate memory for %d long doubles\n", *nv + DNV); + return(-1); + } + ipv = (int *) malloc(sizeof(int) * (*nv + DNV)); + if (!ipv) { + fprintf(stderr, "gverts: failed to allocate memory for %d ints\n", *nv + DNV); + return(-1); + } + ev = (int *) malloc(sizeof(int) * (*nv + DNV)); + if (!ev) { + fprintf(stderr, "gverts: failed to allocate memory for %d ints\n", *nv + DNV); + return(-1); + } + nvmax = *nv + DNV; + } else if (nve > nvemax) { + if (ve) free(ve); + ve = (vec *) malloc(sizeof(vec) * nvmax * (nve + DNV)); + if (!ve) { + fprintf(stderr, "gverts: failed to allocate memory for %d x %d vecs\n", nvmax, nve + DNV); + return(-1); + } + nvemax = nve + DNV; + } + if (!gp || poly->np > npmax) { + if (gp) free(gp); + gp = (int *) malloc(sizeof(int) * (poly->np + DNV)); + if (!gp) { + fprintf(stderr, "gverts: failed to allocate memory for %d ints\n", poly->np + DNV); + return(-1); + } + npmax = poly->np + DNV; + } + + /* compute vertices of polygon */ + ier = gvert(poly, vcirc, tol, nvmax, per, nve, nv, ve, angle, ipv, gp, nev, nev0, ev); + if (ier) return(1); + + } while (*nv > nvmax); + + /* point ve_p, angle_p, ipv_p, gp_p, and ev_p at ve, angle, ipv, gp, and ev */ + *ve_p = ve; + *angle_p = angle; + *ipv_p = ipv; + *gp_p = gp; + *ev_p = ev; + + return(0); +} + +/*------------------------------------------------------------------------------ + Vertices of polygon. + + This is a c interface to fortran subroutine gvert. + + Input: poly is a polygon. + vcirc = 1 to return vertices and midpoints also for bounding circles + which have no intersections; + = 0 not so. + nvmax = dimension of ve[nvmax][nve], angle[nvmax], ipv[nvmax], and ev[nvmax]. + per = 0 or 1 controls meaning of nve. + if per = 0: + nve = desired number of points on each edge, including vertex; + if per = 1: + nve = desired number of points per (2 pi) on each edge. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *nv = number of vertices. + ve[nv][nve] = points on edges of polygon. + angle[nv] = angular lengths of edges of polygon. + ipv[nv] = cap number of vertices/edges; + that is, vertex v[i] and edge points ve[i] + lie on cap number ipv. + gp[np] = which group of intersecting circles each circle belongs to. + *nev = number of connected sequences of vertices. + *nev0 = number of bounding circles which have no intersections. + ev[nev] = end indices of each connected sequence of vertices. + Return value: 0 if ok; + 1 if fatal intersection of boundaries; + -1 if failed to allocate memory. +*/ +int gvert(polygon *poly, int vcirc, long double *tol, int nvmax, int per, int nve, int *nv, vec ve[/*nvmax * nve*/], long double angle[/*nvmax*/], int ipv[/*nvmax*/], int gp[/*poly->np*/], int *nev, int *nev0, int ev[/*nvmax*/]) +{ + int iv; + logical ldegen; + /* work arrays */ + int *iord, *iwk; + long double *phi, *wk; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gvert: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gvert: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + iwk = (int *) malloc(sizeof(int) * nvmax * 4); + if (!iwk) { + fprintf(stderr, "gvert: failed to allocate memory for %d ints\n", nvmax * 4); + return(-1); + } + wk = (long double *) malloc(sizeof(long double) * nvmax); + if (!wk) { + fprintf(stderr, "gvert: failed to allocate memory for %d long doubles\n", nvmax); + return(-1); + } + + /* fortran routine */ + gvert_(ve, angle, ipv, gp, ev, &nvmax, nv, &per, &nve, nev, nev0, poly->rp, poly->cm, &poly->np, &vcirc, tol, phi, iord, wk, iwk, &ldegen); + + /* number of vertices exceeds putative maximum */ + if (poly->np >= 5 && *nv > 6 * (poly->np - 2)) { + msg("CONGRATULATIONS! YOU HAVE DISCOVERED A POLYGON WITH 5 OR MORE CAPS\n"); + msg("(IT HAS %d CAPS) THAT HAS MORE THAN %d VERTICES (IT HAS %d VERTICES).\n", poly->np, 6 * (poly->np - 2), *nv); + msg("(Either that or you have found a bug.)\n"); + msg("PLEASE EMAIL ME Andrew.Hamilton@colorado.edu THE GOOD NEWS,\n"); + msg("ALONG WITH A POLYGON FILE CONTAINING THE POLYGON THAT DID IT.\n"); + dump_poly(1, &poly); + msg("AND THERE'S THE POLYGON FILE I'D LIKE YOU TO SEND. THANKS!\n"); + } + + /* convert vertex/edge indices from fortran to c convention */ + for (iv = 0; iv < *nv && iv < nvmax; iv++) ipv[iv]--; + + /* free work arrays */ + free(iord); + free(phi); + free(iwk); + free(wk); + + /* fatal intersection of boundaries */ + if (ldegen) return(1); + + return(0); +} diff --git a/src/gvert.s.f b/src/gvert.s.f new file mode 100644 index 0000000..1e84676 --- /dev/null +++ b/src/gvert.s.f @@ -0,0 +1,361 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gvert(ve,angle,ipv,gp,ev,nvmax,nv,per,nve,nev,nev0, + * rp,cm,np,vcirc,tol,phi,iord,wk,iwk,ldegen) + integer nvmax,ipv(nvmax),np,gp(np),ev(nvmax),nv,per,nve,nev,nev0, + * vcirc + logical ldegen + real*10 ve(3,nve,nvmax),angle(nvmax),rp(3,np),cm(np),tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np),iwk(nvmax,4) + real*10 phi(2,np),wk(nvmax) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c externals + integer gsegij,gzeroar +c data variables + real*10 big +c real*10 dphmin +c local (automatic) variables + integer i,ii,ik,iseg,iv,ive,j,jm,jml,jmu,jp,jpl,jpu,km,kp, + * mve,ni,scmi +C logical warn + real*10 amve,cmi,dph,ikchk,ph,phm,php + real*10 si,tolin,xi(3),xv,yi(3),yv,zv +c * +c * Vertices, plus points on edges, of the polygon defined by +c * 1 - r.rp(i) < cm(i) (if cm(i).ge.0) +c * 1 - r.rp(i) > -cm(i) (if cm(i).lt.0) +c * for i=1,np where rp(i) are unit directions. +c * +c * Since each pair of circles can intersect at at most 2 points, +c * an upper limit on the number of possible vertices is np*(np-1), +c * twice the number of distinct pairs of np objects. +c * I can find configurations which exhaust this bound for np <= 4. +c * For np >= 4, I can find configurations with 6*(np-2) vertices, +c * namely, form two triangles from the intersection of 3 caps +c * (producing 6 vertices), +c * then for each additional cap, inscribe it as an excluding cap +c * inside one of the triangles, so as to transform that one +c * triangle (with 3 vertices) into 3 triangles (with 9 vertices). +c * +c * gp(i) is the group of circles to which circle i belongs. +c * Two circles are friends, belonging to the same group, +c * if they intersect, and friends of friends are friends. +c * Theorem: A polygon is not simply-connected +c * if and only if its boundaries belong to distinct groups. +c * The group number is the smallest circle number of circles +c * within the group. +c * +c * Connected sequences of vertices are ordered by group, +c * with the lowest group numbers coming first, except that +c * intersecting boundaries come 1st, then non-intersecting boundaries. +c * Each connected sequence of vertices is ordered right-handedly +c * about the polygon, with the vertices belonging to the lowest +c * circle numbers coming first. +c * The array ev records the end index of each connected +c * sequences of vertices. +c * If the polygon is connected and simply-connected, the usual case, +c * then ev(1) = nv on output, and ev(i) = 0 for i >= 2. +c * If the polygon is not connected and simply-connected, +c * then the number of non-zero elements of ev will equal the +c * number of distinct connected boundaries of the polygon. +c * +c Input: nvmax = guess at maximum nv; +c must be >= np; +c recommend: +c = np if 0 <= np <= 2 +c = np*(np-1) if 2 <= np <= 4 +c = 6*(np-2) if np >= 4 +c rp(3,i),i=1,np +c cm(i),i=1,np +c np +c per = controls meaning of nve +c = 0 for nve points per edge +c = 1 for nve points per 2 pi on each edge, +c rounded up, so there is at least 1 point per edge; +c excess points are set to zero. +c nve = desired number of points per edge +c = 1 for vertices only +c = 2 for vertices + midpoints of edges +c >= 2 for vertices + (nve-1) non-vertex points per edge. +c vcirc = 1 to return vertices and edge points also for bounding +c circles which do not intersect any other circle; +c = 0 otherwise. +c Output: ve(3,ive,iv),ive=1,nve,iv=1,nv are points uniformly spaced +c along the edges of the polygon, +c starting with vertices in ve(3,1,iv). +c angle(iv),i=1,nv are azimuthal lengths of edges of polygon. +c ipv(iv),iv=1,nv is the circle number of the iv'th edge, +c that is,points ve(*,ive,iv) lie on circle number ipv. +c gp(i),i=1,np = which group circle i belongs to: +c circle i and circle j are friends if they intersect, +c and friends of friends are friends. +c ev(i),i=1,nev = end index of each connected sequence of edges; +c the number of non-zero elements of ev is the number +c nev of connected boundaries of the polygon, +c and the last nev0 of these are non-intersecting. +c nv = number of points; +c if this exceeds nvmax, then you should call gvert again +c with a larger nvmax. +c nev = number of connected sequences of vertices, +c including those in non-intersecting circles. +c nev0 = number of non-intersecting boundary circles if vcirc=1; +c = 0 if vcirc=0; +c non-intersecting boundaries come last in ve, +c and the last nev0 entries of ev(i) refer +c to non-intersecting boundaries. +c ldegen = .true. means there's a problem with multiply +c intersecting boundary. +c Input/Output: tol +c Work arrays: phi and iord should be dimensioned at least 2*np. +c iwk should be dimensioned at least 4*nvmax. +c wk should be dimensioned at least nvmax. +c +c data dphmin /1.e-8_10/ + data big /1.e6_10/ +c +c input tolerance to multiple intersections + tolin=tol +C print *,'--------------------' +c come here with modified tolerance + 100 continue +c initialise error flag to no error + ldegen=.false. +C warn=.false. +c zero number of vertices + nv=0 + nev=0 + nev0=0 +c initialise ev to zero + do iv=1,nvmax + ev(iv)=0 + enddo +c initially each circle is its own group + do i=1,np + gp(i)=i + enddo +c check for zero area because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c error check on evaluation of vertex terms + ikchk=0._10 +c initialise iwk to inadmissible values + do iv=1,nvmax + iwk(iv,2)=-1 + enddo + do iv=1,nvmax + iwk(iv,3)=-1 + enddo +c--------identify boundary segments around each circle i in turn + do 280 i=1,np +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) goto 280 +c scmi * cmi = 1-cos th(i) + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) +c si = sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c........construct cartesian axes with z-axis along rp(i) + call gaxisi(rp(1,i),xi,yi) +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside polygon + if (ni.eq.-1) goto 280 +c area of polygon is zero + if (ni.eq.-2) then + nv=0 + nev=0 + nev0=0 + goto 410 + endif +c........i circle has no intersections + if (ni.eq.0) then +c want vertices and midpoints for circles without intersections + if (vcirc.eq.1) then +c introduce pretend circle 0 + do j=1,2 + if (j.eq.1) then + ii=0 + km=i + kp=i + phm=0._10 + php=PI + elseif (j.eq.2) then + ii=i + km=0 + kp=0 + phm=PI + php=TWOPI + endif + dph=php-phm + nv=nv+1 + if (nv.le.nvmax) then +c edge index of this vertex + ipv(nv)=i +c azimuthal length of edge + angle(nv)=dph +c edge points + zv=1._10-cmi + if (per.eq.0) then + mve=nve + else + amve=nve*(dph/TWOPI) + mve=amve + if (dble(mve).lt.amve) mve=mve+1 + endif + do ive=1,mve + if (cm(i).ge.0._10) then + ph=(phm*(mve-ive+1)+php*(ive-1))/dble(mve) + else + ph=(php*(mve-ive+1)+phm*(ive-1))/dble(mve) + endif + xv=si*cos(ph) + yv=si*sin(ph) + ve(1,ive,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + ve(2,ive,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + ve(3,ive,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) + enddo + do ive=mve+1,nve + ve(1,ive,nv)=0._10 + ve(2,ive,nv)=0._10 + ve(3,ive,nv)=0._10 + enddo + endif +c record endpoints of edge + call gvtrail(scmi,np,ii,km,kp,iwk,iwk(1,2),nvmax,nv, + * ik,ikchk) + enddo + nev0=nev0+1 + endif +C print *,'at',i,': full circle' +c........i circle has intersections + elseif (ni.gt.0) then +c........friends of i circle + call ggpij(np,gp,i,big,phi) +c........find ordering of intersection angles around i circle + call findbot(phi,2*np,iord,ni) +c........vertices around i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rp(1,i),scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c........segment is edge +c warn about near multiple intersection +c if (dph.lt.dphmin) then +c print *,'*** warning from gvert: near multiple intersectio +c *n at',i,': edge',km,kp,' dph=',real(dph) +c warn=.true. +c endif +C print *,'at',i,': edge',km,kp, +C * ' (',jm,' in',jml,jmu,',',jp,' in',jpl,jpu,' of',ni,')', +C * ' ph=',real(ph),' dph=',real(dph) + nv=nv+1 + if (nv.le.nvmax) then +c edge index of this vertex + ipv(nv)=i +c azimuthal length of edge + angle(nv)=dph +c edge points + zv=1._10-cmi + if (per.eq.0) then + mve=nve + else + amve=nve*(dph/TWOPI) + mve=amve + if (dble(mve).lt.amve) mve=mve+1 + endif + do ive=1,mve + if (cm(i).ge.0._10) then + ph=(phm*(mve-ive+1)+php*(ive-1))/dble(mve) + else + ph=(php*(mve-ive+1)+phm*(ive-1))/dble(mve) + endif + xv=si*cos(ph) + yv=si*sin(ph) + ve(1,ive,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + ve(2,ive,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + ve(3,ive,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) + enddo + do ive=mve+1,nve + ve(1,ive,nv)=0._10 + ve(2,ive,nv)=0._10 + ve(3,ive,nv)=0._10 + enddo + endif +c record endpoints of edge + call gvtrail(scmi,np,i,km,kp,iwk,iwk(1,2),nvmax,nv,ik,ikchk) +c do another segment + goto 220 + endif + 280 continue +c--------check on whether ik endpoints matched ki endpoints + if (ikchk.ne.0._10) then +C warn=.true. +C print *,'*** from gvert: at tol =',tol, +C * ', ikchk=',ikchk,' should be 0' +c retry with modified tolerance + call gtol(tol,tolin) + goto 100 + elseif (tol.gt.0._10) then +C print *,'... from gvert: success at tol =',tol + endif +c--------order vertices right-handedly about polygon + if (nv.gt.0.and.nv.le.nvmax) then +c........which group of friends each circle belongs to + call ggp(np,gp) +c........find order of vertices around polygon + call gvord(np,nv,ipv,gp,ev,nev,iwk,iwk(1,2),iwk(1,3),iwk(1,4)) +c........reorder vertices + call vpermi(ipv,nv,iwk(1,2),iwk(1,3)) + call vpermdd(ve,3*nve,nv,iwk(1,2),wk) + call vpermd(angle,nv,iwk(1,2),wk) + endif +c--------done + 410 continue +C if (warn) then +C write (*,'(a3,a20,4a24)') +C * ' ','x','y','z','r','1-c' +C write (*,'(i3,5g24.16)') +C * (j,(rp(i,j),i=1,3),sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), +C * cm(j),j=1,np) +C endif +c if (nv.gt.nvmax) then +c print *,'*** from gvert: number of vertices =',nv, +c * ' exceeds maximum',nvmax +c endif + return +c + 420 print *,'*** from gvert: total failure at tol = ',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo + ldegen=.true. + return +c + end +c diff --git a/src/gvlim.c b/src/gvlim.c new file mode 100644 index 0000000..45d3347 --- /dev/null +++ b/src/gvlim.c @@ -0,0 +1,237 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/* number of extra vertices to allocate, to allow for expansion */ +#define DNV 4 + +/*------------------------------------------------------------------------------ + Points on polygon nearest to and farthest from unit direction vi, + and minimum and maximum values of cm=1-cosl(theta) + between polygon and unit vector vi. + + This is a wrapper around gvlim, + that calls gvlim until the arrays are large enough. + + Input: poly is a polygon. + vcirc = 1 to return vertices and midpoints also for bounding circles + which have no intersections; + = 0 not so. + vi = unit vector. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *nv = number of vertices. + *vmin_p, vmax_p = pointers to arrays vmin[nv], vmax[nv] + giving nearest and farthest points from unit vector vi + on each edge; memory for the arrays is allocated. + *cmvmin_p, *cmvmax_p = pointer to arrays cmvmin[nv], cmvmax[nv] + giving minimum and maximum cm=1-cosl(theta) + between each edge and unit vector vi; + memory for the arrays is allocated. + *cmpmin_p, *cmpmax_p = pointer to arrays cmpmin[np], cmpmax[np] + giving minimum and maximum cm=1-cosl(theta) + between each circle and unit vector vi; + memory for the arrays is allocated. + *ipv_p = pointer to array ipv[nv] containing cap number of iv'th edge; + that is, ve[iv] lie on cap number ipv; + memory for the array is allocated. + *gp_p = pointer to array gp[np] giving group circle belongs to; + memory for the array is allocated. + *nev = number of connected sequences of vertices. + *nev0 = number of bounding circles which have no intersections. + *ev_p = pointer to array ev[nv] of end indices; + memory for the array is allocated. + Return value: 0 if ok; + 1 if fatal degenerate intersection of boundaries; + -1 if failed to allocate memory. +*/ +int gvlims(polygon *poly, int vcirc, long double *tol, vec vi, int *nv, vec **vmin_p, vec **vmax_p, long double **cmvmin_p, long double **cmvmax_p, long double **cmpmin_p, long double **cmpmax_p, int **ipv_p, int **gp_p, int *nev, int *nev0, int **ev_p) +{ + static int nvmax = 0, npmax = 0; + static int *ipv = 0x0, *gp = 0x0, *ev = 0x0; + static long double *cmvmin = 0x0, *cmvmax = 0x0, *cmpmin = 0x0, *cmpmax = 0x0; + static vec *vmin = 0x0, *vmax = 0x0; + + int ier; + + /* putative maximum number of vertices */ + if (poly->np <= 1) { + *nv = poly->np; + } else if (poly->np <= 4) { + *nv = poly->np * (poly->np - 1); + } else { + *nv = 6 * (poly->np - 2); + } + + /* keep trying till the arrays are big enough */ + do { + + /* make sure that allocated arrays contain enough space */ + if (!vmin || !vmax || !cmvmin || !cmvmax || !ipv || !ev || *nv > nvmax) { + if (vmin) free(vmin); + if (vmax) free(vmax); + if (cmvmin) free(cmvmin); + if (cmvmax) free(cmvmax); + if (ipv) free(ipv); + if (ev) free(ev); + vmin = (vec *) malloc(sizeof(vec) * (*nv + DNV)); + if (!vmin) { + fprintf(stderr, "gvlims: failed to allocate memory for %d vecs\n", *nv + DNV); + return(-1); + } + vmax = (vec *) malloc(sizeof(vec) * (*nv + DNV)); + if (!vmax) { + fprintf(stderr, "gvlims: failed to allocate memory for %d vecs\n", *nv + DNV); + return(-1); + } + cmvmin = (long double *) malloc(sizeof(long double) * (*nv + DNV)); + if (!cmvmin) { + fprintf(stderr, "gvlims: failed to allocate memory for %d long doubles\n", *nv + DNV); + return(-1); + } + cmvmax = (long double *) malloc(sizeof(long double) * (*nv + DNV)); + if (!cmvmax) { + fprintf(stderr, "gvlims: failed to allocate memory for %d long doubles\n", *nv + DNV); + return(-1); + } + ipv = (int *) malloc(sizeof(int) * (*nv + DNV)); + if (!ipv) { + fprintf(stderr, "gvlims: failed to allocate memory for %d ints\n", *nv + DNV); + return(-1); + } + ev = (int *) malloc(sizeof(int) * (*nv + DNV)); + if (!ev) { + fprintf(stderr, "gvlims: failed to allocate memory for %d ints\n", *nv + DNV); + return(-1); + } + nvmax = *nv + DNV; + } + if (!cmpmin || !cmpmax || !gp || poly->np > npmax) { + if (cmpmin) free(cmpmin); + if (cmpmax) free(cmpmax); + if (gp) free(gp); + cmpmin = (long double *) malloc(sizeof(long double) * (poly->np + DNV)); + if (!cmpmin) { + fprintf(stderr, "gvlims: failed to allocate memory for %d long doubles\n", poly->np + DNV); + return(-1); + } + cmpmax = (long double *) malloc(sizeof(long double) * (poly->np + DNV)); + if (!cmpmax) { + fprintf(stderr, "gvlims: failed to allocate memory for %d long doubles\n", poly->np + DNV); + return(-1); + } + gp = (int *) malloc(sizeof(int) * (poly->np + DNV)); + if (!gp) { + fprintf(stderr, "gvlims: failed to allocate memory for %d ints\n", poly->np + DNV); + return(-1); + } + npmax = poly->np + DNV; + } + + /* compute vertices of polygon */ + ier = gvlim(poly, vcirc, tol, vi, nvmax, nv, vmin, vmax, cmvmin, cmvmax, cmpmin, cmpmax, ipv, gp, nev, nev0, ev); + if (ier) return(ier); + + } while (*nv > nvmax); + + /* point arguments at allocated arrays */ + *vmin_p = vmin; + *vmax_p = vmax; + *cmvmin_p = cmvmin; + *cmvmax_p = cmvmax; + *cmpmin_p = cmpmin; + *cmpmax_p = cmpmax; + *ev_p = ev; + + return(0); +} + +/*------------------------------------------------------------------------------ + Points on polygon nearest to and farthest from unit direction vi, + and minimum and maximum values of cm=1-cosl(theta) + between polygon and unit vector vi. + + This is a c interface to fortran subroutine gvlim. + + Input: poly is a polygon. + vcirc = 1 to return vertices and midpoints also for bounding circles + which have no intersections; + = 0 not so. + vi = unit vector. + nvmax = dimension of v[nvmax] and ev[nmax]. + Input/Output: *tol = angle within which to merge multiple intersections. + Output: *nv = number of vertices. + vmin[nv], vmax[nv] = arrays giving nearest and farthest + points from unit vector vi on each edge. + cmvmin[nv], cmvmax[nv] = minimum and maximum cm=1-cosl(theta) + between each edge and unit vector vi. + cmpmin[np], cmvmax[np] = minimum and maximum cm=1-cosl(theta) + between each circle and unit vector vi. + ipv[nv] = cap number of vertices/edges; + that is, vertex v[i] and edge points ve[i] + lie on cap number ipv. + gp[np] = which group of intersecting circles each circle belongs to. + *nev = number of connected sequences of vertices. + *nev0 = number of bounding circles which have no intersections. + ev[nev] = end indices of each connected sequence of vertices. + Return value: 0 if ok; + 1 if fatal degenerate intersection of boundaries; + -1 if failed to allocate memory. +*/ +int gvlim(polygon *poly, int vcirc, long double *tol, vec vi, int nvmax, int *nv, vec vmin[/*nvmax*/], vec vmax[/*nvmax*/], long double cmvmin[/*nvmax*/], long double cmvmax[/*nvmax*/], long double cmpmin[/*poly->np*/], long double cmpmax[/*poly->np*/], int ipv[/*nvmax*/], int gp[/*poly->np*/], int *nev, int *nev0, int ev[/*nvmax*/]) +{ + logical ldegen; + /* work arrays */ + int *iord, *iwk; + long double *phi, *wk; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gvlim: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gvlim: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + iwk = (int *) malloc(sizeof(int) * nvmax * 4); + if (!iwk) { + fprintf(stderr, "gvlim: failed to allocate memory for %d ints\n", nvmax * 4); + return(-1); + } + wk = (long double *) malloc(sizeof(long double) * nvmax); + if (!wk) { + fprintf(stderr, "gvlim: failed to allocate memory for %d long doubles\n", nvmax); + return(-1); + } + + /* fortran routine */ + gvlim_(vmin, vmax, cmvmin, cmvmax, cmpmin, cmpmax, ipv, gp, ev, &nvmax, nv, nev, nev0, poly->rp, poly->cm, &poly->np, vi, &vcirc, tol, phi, iord, wk, iwk, &ldegen); + + /* number of vertices exceeds putative maximum */ + if (poly->np >= 5 && *nv > 6 * (poly->np - 2)) { + msg("CONGRATULATIONS! YOU HAVE DISCOVERED A POLYGON WITH 5 OR MORE CAPS\n"); + msg("(IT HAS %d CAPS) THAT HAS MORE THAN %d VERTICES (IT HAS %d VERTICES).\n", poly->np, 6 * (poly->np - 2), *nv); + msg("(Either that or you have found a bug.)\n"); + msg("PLEASE EMAIL ME Andrew.Hamilton@colorado.edu THE GOOD NEWS,\n"); + msg("ALONG WITH A POLYGON FILE CONTAINING THE POLYGON THAT DID IT.\n"); + msg("THANKS!\n"); + dump_poly(1, &poly); + msg("AND THERE'S THE POLYGON FILE I'D LIKE YOU TO SEND. THANKS!\n"); + } + + /* free work arrays */ + free(iord); + free(phi); + free(iwk); + free(wk); + + /* fatal intersection of boundaries */ + if (ldegen) return(1); + + return(0); +} diff --git a/src/gvlim.s.f b/src/gvlim.s.f new file mode 100644 index 0000000..dd08bdc --- /dev/null +++ b/src/gvlim.s.f @@ -0,0 +1,377 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gvlim(vmin,vmax,cmvmin,cmvmax,cmpmin,cmpmax, + * ipv,gp,ev,nvmax,nv,nev,nev0, + * rp,cm,np,rpi,vcirc,tol,phi,iord,wk,iwk,ldegen) + integer nvmax,ipv(nvmax),np,gp(np),ev(nvmax),nv,nev,nev0,vcirc + logical ldegen + real*10 vmin(3,nvmax),vmax(3,nvmax),cmvmin(nvmax),cmvmax(nvmax), + * cmpmin(np),cmpmax(np),rp(3,np),cm(np),rpi(3),tol +c work arrays (could be made automatic if compiler supports it) + integer iord(2*np),iwk(nvmax,4) + real*10 phi(2,np),wk(nvmax) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c intrinsics + intrinsic abs +c externals + integer gsegij,gzeroar + real*10 cmijf +c data variables + real*10 big +c real*10 dphmin +c local variables + integer i,ii,ik,iphi,iseg,iv,j,jm,jml,jmu,jp,jpl,jpu,km,kp,ni,scmi +C logical warn + real*10 cmi,cmik,dph,ikchk,ph,phin,phif,phm,phmax,phmin,php, + * si,sik,tolin,xi(3),xv,yi(3),yv,zv +c * +c * Lifted mostly from gvert and gcmlim. +c * +c * Points nearest to and farthest from unit direction rpi +c * on each edge of polygon defined by +c * 1 - r.rp(i) < cm(i) (if cm(i).ge.0) +c * 1 - r.rp(i) > -cm(i) (if cm(i).lt.0) +c * for i=1,np where rp(i) are unit directions. +c * +c * The edges are ordered right-handedly about the polygon +c * in the same order as given by gvert. +c * The array ev records the end index of each connected +c * sequences of vertices. +c * Intersecting boundaries come 1st, then non-intersecting boundaries. +c * If the polygon is connected and simply-connected, the usual case, +c * then ev(1) = nv on output, and ev(i) = 0 for i >= 2. +c * If the polygon is not connected and simply-connected, +c * then the number of non-zero elements of ev will equal the number +c * of distinct connected boundaries of the polygon. +c * +c Input: nvmax = guess at maximum nv; +c must be >= np; +c recommend: +c = np if 0 <= np <= 2 +c = np*(np-1) if 2 <= np <= 4 +c = 6*(np-2) if np >= 4 +c rp(3,i),i=1,np +c cm(i),i=1,np +c np +c rpi(3) = unit vector. +c vcirc = 1 to return nearest and farthest points also for +c non-intersecting boundary circles. +c = 0 otherwise. +c Output: vmin(3,i),vmax(3,i),i=1,nv are unit vectors which are the +c nearest and farthest points on each edge from rpi. +c cmvmin, cmvmax = 1 - cos th between nearest and farthest +c points vmin, vmax on each edge from rpi. +c cmpmin, cmpmax = 1 - cos th between nearest and farthest +c points on each circle from rpi. +c ipv(iv),iv=1,nv is the circle number of the iv'th edge, +c that is,points ve(*,ive,iv) lie on circle number ipv. +c gp(i),i=1,np = which group circle i belongs to: +c circle i and circle j are friends if they intersect, +c and friends of friends are friends. +c ev(i) = end index of each connected sequence of edges; +c the number of non-zero elements of ev is the number +c nev of connected boundaries of the polygon, +c and the last nev0 of these are non-intersecting. +c nv = number of points; +c if this exceeds nvmax, then you should call gvlim again +c with a larger nvmax. +c nev = number of connected sequences of vertices, +c including those in non-intersecting circles. +c nev0 = number of non-intersecting boundary circles if vcirc=1; +c = 0 if vcirc=0; +c non-intersecting boundaries come last in ve, +c and the last nev0 entries of ev(i) refer +c to non-intersecting boundaries. +c ldegen = .true. means there's a problem with multiply +c intersecting boundary. +c Input/Output: tol +c Work arrays: phi and iord should be dimensioned at least 2*np. +c iwk should be dimensioned at least 4*nvmax. +c wk should be dimensioned at least nvmax. +c +c data dphmin /1.e-8_10/ + data big /1.e6_10/ +c +c input tolerance to multiple intersections + tolin=tol +c come here with modified tolerance + 100 continue +c initialise error flag to no error + ldegen=.false. +C warn=.false. +c zero number of vertices + nv=0 + nev=0 + nev0=0 +c initialise ev to zero + do iv=1,nvmax + ev(iv)=0 + enddo +c initially each circle is its own group + do i=1,np + gp(i)=i + enddo +c check for zero area because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c error check on evaluation of vertex terms + ikchk=0._10 +c initialise iwk to inadmissible value + do iv=1,nvmax + iwk(iv,2)=-1 + enddo + do iv=1,nvmax + iwk(iv,3)=-1 + enddo +c--------identify boundary segments around each circle i in turn + do 280 i=1,np +c cm(i).ge.2 means include whole sphere, which is no constraint + if (cm(i).ge.2._10) then + cmpmin(i)=2._10 + cmpmax(i)=0._10 + goto 280 + endif +c scmi * cmi = 1-cos th(i) + if (cm(i).ge.0._10) then + scmi=1 + else + scmi=-1 + endif + cmi=abs(cm(i)) +c si = sin th(i) + si=sqrt(cmi*(2._10-cmi)) +c cmik = 1-cos th(ik), th(ik)=angle twixt rpi & rp(i) + cmik=cmijf(rpi,rp(1,i)) +c sik = sin th(ik) + sik=sqrt(cmik*(2._10-cmik)) +c........minimum and maximum cm on circle + cmpmin(i)=cmi+cmik-cmi*cmik-si*sik + cmpmax(i)=cmi+cmik-cmi*cmik+si*sik +c........cartesian axes with z-axis along rp(i) + call gaxisi(rp(1,i),xi,yi) +c........azimuthal angle closest to vector rpi + xv=xi(1)*rpi(1)+xi(2)*rpi(2)+xi(3)*rpi(3) + yv=yi(1)*rpi(1)+yi(2)*rpi(2)+yi(3)*rpi(3) + phin=atan2(yv,xv) + if (phin.ge.0._10) then + phif=phin-PI + else + phif=phin+PI + endif +c........angles phi about z-axis rp(i) of intersection of i & j circles + call gphij(rp,cm,np,i,rp(1,i),scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside polygon + if (ni.eq.-1) goto 280 +c area of polygon is zero + if (ni.eq.-2) then + nv=0 + nev=0 + nev0=0 + goto 410 + endif +c........i circle has no intersections + if (ni.eq.0) then +c want near and far points for non-intersecting boundary circles + if (vcirc.eq.1) then +c introduce pretend circle 0 + do j=1,2 + if (j.eq.1) then + ii=0 + km=i + kp=i + phm=0._10 + php=PI + elseif (j.eq.2) then + ii=i + km=0 + kp=0 + phm=PI + php=TWOPI + endif + ph=(phm+php)/2._10 + dph=php-phm + nv=nv+1 + if (nv.le.nvmax) then +c edge index of this vertex + ipv(nv)=i +c phase phin to central point ph + iphi=nint((phin-ph)/TWOPI) + phin=phin-iphi*TWOPI + if (phm.le.phin.and.phin.le.php) then + phmin=0._10 + elseif (phm.gt.phin) then + phmin=phm-phin + elseif (phin.gt.php) then + phmin=php-phin + endif +c phase phif to central point ph + iphi=nint((phif-ph)/TWOPI) + phif=phif-iphi*TWOPI + if (phm.le.phif.and.phif.le.php) then + phmax=0._10 + elseif (phm.gt.phif) then + phmax=phm-phif + elseif (phif.gt.php) then + phmax=php-phif + endif +c nearest point on edge + xv=si*cos(phmin+phin) + yv=si*sin(phmin+phin) + zv=1._10-cmi + vmin(1,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + vmin(2,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + vmin(3,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) +c farthest point on edge + xv=si*cos(phmax+phif) + yv=si*sin(phmax+phif) + zv=1._10-cmi + vmax(1,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + vmax(2,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + vmax(3,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) +c minimum, maximum cm + cmvmin(nv)=cmijf(rpi,vmin(1,nv)) + cmvmax(nv)=cmijf(rpi,vmax(1,nv)) + endif +c record endpoints of edge + call gvtrail(scmi,np,ii,km,kp,iwk,iwk(1,2),nvmax,nv, + * ik,ikchk) + enddo + nev0=nev0+1 + endif +c........i circle has intersections + elseif (ni.gt.0) then +c........friends of i circle + call ggpij(np,gp,i,big,phi) +c........find ordering of intersection angles around i circle + call findbot(phi,2*np,iord,ni) +c........vertices around i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rp(1,i),scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c........segment is edge +c warn about near multiple intersection +c if (dph.lt.dphmin) then +c print *,'*** warning from gvlim: near multiple intersectio +c *n at',i,': edge',km,kp,' dph=',real(dph) +c warn=.true. +c endif +c print *,'at',i,': edge',km,kp, +c * ' (',jm,' in',jml,jmu,',',jp,' in',jpl,jpu,' of',ni,')', +c * ' ph=',real(ph),' dph=',real(dph) + nv=nv+1 + if (nv.le.nvmax) then +c edge index of this vertex + ipv(nv)=i +c phase phin to central point ph + iphi=nint((phin-ph)/TWOPI) + phin=phin-iphi*TWOPI + if (phm.le.phin.and.phin.le.php) then + phmin=0._10 + elseif (phm.gt.phin) then + phmin=phm-phin + elseif (phin.gt.php) then + phmin=php-phin + endif +c phase phif to central point ph + iphi=nint((phif-ph)/TWOPI) + phif=phif-iphi*TWOPI + if (phm.le.phif.and.phif.le.php) then + phmax=0._10 + elseif (phm.gt.phif) then + phmax=phm-phif + elseif (phif.gt.php) then + phmax=php-phif + endif +c nearest point on edge + xv=si*cos(phmin+phin) + yv=si*sin(phmin+phin) + zv=1._10-cmi + vmin(1,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + vmin(2,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + vmin(3,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) +c farthest point on edge + xv=si*cos(phmax+phif) + yv=si*sin(phmax+phif) + zv=1._10-cmi + vmax(1,nv)=zv*rp(1,i)+xv*xi(1)+yv*yi(1) + vmax(2,nv)=zv*rp(2,i)+xv*xi(2)+yv*yi(2) + vmax(3,nv)=zv*rp(3,i)+xv*xi(3)+yv*yi(3) +c minimum, maximum cm + cmvmin(nv)=cmijf(rpi,vmin(1,nv)) + cmvmax(nv)=cmijf(rpi,vmax(1,nv)) + endif +c record endpoints of edge + call gvtrail(scmi,np,i,km,kp,iwk,iwk(1,2),nvmax,nv,ik,ikchk) +c do another segment + goto 220 + endif + 280 continue +c--------check on whether ik endpoints matched ki endpoints + if (ikchk.ne.0._10) then +c print *,'*** from gvlim: ikchk=',ikchk,' should be 0' +C warn=.true. + call gtol(tol,tolin) + goto 100 + endif +c--------order vertices right-handedly about polygon + if (nv.gt.0.and.nv.le.nvmax) then +c........which group of friends each circle belongs to + call ggp(np,gp) +c........find order of vertices around polygon + call gvord(np,nv,ipv,gp,ev,nev,iwk,iwk(1,2),iwk(1,3),iwk(1,4)) +c........reorder vertices + call vpermi(ipv,nv,iwk(1,2),iwk(1,3)) + call vpermdd(vmin,3,nv,iwk(1,2),wk) + call vpermdd(vmax,3,nv,iwk(1,2),wk) + call vpermd(cmvmin,nv,iwk(1,2),wk) + call vpermd(cmvmax,nv,iwk(1,2),wk) + endif +c--------done + 410 continue +C if (warn) then +C write (*,'(a3,a20,4a24)') +C * ' ','x','y','z', +c * 'r', +C * '1-c' +C do j=1,np +C write (*,'(i3,5g24.16)') +C * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), +C * cm(j) +C enddo +C endif +c if (nv.gt.nvmax) then +c print *,'*** from gvlim: number of vertices =',nv, +c * ' exceeds maximum',nvmax +c endif + return +c + 420 print *,'*** from gvlim: total failure at tol =',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo + ldegen=.true. + return +c + end +c diff --git a/src/gvphi.c b/src/gvphi.c new file mode 100644 index 0000000..ebec088 --- /dev/null +++ b/src/gvphi.c @@ -0,0 +1,53 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Point at the centre of that part of a circle which + (a) lies inside a polygon, and + (b) contains or is closest to a specified unit vector. + + This is a c interface to fortran subroutine gvphi. + + Input: poly is a polygon. + rp, cm define a circle. + vi = unit vector. + *tol = angle within which to merge multiple intersections. + Output: angle = length of that part of boundary segment which + (a) lies inside the polygon, and + (b) contains, or is closest to, unit vector vi. + = 0. if the boundary lies entirely outside the polygon. + v = unit vector at centre of said boundary segment. + Return value: 0 if ok; + -1 if failed to allocate memory. +*/ +int gvphi(polygon *poly, vec rp, long double cm, vec vi, long double *tol, long double *angle, vec v) +{ + /* work arrays */ + int *iord; + long double *phi; + + /* allocate memory for work arrays */ + iord = (int *) malloc(sizeof(int) * poly->np * 2); + if (!iord) { + fprintf(stderr, "gvphi: failed to allocate memory for %d ints\n", poly->np * 2); + return(-1); + } + phi = (long double *) malloc(sizeof(long double) * poly->np * 2); + if (!phi) { + fprintf(stderr, "gvphi: failed to allocate memory for %d long doubles\n", poly->np * 2); + return(-1); + } + + /* fortran routine */ + gvphi_(angle, v, poly->rp, poly->cm, &poly->np, rp, &cm, vi, tol, phi, iord); + + /* free work arrays */ + free(iord); + free(phi); + + return(0); +} diff --git a/src/gvphi.s.f b/src/gvphi.s.f new file mode 100644 index 0000000..914f86b --- /dev/null +++ b/src/gvphi.s.f @@ -0,0 +1,160 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine gvphi(angle,v,rp,cm,np,rpi,cmi,vi,tol,phi,iord) + integer np + real*10 angle,v(3),rp(3,np),cm(np),rpi(3),cmi,vi(3),tol +c work arrays (could be automatic if compiler supports it) + integer iord(2*np) + real*10 phi(2,np) +c +c parameters + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) +c externals + integer gsegij,gzeroar +c data variables + real*10 big +c local (automatic) variables + integer i,iphin,iseg,j,jm,jml,jmu,jp,jpl,jpu,km,kp,ni,scmi + real*10 dph,dphin,dphinmn,ph,phin,phm,php, + * si,xi(3),xv,yi(3),yv,zv +c * +c * This routine is mostly lifted from gphi and gvert. +c * +c * Point at centre of segment of circle +c * 1 - r.rpi = cmi +c * containing, or otherwise closest to, point vi, +c * lying inside +c * 1 - r.rp(j) <= cm(j) (if cm(j).ge.0) +c * 1 - r.rp(j) > -cm(j) (if cm(j).lt.0) +c * for j=1,np where rp(j) are unit directions. +c * +c Input: rp(3,j),j=1,np +c cm(j),j=1,np +c np +c rpi(3) +c cmi +c vi(3) = unit vector desired to lie inside, +c or closest to, segment. +c tol +c Output: angle = angular length of segment of circle +c = 0. if boundary lies entirely outside circle. +c v(3) = unit vector at centre of segment of circle. +c Work arrays: phi and iord should be dimensioned at least 2*np +c + data big /1.e6_10/ +c +c initialise length of segment to zero + angle=0._10 +c initialise point at centre of segment to zero + v(1)=0._10 + v(2)=0._10 + v(3)=0._10 +c check for null circle + if (cmi.lt.0._10) goto 410 + if (cmi.gt.2._10) goto 410 +c check for zero angle because one circle is null + if (gzeroar(cm,np).eq.0) goto 410 +c initialise dphinmn to impossibly large value + dphinmn=big +c........si = sin thi + scmi=1 + si=sqrt(cmi*(2._10-cmi)) +c........construct cartesian axes with z-axis along rpi + call gaxisi(rpi,xi,yi) +c........azimuthal angle closest to vector vi + xv=xi(1)*vi(1)+xi(2)*vi(2)+xi(3)*vi(3) + yv=yi(1)*vi(1)+yi(2)*vi(2)+yi(3)*vi(3) + phin=atan2(yv,xv) +c........angles phi about z-axis rp(i) of intersection of i & j circles +c passing i=0 means circle at edge is considered outside polygon + call gphij(rp,cm,np,0,rpi,scmi,cmi,xi,yi,big,tol,ni,phi) +c i circle lies outside (or at edge of) polygon + if (ni.le.-1) goto 410 +c........order angles around circle +c circle has no intersections + if (ni.eq.0) then + angle=TWOPI + ph=phin + xv=si*cos(ph) + yv=si*sin(ph) + zv=1._10-cmi + v(1)=zv*rpi(1)+xv*xi(1)+yv*yi(1) + v(2)=zv*rpi(2)+xv*xi(2)+yv*yi(2) + v(3)=zv*rpi(3)+xv*xi(3)+yv*yi(3) +c circle has intersections + elseif (ni.gt.0) then +c find ordering of intersection angles around circle + call findbot(phi,2*np,iord,ni) +c........vertices around i circle + jpl=0 +c come here to do another segment + 220 continue +c........is segment edge of polygon? + iseg=gsegij(rp,cm,np,0,0,i,rpi,scmi,cmi,tol,ni, + * phi,iord,jml,jmu,jpl,jpu,1,jm,jp,km,kp,phm,php,ph,dph) +c error + if (iseg.eq.-1) goto 420 +c not an edge + if (iseg.eq.0) goto 220 +c gone full circle + if (iseg.eq.2) goto 280 +c........segment satisfies conditions +c print *,'segment',km,kp, +c * ' (',jm,' in',jml,jmu,',',jp,' in',jpl,jpu,' of',ni,')', +c * ' ph=',real(ph),' dph=',real(dph) +c phase phin to central point ph + iphin=nint((phin-ph)/TWOPI) + phin=phin-iphin*TWOPI + if (phm.le.phin.and.phin.le.php) then + dphin=0._10 + elseif (phm.gt.phin) then + dphin=phm-phin + elseif (phin.gt.php) then + dphin=phin-php + endif +c segment contains or is closest to phin + if (dphin.lt.dphinmn) then + dphinmn=dphin + angle=dph +c coords of centre of edge in frame where axes are xi, yi, rp + xv=si*cos(ph) + yv=si*sin(ph) + zv=1._10-cmi + v(1)=zv*rpi(1)+xv*xi(1)+yv*yi(1) + v(2)=zv*rpi(2)+xv*xi(2)+yv*yi(2) + v(3)=zv*rpi(3)+xv*xi(3)+yv*yi(3) +c segment contains phin, so cannot be beaten + if (dphin.eq.0._10) goto 280 + endif +c do another segment + goto 220 + endif + 280 continue + return +c +c zero angle + 410 continue + return +c + 420 print *,'*** from gvphi: total failure at tol =',tol + write (*,'(a3,a20,4a24)') + * ' ','x','y','z', +c * 'r', + * '1-c' + do j=1,np + write (*,'(i3,5g24.16)') + * j,(rp(i,j),i=1,3), +c * sqrt(rp(1,j)**2+rp(2,j)**2+rp(3,j)**2), + * cm(j) + enddo + write (*,'(i3,5g24.16)') + * 0,(rpi(i),i=1,3), +c * sqrt(rpi(1)**2+rpi(2)**2+rpi(3)**2), + * cmi + return +c + end +c diff --git a/src/harmonics.h b/src/harmonics.h new file mode 100644 index 0000000..17f8185 --- /dev/null +++ b/src/harmonics.h @@ -0,0 +1,7 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#define IM 2 +#define NW (((lmax + 1) * (lmax + 2)) / 2) + +typedef long double harmonic[IM]; diff --git a/src/harmonize.c b/src/harmonize.c new file mode 100644 index 0000000..2c51d86 --- /dev/null +++ b/src/harmonize.c @@ -0,0 +1,123 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include <math.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dql:m:s:e:i:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys, nws,i; + long double area; + harmonic *w; + polygon **polys; + polys=polys_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile, and Wlm_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- harmonize ----------------\n"); + + /* advise harmonic number */ + msg("maximum harmonic number %d\n", lmax); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0 || balkanized==0) { + msg("WARNING: 'snapped' and 'balkanized' keywords not found in all input files.\n"); + msg("Running harmonize on polygons that are not snapped and balkanized may give misleading results.\n"); + } + + /* allocate array containing spherical harmonics of complete mask */ + w = (harmonic *) malloc(sizeof(harmonic) * NW); + if (!w) { + fprintf(stderr, "harmonize: failed to allocate memory for %d harmonics\n", NW); + exit(1); + } + + /* spherical harmonics of region */ + npoly = harmonize_polys(npoly, polys, mtol, lmax, w); + if (npoly == -1) exit(1); + + /* advise area */ + area = w[0][0] * 2. * sqrtl(PI); + msg("area of (weighted) region is %.15Lg str\n", area); + + /* write polygons */ + ifile = argc - 1; + nws = wrspher(argv[ifile], lmax, w); + if (nws == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("harmonize [-d] [-q] [-l<lmax>] [-m<a>[u]] [-s<n>] [-e<n>] [-i<f>[<n>][u]] polygon_infile1 [polygon_infile2 ...] Wlm_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" diff --git a/src/harmonize_polys.c b/src/harmonize_polys.c new file mode 100644 index 0000000..b5c91a5 --- /dev/null +++ b/src/harmonize_polys.c @@ -0,0 +1,170 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" +#include "pi.h" + +/* advise how many polygons done if lmax >= this */ +#define LMAX_ADVICE 250 + +/*------------------------------------------------------------------------------ + Spherical harmonics of sum of weighted polygons. + + Input: poly = array of pointers to npoly polygons. + npoly = number of polygons in poly array. + mtol = initial angular tolerance in radians within which to merge multiple intersections. + lmax = maximum harmonic number. + Output: w = harmonics; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: number of polygons for which spherical harmonics were computed, + or -1 if error occurred. +*/ +int harmonize_polys(int npoly, polygon *poly[/*npoly*/], long double mtol, int lmax, harmonic w[/*NW*/]) +{ + int accelerate, i, ier, ip, ipoly, iq, ir, isrect, iw, naccelerate, ndone, ner, nrect; + long double azmin, azmax, elmin, elmax, azmn, azmx, elmn, elmx, tol; + /* work array contains harmonics of single polygon */ + harmonic *dw; + /* work arrays to deal with possible acceleration */ + int *iord, *ir_to_ip; + long double *elord; + + /* work arrays */ + dw = (harmonic *) malloc(sizeof(harmonic) * NW); + if (!dw) { + fprintf(stderr, "harmonize_polys: failed to allocate memory for %d harmonics\n", NW); + return(-1); + } + iord = (int *) malloc(sizeof(int) * npoly); + if (!iord) { + fprintf(stderr, "harmonize_polys: failed to allocate memory for %d ints\n", npoly); + return(-1); + } + ir_to_ip = (int *) malloc(sizeof(int) * npoly); + if (!ir_to_ip) { + fprintf(stderr, "harmonize_polys: failed to allocate memory for %d ints\n", npoly); + return(-1); + } + elord = (long double *) malloc(sizeof(long double) * npoly); + if (!elord) { + fprintf(stderr, "harmonize_polys: failed to allocate memory for %d long doubles\n", npoly); + return(-1); + } + + /* zero harmonics of mask */ + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) { + w[iw][i] = 0.; + } + } + + /* determine which polygons are rectangles, for which acceleration may be possible */ + nrect = 0; + ir = npoly; + for (ipoly = 0; ipoly < npoly; ipoly++) { + isrect = poly_to_rect(poly[ipoly], &azmin, &azmax, &elmin, &elmax); + if (isrect && poly[ipoly]->weight != 0.) { + ir_to_ip[nrect] = ipoly; + elord[nrect] = elmin * 1.e8 + elmax; + nrect++; + } else { + ir--; + ir_to_ip[ir] = ipoly; + } + } + msg("harmonize_polys: %d polygons are rectangles, for which acceleration may be possible\n", + nrect); + + /* order rectangles by elmin, elmax */ + findtop(elord, nrect, iord, nrect); + + /* do each polygon */ + ndone = 0; + naccelerate = 0; + ner = 0; + if (lmax >= LMAX_ADVICE) msg("doing polygon number (of %d):\n", npoly); + for (ip = 0; ip < npoly; ip++) { + if (lmax >= LMAX_ADVICE) msg(" %d", ip); + accelerate = 0; + /* rectangle */ + if (ip < nrect) { + ir = iord[ip]; + ipoly = ir_to_ip[ir]; + poly_to_rect(poly[ipoly], &azmin, &azmax, &elmin, &elmax); + /* does previous rectangle have same elevation limits? */ + if (ip > 0) { + iq = iord[ip - 1]; + iq = ir_to_ip[iq]; + poly_to_rect(poly[iq], &azmn, &azmx, &elmn, &elmx); + /* if so, use acceleration */ + if (elmn == elmin && elmx == elmax) accelerate = 1; + } + /* if not, does next rectangle have same elevation limits? */ + if (!accelerate && ip + 1 < nrect) { + iq = iord[ip + 1]; + iq = ir_to_ip[iq]; + poly_to_rect(poly[iq], &azmn, &azmx, &elmn, &elmx); + /* if so, worth accelerating */ + if (elmn == elmin && elmx == elmax) accelerate = 1; + } + /* accelerated computation */ + if (accelerate) { + ier = gsphra(azmin, azmax, elmin, elmax, lmax, dw); + if (ier == -1) return(-1); + /* standard computation */ + } else { + tol = mtol; + ier = gsphr(poly[ipoly], lmax, &tol, dw); + if (ier == -1) return(-1); + } + /* non-rectangle */ + } else { + ipoly = ir_to_ip[ip]; + /* zero weight polygon requires no computation */ + if (poly[ipoly]->weight == 0.) { + ndone++; + continue; + } else { + tol = mtol; + ier = gsphr(poly[ipoly], lmax, &tol, dw); + if (ier == -1) return(-1); + } + } + /* computation failed */ + if (ier) { + ner++; + if (lmax >= LMAX_ADVICE) msg("\n"); + fprintf(stderr, "harmonize_polys: computation failed for polygon %d; discard it\n", ipoly); + /* success */ + } else { + naccelerate += accelerate; + ndone++; + /* increment harmonics of region */ + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) { + w[iw][i] += dw[iw][i] * poly[ipoly]->weight; + } + } + } + } + if (lmax >= LMAX_ADVICE) msg("\n"); + + /* number of computations that were accelerated */ + msg("computation was accelerated for %d rectangles\n", naccelerate); + /* advise */ + if (ner > 0) { + fprintf(stderr, "harmonize_polys: discarded %d polygons for which computations failed\n", ner); + } + msg("spherical harmonics of %d weighted polygons accumulated\n", ndone); + + /* free work arrays */ + free(dw); + free(iord); + free(ir_to_ip); + free(elord); + + return(ndone); +} diff --git a/src/harmonizepolys_.c b/src/harmonizepolys_.c new file mode 100644 index 0000000..2f1bab0 --- /dev/null +++ b/src/harmonizepolys_.c @@ -0,0 +1,24 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include "manglefn.h" + +/* polygons declared in rdmask_() */ +extern int npolys; +extern polygon *polys[]; + +/*------------------------------------------------------------------------------ + Simplified fortran interface to harmonize_polys routine. + real *8 mtol + integer lmax + real *8 w(IM,NW) + call harmonizepolys(mtol, lmax, w) +*/ +void harmonizepolys_(long double *mtol, int *lmax, harmonic w[]) +{ + int ndone; + + ndone = harmonize_polys(npolys, polys, *mtol, *lmax, w); + if (ndone == -1) exit(1); +} diff --git a/src/healpix/chealpix.c b/src/healpix/chealpix.c new file mode 100644 index 0000000..15b89a3 --- /dev/null +++ b/src/healpix/chealpix.c @@ -0,0 +1,1079 @@ +/* ----------------------------------------------------------------------------- + * + * Copyright (C) 1997-2012 Krzysztof M. Gorski, Eric Hivon, Martin Reinecke, + * Benjamin D. Wandelt, Anthony J. Banday, + * Matthias Bartelmann, + * Reza Ansari & Kenneth M. Ganga + * + * + * This file is part of HEALPix. + * + * HEALPix is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * HEALPix is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HEALPix; if not, write to the Free Software + * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + * + * For more information about HEALPix see http://healpix.sourceforge.net + * + *---------------------------------------------------------------------------*/ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <math.h> +#ifdef ENABLE_FITSIO +#include "fitsio.h" +#endif +#include "chealpix.h" + +static const double twothird=2.0/3.0; +static const double pi=3.141592653589793238462643383279502884197; +static const double twopi=6.283185307179586476925286766559005768394; +static const double halfpi=1.570796326794896619231321691639751442099; +static const double inv_halfpi=0.6366197723675813430755350534900574; + +static void util_fail_ (const char *file, int line, const char *func, + const char *msg) + { + fprintf(stderr,"%s, %i (%s):\n%s\n",file,line,func,msg); + exit(1); + } + +#if defined (__GNUC__) +#define UTIL_FUNC_NAME__ __func__ +#else +#define UTIL_FUNC_NAME__ "unknown" +#endif +#define UTIL_ASSERT(cond,msg) \ + if(!(cond)) util_fail_(__FILE__,__LINE__,UTIL_FUNC_NAME__,msg) +#define UTIL_FAIL(msg) \ + util_fail_(__FILE__,__LINE__,UTIL_FUNC_NAME__,msg) +#define RALLOC(type,num) \ + ((type *)util_malloc_((num)*sizeof(type))) +#define DEALLOC(ptr) \ + do { util_free_(ptr); (ptr)=NULL; } while(0) + +static void *util_malloc_ (size_t sz) + { + void *res; + if (sz==0) return NULL; + res = malloc(sz); + UTIL_ASSERT(res,"malloc() failed"); + return res; + } +static void util_free_ (void *ptr) + { if ((ptr)!=NULL) free(ptr); } + +/*! Returns the remainder of the division \a v1/v2. + The result is non-negative. + \a v1 can be positive or negative; \a v2 must be positive. */ +static double fmodulo (double v1, double v2) + { + if (v1>=0) + return (v1<v2) ? v1 : fmod(v1,v2); + double tmp=fmod(v1,v2)+v2; + return (tmp==v2) ? 0. : tmp; +/* return (v1>=0) ? ((v1<v2) ? v1 : fmod(v1,v2)) : (fmod(v1,v2)+v2); */ + } +/*! Returns the remainder of the division \a v1/v2. + The result is non-negative. + \a v1 can be positive or negative; \a v2 must be positive. */ +static int imodulo (int v1, int v2) + { int v=v1%v2; return (v>=0) ? v : v+v2; } +static int isqrt(int v) + { return (int)(sqrt(v+0.5)); } + +/* ctab[m] = (short)( + (m&0x1 ) | ((m&0x2 ) << 7) | ((m&0x4 ) >> 1) | ((m&0x8 ) << 6) + | ((m&0x10) >> 2) | ((m&0x20) << 5) | ((m&0x40) >> 3) | ((m&0x80) << 4)); */ +static const short ctab[]={ + 0,1,256,257,2,3,258,259,512,513,768,769,514,515,770,771,4,5,260,261,6,7,262, + 263,516,517,772,773,518,519,774,775,1024,1025,1280,1281,1026,1027,1282,1283, + 1536,1537,1792,1793,1538,1539,1794,1795,1028,1029,1284,1285,1030,1031,1286, + 1287,1540,1541,1796,1797,1542,1543,1798,1799,8,9,264,265,10,11,266,267,520, + 521,776,777,522,523,778,779,12,13,268,269,14,15,270,271,524,525,780,781,526, + 527,782,783,1032,1033,1288,1289,1034,1035,1290,1291,1544,1545,1800,1801,1546, + 1547,1802,1803,1036,1037,1292,1293,1038,1039,1294,1295,1548,1549,1804,1805, + 1550,1551,1806,1807,2048,2049,2304,2305,2050,2051,2306,2307,2560,2561,2816, + 2817,2562,2563,2818,2819,2052,2053,2308,2309,2054,2055,2310,2311,2564,2565, + 2820,2821,2566,2567,2822,2823,3072,3073,3328,3329,3074,3075,3330,3331,3584, + 3585,3840,3841,3586,3587,3842,3843,3076,3077,3332,3333,3078,3079,3334,3335, + 3588,3589,3844,3845,3590,3591,3846,3847,2056,2057,2312,2313,2058,2059,2314, + 2315,2568,2569,2824,2825,2570,2571,2826,2827,2060,2061,2316,2317,2062,2063, + 2318,2319,2572,2573,2828,2829,2574,2575,2830,2831,3080,3081,3336,3337,3082, + 3083,3338,3339,3592,3593,3848,3849,3594,3595,3850,3851,3084,3085,3340,3341, + 3086,3087,3342,3343,3596,3597,3852,3853,3598,3599,3854,3855 }; +/* utab[m] = (short)( + (m&0x1 ) | ((m&0x2 ) << 1) | ((m&0x4 ) << 2) | ((m&0x8 ) << 3) + | ((m&0x10) << 4) | ((m&0x20) << 5) | ((m&0x40) << 6) | ((m&0x80) << 7)); */ +static const short utab[]={ + 0,1,4,5,16,17,20,21,64,65,68,69,80,81,84,85,256,257,260,261,272,273,276,277, + 320,321,324,325,336,337,340,341,1024,1025,1028,1029,1040,1041,1044,1045,1088, + 1089,1092,1093,1104,1105,1108,1109,1280,1281,1284,1285,1296,1297,1300,1301, + 1344,1345,1348,1349,1360,1361,1364,1365,4096,4097,4100,4101,4112,4113,4116, + 4117,4160,4161,4164,4165,4176,4177,4180,4181,4352,4353,4356,4357,4368,4369, + 4372,4373,4416,4417,4420,4421,4432,4433,4436,4437,5120,5121,5124,5125,5136, + 5137,5140,5141,5184,5185,5188,5189,5200,5201,5204,5205,5376,5377,5380,5381, + 5392,5393,5396,5397,5440,5441,5444,5445,5456,5457,5460,5461,16384,16385,16388, + 16389,16400,16401,16404,16405,16448,16449,16452,16453,16464,16465,16468,16469, + 16640,16641,16644,16645,16656,16657,16660,16661,16704,16705,16708,16709,16720, + 16721,16724,16725,17408,17409,17412,17413,17424,17425,17428,17429,17472,17473, + 17476,17477,17488,17489,17492,17493,17664,17665,17668,17669,17680,17681,17684, + 17685,17728,17729,17732,17733,17744,17745,17748,17749,20480,20481,20484,20485, + 20496,20497,20500,20501,20544,20545,20548,20549,20560,20561,20564,20565,20736, + 20737,20740,20741,20752,20753,20756,20757,20800,20801,20804,20805,20816,20817, + 20820,20821,21504,21505,21508,21509,21520,21521,21524,21525,21568,21569,21572, + 21573,21584,21585,21588,21589,21760,21761,21764,21765,21776,21777,21780,21781, + 21824,21825,21828,21829,21840,21841,21844,21845 }; + +static const int jrll[] = { 2,2,2,2,3,3,3,3,4,4,4,4 }; +static const int jpll[] = { 1,3,5,7,0,2,4,6,1,3,5,7 }; + +static int xyf2nest (int nside, int ix, int iy, int face_num) + { + return (face_num*nside*nside) + + (utab[ix&0xff] | (utab[ix>>8]<<16) + | (utab[iy&0xff]<<1) | (utab[iy>>8]<<17)); + } +static void nest2xyf (int nside, int pix, int *ix, int *iy, int *face_num) + { + int npface_=nside*nside, raw; + *face_num = pix/npface_; + pix &= (npface_-1); + raw = (pix&0x5555) | ((pix&0x55550000)>>15); + *ix = ctab[raw&0xff] | (ctab[raw>>8]<<4); + pix >>= 1; + raw = (pix&0x5555) | ((pix&0x55550000)>>15); + *iy = ctab[raw&0xff] | (ctab[raw>>8]<<4); + } +static int xyf2ring (int nside_, int ix, int iy, int face_num) + { + int nl4 = 4*nside_; + int jr = (jrll[face_num]*nside_) - ix - iy - 1, jp; + + int nr, kshift, n_before; + if (jr<nside_) + { + nr = jr; + n_before = 2*nr*(nr-1); + kshift = 0; + } + else if (jr > 3*nside_) + { + nr = nl4-jr; + n_before = 12*nside_*nside_ - 2*(nr+1)*nr; + kshift = 0; + } + else + { + int ncap_=2*nside_*(nside_-1); + nr = nside_; + n_before = ncap_ + (jr-nside_)*nl4; + kshift = (jr-nside_)&1; + } + + jp = (jpll[face_num]*nr + ix - iy + 1 + kshift) / 2; + if (jp>nl4) + jp-=nl4; + else + if (jp<1) jp+=nl4; + + return n_before + jp - 1; + } +static void ring2xyf (int nside_, int pix, int *ix, int *iy, int *face_num) + { + int iring, iphi, kshift, nr, tmp, irt, ipt; + int ncap_=2*nside_*(nside_-1); + int npix_=12*nside_*nside_; + int nl2 = 2*nside_; + + if (pix<ncap_) /* North Polar cap */ + { + iring = (int)(0.5*(1+isqrt(1+2*pix))); /* counted from North pole */ + iphi = (pix+1) - 2*iring*(iring-1); + kshift = 0; + nr = iring; + *face_num=0; + tmp = iphi-1; + if (tmp>=(2*iring)) + { + *face_num=2; + tmp-=2*iring; + } + if (tmp>=iring) ++(*face_num); + } + else if (pix<(npix_-ncap_)) /* Equatorial region */ + { + unsigned int ire, irm; + int ifm, ifp; + int ip = pix - ncap_; + iring = (ip/(4*nside_)) + nside_; /* counted from North pole */ + iphi = (ip%(4*nside_)) + 1; + kshift = (iring+nside_)&1; + nr = nside_; + ire = iring-nside_+1; + irm = nl2+2-ire; + ifm = (iphi - ire/2 + nside_ -1) / nside_; + ifp = (iphi - irm/2 + nside_ -1) / nside_; + if (ifp == ifm) /* faces 4 to 7 */ + *face_num = (ifp==4) ? 4 : ifp+4; + else if (ifp<ifm) /* (half-)faces 0 to 3 */ + *face_num = ifp; + else /* (half-)faces 8 to 11 */ + *face_num = ifm + 8; + } + else /* South Polar cap */ + { + int ip = npix_ - pix; + iring = (int)(0.5*(1+isqrt(2*ip-1))); /* counted from South pole */ + iphi = 4*iring + 1 - (ip - 2*iring*(iring-1)); + kshift = 0; + nr = iring; + iring = 2*nl2-iring; + *face_num=8; + tmp = iphi-1; + if (tmp>=(2*nr)) + { + *face_num=10; + tmp-=2*nr; + } + if (tmp>=nr) ++(*face_num); + } + + irt = iring - (jrll[*face_num]*nside_) + 1; + ipt = 2*iphi- jpll[*face_num]*nr - kshift -1; + if (ipt>=nl2) ipt-=8*nside_; + + *ix = (ipt-irt) >>1; + *iy =(-(ipt+irt))>>1; + } + +static int ang2pix_nest_z_phi (long nside_, double z, double phi) + { + double za = fabs(z); + double tt = fmodulo(phi,twopi) * inv_halfpi; /* in [0,4) */ + int face_num, ix, iy; + + if (za<=twothird) /* Equatorial region */ + { + double temp1 = nside_*(0.5+tt); + double temp2 = nside_*(z*0.75); + int jp = (int)(temp1-temp2); /* index of ascending edge line */ + int jm = (int)(temp1+temp2); /* index of descending edge line */ + int ifp = jp/nside_; /* in {0,4} */ + int ifm = jm/nside_; + if (ifp == ifm) /* faces 4 to 7 */ + face_num = (ifp==4) ? 4: ifp+4; + else if (ifp < ifm) /* (half-)faces 0 to 3 */ + face_num = ifp; + else /* (half-)faces 8 to 11 */ + face_num = ifm + 8; + + ix = jm & (nside_-1); + iy = nside_ - (jp & (nside_-1)) - 1; + } + else /* polar region, za > 2/3 */ + { + int ntt = (int)tt, jp, jm; + double tp, tmp; + if (ntt>=4) ntt=3; + tp = tt-ntt; + tmp = nside_*sqrt(3*(1-za)); + + jp = (int)(tp*tmp); /* increasing edge line index */ + jm = (int)((1.0-tp)*tmp); /* decreasing edge line index */ + if (jp>=nside_) jp = nside_-1; /* for points too close to the boundary */ + if (jm>=nside_) jm = nside_-1; + if (z >= 0) + { + face_num = ntt; /* in {0,3} */ + ix = nside_ - jm - 1; + iy = nside_ - jp - 1; + } + else + { + face_num = ntt + 8; /* in {8,11} */ + ix = jp; + iy = jm; + } + } + + return xyf2nest(nside_,ix,iy,face_num); + } + +static int ang2pix_ring_z_phi (long nside_, double z, double phi) + { + double za = fabs(z); + double tt = fmodulo(phi,twopi) * inv_halfpi; /* in [0,4) */ + + if (za<=twothird) /* Equatorial region */ + { + double temp1 = nside_*(0.5+tt); + double temp2 = nside_*z*0.75; + int jp = (int)(temp1-temp2); /* index of ascending edge line */ + int jm = (int)(temp1+temp2); /* index of descending edge line */ + + /* ring number counted from z=2/3 */ + int ir = nside_ + 1 + jp - jm; /* in {1,2n+1} */ + int kshift = 1-(ir&1); /* kshift=1 if ir even, 0 otherwise */ + + int ip = (jp+jm-nside_+kshift+1)/2; /* in {0,4n-1} */ + ip = imodulo(ip,4*nside_); + + return nside_*(nside_-1)*2 + (ir-1)*4*nside_ + ip; + } + else /* North & South polar caps */ + { + double tp = tt-(int)(tt); + double tmp = nside_*sqrt(3*(1-za)); + + int jp = (int)(tp*tmp); /* increasing edge line index */ + int jm = (int)((1.0-tp)*tmp); /* decreasing edge line index */ + + int ir = jp+jm+1; /* ring number counted from the closest pole */ + int ip = (int)(tt*ir); /* in {0,4*ir-1} */ + ip = imodulo(ip,4*ir); + + if (z>0) + return 2*ir*(ir-1) + ip; + else + return 12*nside_*nside_ - 2*ir*(ir+1) + ip; + } + } + +static void pix2ang_ring_z_phi (int nside_, int pix, double *z, double *phi) + { + long ncap_=nside_*(nside_-1)*2; + long npix_=12*nside_*nside_; + double fact2_ = 4./npix_; + if (pix<ncap_) /* North Polar cap */ + { + int iring = (int)(0.5*(1+isqrt(1+2*pix))); /* counted from North pole */ + int iphi = (pix+1) - 2*iring*(iring-1); + + *z = 1.0 - (iring*iring)*fact2_; + *phi = (iphi-0.5) * halfpi/iring; + } + else if (pix<(npix_-ncap_)) /* Equatorial region */ + { + double fact1_ = (nside_<<1)*fact2_; + int ip = pix - ncap_; + int iring = ip/(4*nside_) + nside_; /* counted from North pole */ + int iphi = ip%(4*nside_) + 1; + /* 1 if iring+nside is odd, 1/2 otherwise */ + double fodd = ((iring+nside_)&1) ? 1 : 0.5; + + int nl2 = 2*nside_; + *z = (nl2-iring)*fact1_; + *phi = (iphi-fodd) * pi/nl2; + } + else /* South Polar cap */ + { + int ip = npix_ - pix; + int iring = (int)(0.5*(1+isqrt(2*ip-1))); /* counted from South pole */ + int iphi = 4*iring + 1 - (ip - 2*iring*(iring-1)); + + *z = -1.0 + (iring*iring)*fact2_; + *phi = (iphi-0.5) * halfpi/iring; + } + } + +static void pix2ang_nest_z_phi (int nside_, int pix, double *z, double *phi) + { + int nl4 = nside_*4; + int npix_=12*nside_*nside_; + double fact2_ = 4./npix_; + int face_num, ix, iy, jr, nr, kshift, jp; + + nest2xyf(nside_,pix,&ix,&iy,&face_num); + jr = (jrll[face_num]*nside_) - ix - iy - 1; + + if (jr<nside_) + { + nr = jr; + *z = 1 - nr*nr*fact2_; + kshift = 0; + } + else if (jr > 3*nside_) + { + nr = nl4-jr; + *z = nr*nr*fact2_ - 1; + kshift = 0; + } + else + { + double fact1_ = (nside_<<1)*fact2_; + nr = nside_; + *z = (2*nside_-jr)*fact1_; + kshift = (jr-nside_)&1; + } + + jp = (jpll[face_num]*nr + ix -iy + 1 + kshift) / 2; + if (jp>nl4) jp-=nl4; + if (jp<1) jp+=nl4; + + *phi = (jp-(kshift+1)*0.5)*(halfpi/nr); + } + +void ang2vec(double theta, double phi, double *vec) + { + double sz = sin(theta); + vec[0] = sz * cos(phi); + vec[1] = sz * sin(phi); + vec[2] = cos(theta); + } + +void vec2ang(const double *vec, double *theta, double *phi) + { + *theta = atan2(sqrt(vec[0]*vec[0]+vec[1]*vec[1]),vec[2]); + *phi = atan2 (vec[1],vec[0]); + if (*phi<0.) *phi += twopi; + } + +long npix2nside(long npix) + { + long res = (long)floor(sqrt(npix/12.)+0.5); + return (res*res*12==npix) ? res : -1; + } + +long nside2npix(const long nside) + { return 12*nside*nside; } + +void ang2pix_ring(long nside, double theta, double phi, long *ipix) + { + UTIL_ASSERT((theta>=0)&&(theta<=pi),"theta out of range"); + *ipix=ang2pix_ring_z_phi (nside,cos(theta),phi); + } +void ang2pix_nest(long nside, double theta, double phi, long *ipix) + { + UTIL_ASSERT((theta>=0)&&(theta<=pi),"theta out of range"); + *ipix=ang2pix_nest_z_phi (nside,cos(theta),phi); + } +void vec2pix_ring(long nside, const double *vec, long *ipix) + { + double vlen=sqrt(vec[0]*vec[0]+vec[1]*vec[1]+vec[2]*vec[2]); + *ipix=ang2pix_ring_z_phi (nside,vec[2]/vlen, atan2(vec[1],vec[0])); + } +void vec2pix_nest(long nside, const double *vec, long *ipix) + { + double vlen=sqrt(vec[0]*vec[0]+vec[1]*vec[1]+vec[2]*vec[2]); + *ipix=ang2pix_nest_z_phi (nside,vec[2]/vlen, atan2(vec[1],vec[0])); + } +void pix2ang_ring(long nside, long ipix, double *theta, double *phi) + { + double z; + pix2ang_ring_z_phi (nside,ipix,&z,phi); + *theta=acos(z); + } +void pix2ang_nest(long nside, long ipix, double *theta, double *phi) + { + double z; + pix2ang_nest_z_phi (nside,ipix,&z,phi); + *theta=acos(z); + } +void pix2vec_ring(long nside, long ipix, double *vec) + { + double z, phi, stheta; + pix2ang_ring_z_phi (nside,ipix,&z,&phi); + stheta=sqrt((1.-z)*(1.+z)); + vec[0]=stheta*cos(phi); + vec[1]=stheta*sin(phi); + vec[2]=z; + } +void pix2vec_nest(long nside, long ipix, double *vec) + { + double z, phi, stheta; + pix2ang_nest_z_phi (nside,ipix,&z,&phi); + stheta=sqrt((1.-z)*(1.+z)); + vec[0]=stheta*cos(phi); + vec[1]=stheta*sin(phi); + vec[2]=z; + } +void nest2ring(long nside, long ipnest, long *ipring) + { + int ix, iy, face_num; + if ((nside&(nside-1))!=0) { *ipring=-1; return; } + nest2xyf (nside, ipnest, &ix, &iy, &face_num); + *ipring = xyf2ring (nside, ix, iy, face_num); + } +void ring2nest(long nside, long ipring, long *ipnest) + { + int ix, iy, face_num; + if ((nside&(nside-1))!=0) { *ipnest=-1; return; } + ring2xyf (nside, ipring, &ix, &iy, &face_num); + *ipnest = xyf2nest (nside, ix, iy, face_num); + } + +/* 64bit functions */ + +static hpint64 imodulo64 (hpint64 v1, hpint64 v2) + { hpint64 v=v1%v2; return (v>=0) ? v : v+v2; } +static long isqrt64(hpint64 v) + { + hpint64 res = sqrt(v+0.5); + if (v<((hpint64)(1)<<50)) return (long)res; + if (res*res>v) + --res; + else if ((res+1)*(res+1)<=v) + ++res; + return (long)res; + } + +static hpint64 spread_bits64 (int v) + { + return (hpint64)(utab[ v &0xff]) + | ((hpint64)(utab[(v>> 8)&0xff])<<16) + | ((hpint64)(utab[(v>>16)&0xff])<<32) + | ((hpint64)(utab[(v>>24)&0xff])<<48); + } + +static hpint64 compress_bits64 (hpint64 v) + { + hpint64 raw = v&0x5555555555555555ull; + raw|=raw>>15; + return ctab[ raw &0xff] | (ctab[(raw>> 8)&0xff]<< 4) + | (ctab[(raw>>32)&0xff]<<16) | (ctab[(raw>>40)&0xff]<<20); + } + +static hpint64 xyf2nest64 (hpint64 nside, int ix, int iy, int face_num) + { + return (face_num*nside*nside) + spread_bits64(ix) + (spread_bits64(iy)<<1); + } + +static void nest2xyf64 (hpint64 nside, hpint64 pix, int *ix, int *iy, + int *face_num) + { + hpint64 npface_=nside*nside; + *face_num = pix/npface_; + pix &= (npface_-1); + *ix = compress_bits64(pix); + *iy = compress_bits64(pix>>1); + } + +static hpint64 xyf2ring64 (hpint64 nside_, int ix, int iy, int face_num) + { + hpint64 nl4 = 4*nside_; + hpint64 jr = (jrll[face_num]*nside_) - ix - iy - 1, jp; + + hpint64 nr, kshift, n_before; + if (jr<nside_) + { + nr = jr; + n_before = 2*nr*(nr-1); + kshift = 0; + } + else if (jr > 3*nside_) + { + nr = nl4-jr; + n_before = 12*nside_*nside_ - 2*(nr+1)*nr; + kshift = 0; + } + else + { + hpint64 ncap_=2*nside_*(nside_-1); + nr = nside_; + n_before = ncap_ + (jr-nside_)*nl4; + kshift = (jr-nside_)&1; + } + + jp = (jpll[face_num]*nr + ix - iy + 1 + kshift) / 2; + if (jp>nl4) + jp-=nl4; + else + if (jp<1) jp+=nl4; + + return n_before + jp - 1; + } +static void ring2xyf64 (hpint64 nside_, hpint64 pix, int *ix, int *iy, + int *face_num) + { + hpint64 iring, iphi, kshift, nr, tmp, irt, ipt; + hpint64 ncap_=2*nside_*(nside_-1); + hpint64 npix_=12*nside_*nside_; + hpint64 nl2 = 2*nside_; + + if (pix<ncap_) /* North Polar cap */ + { + iring = (hpint64)(0.5*(1+isqrt64(1+2*pix))); /* counted from North pole */ + iphi = (pix+1) - 2*iring*(iring-1); + kshift = 0; + nr = iring; + *face_num=0; + tmp = iphi-1; + if (tmp>=(2*iring)) + { + *face_num=2; + tmp-=2*iring; + } + if (tmp>=iring) ++(*face_num); + } + else if (pix<(npix_-ncap_)) /* Equatorial region */ + { + hpint64 ire, irm; + hpint64 ifm, ifp; + hpint64 ip = pix - ncap_; + iring = (ip/(4*nside_)) + nside_; /* counted from North pole */ + iphi = (ip%(4*nside_)) + 1; + kshift = (iring+nside_)&1; + nr = nside_; + ire = iring-nside_+1; + irm = nl2+2-ire; + ifm = (iphi - ire/2 + nside_ -1) / nside_; + ifp = (iphi - irm/2 + nside_ -1) / nside_; + if (ifp == ifm) /* faces 4 to 7 */ + *face_num = (ifp==4) ? 4 : ifp+4; + else if (ifp<ifm) /* (half-)faces 0 to 3 */ + *face_num = ifp; + else /* (half-)faces 8 to 11 */ + *face_num = ifm + 8; + } + else /* South Polar cap */ + { + hpint64 ip = npix_ - pix; + iring = (hpint64)(0.5*(1+isqrt64(2*ip-1))); /* counted from South pole */ + iphi = 4*iring + 1 - (ip - 2*iring*(iring-1)); + kshift = 0; + nr = iring; + iring = 2*nl2-iring; + *face_num=8; + tmp = iphi-1; + if (tmp>=(2*nr)) + { + *face_num=10; + tmp-=2*nr; + } + if (tmp>=nr) ++(*face_num); + } + + irt = iring - (jrll[*face_num]*nside_) + 1; + ipt = 2*iphi- jpll[*face_num]*nr - kshift -1; + if (ipt>=nl2) ipt-=8*nside_; + + *ix = (ipt-irt) >>1; + *iy =(-(ipt+irt))>>1; + } + +static hpint64 ang2pix_nest_z_phi64 (hpint64 nside_, double z, double s, + double phi) + { + double za = fabs(z); + double tt = fmodulo(phi,twopi) * inv_halfpi; /* in [0,4) */ + int face_num, ix, iy; + + if (za<=twothird) /* Equatorial region */ + { + double temp1 = nside_*(0.5+tt); + double temp2 = nside_*(z*0.75); + hpint64 jp = (hpint64)(temp1-temp2); /* index of ascending edge line */ + hpint64 jm = (hpint64)(temp1+temp2); /* index of descending edge line */ + hpint64 ifp = jp/nside_; /* in {0,4} */ + hpint64 ifm = jm/nside_; + if (ifp == ifm) /* faces 4 to 7 */ + face_num = (ifp==4) ? 4: ifp+4; + else if (ifp < ifm) /* (half-)faces 0 to 3 */ + face_num = ifp; + else /* (half-)faces 8 to 11 */ + face_num = ifm + 8; + + ix = jm & (nside_-1); + iy = nside_ - (jp & (nside_-1)) - 1; + } + else /* polar region, za > 2/3 */ + { + int ntt = (int)tt, jp, jm; + double tp, tmp; + if (ntt>=4) ntt=3; + tp = tt-ntt; + if (s>-2.) + tmp = nside_*s/sqrt((1.+za)/3.); + else + tmp = nside_*sqrt(3*(1-za)); + + jp = (hpint64)(tp*tmp); /* increasing edge line index */ + jm = (hpint64)((1.0-tp)*tmp); /* decreasing edge line index */ + if (jp>=nside_) jp = nside_-1; /* for points too close to the boundary */ + if (jm>=nside_) jm = nside_-1; + if (z >= 0) + { + face_num = ntt; /* in {0,3} */ + ix = nside_ - jm - 1; + iy = nside_ - jp - 1; + } + else + { + face_num = ntt + 8; /* in {8,11} */ + ix = jp; + iy = jm; + } + } + + return xyf2nest64(nside_,ix,iy,face_num); + } + +static hpint64 ang2pix_ring_z_phi64 (hpint64 nside_, double z, double s, + double phi) + { + double za = fabs(z); + double tt = fmodulo(phi,twopi) * inv_halfpi; /* in [0,4) */ + + if (za<=twothird) /* Equatorial region */ + { + double temp1 = nside_*(0.5+tt); + double temp2 = nside_*z*0.75; + hpint64 jp = (hpint64)(temp1-temp2); /* index of ascending edge line */ + hpint64 jm = (hpint64)(temp1+temp2); /* index of descending edge line */ + + /* ring number counted from z=2/3 */ + hpint64 ir = nside_ + 1 + jp - jm; /* in {1,2n+1} */ + int kshift = 1-(ir&1); /* kshift=1 if ir even, 0 otherwise */ + + hpint64 ip = (jp+jm-nside_+kshift+1)/2; /* in {0,4n-1} */ + ip = imodulo64(ip,4*nside_); + + return nside_*(nside_-1)*2 + (ir-1)*4*nside_ + ip; + } + else /* North & South polar caps */ + { + double tp = tt-(int)(tt); + double tmp = (s>-2.) ? nside_*s/sqrt((1.+za)/3.) : nside_*sqrt(3*(1-za)); + + hpint64 jp = (hpint64)(tp*tmp); /* increasing edge line index */ + hpint64 jm = (hpint64)((1.0-tp)*tmp); /* decreasing edge line index */ + + hpint64 ir = jp+jm+1; /* ring number counted from the closest pole */ + hpint64 ip = (hpint64)(tt*ir); /* in {0,4*ir-1} */ + ip = imodulo64(ip,4*ir); + + if (z>0) + return 2*ir*(ir-1) + ip; + else + return 12*nside_*nside_ - 2*ir*(ir+1) + ip; + } + } + +static void pix2ang_ring_z_phi64 (hpint64 nside_, hpint64 pix, + double *z, double *s, double *phi) + { + hpint64 ncap_=nside_*(nside_-1)*2; + hpint64 npix_=12*nside_*nside_; + double fact2_ = 4./npix_; + *s=-5; + if (pix<ncap_) /* North Polar cap */ + { + hpint64 iring = (hpint64)(0.5*(1+isqrt64(1+2*pix))); /* from N pole */ + hpint64 iphi = (pix+1) - 2*iring*(iring-1); + double tmp=(iring*iring)*fact2_; + + *z = 1.0 - tmp; + if (*z>0.99) *s=sqrt(tmp*(2.-tmp)); + *phi = (iphi-0.5) * halfpi/iring; + } + else if (pix<(npix_-ncap_)) /* Equatorial region */ + { + double fact1_ = (nside_<<1)*fact2_; + hpint64 ip = pix - ncap_; + hpint64 iring = ip/(4*nside_) + nside_; /* counted from North pole */ + hpint64 iphi = ip%(4*nside_) + 1; + /* 1 if iring+nside is odd, 1/2 otherwise */ + double fodd = ((iring+nside_)&1) ? 1 : 0.5; + + hpint64 nl2 = 2*nside_; + *z = (nl2-iring)*fact1_; + *phi = (iphi-fodd) * pi/nl2; + } + else /* South Polar cap */ + { + hpint64 ip = npix_ - pix; + hpint64 iring = (hpint64)(0.5*(1+isqrt64(2*ip-1))); /* from S pole */ + hpint64 iphi = 4*iring + 1 - (ip - 2*iring*(iring-1)); + + double tmp=(iring*iring)*fact2_; + *z = tmp - 1.0; + if (*z<-0.99) *s=sqrt(tmp*(2.-tmp)); + *phi = (iphi-0.5) * halfpi/iring; + } + } + +static void pix2ang_nest_z_phi64 (hpint64 nside_, hpint64 pix, double *z, + double *s, double *phi) + { + hpint64 nl4 = nside_*4; + hpint64 npix_=12*nside_*nside_; + double fact2_ = 4./npix_; + int face_num, ix, iy; + hpint64 jr, nr, kshift, jp; + *s=-5; + + nest2xyf64(nside_,pix,&ix,&iy,&face_num); + jr = (jrll[face_num]*nside_) - ix - iy - 1; + + if (jr<nside_) + { + double tmp; + nr = jr; + tmp=(nr*nr)*fact2_; + *z = 1 - tmp; + if (*z>0.99) *s=sqrt(tmp*(2.-tmp)); + kshift = 0; + } + else if (jr > 3*nside_) + { + double tmp; + nr = nl4-jr; + tmp=(nr*nr)*fact2_; + *z = tmp - 1; + if (*z<-0.99) *s=sqrt(tmp*(2.-tmp)); + kshift = 0; + } + else + { + double fact1_ = (nside_<<1)*fact2_; + nr = nside_; + *z = (2*nside_-jr)*fact1_; + kshift = (jr-nside_)&1; + } + + jp = (jpll[face_num]*nr + ix -iy + 1 + kshift) / 2; + if (jp>nl4) jp-=nl4; + if (jp<1) jp+=nl4; + + *phi = (jp-(kshift+1)*0.5)*(halfpi/nr); + } + +long npix2nside64(hpint64 npix) + { + hpint64 res = isqrt64(npix/12.); + return (res*res*12==npix) ? (long)res : -1; + } + +hpint64 nside2npix64(hpint64 nside) + { return 12*nside*nside; } + +void ang2pix_ring64(hpint64 nside, double theta, double phi, hpint64 *ipix) + { + UTIL_ASSERT((theta>=0)&&(theta<=pi),"theta out of range"); + double cth=cos(theta), sth=(fabs(cth)>0.99) ? sin(theta) : -5; + *ipix=ang2pix_ring_z_phi64 (nside,cth,sth,phi); + } +void ang2pix_nest64(hpint64 nside, double theta, double phi, hpint64 *ipix) + { + UTIL_ASSERT((theta>=0)&&(theta<=pi),"theta out of range"); + double cth=cos(theta), sth=(fabs(cth)>0.99) ? sin(theta) : -5; + *ipix=ang2pix_nest_z_phi64 (nside,cth,sth,phi); + } +void vec2pix_ring64(hpint64 nside, const double *vec, hpint64 *ipix) + { + double vlen=sqrt(vec[0]*vec[0]+vec[1]*vec[1]+vec[2]*vec[2]); + double cth = vec[2]/vlen; + double sth=(fabs(cth)>0.99) ? sqrt(vec[0]*vec[0]+vec[1]*vec[1])/vlen : -5; + *ipix=ang2pix_ring_z_phi64 (nside,cth,sth,atan2(vec[1],vec[0])); + } +void vec2pix_nest64(hpint64 nside, const double *vec, hpint64 *ipix) + { + double vlen=sqrt(vec[0]*vec[0]+vec[1]*vec[1]+vec[2]*vec[2]); + double cth = vec[2]/vlen; + double sth=(fabs(cth)>0.99) ? sqrt(vec[0]*vec[0]+vec[1]*vec[1])/vlen : -5; + *ipix=ang2pix_nest_z_phi64 (nside,cth,sth,atan2(vec[1],vec[0])); + } +void pix2ang_ring64(hpint64 nside, hpint64 ipix, double *theta, double *phi) + { + double z,s; + pix2ang_ring_z_phi64 (nside,ipix,&z,&s,phi); + *theta= (s<-2) ? acos(z) : atan2(s,z); + } +void pix2ang_nest64(hpint64 nside, hpint64 ipix, double *theta, double *phi) + { + double z,s; + pix2ang_nest_z_phi64 (nside,ipix,&z,&s,phi); + *theta= (s<-2) ? acos(z) : atan2(s,z); + } +void pix2vec_ring64(hpint64 nside, hpint64 ipix, double *vec) + { + double z, phi, stheta; + pix2ang_ring_z_phi64 (nside,ipix,&z,&stheta,&phi); + if (stheta<-2) stheta=sqrt((1.-z)*(1.+z)); + vec[0]=stheta*cos(phi); + vec[1]=stheta*sin(phi); + vec[2]=z; + } +void pix2vec_nest64(hpint64 nside, hpint64 ipix, double *vec) + { + double z, phi, stheta; + pix2ang_nest_z_phi64 (nside,ipix,&z,&stheta,&phi); + if (stheta<-2) stheta=sqrt((1.-z)*(1.+z)); + vec[0]=stheta*cos(phi); + vec[1]=stheta*sin(phi); + vec[2]=z; + } +void nest2ring64(hpint64 nside, hpint64 ipnest, hpint64 *ipring) + { + int ix, iy, face_num; + if ((nside&(nside-1))!=0) { *ipring=-1; return; } + nest2xyf64 (nside, ipnest, &ix, &iy, &face_num); + *ipring = xyf2ring64 (nside, ix, iy, face_num); + } +void ring2nest64(hpint64 nside, hpint64 ipring, hpint64 *ipnest) + { + int ix, iy, face_num; + if ((nside&(nside-1))!=0) { *ipnest=-1; return; } + ring2xyf64 (nside, ipring, &ix, &iy, &face_num); + *ipnest = xyf2nest64 (nside, ix, iy, face_num); + } + +#ifdef ENABLE_FITSIO + +static void printerror (int status) + { + if (status==0) return; + + fits_report_error(stderr, status); + UTIL_FAIL("FITS error"); + } + +static void setCoordSysHP(char coordsys,char *coordsys9) + { + strcpy(coordsys9,"C "); + if (coordsys=='G') + strcpy (coordsys9,"G "); + else if (coordsys=='E') + strcpy (coordsys9,"E "); + else if ((coordsys!='C')&&(coordsys!='Q')) + fprintf(stderr, "%s (%d): System Cordinates are not correct" + "(Galactic,Ecliptic,Celestial=Equatorial). " + " Celestial system was set.\n", __FILE__, __LINE__); + } + +float *read_healpix_map(const char *infile, long *nside, char *coordsys, + char *ordering) + { + /* Local Declarations */ + long naxes, *naxis, npix; + int status=0, hdutype, nfound, anynul; + float nulval, *map; + fitsfile *fptr; + + fits_open_file(&fptr, infile, READONLY, &status); + fits_movabs_hdu(fptr, 2, &hdutype, &status); + printerror(status); + + UTIL_ASSERT(hdutype==BINARY_TBL,"Extension is not binary!"); + + /* Read the sizes of the array */ + fits_read_key_lng(fptr, "NAXIS", &naxes, NULL, &status); + printerror(status); + + naxis = RALLOC(long,naxes); + fits_read_keys_lng(fptr, "NAXIS", 1, naxes, naxis, &nfound, &status); + printerror(status); + UTIL_ASSERT(nfound==naxes,"nfound!=naxes"); + + fits_read_key_lng(fptr, "NSIDE", nside, NULL, &status); + printerror(status); + + npix = 12*(*nside)*(*nside); + UTIL_ASSERT((npix%naxis[1])==0,"Problem with npix."); + + if (fits_read_key(fptr, TSTRING, "COORDSYS",coordsys, NULL, &status)) { + fprintf(stderr, "WARNING: Could not find %s keyword in in file %s\n", + "COORDSYS",infile); + status = 0; + } + + if (fits_read_key(fptr, TSTRING, "ORDERING", ordering, NULL, &status)) { + fprintf(stderr, "WARNING: Could not find %s keyword in in file %s\n", + "ORDERING",infile); + status = 0; + } + + /* Read the array */ + map = RALLOC(float,npix); + nulval = HEALPIX_NULLVAL; + fits_read_col(fptr, TFLOAT, 1, 1, 1, npix, &nulval, map, &anynul, &status); + printerror(status); + + DEALLOC(naxis); + + fits_close_file(fptr, &status); + printerror(status); + + return map; + } + +long get_fits_size(const char *filename, long *nside, char *ordering) + { + fitsfile *fptr; /* pointer to the FITS file, defined in fitsio.h */ + int status=0, hdutype; + long obs_npix; + + fits_open_file(&fptr, filename, READONLY, &status); + fits_movabs_hdu(fptr, 2, &hdutype, &status); /* move to 2nd HDU */ + + fits_read_key(fptr, TSTRING, "ORDERING", ordering, NULL, &status); + fits_read_key(fptr, TLONG, "NSIDE", nside, NULL, &status); + printerror(status); + + if (fits_read_key(fptr, TLONG, "OBS_NPIX", &obs_npix, NULL, &status)) { + obs_npix = 12 * (*nside) * (*nside); + status = 0; + } + + fits_close_file(fptr, &status); + printerror(status); + return obs_npix; + } + +void write_healpix_map (const float *signal, long nside, const char *filename, + char nest, const char *coordsys) + { + fitsfile *fptr; /* pointer to the FITS file, defined in fitsio.h */ + int status=0, hdutype; + + long naxes[] = {0,0}; + + char order[9]; /* HEALPix ordering */ + char *ttype[] = { "SIGNAL" }; + char *tform[] = { "1E" }; + char *tunit[] = { " " }; + char coordsys9[9]; + + /* create new FITS file */ + fits_create_file(&fptr, filename, &status); + fits_create_img(fptr, SHORT_IMG, 0, naxes, &status); + fits_write_date(fptr, &status); + fits_movabs_hdu(fptr, 1, &hdutype, &status); + fits_create_tbl( fptr, BINARY_TBL, 12L*nside*nside, 1, ttype, tform, + tunit, "BINTABLE", &status); + fits_write_key(fptr, TSTRING, "PIXTYPE", "HEALPIX", "HEALPIX Pixelisation", + &status); + + strcpy(order, nest ? "NESTED " : "RING "); + fits_write_key(fptr, TSTRING, "ORDERING", order, + "Pixel ordering scheme, either RING or NESTED", &status); + fits_write_key(fptr, TLONG, "NSIDE", &nside, + "Resolution parameter for HEALPIX", &status); + + UTIL_ASSERT(strlen(coordsys)>=1,"bad ccordsys value"); + setCoordSysHP(coordsys[0],coordsys9); + fits_write_key(fptr, TSTRING, "COORDSYS", coordsys9, + "Pixelisation coordinate system", &status); + + fits_write_key(fptr, TSTRING, "INDXSCHM", "IMPLICIT", "Index scheme", &status); + + fits_write_comment(fptr, + "G = Galactic, E = ecliptic, C = celestial = equatorial", &status); + + fits_write_col(fptr, TFLOAT, 1, 1, 1, 12*nside*nside, (void *)signal,&status); + fits_close_file(fptr, &status); + printerror(status); + } + +#endif diff --git a/src/healpix/chealpix.h b/src/healpix/chealpix.h new file mode 100644 index 0000000..3aefb07 --- /dev/null +++ b/src/healpix/chealpix.h @@ -0,0 +1,170 @@ +/* ----------------------------------------------------------------------------- + * + * Copyright (C) 1997-2012 Krzysztof M. Gorski, Eric Hivon, Martin Reinecke, + * Benjamin D. Wandelt, Anthony J. Banday, + * Matthias Bartelmann, + * Reza Ansari & Kenneth M. Ganga + * + * + * This file is part of HEALPix. + * + * HEALPix is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * HEALPix is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HEALPix; if not, write to the Free Software + * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + * + * For more information about HEALPix see http://healpix.sourceforge.net + * + *----------------------------------------------------------------------------*/ +/* + * chealpix.h + */ + +#ifndef CHEALPIX_H +#define CHEALPIX_H + +#ifdef __cplusplus +extern "C" { +#endif + +/*! \defgroup chealpix HEALPix C interface + All angles are in radian, all \a theta values are colatitudes, i.e. counted + downwards from the North Pole. \a Nside can be any positive number for + pixelisations in RING scheme; in NEST scheme, they must be powers of 2. + The maximum \a Nside for the traditional interface is 8192; for the + 64bit interface it is 2^29. + */ +/*! \{ */ + +/* -------------------- */ +/* Constant Definitions */ +/* -------------------- */ + +#ifndef HEALPIX_NULLVAL +#define HEALPIX_NULLVAL (-1.6375e30) +#endif /* HEALPIX_NULLVAL */ + +/* pixel operations */ +/* ---------------- */ +/*! Sets \a *ipix to the pixel number in NEST scheme at resolution \a nside, + which contains the position \a theta, \a phi. */ +void ang2pix_nest(long nside, double theta, double phi, long *ipix); +/*! Sets \a *ipix to the pixel number in RING scheme at resolution \a nside, + which contains the position \a theta, \a phi. */ +void ang2pix_ring(long nside, double theta, double phi, long *ipix); + +/*! Sets \a theta and \a phi to the angular position of the center of pixel + \a ipix in NEST scheme at resolution \a nside. */ +void pix2ang_nest(long nside, long ipix, double *theta, double *phi); +/*! Sets \a theta and \a phi to the angular position of the center of pixel + \a ipix in NEST scheme at resolution \a nside. */ +void pix2ang_ring(long nside, long ipix, double *theta, double *phi); + +/*! Computes the RING pixel index of pixel \a ipnest at resolution \a nside + and returns it in \a *ipring. On error, \a *ipring is set to -1. */ +void nest2ring(long nside, long ipnest, long *ipring); +/*! Computes the NEST pixel index of pixel \a ipring at resolution \a nside + and returns it in \a *ipring. On error, \a *ipnest is set to -1. */ +void ring2nest(long nside, long ipring, long *ipnest); + +/*! Returns \a 12*nside*nside. */ +long nside2npix(long nside); +/*! Returns \a sqrt(npix/12) if this is an integer number, otherwise \a -1. */ +long npix2nside(long npix); + +/*! Computes a normalized Cartesian vector pointing in the same direction as + \a theta, \a phi, and stores it in \a vec. \a vec must point to storage + sufficient for at least three doubles. */ +void ang2vec(double theta, double phi, double *vec); +/*! Computes the angles \a *theta and \a *phi describing the same directions + as the Cartesian vector \a vec. \a vec need not be normalized. */ +void vec2ang(const double *vec, double *theta, double *phi); + +/*! Sets \a *ipix to the pixel number in NEST scheme at resolution \a nside, + which contains the direction described the Cartesian vector \a vec. */ +void vec2pix_nest(long nside, const double *vec, long *ipix); +/*! Sets \a *ipix to the pixel number in RING scheme at resolution \a nside, + which contains the direction described the Cartesian vector \a vec. */ +void vec2pix_ring(long nside, const double *vec, long *ipix); + +/*! Sets \a vec to the Cartesian vector pointing in the direction of the center + of pixel \a ipix in NEST scheme at resolution \a nside. */ +void pix2vec_nest(long nside, long ipix, double *vec); +/*! Sets \a vec to the Cartesian vector pointing in the direction of the center + of pixel \a ipix in RING scheme at resolution \a nside. */ +void pix2vec_ring(long nside, long ipix, double *vec); + +/* operations on Nside values up to 2^29 */ + +/*! 64bit integer type + \note We are not using \c int64_t, since this type is not part of the C++ + standard, and we want the header to be usable from C++. */ +typedef long long hpint64; + +/*! Sets \a *ipix to the pixel number in NEST scheme at resolution \a nside, + which contains the position \a theta, \a phi. */ +void ang2pix_nest64(hpint64 nside, double theta, double phi, hpint64 *ipix); +/*! Sets \a *ipix to the pixel number in RING scheme at resolution \a nside, + which contains the position \a theta, \a phi. */ +void ang2pix_ring64(hpint64 nside, double theta, double phi, hpint64 *ipix); + +/*! Sets \a theta and \a phi to the angular position of the center of pixel + \a ipix in NEST scheme at resolution \a nside. */ +void pix2ang_nest64(hpint64 nside, hpint64 ipix, double *theta, double *phi); +/*! Sets \a theta and \a phi to the angular position of the center of pixel + \a ipix in RING scheme at resolution \a nside. */ +void pix2ang_ring64(hpint64 nside, hpint64 ipix, double *theta, double *phi); + +/*! Computes the RING pixel index of pixel \a ipnest at resolution \a nside + and returns it in \a *ipring. On error, \a *ipring is set to -1. */ +void nest2ring64(hpint64 nside, hpint64 ipnest, hpint64 *ipring); +/*! Computes the NEST pixel index of pixel \a ipring at resolution \a nside + and returns it in \a *ipring. On error, \a *ipnest is set to -1. */ +void ring2nest64(hpint64 nside, hpint64 ipring, hpint64 *ipnest); + +/*! Returns \a 12*nside*nside. */ +hpint64 nside2npix64(hpint64 nside); +/*! Returns \a sqrt(npix/12) if this is an integer number, otherwise \a -1. */ +long npix2nside64(hpint64 npix); + +/*! Sets \a *ipix to the pixel number in NEST scheme at resolution \a nside, + which contains the direction described the Cartesian vector \a vec. */ +void vec2pix_nest64(hpint64 nside, const double *vec, hpint64 *ipix); +/*! Sets \a *ipix to the pixel number in RING scheme at resolution \a nside, + which contains the direction described the Cartesian vector \a vec. */ +void vec2pix_ring64(hpint64 nside, const double *vec, hpint64 *ipix); + +/*! Sets \a vec to the Cartesian vector pointing in the direction of the center + of pixel \a ipix in NEST scheme at resolution \a nside. */ +void pix2vec_nest64(hpint64 nside, hpint64 ipix, double *vec); +/*! Sets \a vec to the Cartesian vector pointing in the direction of the center + of pixel \a ipix in RING scheme at resolution \a nside. */ +void pix2vec_ring64(hpint64 nside, hpint64 ipix, double *vec); + +/* FITS operations */ +/* --------------- */ + +float *read_healpix_map (const char *infile, long *nside, char *coordsys, + char *ordering); + +void write_healpix_map (const float *signal, long nside, const char *filename, + char nest, const char *coordsys); + +long get_fits_size(const char *filename, long *nside, char *ordering); + +/*! \} */ + +#ifdef __cplusplus +} /* extern "C" */ +#endif + +#endif /* CHEALPIX_H */ diff --git a/src/healpix_ang2pix_nest.c b/src/healpix_ang2pix_nest.c new file mode 100644 index 0000000..43412cd --- /dev/null +++ b/src/healpix_ang2pix_nest.c @@ -0,0 +1,154 @@ +/* ----------------------------------------------------------------------------- + * + * Copyright (C) 1997-2005 Krzysztof M. Gorski, Eric Hivon, + * Benjamin D. Wandelt, Anthony J. Banday, + * Matthias Bartelmann, + * Reza Ansari & Kenneth M. Ganga + * + * + * This file is part of HEALPix. + * + * HEALPix is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; either version 2 of the License, or + * (at your option) any later version. + * + * HEALPix is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with HEALPix; if not, write to the Free Software + * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA + * + * For more information about HEALPix see http://healpix.jpl.nasa.gov + * + *----------------------------------------------------------------------------- */ +/* healpix_ang2pix_nest.c */ + +/* Standard Includes */ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include "pi.h" +#include "manglefn.h" + +void healpix_ang2pix_nest( const int nside, long double theta, long double phi, int *ipix) { + + /* ======================================================================= + * subroutine ang2pix_nest(nside, theta, phi, ipix) + * ======================================================================= + * gives the pixel number ipix (NESTED) corresponding to angles theta and phi + * + * the computation is made to the highest resolution available (nside=8192) + * and then degraded to that required (by integer division) + * this doesn't cost more, and it makes sure that the treatement of round-off + * will be consistent for every resolution + * ======================================================================= + */ + + long double z, za, z0, tt, tp, tmp; + int face_num,jp,jm; + int ifp, ifm; + int ix, iy, ix_low, ix_hi, iy_low, iy_hi, ipf, ntt; + int i, K, IP, I, J, id; + int ns_max = 8192; + static int x2pix[128], y2pix[128]; + static char setup_done = 0; + + if( nside < 1 || nside > ns_max ) { + fprintf(stderr, "healpix_ang2pix_nest: nside out of range: %d\n", nside); + exit(0); + } + if( theta < 0. || theta > PI ) { + fprintf(stderr, "healpix_ang2pix_nest: theta out of range: %Lf\n", theta); + exit(0); + } + if( !setup_done ) { + /* set the array giving the number of the pixel lying in (x,y), where x and y + are in {1,128} and the pixel number is in {0,128^2-1} */ + for (i = 0; i < 127; i++) x2pix[i] = 0; + for (I = 1; I <= 128; I++) { + J = I - 1; // !pixel numbers + K = 0; + IP = 1; + truc : if (J == 0) { + x2pix[I-1] = K; + y2pix[I-1] = 2*K; + } + else { + id = (int)fmodl(J,2); + J = J/2; + K = IP*id + K; + IP = IP*4; + goto truc; + } + } + setup_done = 1; + } + + z = cosl(theta); + za = fabsl(z); + z0 = 2./3.; + if( phi >= TWOPI ) phi = phi - TWOPI; + if( phi < 0. ) phi = phi + TWOPI; + tt = phi / PIBYTWO; /* in [0,4] */ + + if( za <= z0 ) { /* equatorial region */ + + /* (the index of edge lines increase when the longitude=phi goes up) */ + jp = (int)floorl(ns_max*(0.5 + tt - z*0.75)); /* ascending edge line index */ + jm = (int)floorl(ns_max*(0.5 + tt + z*0.75)); /* descending edge line index */ + + /* finds the face */ + ifp = jp / ns_max; /* in {0,4} */ + ifm = jm / ns_max; + + if( ifp == ifm ) face_num = (int)fmodl(ifp,4) + 4; /* faces 4 to 7 */ + else if( ifp < ifm ) face_num = (int)fmodl(ifp,4); /* (half-)faces 0 to 3 */ + else face_num = (int)fmodl(ifm,4) + 8; /* (half-)faces 8 to 11 */ + + ix = (int)fmodl(jm, ns_max); + iy = ns_max - (int)fmodl(jp, ns_max) - 1; + } + else { /* polar region, za > 2/3 */ + + ntt = (int)floorl(tt); + if( ntt >= 4 ) ntt = 3; + tp = tt - ntt; + tmp = sqrtl( 3.*(1. - za) ); /* in ]0,1] */ + + /* (the index of edge lines increase when distance from the closest pole + * goes up) + */ + /* line going toward the pole as phi increases */ + jp = (int)floorl( ns_max * tp * tmp ); + + /* that one goes away of the closest pole */ + jm = (int)floorl( ns_max * (1. - tp) * tmp ); + jp = (int)(jp < ns_max-1 ? jp : ns_max-1); + jm = (int)(jm < ns_max-1 ? jm : ns_max-1); + + /* finds the face and pixel's (x,y) */ + if( z >= 0 ) { + face_num = ntt; /* in {0,3} */ + ix = ns_max - jm - 1; + iy = ns_max - jp - 1; + } + else { + face_num = ntt + 8; /* in {8,11} */ + ix = jp; + iy = jm; + } + } + + ix_low = (int)fmodl(ix,128); + ix_hi = ix/128; + iy_low = (int)fmodl(iy,128); + iy_hi = iy/128; + + ipf = (x2pix[ix_hi] + y2pix[iy_hi]) * (128 * 128) + (x2pix[ix_low] + y2pix[iy_low]); + ipf = (int)(ipf / powl(ns_max/nside,2)); /* in {0, nside**2 - 1} */ + *ipix =(int)( ipf + face_num*powl(nside,2)); /* in {0, 12*nside**2 - 1} */ +} diff --git a/src/healpixpolys.c b/src/healpixpolys.c new file mode 100644 index 0000000..6653993 --- /dev/null +++ b/src/healpixpolys.c @@ -0,0 +1,252 @@ +/*------------------------------------------------------------- +(C) J C Hill 2006 +-------------------------------------------------------------*/ +#include <stdlib.h> +#include <math.h> +#include "pi.h" +#include "manglefn.h" + +/*----------------------------------------------------------- + get_healpix_poly: uses the HEALPix Fortran subroutine + pix2vec_nest to construct the HEALPix + pixels at the desired resolution + + Input: nside = HEALPix parameter describing resolution (for + res >= 1, simply defined by 2^(res-1); for + res = 0, define nside = 0) + hpix = id number of HEALPix pixel that you wish to construct + Return value: pointer to polygon if successful + 0x0 if error occurred +*/ + +polygon *get_healpix_poly(int nside, int hpix) +{ + int nv, nvmax, i, pix_n, pix_e, pix_s, pix_w, ev[1]; + vertices *vert; + polygon *pixel, *pixelbetter; + long double verts_vec[12], verts_vec_n[12], verts_vec_e[12], verts_vec_s[12], verts_vec_w[12], dist_n, dist_w, dist_s, dist_e; + vec center, center_n, center_e, center_s, center_w, vertices_vec[4], vertices_vec_n[4], vertices_vec_e[4], vertices_vec_s[4], vertices_vec_w[4]; + azel *vertices_azel[8], vertices[8]; + + for(i=0;i<=7;i++) vertices_azel[i] = &(vertices[i]); + + if (nside == 0) { + pixel=new_poly(0); + pixel->weight=1; + pixel->pixel=0; + + return(pixel); + } + + else { + healpix_verts(nside, hpix, center, verts_vec); + + /* north vertex */ + for(i=0;i<=2;i++) (vertices_vec[0])[i] = verts_vec[i]; + + /* east vertex */ + for(i=0;i<=2;i++) (vertices_vec[1])[i] = verts_vec[i+3]; + + /* south vertex */ + for(i=0;i<=2;i++) (vertices_vec[2])[i] = verts_vec[i+6]; + + /* west vertex */ + for(i=0;i<=2;i++) (vertices_vec[3])[i] = verts_vec[i+9]; + + rp_to_azel(vertices_vec[0], vertices_azel[0]); + rp_to_azel(vertices_vec[3], vertices_azel[2]); + rp_to_azel(vertices_vec[2], vertices_azel[4]); + rp_to_azel(vertices_vec[1], vertices_azel[6]); + + pix_n = 4*hpix + 3; + pix_e = 4*hpix + 1; + pix_s = 4*hpix; + pix_w = 4*hpix + 2; + + healpix_verts(nside*2, pix_n, center_n, verts_vec_n); + healpix_verts(nside*2, pix_e, center_e, verts_vec_e); + healpix_verts(nside*2, pix_s, center_s, verts_vec_s); + healpix_verts(nside*2, pix_w, center_w, verts_vec_w); + + /* north vertex of each child pixel */ + for(i=0;i<=2;i++){ + (vertices_vec_n[0])[i] = verts_vec_n[i]; + (vertices_vec_e[0])[i] = verts_vec_e[i]; + (vertices_vec_s[0])[i] = verts_vec_s[i]; + (vertices_vec_w[0])[i] = verts_vec_w[i]; + } + + /* east vertex of each child pixel */ + for(i=0;i<=2;i++){ + (vertices_vec_n[1])[i] = verts_vec_n[i+3]; + (vertices_vec_e[1])[i] = verts_vec_e[i+3]; + (vertices_vec_s[1])[i] = verts_vec_s[i+3]; + (vertices_vec_w[1])[i] = verts_vec_w[i+3]; + } + + /* south vertex of each child pixel */ + for(i=0;i<=2;i++){ + (vertices_vec_n[2])[i] = verts_vec_n[i+6]; + (vertices_vec_e[2])[i] = verts_vec_e[i+6]; + (vertices_vec_s[2])[i] = verts_vec_s[i+6]; + (vertices_vec_w[2])[i] = verts_vec_w[i+6]; + } + + /* west vertex of each child pixel */ + for(i=0;i<=2;i++){ + (vertices_vec_n[3])[i] = verts_vec_n[i+9]; + (vertices_vec_e[3])[i] = verts_vec_e[i+9]; + (vertices_vec_s[3])[i] = verts_vec_s[i+9]; + (vertices_vec_w[3])[i] = verts_vec_w[i+9]; + } + + rp_to_azel(vertices_vec_n[3], vertices_azel[1]); + rp_to_azel(vertices_vec_w[2], vertices_azel[3]); + rp_to_azel(vertices_vec_s[1], vertices_azel[5]); + rp_to_azel(vertices_vec_e[0], vertices_azel[7]); + + for(i=0; i<8; i++){ + if(vertices[i].az < 0.) vertices[i].az = vertices[i].az + TWOPI; + else {}; + } + + for(i=0; i<8; i++){ + if(vertices[i].az >= TWOPI) vertices[i].az = vertices[i].az - TWOPI; + else {}; + } + + nv=8; nvmax=8; + vert=new_vert(nvmax); + if(!vert){ + fprintf(stderr, "error in get_healpix_poly: failed to allocate memory for 8 vertices\n"); + return(0x0); + } + vert->nv=nv; vert->v=&vertices[0]; + + pixel=new_poly(4); + + if(!pixel){ + fprintf(stderr, "error in get_healpix_poly: failed to allocate memory for polygon of 4 caps\n"); + return(0x0); + } + + ev[0] = 8; + + edge_to_poly(vert, 2, &ev[0], pixel); + pixel->id = hpix; + + pixelbetter=new_poly(5); + + if(!pixelbetter){ + fprintf(stderr, "error in get_healpix_poly: failed to allocate memory for polygon of 5 caps\n"); + return(0x0); + } + + pixelbetter->np = 5; + pixelbetter->npmax = 5; + + for(i=0; i<=3; i++) { + pixelbetter->rp[i][0] = pixel->rp[i][0]; + pixelbetter->rp[i][1] = pixel->rp[i][1]; + pixelbetter->rp[i][2] = pixel->rp[i][2]; + pixelbetter->cm[i] = pixel->cm[i]; + } + + pixelbetter->rp[4][0] = center[0]; pixelbetter->rp[4][1] = center[1]; pixelbetter->rp[4][2] = center[2]; + pixelbetter->id = hpix; + + dist_n = cmrpirpj(center, vertices_vec[0]); + dist_w = cmrpirpj(center, vertices_vec[3]); + dist_s = cmrpirpj(center, vertices_vec[2]); + dist_e = cmrpirpj(center, vertices_vec[1]); + + if(dist_n>=dist_w && dist_n>=dist_s && dist_n>=dist_e){ + pixelbetter->cm[4] = dist_n+0.000001; + } + else if(dist_w>=dist_n && dist_w>=dist_s && dist_w>=dist_e){ + pixelbetter->cm[4] = dist_w+0.000001; + } + else if(dist_s>=dist_n && dist_s>=dist_w && dist_s>=dist_e){ + pixelbetter->cm[4] = dist_s+0.000001; + } + else if(dist_e>=dist_n && dist_e>=dist_s && dist_e>=dist_w){ + pixelbetter->cm[4] = dist_e+0.000001; + } + else{ + fprintf(stderr, "error in get_healpix_poly: cannot find correct fifth cap\n"); + return(0x0); + } + + + if(!pixelbetter){ + fprintf(stderr, "error in get_healpix_poly: polygon is NULL.\n"); + return(0x0); + } + + return(pixelbetter); + } +} + +/*------------------------------------------------------------ + get_nside: determines the HEALPix nside parameter (related to + the resolution) from the number of weights (i.e., + polygons) listed in the input file + + Input: nweights = number of weights in HEALPix_weight input file + Return value: nside parameter +*/ + +int get_nside(int nweights) +{ + int res, nside; + long double res_d; + + if (nweights == 1) { + nside = 0; + return(nside); + } + + else { + res_d = (long double)(logl(((long double)nweights)/3.0)/logl(4.0)); + + /* res_d is often slightly under the correct res, so we add 0.1 to make it correct upon truncation */ + res = (int)(res_d+0.1); + nside = (int)(powl(2,(int)(res-1))); + return(nside); + } +} + +/*------------------------------------------------------------ + healpix_verts: interface to Fortran subroutine that calculates + the exact vertices of any HEALPix pixel at a + given nside + + Input: nside = HEALPix parameter describing resolution + pix = pixel number, where the first pixel number + for any resolution is always 0 + Output: center = (x,y,z) coordinates of the pixel center + verts = array of (x,y,z) positions of the four + pixel vertices in the order N,E,S,W +*/ + +void healpix_verts(int nside, int pix, vec center, long double verts[12]) +{ + pix2vec_nest__(&nside, &pix, &(center[0]), &(center[1]), &(center[2]), &(verts[0]), &(verts[1]), &(verts[2]), &(verts[3]), &(verts[4]), &(verts[5]), &(verts[6]), &(verts[7]), &(verts[8]), &(verts[9]), &(verts[10]), &(verts[11])); +} + +/*------------------------------------------------------------- + cmrpirpj: C version of Fortran subroutine that calculates the value + of (1-cosl(th(ij))), where th(ij) is the angle between the + unit vectors rpi and rpj + + Input: rpi, rpj = unit vectors + Return value: 1- cosl(th(ij)) +*/ + +long double cmrpirpj(vec rpi, vec rpj) +{ + long double cmij; + + cmij = (powl((rpi[0]-rpj[0]),2)+powl((rpi[1]-rpj[1]),2)+powl((rpi[2]-rpj[2]),2))/2.; + return(cmij); +} diff --git a/src/heapsort.inc b/src/heapsort.inc new file mode 100644 index 0000000..ffed199 --- /dev/null +++ b/src/heapsort.inc @@ -0,0 +1,75 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- +c * +c * Inline code to find the first nb ordered elements of an array. +c * The order is defined by the `function' order(i,j). +c * It's inlined to allow greater flexibility in defining the +c * order() function. For example, the same code works for both +c * real and integer arrays. +c * +c * Returns index iord of these nb elements, ordered so that iord(1) +c * corresponds to the element having the most extreme value. +c * If nb .gt. na, then the last nb-na elements of iord are undefined. +c * Uses heapsort algorithm. +c * + n=min(na,nb) + if (n.le.0) return +c heap first n elements, so smallest element is at top of heap + do 210 ib=n/2+1,n + iord(ib)=ib + 210 continue + do 240 ia=n/2,1,-1 + i=ia + 230 ib=i*2 + if (ib.le.n) then + if (ib.lt.n) then + if (order(iord(ib),iord(ib+1))) ib=ib+1 + endif + if (order(ia,iord(ib))) then + iord(i)=iord(ib) + i=ib + goto 230 + endif + endif + iord(i)=ia + 240 continue +c now compare rest of elements of array to heap + do 340 ia=n+1,na +c if new element is greater than smallest, sift it into heap + i=1 + if (order(ia,iord(i))) then + 330 ib=i*2 + if (ib.le.n) then + if (ib.lt.n) then + if (order(iord(ib),iord(ib+1))) ib=ib+1 + endif + if (order(ia,iord(ib))) then + iord(i)=iord(ib) + i=ib + goto 330 + endif + endif + iord(i)=ia + endif + 340 continue +c unheap iord so largest element is at top + do 390 ja=2,n + ia=2+n-ja + it=iord(ia) + i=1 + iord(ia)=iord(i) + 380 ib=i*2 + if (ib.le.ia-1) then + if (ib.lt.ia-1) then + if (order(iord(ib),iord(ib+1))) ib=ib+1 + endif + if (order(it,iord(ib))) then + iord(i)=iord(ib) + i=ib + goto 380 + endif + endif + iord(i)=it + 390 continue +c diff --git a/src/ikrand.c b/src/ikrand.c new file mode 100644 index 0000000..75e891a --- /dev/null +++ b/src/ikrand.c @@ -0,0 +1,76 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include <stdio.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Called as fortran subroutine + ikrand(ik,ikran) + + Pseudo-random unsigned long or unsigned long long associated with integer ik, + returned as a long double. +*/ +void ikrand_(int *ik, long double *ikran) +{ + unsigned long *likran; + unsigned long long *llikran; + + /* seed random number generator with *ik */ + srandom((unsigned int) *ik); + + /* generate pseudo-random unsigned long */ + if (sizeof(long long) > sizeof(long double)) { + likran = (unsigned long *)ikran; + *likran = random(); + /* generate pseudo-random unsigned long long */ + } else { + llikran = (unsigned long long *)ikran; + *llikran = random(); + *llikran <<= (8 * sizeof(unsigned long)); + *llikran |= random(); + } +} + +/*------------------------------------------------------------------------------ + Called as fortran subroutine + ikrandp(ikchk,ikran) + + ikchk = ikchk + ikran + passed as long double's, but treated as unsigned long's or unsigned long long's. +*/ +void ikrandp_(long double *ikchk, long double *ikran) +{ + unsigned long *likchk; + unsigned long long *llikchk; + + if (sizeof(long long) > sizeof(long double)) { + likchk = (unsigned long *)ikchk; + *likchk += *(unsigned long *)ikran; + } else { + llikchk = (unsigned long long *)ikchk; + *llikchk += *(unsigned long long *)ikran; + } +} + +/*------------------------------------------------------------------------------ + Called as fortran subroutine + ikrandm(ikchk,ikran) + + ikchk = ikchk - ikran + passed as long double's, but treated as unsigned long's or unsigned long long's. +*/ +void ikrandm_(long double *ikchk, long double *ikran) +{ + unsigned long *likchk; + unsigned long long *llikchk; + + if (sizeof(long long) > sizeof(long double)) { + likchk = (unsigned long *)ikchk; + *likchk -= *(unsigned long *)ikran; + } else { + llikchk = (unsigned long long *)ikchk; + *llikchk -= *(unsigned long long *)ikran; + } +} diff --git a/src/inputfile.h b/src/inputfile.h new file mode 100644 index 0000000..0b43384 --- /dev/null +++ b/src/inputfile.h @@ -0,0 +1,20 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef INPUTFILE_H +#define INPUTFILE_H + +#include <stdio.h> + +typedef struct _inputfile { + char *name; /* filename */ + FILE *file; /* file stream */ + char *line; /* line buffer */ + size_t bufsize; /* size of line buffer (will expand as necessary) */ + unsigned int line_number; /* line number */ + unsigned int end; /* maximum number of characters to read (0 = no limit) */ +} inputfile; + +int rdline(inputfile *); + +#endif /* INPUTFILE_H */ diff --git a/src/iylm.s.f b/src/iylm.s.f new file mode 100644 index 0000000..527c32f --- /dev/null +++ b/src/iylm.s.f @@ -0,0 +1,74 @@ +c----------------------------------------------------------------------- + subroutine iylm(thmin,thmax,w,lmax1,nw,v) + integer lmax1,nw + real*10 thmin,thmax,w(nw) +c work array (could be automatic if compiler supports it) + real*10 v(lmax1) +c +c parameters + include 'pi.par' +c data variables + real*10 tiny +c local (automatic) variables + integer lm,lmx1,qphi + real*10 ri,phi,zi,ci,si,ph,dph +c * +c * w_lm = integral from thmin to thmax Y_lm(th,0) sin th d th +c * +c * ISN'T THERE A FASTER WAY OF DOING THIS? +c * I can find an expansion in incomplete beta functions, +c * but the expansion is not much shorter, and not as pretty. +c * +c Input: thmin, thmax = minimum, maximum polar angle in radians. +c lmax1 = lmax+1 where lmax is maximum desired l of transform. +c nw = [(lmax+1)*(lmax+2)]/2 . +c Output: w(lm) = integral from thmax to thmin Y_lm(th,0) d cos th . +c Work array: v should be dimensioned at least lmax1 . +c + data tiny /1.e-30_10/ +c + do 120 lm=1,nw + w(lm)=0._10 + 120 continue +c upper latitude term + ri=0._10 + zi=1._10 + phi=0._10 + ph=0._10 + dph=-tiny + if (thmin.eq.0._10.or.thmin.eq.PI) then + si=0._10 + lmx1=1 + else + si=sin(thmin) + lmx1=lmax1 + endif + ci=cos(thmin) + call wlm(w,lmx1,1,nw,ri,phi,0,zi,ci,si,ph,dph,v) +c lower latitude term + dph=tiny + if (thmax.eq.0._10.or.thmax.eq.PI) then + si=0._10 + lmx1=1 + else + si=sin(thmax) + lmx1=lmax1 + endif + ci=cos(thmax) + call wlm(w,lmx1,1,nw,ri,phi,0,zi,ci,si,ph,dph,v) +c longitude term + ri=1._10 + zi=0._10 + ci=0._10 + si=1._10 + phi=tiny + qphi=-1 + ph=PI-(thmin+thmax)/2._10 + dph=thmax-thmin + call wlm(w,lmax1,1,nw,ri,phi,qphi,zi,ci,si,ph,dph,v) + do 140 lm=1,nw + w(lm)=w(lm)/tiny + 140 continue + return + end +c diff --git a/src/logical.h b/src/logical.h new file mode 100644 index 0000000..8ca4913 --- /dev/null +++ b/src/logical.h @@ -0,0 +1,18 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/#include <limits.h> +#ifndef LOGICAL_H +#define LOGICAL_H + +/* define a c type logical equivalent to fortran's logical, which (on most +systems) is a 32 bit integer + */ +#if LONG_MAX==2147483647 +typedef long int logical; /* type of fortran logical, according to f2c */ +#elif INT_MAX==2147483647 +typedef int logical; /* if long is too big, make logical an int */ +#else +#error Could not define a 32-bit integer type for "logical" +#endif + +#endif /* LOGICAL_H */ diff --git a/src/mangdir.inc b/src/mangdir.inc new file mode 100644 index 0000000..82aa62b --- /dev/null +++ b/src/mangdir.inc @@ -0,0 +1,9 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- +c * mangenv = name of environment variable containing mangle directory. +c * mangdir = pathname of directory containing mangle code. +c * The contents of these variables is initialized in mangdir.dat + character*16 mangenv + character*64 mangdir +c diff --git a/src/manglefn.h b/src/manglefn.h new file mode 100644 index 0000000..049cf9d --- /dev/null +++ b/src/manglefn.h @@ -0,0 +1,357 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2003 +------------------------------------------------------------------------------*/ +#ifndef MANGLEFN_H +#define MANGLEFN_H + +#include "defines.h" +#include "format.h" +#include "harmonics.h" +#include "logical.h" +#include "polygon.h" +#include "vertices.h" +#include "polysort.h" + +#ifdef __cplusplus +extern "C" { +#endif + +void advise_fmt(format *); + +void azel_(long double *, long double *, long double *, long double *, long double *, long double *, long double *); +void azell_(long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *); + +void braktop(long double, int *, long double [], int, int); +void brakbot(long double, int *, long double [], int, int); +void braktpa(long double, int *, long double [], int, int); +void brakbta(long double, int *, long double [], int, int); +void braktop_(long double *, int *, long double [], int *, int *); +void brakbot_(long double *, int *, long double [], int *, int *); +void braktpa_(long double *, int *, long double [], int *, int *); +void brakbta_(long double *, int *, long double [], int *, int *); + +void cmminf(polygon *, int *, long double *); + +void vert_to_poly(vertices *, polygon *); +void edge_to_poly(vertices *, int, int *, polygon *); +void rect_to_poly(long double [4], polygon *); + +#if defined(GCC) && 0 +void rps_to_vert(int nv, vec [nv], vertices *); +#else +void rps_to_vert(int nv, vec [/*nv*/], vertices *); +#endif +void rp_to_azel(vec, azel *); +void azel_to_rp(azel *, vec); +void azel_to_gc(azel *, azel *, vec, long double *); +void rp_to_gc(vec, vec, vec, long double *); +void edge_to_rpcm(azel *, azel *, azel *, vec, long double *); +void rp_to_rpcm(vec, vec, vec, vec, long double *); +void circ_to_rpcm(long double [3], vec, long double *); +void rpcm_to_circ(vec, long double *, long double [3]); +void az_to_rpcm(long double, int, vec, long double *); +void el_to_rpcm(long double, int, vec, long double *); +long double thij(vec, vec); +long double cmij(vec, vec); +int poly_to_rect(polygon *, long double *, long double *, long double *, long double *); +int antivert(vertices *, polygon *); + +void copy_format(format *, format *); + +void copy_poly(polygon *, polygon *); +void copy_polyn(polygon *, int, polygon *); +void poly_poly(polygon *, polygon *, polygon *); +void poly_polyn(polygon *, polygon *, int, int, polygon *); +#if defined(GCC) && 0 +void group_poly(polygon *poly, int [poly->np], int, polygon *); +#else +void group_poly(polygon *poly, int [/*poly->np*/], int, polygon *); +#endif + +void assign_parameters(); +void pix2ang(int, unsigned long, long double *, long double *); +void ang2pix(int, long double, long double, unsigned long *); +void pix2ang_radec(int, unsigned long, long double *, long double *); +void ang2pix_radec(int, long double, long double, unsigned long *); +void csurvey2eq(long double, long double, long double *, long double *); +void eq2csurvey(long double, long double, long double *, long double *); +void superpix(int, unsigned long, int, unsigned long *); +void subpix(int, unsigned long, unsigned long *, unsigned long *, unsigned long *, unsigned long *); +void pix_bound(int, unsigned long, long double *, long double *, long double *, long double *); +long double pix_area(int, unsigned long); +void pix2xyz(int, unsigned long, long double *, long double *, long double *); +void area_index(int, long double, long double, long double, long double, unsigned long *, unsigned long *, unsigned long *, unsigned long *); +void area_index_stripe(int, int, unsigned long *, unsigned long *, unsigned long *, unsigned long *); + +long double drandom(void); + +#if defined(GCC) && 0 +int cmlim_polys(int npoly, polygon *[npoly], long double, vec); +int drangle_polys(int npoly, polygon *[npoly], long double, vec, int nth, long double [nth], long double [nth]); +#else +int cmlim_polys(int npoly, polygon *[/*npoly*/], long double, vec); +int drangle_polys(int npoly, polygon *[/*npoly*/], long double, vec, int nth, long double [/*nth*/], long double [/*nth*/]); +#endif + +void cmlimpolys_(long double *, vec); +#if defined(GCC) && 0 +void dranglepolys_(long double *, vec, int *nth, long double [*nth], long double [*nth]); +#else +void dranglepolys_(long double *, vec, int *nth, long double [/**nth*/], long double [/**nth*/]); +#endif + +#if defined(GCC) && 0 +void dump_poly(int npoly, polygon *[npoly]); +#else +void dump_poly(int, polygon *[/*npoly*/]); +#endif + +void fframe_(int *, long double *, long double *, int *, long double *, long double *); + +void findtop(long double [], int, int [], int); +void findbot(long double [], int, int [], int); +void findtpa(long double [], int, int [], int); +void findbta(long double [], int, int [], int); +void finitop(int [], int, int [], int); +void finibot(int [], int, int [], int); +void finitpa(int [], int, int [], int); +void finibta(int [], int, int [], int); + +void findtop_(long double [], int *, int [], int *); +void findbot_(long double [], int *, int [], int *); +void findtpa_(long double [], int *, int [], int *); +void findbta_(long double [], int *, int [], int *); +void finitop_(int [], int *, int [], int *); +void finibot_(int [], int *, int [], int *); +void finitpa_(int [], int *, int [], int *); +void finibta_(int [], int *, int [], int *); + +polygon *get_pixel(int,char); +int get_child_pixels(int, int [], char); +int get_parent_pixels(int, int [], char); +int get_res(int,char); + +void healpix_ang2pix_nest(int, long double, long double, int *); +polygon *get_healpix_poly(int, int); +int get_nside(int); +void healpix_verts(int, int, vec, long double []); +void pix2vec_nest__(int *, int *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *, long double *); +long double cmrpirpj(vec, vec); + +int garea(polygon *, long double *, int, long double *); +int gcmlim(polygon *, long double *, vec, long double *, long double *); +int gphbv(polygon *, int, int, long double *, long double [2], long double [2]); +int gphi(polygon *, long double *, vec, long double, long double *); +int gptin(polygon *, vec); +#if defined(GCC) && 0 +int gspher(polygon *, int lmax, long double *, long double *, long double [2], long double [2], harmonic [NW]); +int gsphera(long double, long double, long double, long double, int lmax, long double *, long double [2], long double [2], harmonic [NW]); +int gsphr(polygon *, int lmax, long double *, harmonic [NW]); +int gsphra(long double, long double, long double, long double, int lmax, harmonic [NW]); +#else +int gspher(polygon *, int lmax, long double *, long double *, long double [2], long double [2], harmonic [/*NW*/]); +int gsphera(long double, long double, long double, long double, int lmax, long double *, long double [2], long double [2], harmonic [/*NW*/]); +int gsphr(polygon *, int lmax, long double *, harmonic [/*NW*/]); +int gsphra(long double, long double, long double, long double, int lmax, harmonic [/*NW*/]); +#endif +int gverts(polygon *, int, long double *, int, int, int *, vec **, long double **, int **, int **, int *, int *, int **); +#if defined(GCC) && 0 +int gvert(polygon *poly, int, long double *, int nvmax, int, int nve, int *, vec [nvmax * nve], long double [nvmax], int [nvmax], int [poly->np], int *, int *, int [nvmax]); +#else +int gvert(polygon *poly, int, long double *, int nvmax, int, int nve, int *, vec [/*nvmax * nve*/], long double [/*nvmax*/], int [/*nvmax*/], int [/*poly->np*/], int *, int *, int [/*nvmax*/]); +#endif +int gvlims(polygon *, int, long double *, vec, int *, vec **, vec **, long double **, long double **, long double **, long double **, int **, int **, int *, int *, int **); +#if defined(GCC) && 0 +int gvlim(polygon *poly, int, long double *, vec, int nvmax, int *, vec [nvmax], vec [nvmax], long double [nvmax], long double [nvmax], long double [poly->np], long double [poly->np], int [nvmax], int [poly->np], int *, int *, int [nvmax]); +#else +int gvlim(polygon *poly, int, long double *, vec, int nvmax, int *, vec [/*nvmax*/], vec [/*nvmax*/], long double [/*nvmax*/], long double [/*nvmax*/], long double [/*poly->np*/], long double [/*poly->np*/], int [/*nvmax*/], int [/*poly->np*/], int *, int *, int [/*nvmax*/]); +#endif +int gvphi(polygon *, vec, long double, vec, long double *, long double *, vec); + +void garea_(long double *, vec [], long double [], int *, long double *, int *, long double *, int *, logical *); +void gaxisi_(vec, vec, vec); +void gcmlim_(vec [], long double [], int *, vec, long double *, long double *, long double *, long double *, int *); +void gphbv_(long double [2], long double [2], vec [], long double [], int *, int *, int *, int *, long double *, long double *, int *); +void gphi_(long double *, vec [], long double [], int *, vec, long double *, long double *, long double *, int *); +logical gptin_(vec [], long double [], int *, vec); +void gspher_(long double *, long double [2], long double [2], harmonic [], int *, int *, int *, vec [], long double [], int *, int *, int *, int *, long double *, long double *, int *, long double *, logical *); +void gsphera_(long double *, long double [2], long double [2], harmonic [], int *, int *, int *, int *, long double *, long double *, long double *, long double *, long double *, long double *); +void gvert_(vec [], long double [], int [], int [], int [], int *, int *, int *, int *, int *, int *, vec [], long double [], int *, int *, long double *, long double *, int *, long double *, int *, logical *); + +void gvlim_(vec [], vec [], long double [], long double [], long double [], long double [], int [], int [], int [], int *, int *, int *, int *, vec [], long double [], int *, long double [], int *, long double *, long double *, int *, long double *, int *, logical *); +void gvphi_(long double *, vec, vec [], long double [], int *, vec, long double *, vec, long double *, long double *, int *); + +#if defined(GCC) && 0 +int harmonize_polys(int npoly, polygon *[npoly], long double, int lmax, harmonic w[NW]); +#else +int harmonize_polys(int npoly, polygon *poly[/*npoly*/], long double, int lmax, harmonic w[/*NW*/]); +#endif + +void harmonizepolys_(long double *, int *, harmonic []); + +void ikrand_(int *, long double *); +void ikrandp_(long double *, long double *); +void ikrandm_(long double *, long double *); + +void msg(char *, ...); + +polygon *new_poly(int); +void free_poly(polygon *); +int room_poly(polygon **, int, int, int); +void memmsg(void); + +vertices *new_vert(int); +void free_vert(vertices *); + +void parse_args(int, char *[]); + +int parse_fopt(void); + +#if defined(GCC) && 0 +int partition_poly(polygon **, int npolys, polygon *[npolys], long double, int, int, int, int, int *); +int partition_gpoly(polygon *, int npolys, polygon *[npolys], long double, int, int, int, int *); +int part_poly(polygon *, int npolys, polygon *[npolys], long double, int, int, int, int *, int *); +int pixel_list(int npoly, polygon *[npoly], int max_pixel, int [max_pixel], int [max_pixel]); +#else +int partition_poly(polygon **, int npolys, polygon *[/*npolys*/], long double, int, int, int, int, int *); +int partition_gpoly(polygon *, int npolys, polygon *[/*npolys*/], long double, int, int, int, int *); +int part_poly(polygon *, int npolys, polygon *[/*npolys*/], long double, int, int, int, int *, int *); +int pixel_list(int npoly, polygon *[/*npoly*/], int max_pixel, int [/*max_pixel*/], int [/*max_pixel*/]); +#endif +int pixel_start(int, char); + +long double places(long double, int); +int poly_cmp(polygon **, polygon **); + +#if defined(GCC) && 0 +int poly_id(int npoly, polygon *[npoly], long double, long double, int **, long double **); +void poly_sort(int npoly, polygon *[npoly], char); +#else +int poly_id(int npoly, polygon *[/*npoly*/], long double, long double, int **, long double **); +void poly_sort(int npoly, polygon *[/*npoly*/], char); +#endif + + +int prune_poly(polygon *, long double); +int trim_poly(polygon *); +int touch_poly(polygon *); + +int rdangle(char *, char **, char, long double *); + +#if defined(GCC) && 0 +int rdmask(char *, format *, int npolys, polygon *[npolys]); +#else +int rdmask(char *, format *, int npolys, polygon *[/*npolys*/]); +#endif + +void rdmask_(void); + +int rdspher(char *, int *, harmonic **); + +void scale(long double *, char, char); +void scale_azel(azel *, char, char); +void scale_vert(vertices *, char, char); + +#if defined(GCC) && 0 +int search(int n, long double [n], long double); +#else +int search(int n, long double [/*n*/], long double); +#endif + +#if defined(GCC) && 0 +int snap_polys(format *fmt, int npoly, polygon *poly[npoly], int, long double, long double, long double, long double, long double, int, char *); +#else +int snap_polys(format *fmt, int npoly, polygon *poly[/*npoly*/], int, long double, long double, long double, long double, long double, int, char *); +#endif +int snap_poly(polygon *, polygon *, long double, long double); +int snap_polyth(polygon *, polygon *, long double, long double, long double); + +int split_poly(polygon **, polygon *, polygon **, long double, char); +#if defined(GCC) && 0 +int fragment_poly(polygon **, polygon *, int, int npolys, polygon *[npolys], long double, char); +#else +int fragment_poly(polygon **, polygon *, int, int npolys, polygon *[/*npolys*/], long double, char); +#endif + +int strcmpl(const char *, const char *); +int strncmpl(const char *, const char *, size_t); + +int strdict(char *, char *[]); +int strdictl(char *, char *[]); + +#if defined(GCC) && 0 +int vmid(polygon *, long double, int nv, int nve, vec [nv * nve], int [nv], int [nv], int *, vec **); +int vmidc(polygon *, int nv, int nve, vec [nv * nve], int [nv], int [nv], int *, vec **); +#else +int vmid(polygon *, long double, int nv, int nve, vec [/*nv * nve*/], int [/*nv*/], int [/*nv*/], int *, vec **); +int vmidc(polygon *, int nv, int nve, vec [/*nv * nve*/], int [/*nv*/], int [/*nv*/], int *, vec **); +#endif + +long double weight_fn(long double, long double, char *); +long double rdweight(char *); + +long double twoqz_(long double *, long double *, int *); +long double twodf100k_(long double *, long double *); +long double twodf230k_(long double *, long double *); + +int which_pixel(long double, long double, int, char); + +#if defined(GCC) && 0 +void wrangle(long double, char, int, size_t str_len, char [str_len]); +#else +void wrangle(long double, char, int, size_t str_len, char [/*str_len*/]); +#endif + +#if defined(GCC) && 0 +long double wrho(long double, long double, int lmax, int, harmonic w[NW], long double, long double); +#else +long double wrho(long double, long double, int lmax, int, harmonic w[/*NW*/], long double, long double); +#endif + +long double wrho_(long double *, long double *, harmonic *, int *, int *, int *, int *, long double *, long double *); + +#if defined(GCC) && 0 +int wr_bin_poly(char *, format *, int npolys, polygon *[npolys], int); +int wrmask(char *, format *, int npolys, polygon *[npolys]); +int wr_circ(char *, format *, int npolys, polygon *[npolys], int); +int wr_edge(char *, format *, int npolys, polygon *[npolys], int); +int wr_rect(char *, format *, int npolys, polygon *[npolys], int); +int wr_poly(char *, format *, int npolys, polygon *[npolys], int); +int wr_Reg(char *, format *, int npolys, polygon *[npolys], int); +int wr_area(char *, format *, int npolys, polygon *[npolys], int); +int wr_id(char *, int npolys, polygon *[npolys], int); +int wr_midpoint(char *, format *, int npolys, polygon *[npolys], int); +int wr_weight(char *, format *, int npolys, polygon *[npolys], int); +int wr_healpix_weight(char *, format *, int numweight, long double [numweight]); +int wr_list(char *, format *, int npolys, polygon *[npolys], int); +int discard_poly(int npolys, polygon *[npolys]); +#else +int wr_bin_poly(char *, format *, int npolys, polygon *[/* npolys */], int); +int wrmask(char *, format *, int npolys, polygon *[/*npolys*/]); +int wr_circ(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_edge(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_rect(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_poly(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_Reg(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_area(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_id(char *, int npolys, polygon *[/*npolys*/], int); +int wr_midpoint(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_weight(char *, format *, int npolys, polygon *[/*npolys*/], int); +int wr_healpix_weight(char *, format *, int numweight, long double [/*numweight*/]); +int wr_list(char *, format *, int npolys, polygon *[/*npolys*/], int); +int discard_poly(int npolys, polygon *[/*npolys*/]); +#endif + +int wrrrcoeffs(char *, long double, long double [2], long double [2]); + +#if defined(GCC) && 0 +int wrspher(char *, int lmax, harmonic [NW]); +#else +int wrspher(char *, int lmax, harmonic [/*NW*/]); +#endif + +#ifdef __cplusplus +} +#endif + +#endif /* MANGLEFN_H */ diff --git a/src/map.c b/src/map.c new file mode 100644 index 0000000..1506d49 --- /dev/null +++ b/src/map.c @@ -0,0 +1,246 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" + +/* redefine default maximum harmonic */ +#undef LMAX +#define LMAX MAXINT + +/* getopt options */ +const char *optstr = "dqw:l:g:x:u:p:"; + +/* local functions */ +void usage(void); +#ifdef GCC +int map(char *, char *, format *, int lmax, harmonic w[NW], long double, long double); +#else +int map(char *, char *, format *, int lmax, harmonic w[/*NW*/], long double, long double); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int nmap, nws; + harmonic *w_p; + + /* lmax will be read from Wlm_filename, or set by command line */ + lmax = LMAX; + + /* parse arguments */ + parse_args(argc, argv); + + /* one input and output filename required as arguments */ + if (argc - optind != 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires 2 arguments: azel_infile, and outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + /* file containing harmonics must have been specified */ + if (!Wlm_filename) { + fprintf(stderr, "%s requires -w<Wlm_filename> option to specify file containing harmonics\n", argv[0]); + exit(1); + } + + msg("---------------- map ----------------\n"); + + /* advise */ + if (lsmooth == 0.) { + msg("no smoothing\n"); + } else { + msg("smoothing harmonic number lsmooth = %Lg\n", lsmooth); + if (esmooth != 2.) { + msg("smoothing exponent = %Lg\n", esmooth); + } + } + + /* read harmonics */ + nws = rdspher(Wlm_filename, &lmax, &w_p); + if (nws == -1) exit(1); + + /* map */ + nmap = map(argv[argc - 2], argv[argc - 1], &fmt, lmax, w_p, lsmooth, esmooth); + if (nmap == -1) exit(1); + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("map [-d] [-q] -w<Wlmfile> [-l<lmax>] [-g<lsmooth>] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] azel_infile outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Map. Implemented as interpretive read/write, to permit interactive behaviour. + + Input: in_filename = name of file to read from; + "" or "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + w = array containing spherical harmonics. + lmax = maximum harmonic number. + lsmooth = smoothing harmonic number (0. = no smooth). + esmooth = smoothing exponent (2. = gaussian). + Return value: number of items written, + or -1 if error occurred. +*/ +int map(char *in_filename, char *out_filename, format *fmt, int lmax, harmonic w[/*NW*/], long double lsmooth, long double esmooth) +{ +/* precision of map values written to file */ +#define PRECISION 8 +#define AZEL_STR_LEN 32 + inputfile file = { + '\0', /* input filename */ + 0x0, /* input file stream */ + '\0', /* line buffer */ + 64, /* size of line buffer (will expand as necessary) */ + 0, /* line number */ + 0 /* maximum number of characters to read (0 = no limit) */ + }; + char input[] = "input", output[] = "output"; + char *word, *next; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int ird, len, mmax, nmap, width; + long double rho; + azel v; + char *out_fn; + FILE *outfile; + + /* open in_filename for reading */ + if (!in_filename || strcmp(in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", in_filename); + return(-1); + } + file.name = in_filename; + } + file.line_number = 0; + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "cannot open %s for writing\n", out_filename); + return(-1); + } + out_fn = out_filename; + } + + /* advise angular units */ + msg("will take units of input az, el angles in %s to be ", file.name); + switch (fmt->inunit) { +#include "angunit.h" + } + msg("\n"); + if (fmt->outunit != fmt->inunit) { + msg("units of output az, el angles will be "); + switch (fmt->outunit) { +#include "angunit.h" + } + msg("\n"); + } + + /* setting mmax = lmax ensures complete set of azimuthal harmonics */ + mmax = lmax; + + /* width of map value */ + width = PRECISION + 6; + + /* write header */ + v.az = 0.; + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + len = strlen(az_str); + if (fmt->outunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunit); + sprintf(el_str, "el(%c)", fmt->outunit); + } + fprintf(outfile, "%*s %*s %*s\n", len, az_str, len, el_str, width - 4, "wrho"); + + /* interpretive read/write loop */ + nmap = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + + /* read <az> */ + word = file.line; + ird = rdangle(word, &next, fmt->inunit, &v.az); + /* skip header */ + if (ird != 1 && nmap == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* read <el> */ + word = next; + ird = rdangle(word, &next, fmt->inunit, &v.el); + /* skip header */ + if (ird != 1 && nmap == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* convert az and el from input units to radians */ + scale_azel(&v, fmt->inunit, 'r'); + + /* + The entire of map.c is an interface to the next line of code. + Bizarre, huh? + */ + /* compute the value of the window function at this point */ + rho = wrho(v.az, v.el, lmax, mmax, w, lsmooth, esmooth); + + /* convert az and el from radians to output units */ + scale_azel(&v, 'r', fmt->outunit); + + /* write result */ + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(outfile, "%s %s %- #*.*Lg\n", az_str, el_str, width, PRECISION, rho); + fflush(outfile); + + /* increment counter of results */ + nmap++; + } + + if (outfile != stdout) { + msg("map: %d values written to %s\n", nmap, out_fn); + } + + return(nmap); +} diff --git a/src/msg.c b/src/msg.c new file mode 100644 index 0000000..b8b0611 --- /dev/null +++ b/src/msg.c @@ -0,0 +1,32 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include "manglefn.h" + +#ifdef GCC +# include <stdarg.h> +#endif +#ifdef LINUX +# include <stdarg.h> +#endif +#ifdef SUN +# include <sys/varargs.h> +#endif + +extern int verbose; + +/*------------------------------------------------------------------------------ + Print messages. +*/ +void msg(char *fmt, ...) +{ + va_list args; + + if (verbose) { + va_start(args, fmt); + vprintf(fmt, args); + va_end(args); + fflush(stdout); + } +} diff --git a/src/new_poly.c b/src/new_poly.c new file mode 100644 index 0000000..c1376d2 --- /dev/null +++ b/src/new_poly.c @@ -0,0 +1,120 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +#define MEG(i) (long double)((i+999)/1000)/1000. + +static long memory = 0, femory = 0; +static int mpoly = 0, fpoly = 0; + +/*------------------------------------------------------------------------------ + Allocate memory for polygon of np caps. + + Input: npmax = desired number of caps of polygon. + Return value: pointer to a new polygon, + or null if failed to allocate memory. +*/ +polygon *new_poly(int npmax) +{ + polygon *poly; + + /* allocate memory for new polygon */ + poly = (polygon *) malloc(sizeof(polygon)); + if (!poly) return(0x0); + mpoly++; + memory += sizeof(polygon); + + /* allocate new rp array */ + poly->rp = (vec *) malloc(sizeof(vec) * npmax); + if (!poly->rp) return(0x0); + memory += sizeof(vec) * npmax; + + /* allocate new cm array */ + poly->cm = (long double *) malloc(sizeof(long double) * npmax); + if (!poly->cm) return(0x0); + memory += sizeof(long double) * npmax; + + /* allocated number of caps of polygon */ + poly->npmax = npmax; + + return(poly); +} + +/*------------------------------------------------------------------------------ + Free polygon memory. +*/ +void free_poly(polygon *poly) +{ + + if (poly) { + + fpoly++; + femory += sizeof(polygon); + if (poly->rp) { + free(poly->rp); + poly->rp = 0x0; + femory += sizeof(vec) * poly->npmax; + } + + if (poly->cm) { + free(poly->cm); + poly->cm = 0x0; + femory += sizeof(long double) * poly->npmax; + } + free(poly); + } +} + +/*------------------------------------------------------------------------------ + Test whether a polygon contains enough space; + if not, free the polygon, and allocate a new polygon with enough space, + plus a bit extra to allow for subsequent expansion. + + Input: *poly = pointer to polygon. + np = desired number of caps of polygon. + dnp = number of extra caps to allocate. + save = 0 to discard contents of poly when making new poly; + 1 to copy contents of poly to new poly. + If poly already contains enough space, it is left unchanged. + Return value: -1 if could not allocate new memory; + here *poly is left unchanged, so use the return value, + not whether *poly is null, to test for failure; + 0 if polygon contained enough space; + 1 if new polygon was allocated. +*/ +int room_poly(polygon **poly, int np, int dnp, int save) +{ + polygon *newpoly; + + /* polygon contains enough space */ + if (*poly && (*poly)->npmax >= np) return(0); + + /* allocate new polygon with np + dnp caps */ + newpoly = new_poly(np + dnp); + + if (!newpoly) return(-1); + + /* copy poly to new polygon */ + if (*poly && save) copy_poly(*poly, newpoly); + + /* free polygon */ + if (*poly) free_poly(*poly); + + /* point poly to new polygon */ + *poly = newpoly; + + return(1); +} + +/*------------------------------------------------------------------------------ + Advise memory used. +*/ +void memmsg(void) +{ + if (mpoly > 0) + msg("%d polygons (%.3LfMb) allocated, %d (%.3LfMb) freed\n", + mpoly, MEG(memory), fpoly, MEG(femory)); +} diff --git a/src/new_vert.c b/src/new_vert.c new file mode 100644 index 0000000..6d8bf74 --- /dev/null +++ b/src/new_vert.c @@ -0,0 +1,44 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Allocate memory for vertices structure of nvmax vertices. + + Input: nvmax = desired number of vertices. + Return value: pointer to a new vertices structure, + or null if failed to allocate memory. +*/ +vertices *new_vert(int nvmax) +{ + vertices *vert = 0x0; + + /* allocate memory for new vertices structure */ + vert = (vertices *) malloc(sizeof(vertices)); + if (!vert) return(0x0); + + /* allocate memory for array of nvmax az-el structures */ + vert->v = (azel *) malloc(sizeof(azel) * nvmax); + if (!vert->v) return(0x0); + + vert->nvmax = nvmax; + + return(vert); +} + +/*------------------------------------------------------------------------------ + Free vertices memory. +*/ +void free_vert(vertices *vert) +{ + if (vert) { + if (vert->v) { + free(vert->v); + vert->v = 0x0; + } + free(vert); + } +} diff --git a/src/parse_args.c b/src/parse_args.c new file mode 100644 index 0000000..7b05700 --- /dev/null +++ b/src/parse_args.c @@ -0,0 +1,564 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Parse arguments. + + Included inline to ensure uniform processing of arguments by all programs. +*/ +void parse_args(int argc, char *argv[]) +{ + char null = '\0'; + char in, opt, out; + int iscan; + + /* turn off getopt complaints */ + opterr = 0; + + /* parse arguments */ + while (1) { + opt = getopt(argc, argv, optstr); + switch (opt) { + case 'A': + weight_is_area = 1; + break; + case 'd': /* advise defaults */ + printf("%s", argv[0]); + if (*optstr) { + if ((strchr(optstr, 'l')) && LMAX < MAXINT) printf(" -l%d", LMAX); + if (strchr(optstr, 'g')) printf(" -g%g", LSMOOTH); + if (strchr(optstr, 'c')) printf(" -c%u", SEED); + if (strchr(optstr, 'r')) printf(" -r%d", NRANDOM); + if (strchr(optstr, 'a')) printf(" -a%.15g%c", AXTOL, AXUNIT); + if (strchr(optstr, 'b')) printf(" -b%.15g%c", BTOL, BUNIT); + if (strchr(optstr, 't')) printf(" -t%.15g%c", THTOL, THUNIT); + if (strchr(optstr, 'y')) printf(" -y%.15g", YTOL); + if (strchr(optstr, 'm')) printf(" -m%.15g%c", MTOL, MUNIT); + if (strchr(optstr, 's')) printf(" -s%d", SKIP); + if (strchr(optstr, 'e')) printf(" -e%d", END); + if (strchr(optstr, 'v')) printf(" -v%c", fmt.newid); + if (strchr(optstr, 'f')) printf(" -f%.15g,%.15g,%.15g%c", AZN, ELN, AZP, TRUNIT); + if (strchr(optstr, 'u')) printf(" -u%c,%c", INUNIT, OUTUNIT); + if (strchr(optstr, 'p')) printf(" -p%c%s", OUTPHASE, "auto"); + if (strchr(optstr, 'P')) printf(" -P%c%d,%d", SCHEME,POLYS_PER_PIXEL,RES_MAX); + if (strchr(optstr, 'B')) printf(" -B%c", BMETHOD); + if (strchr(optstr, 'i')) { + if (!fmt.in) { + printf(" -i?%c", INUNITP); + } else if (fmt.in[0] == 'e') { + printf(" -i%c%d%c", fmt.in[0], NVE, INUNITP); + } else if (fmt.in[0] == 'i' || fmt.in[0] == 'w') { + printf(" -i%c", fmt.in[0]); + } else { + printf(" -i%c%c", fmt.in[0], INUNITP); + } + } + if (strchr(optstr, 'o')) { + if (fmt.out[0] == 'e' || fmt.out[0] == 'g') { + printf(" -o%c%d%c", fmt.out[0], NVE, OUTUNITP); + } else if (fmt.out[0] == 'i' || fmt.out[0] == 'w') { + printf(" -o%c", fmt.out[0]); + } else { + printf(" -o%c%c", fmt.out[0], OUTUNITP); + } + } + } + printf("\n"); + exit(0); + case 'q': /* be quiet */ + verbose = 0; + break; + case 'w': /* harmonics file */ + if (Wlm_filename) free(Wlm_filename); + Wlm_filename = (char *) malloc(sizeof(char) * (strlen(optarg) + 1)); + sscanf(optarg, "%s", Wlm_filename); + break; + case 'z': /* survey, or name of file containing weights */ + if (survey) free(survey); + survey = (char *) malloc(sizeof(char) * (strlen(optarg) + 1)); + sscanf(optarg, "%s", survey); + break; + case 'l': /* maximum harmonic number */ + iscan = sscanf(optarg, "%d", &lmax); + if (iscan != 1) { + fprintf(stderr, "-%c%s: expecting integer argument\n", opt, optarg); + exit(1); + } + if (lmax < 0) { + fprintf(stderr, "-%c%s: maximum harmonic number %d must >= 0\n", opt, optarg, lmax); + exit(1); + } + break; + case 'g': /* smoothing harmonic number */ + /* and smoothing exponent (default 2.) */ + iscan = sscanf(optarg, "%Lg %*[,] %Lg", &lsmooth, &esmooth); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting real argument\n", opt, optarg); + exit(1); + } + break; + case 'c': /* seed for random number generator */ + iscan = sscanf(optarg, "%u", &seed); + if (iscan != 1) { + fprintf(stderr, "-%c%s: expecting unsigned integer argument\n", opt, optarg); + exit(1); + } + seed_read = 1; + break; + case 'r': /* number of random points to generate */ + iscan = sscanf(optarg, "%d", &nrandom); + if (iscan != 1) { + fprintf(stderr, "-%c%s: expecting integer argument\n", opt, optarg); + exit(1); + } + if (nrandom < 1) { + fprintf(stderr, "-%c%s: number of random points %d should >= 1\n", opt, optarg, nrandom); + exit(1); + } + break; + case 'S': /* self-snap */ + selfsnap = 1; + break; + case 'a': /* axis tolerance */ + iscan = sscanf(optarg, "%Lg %c", &axtol, &axunit); + if (iscan < 1) { + iscan = sscanf(optarg, " %c", &axunit); + } + if (!strchr(UNITS, axunit)) { + fprintf(stderr, "-%c%s: unit %c must be one of %s\n", opt, optarg, axunit, UNITS); + exit(1); + } + break; + case 'b': /* latitude tolerance */ + iscan = sscanf(optarg, "%Lg %c", &btol, &bunit); + if (iscan < 1) { + iscan = sscanf(optarg, " %c", &bunit); + } + if (!strchr(UNITS, bunit)) { + fprintf(stderr, "-%c%s: unit %c must be one of %s\n", opt, optarg, bunit, UNITS); + exit(1); + } + break; + case 't': /* edge tolerance */ + iscan = sscanf(optarg, "%Lg %c", &thtol, &thunit); + if (iscan < 1) { + iscan = sscanf(optarg, " %c", &thunit); + } + if (!strchr(UNITS, thunit)) { + fprintf(stderr, "-%c%s: unit %c must be one of %s\n", opt, optarg, thunit, UNITS); + exit(1); + } + break; + case 'y': /* edge to length tolerance */ + iscan = sscanf(optarg, "%Lg", &ytol); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting real argument\n", opt, optarg); + exit(1); + } + break; + case 'm': /* multiple intersection tolerance */ + iscan = sscanf(optarg, "%Lg %c", &mtol, &munit); + if (iscan < 1) { + iscan = sscanf(optarg, " %c", &munit); + } + if (!strchr(UNITS, munit)) { + fprintf(stderr, "-%c%s: unit %c must be one of %s\n", opt, optarg, munit, UNITS); + exit(1); + } + break; + case 'j': /* keep weights in interval [min, max] */ + iscan = sscanf(optarg, "%Lg %*[,] %Lg", &weight_min, &weight_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %Lg", &weight_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c<min> or -%c<min>,<max> or -%c,<max>\n", opt, optarg, opt, opt, opt); + exit(1); + } + is_weight_max = 1; + } else if (iscan == 1) { + is_weight_min = 1; + } else if (iscan == 2) { + is_weight_min = 1; + is_weight_max = 1; + } + break; + case 'k': /* keep areas in interval [min, max] */ + iscan = sscanf(optarg, "%Lg %*[,] %Lg", &area_min, &area_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %Lg", &area_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c<min> or -%c<min>,<max> or -%c,<max>\n", opt, optarg, opt, opt, opt); + exit(1); + } + is_area_max = 1; + } else if (iscan == 1) { + is_area_min = 1; + } else if (iscan == 2) { + is_area_min = 1; + is_area_max = 1; + } + break; + case 'J': /* keep ids in interval [min, max] */ + iscan = sscanf(optarg, "%d %*[,] %d", &id_min, &id_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %d", &id_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c<min> or -%c<min>,<max> or -%c,<max>\n", opt, optarg, opt, opt, opt); + exit(1); + } + is_id_max = 1; + } else if (iscan == 1) { + is_id_min = 1; + } else if (iscan == 2) { + is_id_min = 1; + is_id_max = 1; + } + break; + case 'K': /* keep pixels in interval [min, max] */ + iscan = sscanf(optarg, "%d %*[,] %d", &pixel_min, &pixel_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %d", &pixel_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c<min> or -%c<min>,<max> or -%c,<max>\n", opt, optarg, opt, opt, opt); + exit(1); + } + is_pixel_max = 1; + } else if (iscan == 1) { + is_pixel_min = 1; + } else if (iscan == 2) { + is_pixel_min = 1; + is_pixel_max = 1; + } + break; + case 'n': /* take intersection of input polygon files */ + intersect = 1; + break; + case 's': /* skip 1st skip characters of lines of data */ + iscan = sscanf(optarg, "%zd", &fmt.skip); + if (iscan != 1) { + fprintf(stderr, "-%c%s: expecting integer argument\n", opt, optarg); + exit(1); + } + if (fmt.skip < 0) { + fprintf(stderr, "-%c%s: number of characters %zd to skip must be >= 0\n", opt, optarg, fmt.skip); + exit(1); + } + break; + case 'e': /* read only up to end'th character of line */ + iscan = sscanf(optarg, "%zd", &fmt.end); + if (iscan != 1) { + fprintf(stderr, "-%c%s: expecting integer argument\n", opt, optarg); + exit(1); + } + if (fmt.end < 0) { + fprintf(stderr, "-%c%s: last character number %zd to read to must be >= 0\n", opt, optarg, fmt.end); + exit(1); + } + break; + case 'v': /* apply old|new id numbers to output polygons */ + iscan = sscanf(optarg, " %c", &fmt.newid); + if (!strchr("onp", fmt.newid)) { + if (fmt.newid == '-') { + fprintf(stderr, "-%c: expecting option o (old id), n (new id), or p (pixel number=id)\n", opt); + } else { + fprintf(stderr, "-%c%s: option %c should be o (old id), n (new id), or p (pixel number=id)\n", opt, optarg, fmt.newid); + } + exit(1); + } + break; + case 'B': /* set balkanize method */ + iscan = sscanf(optarg, " %c", &bmethod); + if (!strchr(BMETHODS, bmethod)) { + if (fmt.newid == '-') { + fprintf(stderr, "-%c: expecting option l (last weight), a (add weights together), n (use minimum weight) or x (use maximum weight)\n", opt); + } else { + fprintf(stderr, "-%c%s: option %c should be l (last weight), a (add weights together), n (use minimum weight) or x (use maximum weight)\n", opt, optarg, bmethod); + } + exit(1); + } + break; + case 'f': /* angular coordinate frame */ + /* store argument to -f in fopt, for later parsing */ + if (fopt) free(fopt); + if (optarg) { + fopt = (char *) malloc(sizeof(char) * (strlen(optarg) + 1)); + sscanf(optarg, "%s", fopt); + } else { + fopt = &null; + } + break; + case 'u': /* input, output angular units of az, el data */ + if (strchr(optarg, ',')) { + iscan = sscanf(optarg, " %c %*[,] %c", &fmt.inunit, &fmt.outunit); + if (fmt.inunit == ',') { + fmt.inunit = INUNIT; + iscan = sscanf(optarg, " %*[,] %c", &fmt.outunit); + } + } else { + iscan = sscanf(optarg, " %c %c", &fmt.inunit, &fmt.outunit); + if (iscan == 1 || !fmt.outunit) fmt.outunit = fmt.inunit; + } + if (!strchr(UNITS, fmt.inunit)) { + fprintf(stderr, "-%c%s: input angular unit %c must be one of %s\n", opt, optarg, fmt.inunit, UNITS); + exit(1); + } + if (!strchr(UNITS, fmt.outunit)) { + fprintf(stderr, "-%c%s: output angular unit %c must be one of %s\n", opt, optarg, fmt.outunit, UNITS); + exit(1); + } + break; + case 'p': /* phase of output azimuth, and number of digits after decimal place in output angles */ + iscan = sscanf(optarg, " %c", &in); + switch (in) { + case '-': + case '+': + iscan = sscanf(optarg, " %c %d", &fmt.outphase, &fmt.outprecision); + break; + default: + iscan = sscanf(optarg, "%d", &fmt.outprecision); + break; + } + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting [+|-]integer argument\n", opt, optarg); + exit(1); + } + break; + case 'h': /* write only summary to output */ + summary = 1; + break; + case 'P': //define pixelization parameters + //get first character for pixelization scheme + sscanf(optarg, " %c", &scheme); + //if there is no scheme specified, look for polys_per_pixel and res_max + if(strchr("0123456789,",scheme)){ + scheme=SCHEME; + iscan = sscanf(optarg, "%d %*[,] %d", &polys_per_pixel, &res_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %d", &res_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c<polys_per_pixel> or -%c<polys_per_pixel>,<res_max> or -%c,<res_max>\n", opt, optarg, opt, opt, opt); + exit(1); + } + } + } + //check to make sure specified scheme is allowed + else if (!strchr(SCHEMES, scheme)) { + fprintf(stderr, "-%c%s: input pixelization scheme %c must be one of %s\n", opt, optarg, scheme, SCHEMES); + exit(1); + } + //step over scheme char to look for polys_per_pixel and res_max + else{ + optarg++; + if (*optarg) { + iscan = sscanf(optarg, "%d %*[,] %d", &polys_per_pixel, &res_max); + if (iscan < 1) { + iscan = sscanf(optarg, " %*[,] %d", &res_max); + if (iscan < 1) { + fprintf(stderr, "-%c%s: expecting -%c%c<polys_per_pixel> or -%c%c<polys_per_pixel>,<res_max> or -%c%c,<res_max>\n", opt, optarg, opt,scheme, opt,scheme, opt,scheme); + exit(1); + } + } + } + } + break; + case 'U': //unify across pixels to unpixelize a mask + unpixelize=1; + break; + case 'W': //print out weights rather than id numbers in polyid + polyid_weight=1; + break; + case 'i': /* format of input files */ + sscanf(optarg, " %c", &in); + switch (in) { + case 'a': /* input data consist of areas */ + fprintf(stderr, "-%c%s: sorry, area format is implemented only as output, not input\n", opt, optarg); + exit(1); + case 'c': /* input data consist of circles */ + fmt.in = keywords[CIRCLE]; + fmt.single = 0; + fmt.n = 0; /* variable number of circles per line */ + fmt.nn = 3; /* <az> <el> <rad> */ + break; + case 'e': /* input data consist of edges */ + fmt.in = keywords[EDGES]; + fmt.single = 0; + fmt.n = 0; /* variable number of edges per line */ + fmt.innve = NVE;/* NVE points per edge */ + fmt.nn = 2; /* <az> <el> */ + break; + case 'g': /* input data consist of graphics */ + fprintf(stderr, "-%c%s: sorry, graphics format is implemented only as output, not input ('cos it's ambiguous)\n", opt, optarg); + exit(1); + case 'h': /* input data consist of healpix weights */ + fmt.in = keywords[HEALPIX_WEIGHT]; + fmt.single = 0; + fmt.n = 1; + fmt.nn = 1; /* <weight> */ + fmt.auto_healpix = -1; + break; + case 'H': + fmt.in = keywords[HEALPIX_WEIGHT]; + fmt.auto_healpix = 0; + break; + case 'i': /* input data consist of ids */ + fprintf(stderr, "-%c%s: sorry, id format is implemented only as output, not input\n", opt, optarg); + exit(1); + case 'm': /* input data consist of midpoints */ + fprintf(stderr, "-%c%s: sorry, midpoint format is implemented only as output, not input\n", opt, optarg); + exit(1); + case 'p': + case 's': + fmt.in = keywords[POLYGON]; + fmt.single = 1; /* keyword defines only one polygon */ + break; + case 'b': + fmt.in = keywords[BINARY_POLYGON]; + fmt.single = 1; + break; + case 'r': /* input data consist of rectangles */ + fmt.in = keywords[RECTANGLE]; + fmt.single = 0; + fmt.n = 1; /* one rectangle per line */ + fmt.nn = 4; /* <azmin> <azmax> <elmin> <elmax> */ + break; + case 'R': + fmt.in = keywords[REGION]; + fmt.single = 1; /* keyword defines only one polygon */ + break; + case 'v': /* input data consist of vertices */ + fmt.in = keywords[VERTICES]; + fmt.single = 0; + fmt.n = 0; /* variable number of vertices per line */ + fmt.innve = 1; /* 1 point per edge */ + fmt.nn = 2; /* <az> <el> */ + break; + case 'w': /* input data consist of weights */ + fprintf(stderr, "-%c%s: sorry, weight format is implemented only as output, not input\n", opt, optarg); + exit(1); + default: + fprintf(stderr, "-%c%s: format %c must be one of %s\n", opt, optarg, in, RFMTS); + exit(1); + break; + } + optarg++; + if (*optarg) { + if (in == 'e') { + iscan = sscanf(optarg, "%d %*[,] %d %c", &fmt.innve, &fmt.n, &fmt.inunitp); + if (iscan <= 1) { + iscan = sscanf(optarg, "%d %c", &fmt.innve, &fmt.inunitp); + } + } else if (in == 'H') { + iscan = sscanf(optarg, "%d", &fmt.auto_healpix); + } else { + iscan = sscanf(optarg, "%d %c", &fmt.n, &fmt.inunitp); + } + if (iscan <= 0) { + iscan = sscanf(optarg, " %c", &fmt.inunitp); + } + if (in == 'r' && fmt.n != 1) { + fprintf(stderr, "-%c%c%s: number of rectangles %d per line must be 1\n", opt, in, optarg, fmt.n); + exit(1); + } + if (in == 'h' && fmt.n != 1) { + fprintf(stderr, "-%c%c%s: number of HEALPix weights %d per line must be 1\n", opt, in, optarg, fmt.n); + exit(1); + } else if (fmt.n < 0) { + fprintf(stderr, "-%c%c%s: number of objects %d per line must be >= 0\n", opt, in, optarg, fmt.n); + exit(1); + } + } + if (in == 'e' && fmt.innve < 1) { + fprintf(stderr, "-%c%c%s: number of points %d per edges must be >= 1\n", opt, in, optarg, fmt.innve); + exit(1); + } + if (!strchr(UNITS, fmt.inunitp)) { + fprintf(stderr, "-%c%c%s: input angular unit %c must be one of %s\n", opt, in, optarg, fmt.inunitp, UNITS); + exit(1); + } + break; + case 'o': /* format of output file */ + sscanf(optarg, " %c", &out); + switch (out) { + case 'a': fmt.out = keywords[AREA]; break; + case 'c': fmt.out = keywords[CIRCLE]; break; + case 'e': + fmt.out = keywords[EDGES]; + fmt.outper = 0; /* outnve interpreted as number of points/edge */ + break; + case 'g': + fmt.out = keywords[GRAPHICS]; + fmt.outper = 1; /* outnve interpreted as number of points/(2 pi) */ + break; + case 'h': + fprintf(stderr, "-%c%s: sorry, healpix_weight format is implemented only as input, except for rasterize (use -H); to output a file containing the weights of your polygons, use -ow\n", opt, optarg); + exit(1); + case 'l': + fmt.out = keywords[LIST]; + fmt.outper = 1; /* outnve interpreted as number of points/(2 pi) */ + break; + case 'i': fmt.out = keywords[ID]; break; + case 'm': fmt.out = keywords[MIDPOINT]; break; + case 'p': fmt.out = keywords[POLYGON]; break; + case 'r': fmt.out = keywords[RECTANGLE]; break; + case 'R': fmt.out = keywords[REGION]; break; + case 's': fmt.out = keywords[SPOLYGON]; break; + case 'v': + fmt.out = keywords[VERTICES]; + fmt.outper = 0; /* outnve interpreted as number of points/edge */ + fmt.outnve = 1; /* one point/edge */ + break; + case 'b': fmt.out = keywords[BINARY_POLYGON]; break; + case 'w': fmt.out = keywords[WEIGHT]; break; + default: + fprintf(stderr, "-%c%s: outfile format %c must be one of %s\n", opt, optarg, out, WFMTS); + exit(1); + } + optarg++; + if (*optarg) { + iscan = 0; + if (out == 'e' || out == 'g' || out == 'l') { + iscan = sscanf(optarg, "%d %c", &fmt.outnve, &fmt.outunitp); + } + if (iscan <= 0) { + iscan = sscanf(optarg, " %c", &fmt.outunitp); + } + } + if (out == 'e' && fmt.outnve < 0) { + fprintf(stderr, "-%c%c%s: number of points %d per edge must be >= 0\n", opt, out, optarg, fmt.outnve); + exit(1); + } else if ((out == 'g' || out == 'l') && fmt.outnve < 0) { + fprintf(stderr, "-%c%c%s: number of points %d per (2 pi) must be >= 0\n", opt, out, optarg, fmt.outnve); + exit(1); + } + if (!strchr(UNITS, fmt.outunitp)) { + fprintf(stderr, "-%c%c%s: angular unit %c must be one of %s\n", opt, out, optarg, fmt.outunitp, UNITS); + exit(1); + } + break; + case 'H': /* write output of rasterize in healpix_weight file instead of polygon file */ + fmt.out = keywords[HEALPIX_WEIGHT]; + break; + case '0': + machine_output = 1; + break; + case ':': + case '?': + if (optopt == 'f') { + if (fopt) free(fopt); + fopt = &null; + } else if (strchr(optstr, optopt)) { + fprintf(stderr, "%s: missing parameter to option -%c\n", argv[0], optopt); + exit(1); + } else { + fprintf(stderr, "%s: option -%c unknown\n", argv[0], optopt); + exit(1); + } + //case -1: + case 'ÿ': + return; + } + } +} diff --git a/src/parse_fopt.c b/src/parse_fopt.c new file mode 100644 index 0000000..a3045d3 --- /dev/null +++ b/src/parse_fopt.c @@ -0,0 +1,119 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Parse option <fopt> to -f<fopt> switch. + + Included inline to ensure uniform processing of arguments by all programs. +*/ +int parse_fopt(void) +{ + int iscan, itr; + char unit; + char opt = 'f'; + char ins[16], outs[16]; + char *ch, *word; + long double angle, az, el, azn, eln, azp; + + itr = 0; + + /* try -f<inframe>,<outframe> format */ + iscan = sscanf(fopt, "%[^ \t,]%*[ \t,]%[^ \t,]", ins, outs); + if (iscan >= 1) { + /* skip zeroth frame, which is "unknown" */ + fmt.inframe = strdictl(ins, &frames[1]) + 1; + if (iscan == 1) { + fmt.outframe = fmt.inframe; + } else if (iscan == 2) { + fmt.outframe = strdictl(outs, &frames[1]) + 1; + } + + /* transformation angles */ + if (fmt.inframe > 0 && fmt.outframe > 0) { + /* pole */ + az = 0.; el = 90.; + /* az, el of old pole wrt new frame */ + fframe_(&fmt.inframe, &az, &el, &fmt.outframe, &fmt.azp, &fmt.eln); + /* az, el of new pole wrt old frame */ + fframe_(&fmt.outframe, &az, &el, &fmt.inframe, &fmt.azn, &fmt.eln); + } + } + + /* try -f<azn>,<eln>,<azp>[u] format */ + if (iscan < 1 || fmt.inframe <= 0 || fmt.outframe <= 0) { + word = fopt; + do { + /* look for angular unit in word */ + for (ch = word; *ch && !strchr(UNITS, *ch); ch++); + fmt.trunit = (*ch)? *ch : 'd'; + ch = word; + for (iscan = 0; iscan < 3; iscan++) { + if (rdangle(ch, &ch, fmt.trunit, &angle) != 1) break; + switch (iscan) { + case 0: azn = angle; break; + case 1: eln = angle; break; + case 2: azp = angle; break; + } + while (*ch && strchr(" \t,", *ch)) ch++; + } + /* success */ + if (iscan == 3) { + /* check angular unit is 4th quantity in word */ + if (*ch && *ch != ':') { + iscan = sscanf(ch, "%c", &unit); + if (unit != fmt.trunit) { + fprintf(stderr, "-%c%s: angular unit %c must be one of %s\n", opt, fopt, unit, UNITS); + exit(1); + } + ch++; + } + /* convert to degrees */ + scale(&azn, fmt.trunit, 'd'); + scale(&eln, (fmt.trunit == 'h')? 'd' : fmt.trunit, 'd'); + scale(&azp, fmt.trunit, 'd'); + fmt.trunit = 'd'; + /* number of transformations */ + itr++; + /* initialize transformation */ + if (itr == 1) { + fmt.azn = azn; + fmt.eln = eln; + fmt.azp = azp; + /* accumulate transformation */ + } else { + azell_(&azn, &eln, &azp, &fmt.azp, &fmt.eln, &fmt.azn, &fmt.azn, &fmt.eln, &fmt.azp); + } + /* flag transformation is custom */ + fmt.outframe = -1; + /* failure */ + } else { + fmt.outframe = 0; + } + if (*ch && *ch == ':') word = ch + 1; + } while (*ch && *ch == ':'); + + if (fmt.outframe == 0) { + fprintf(stderr, "-%c%s: expecting -%c<inframe>[,<outframe>]\n", opt, fopt, opt); + fprintf(stderr, "Input and output angular frames <inframe> and <outframe> should be one of:\n"); + for (fmt.inframe = 1; frames[fmt.inframe]; fmt.inframe++) { + fprintf(stderr, " %s", frames[fmt.inframe]); + } + fprintf(stderr, "\n"); + fprintf(stderr, "Alternatively, a general rotation may be specified by -%c<azn>,<eln>,<azp>[u]\n", opt); + fprintf(stderr, "<azn> = azimuth of new pole wrt old frame\n"); + fprintf(stderr, "<eln> = elevation of new pole wrt old frame\n"); + fprintf(stderr, " = elevation of old pole wrt new frame\n"); + fprintf(stderr, "<azp> = azimuth of old pole wrt new frame\n"); + fprintf(stderr, " u = r radians, d degrees, m arcmin, s arcsec, h hms(RA) & dms(Dec)\n"); + fprintf(stderr, "A sequence of rotations -%c<azn_1>,<eln_1>,<azp_1>[u1]\n", opt); + fprintf(stderr, " followed by -%c<azn_2>,<eln_2>,<azp_2>[u2] may be specified by\n", opt); + fprintf(stderr, " -%c<azn_1>,<eln_1>,<azp_1>[u1]:<azn_2>,<eln_2>,<azp_2>[u2]\n", opt); + + exit(1); + } + } + + return(itr); +} diff --git a/src/partition_poly.c b/src/partition_poly.c new file mode 100644 index 0000000..814b701 --- /dev/null +++ b/src/partition_poly.c @@ -0,0 +1,1001 @@ +/*------------------------------------------------------------------------------ + © A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include "manglefn.h" + +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + +/*------------------------------------------------------------------------------ + Partition disconnected polygon into connected polygons. + Identifies the groups of boundaries of the polygon + (two circles are friends, belonging to the same group, if they intersect, + and friends of friends are friends), + calls partition_gpoly to partition each group polygon into its parts, + and combines parts from each group. + + The value of the flag overwrite_original determines whether the + original polygon in poly is overwritten or not. + + Input: *poly is a polygon. + npolys = maximum number of polygons available in polys array. + mtol = initial angular tolerance within which to merge multiple intersections. + all_oneboundary = 2 to lasso all one-boundary polygons, + 1 to lasso only those one-boundary polygons + with more caps than vertices, + 0 never to lasso one-boundary polygons; + in all cases, all multi-boundary polygons are lassoed. + adjust_lasso = how to tighten lasso: + = 0 as tight as possible, + 1 for balkanize, + 2 for ransack. + force_split = 1 to force a polygon to be split + even if no boundary can be lassoed; + 0 otherwise. + overwrite_original = 2 to overwrite original polygon poly in all cases, + whether or not partitioning succeeds; + 1 to overwrite poly only if partitioning succeeds; + 0 never to overwrite original poly. + Output: (*poly and) polys[i], i = 0 to *npoly-1, are the parts of *poly. + *npoly = number of polygons in polys; + if *npoly > npolys, then there was not enough space. + Return value: -1 if error occurred; + 0 if *poly was fully partitioned into its parts; + 1 if *poly was partially partioned; + the parts of *poly constitute a valid set of parts, + whose union equals the input *poly, + though some parts are disconnected. +*/ +int partition_poly(polygon **poly, int npolys, polygon *polys[/*npolys*/], long double mtol, int all_oneboundary, int adjust_lasso, int force_split, int overwrite_original, int *npoly) +{ + const int do_vcirc = 1; + const int per = 0; + const int nve = 2; + int dnp, dnpoly, ier, iev, igp, ip, ipoly, jpoly, kpoly, nev, nev0, ngp, np, nret, nv, verb; + long double area, areag, atol, tol; + int *ipv, *gp_tmp, *ev; + long double *angle; + vec *ve; + /* work arrays */ + int *gp = 0x0, *gpg = 0x0; + polygon *gpoly = 0x0; + + /* initialize return value to normal */ + nret = 0; + + /* initialize number of polygon parts in polys to zero */ + *npoly = 0; + + /* call gverts to determine which groups connected boundaries belong to */ + tol = mtol; + ier = gverts(*poly, do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp_tmp, &nev, &nev0, &ev); + if (ier) goto error; + + /* no boundaries */ + if (nev == 0) return(0); + + /* polygon has 1 connected boundary, and not too many caps */ + if (!all_oneboundary && nev == 1 && (*poly)->np <= nv + 1) return(0); + + /* allocate memory for gp and gpg */ + gp = (int *) malloc(sizeof(int) * (*poly)->np); + if (!gp) { + fprintf(stderr, "partition_poly: failed to allocate memory for %d ints\n", (*poly)->np); + return(-1); + } + gpg = (int *) malloc(sizeof(int) * (*poly)->np); + if (!gpg) { + fprintf(stderr, "partition_poly: failed to allocate memory for %d ints\n", (*poly)->np); + return(-1); + } + + /* copy group numbers, because they will be destroyed by subsequent call to gverts() */ + for (ip = 0; ip < (*poly)->np; ip++) { + gp[ip] = gp_tmp[ip]; + } + + /* distinct groups */ + ngp = 0; + for (iev = 0; iev < nev; iev++) { + if (ngp == 0 || gp[ipv[ev[iev] - 1]] != gpg[ngp - 1]) { + gpg[ngp] = gp[ipv[ev[iev] - 1]]; + ngp++; + } + } + + /* accept error messages from garea */ + verb = 1; + + /* each group of connected boundaries */ + for (igp = 0; igp < ngp; igp++) { + + /* polygon contains only one group of connected boundaries */ + if (ngp == 1) { + /* point group polygon gpoly at original polygon */ + gpoly = *poly; + + /* polygon contains more than one group of connected boundaries */ + } else { + /* make sure group polygon gpoly contains enough space */ + np = (*poly)->np; + dnp = 0; + ier = room_poly(&gpoly, np, dnp, 0); + if (ier == -1) goto out_of_memory; + + /* make group polygon */ + group_poly(*poly, gp, gpg[igp], gpoly); + + } + + /* partition group polygon */ + ier = partition_gpoly(gpoly, npolys - *npoly, &polys[*npoly], tol, all_oneboundary, adjust_lasso, force_split, &dnpoly); + if (ier == -1) goto error; + + /* flag that partitioning was only partly successful */ + if (ier == 1) nret = 1; + + /* just one group */ + if (ngp == 1) { + /* number of polygon parts */ + *npoly = dnpoly; + + /* not enough polygons */ + if (*npoly > npolys) return(0); + + /* two or more groups */ + } else { + /* first group */ + if (igp == 0) { + if (dnpoly == 0) { + /* not enough polygons */ + if (*npoly >= npolys) { + (*npoly)++; + return(0); + } + + /* move group polygon into cumulative polygon polys[*npoly] */ + free_poly(polys[*npoly]); + polys[*npoly] = gpoly; + gpoly = 0x0; + (*npoly)++; + } else { + *npoly = dnpoly; + } + + /* subsequent groups */ + } else { + dnp = DNP; + + /* index of next polygon after cumulative and group polygons */ + kpoly = *npoly + dnpoly; + + /* accumulate polygons */ + for (ipoly = 0; ipoly < *npoly; ipoly++) { + + /* area of cumulative polygon polys[ipoly] */ + atol = tol; + ier = garea(polys[ipoly], &atol, verb, &area); + if (ier) goto error; + + /* not enough polygons */ + if (kpoly >= npolys) { + *npoly = kpoly + 1; + return(0); + } + + /* intersection of cumulative polygon polys[ipoly] with group polygon gpoly */ + np = polys[ipoly]->np + gpoly->np; + ier = room_poly(&polys[kpoly], np, dnp, 0); + if (ier == -1) goto out_of_memory; + poly_poly(polys[ipoly], gpoly, polys[kpoly]); + + /* area of intersection of cumulative polygon polys[ipoly] with group polygon gpoly */ + ier = garea(polys[kpoly], &atol, verb, &areag); + if (ier) goto error; + + /* paranoid check: group polygon gpoly does not intersect cumulative polygon polys[ipoly]: should not happen */ + if (areag == 0.) { + fprintf(stderr, "partition_poly: group %d does not intersect part %d of polygon with input id %d; should not happen; continuing ...\n", igp, ipoly, polys[ipoly]->id); + /* goto error; */ + /* group polygon gpoly encloses cumulative polygon polys[ipoly], so offers no further constraint */ + } else if (areag == area) { + continue; + } + + /* group polygon was not partitioned */ + if (dnpoly == 0) { + /* replace cumulative polygon polys[ipoly] with intersection polygon polys[kpoly] */ + free_poly(polys[ipoly]); + polys[ipoly] = polys[kpoly]; + polys[kpoly] = 0x0; + + /* group polygon was partitioned */ + } else { + /* intersect cumulative polygon polys[ipoly] with each part of group polygon */ + for (jpoly = *npoly; jpoly < *npoly + dnpoly; jpoly++) { + /* not enough polygons */ + if (kpoly >= npolys) { + *npoly = kpoly + 1; + return(0); + } + np = polys[ipoly]->np + gpoly->np; + ier = room_poly(&polys[kpoly], np, dnp, 0); + if (ier == -1) goto out_of_memory; + poly_poly(polys[ipoly], polys[jpoly], polys[kpoly]); + /* increment number of polygons */ + kpoly++; + } + + /* replace cumulative polygon polys[ipoly] with last intersected part polys[kpoly - 1] */ + free_poly(polys[ipoly]); + kpoly--; + polys[ipoly] = polys[kpoly]; + polys[kpoly] = 0x0; + + } + + } + + if (dnpoly > 0) { + /* free parts of group polygon */ + for (jpoly = *npoly; jpoly < *npoly + dnpoly; jpoly++) { + free_poly(polys[jpoly]); + } + /* decrement number of polygons */ + kpoly -= dnpoly; + /* move down cumulative polygons */ + for (ipoly = *npoly; ipoly < kpoly; ipoly++) { + polys[ipoly] = polys[ipoly + dnpoly]; + } + /* nullify vacated polygons */ + for (ipoly = kpoly; ipoly < kpoly + dnpoly; ipoly++) { + polys[ipoly] = 0x0; + } + } + + /* revised number of polygons */ + *npoly = kpoly; + + } + + } + + } + + /* polygon contains just one group of connected boundaries */ + if (ngp == 1) { + /* point original polygon at group polygon */ + *poly = gpoly; + + /* polygon contains more than one group of connected boundaries */ + } else { + /* free group polygon */ + free_poly(gpoly); + + } + + /* move final polygon part to poly */ + if (*npoly > 0 + && (overwrite_original == 2 + || (overwrite_original == 1 && ier == 0))) { + + /* free input poly */ + free_poly(*poly); + + /* point poly at last polygon part */ + *poly = polys[*npoly - 1]; + + /* nullify last polygon part */ + polys[*npoly - 1] = 0x0; + + /* decrement number of polygons */ + (*npoly)--; + } + + if (gp) free(gp); + if (gpg) free(gpg); + + return(nret); + + /* ---------------- error returns ---------------- */ + error: + if (gp) free(gp); + if (gpg) free(gpg); + return(-1); + + out_of_memory: + fprintf(stderr, "partition_poly: failed to allocate memory for polygon of %d caps\n", np + dnp); + if (gp) free(gp); + if (gpg) free(gpg); + return(-1); +} + +/*------------------------------------------------------------------------------ + Partition group polygon into connected polygons + by calling part_poly repeatedly until the group polygon is fully partitioned, + or until partitioning fails. + + If the group polygon has two or more connected boundaries none of which + can be lassoed, then the force_split option controls whether part_poly + should be forced to split the polygon in two. + If a split is forced, then each of the resulting two polygons is subjected + to further partitioning, or is in turn forcibly split if necessary. + If too many forcible splits occur, then it is assumed that the procedure + is not converging, and the routine bails out. + + Input: gpoly is a polygon all of whose circles belong to a single group. + npolys = maximum number of polygons available in polys array. + mtol = parameter passed to part_poly. + all_oneboundary = parameter passed to part_poly. + adjust_lasso = parameter passed to part_poly. + force_split = 1 to force part_poly to split a polygon + even if no boundary can be lassoed; + 0 otherwise. + Output: polys[i], i = 0 to *npoly-1, are the parts of gpoly; + if return value = 0, then: + if *npoly = 0, then: + input gpoly already consists of a single connected part + that needs no partitioning; + if *npoly > 0, then: + gpoly was fully partitioned into its parts; + if return value = 1, then: + if force_split = 0, then: + gpoly was partially partitioned, + and polys[*npoly-1] contains those parts of the + input gpoly that were not partitioned successfully; + in spite of the failure, + polys[i], i = 0 to *npoly-1 + constitute a valid set of parts, + whose union equals the input gpoly; + if force_split = 1, then: + the attempt to partition gpoly was abandoned after + gpoly was forcibly split too many times; + polys[i], i = 0 to *npoly-1 + contain the parts of gpoly obtained so far; + in spite of the failure, + polys[i], i = 0 to *npoly-1 + constitute a valid set of parts, + whose union equals the input gpoly, + though some parts are disconnected. + *npoly = number of polygons in polys; + if *npoly > npolys, then there was not enough space. + Return value: -1 if error occurred; + 0 if gpoly was successfully partitioned; + 1 if gpoly was not fully partitioned. +*/ +int partition_gpoly(polygon *gpoly, int npolys, polygon *polys[/*npolys*/], long double mtol, int all_oneboundary, int adjust_lasso, int force_split, int *npoly) +{ +/* bail out if number of forcibly split polygons to partition exceeds this maximum */ +#define NFORCEMAX 200 + int dnpoly, dnpoly_try, iforce, ier, ipoly, iprune, jpoly, nforce; + int do_poly[NFORCEMAX]; + polygon *poly; + + /* initialize number of polygon parts in polys to zero */ + *npoly = 0; + + /* number of forcibly split polygons to partition */ + nforce = 0; + + /* partition these polygons */ + for (iforce = -1; iforce < nforce; iforce++) { + + /* start with input group polygon */ + if (iforce == -1) { + poly = gpoly; + /* subsequent polygons that have been split forcibly */ + } else { + poly = polys[do_poly[iforce]]; + } + + /* partition polygon repeatedly, as long as progress is made */ + while (1) { + /* partition polygon by lassoing its boundaries with circles */ + ier = part_poly(poly, npolys - *npoly, &polys[*npoly], mtol, all_oneboundary, adjust_lasso, force_split, &dnpoly, &dnpoly_try); + if (ier == -1) return(-1); + + /* increment number of polygons made */ + *npoly += dnpoly; + + /* not enough polygons */ + if (*npoly > npolys) return(0); + + /* partitioning was partially successful */ + if (dnpoly > 0 && dnpoly < dnpoly_try && ier == 0) { + /* move last polygon into poly and repeat */ + (*npoly)--; + poly = polys[*npoly]; + polys[*npoly] = 0x0; + + /* partitioning succeeded, or failed completely */ + } else { + /* poly was left unpartitioned, and is not the original group polygon */ + if (dnpoly == 0 && *npoly > 0) { + /* move poly into next polygon */ + polys[*npoly] = poly; + /* nullify source of poly, if it is a forcibly split polygon */ + if (iforce >= 0 && poly == polys[do_poly[iforce]]) polys[do_poly[iforce]] = 0x0; + (*npoly)++; + } + /* break out of loop */ + break; + } + } + + /* part_poly forcibly split polygon into two parts, which need further partitioning */ + if (ier == 1) { + if (nforce + 2 <= NFORCEMAX) { + for (ipoly = *npoly - 2; ipoly < *npoly; ipoly++) { + /* prune polygon that needs further partitioning */ + iprune = prune_poly(polys[ipoly], mtol); + if (iprune == -1) { + fprintf(stderr, "partition_gpoly: failed to prune forcibly split part %d of polygon with input id %d\n", nforce, polys[ipoly]->id); + goto error; + } + if (iprune >= 2) { + fprintf(stderr, "partition_poly: forcibly split part %d of polygon with input id %d has zero area; should not happen; continuing ...\n", nforce, polys[ipoly]->id); + dump_poly(2, &polys[*npoly - 2]); + continue; + } + /* flag polygon for further partitioning */ + do_poly[nforce] = ipoly; + nforce++; + } + + /* too many forcible splits: bail out */ + } else { + /* advise */ + msg("partition_gpoly: unable to lasso parts of a polygon even after it has been\n"); + msg("split forcibly many times; bailing out with %d polygon parts.\n", *npoly); + msg("CONGRATULATIONS! YOU HAVE FOUND A POLYGON THAT BEATS MANGLE.\n"); + msg("PLEASE EMAIL ME Andrew.Hamilton@colorado.edu THE GOOD NEWS\n"); + msg("ALONG WITH A POLYGON FILE CONTAINING THE POLYGON THAT DID IT.\n"); + /* dump the polygon to a polygon file */ + dump_poly(1, &gpoly); + msg("AND THERE'S THE POLYGON FILE I'D LIKE YOU TO SEND. THANKS!\n"); + /* number of forcibly split polygons that have been partitioned */ + nforce = iforce + 1; + /* break out of partitioning loop */ + break; + + } + } + } + + /* flag that partitioning was only partially successful */ + if (dnpoly < dnpoly_try) ier = 1; + + /* remove forcibly split polygons that were partitioned */ + if (nforce > 0) { + iforce = 0; + jpoly = 0; + for (ipoly = 0; ipoly < *npoly; ipoly++) { + /* free forcibly split polygons */ + if (iforce < nforce && ipoly == do_poly[iforce]) { + if (polys[ipoly]) free_poly(polys[ipoly]); + iforce++; + /* move down polygons */ + } else { + polys[jpoly] = polys[ipoly]; + jpoly++; + } + } + /* nullify vacated polygons */ + for (ipoly = jpoly; ipoly < *npoly; ipoly++) { + polys[ipoly] = 0x0; + } + /* revise number of polygons */ + *npoly = jpoly; + } + + return(ier); + + /* ---------------- error returns ---------------- */ + error: + return(-1); +} + +/*------------------------------------------------------------------------------ + Partition a polygon by lassoing its connected boundaries with circles. + + Normally the input polygon poly would be a group polygon, + all of whose connected boundaries belong to a single group. + If the boundaries of the input polygon belong to more than one group, + then the polygon is not simply-connected, and each non-simply-connected part + of the polygon will contain two or more boundaries. + The algorithm will attempt to lasso all these boundaries, even though + lassoing boundaries of a non-simply-connected part of the polygon + cannot partition the polygon. + + The routine attempts to lasso all the connected boundaries of a polygon, + unless the polygon has only a single connected boundary. + If the polygon has a single connected boundary, then + the all_oneboundary option controls whether or not this boundary is lassoed. + + An attempted lasso is discarded if it lies fully inside or fully outside + all the caps of the polygon. It would be incorrect to retain a lasso + that lies fully inside the polygon, and it would be superfluous to retain + a lasso that fully encloses the polygon. + In the normal case where the input polygon is a group polygon, + a lasso can lie fully inside or outside the caps of the group polygon + if the group polygon has a single connected boundary. + + If the input polygon has two or more connected boundaries none of which + can be lassoed, then the force_split option controls whether the + routine gives up, or else forcibly splits the input polygon into two parts, + each of which will require further splitting. + + Input: poly is a polygon. + npolys = maximum number of polygons available in polys array. + mtol = initial angular tolerance within which to merge multiple intersections. + all_oneboundary = 2 to lasso all one-boundary polygons, + 1 to lasso only those one-boundary polygons + with more caps than vertices, + 0 never to lasso one-boundary polygons; + in all cases, all multi-boundary polygons are lassoed. + adjust_lasso = how to tighten lasso: + = 0 as tight as possible, + 1 for balkanize, + 2 for ransack. + force_split = 1 to force a polygon to be split + even if no boundary can be lassoed; + 0 otherwise. + Output: polys[i], i = 0 to npoly-1, are the connected parts of poly; + if return value = 0, then: + if *npoly = *npoly_try = 0, then: + input poly already consists of a single connected part + that needs no partitioning; + if *npoly = *npoly_try > 0, then: + poly was fully partitioned into its parts; + if *npoly < *npoly_try then: + poly was partially partitioned, + and poly[npoly - 1] contains the parts of poly + that were not partitioned successfully; + if return value = 1, + which can occur only if force_split = 1, then: + poly contains at least 2 connected boundaries, + none of which could be lassoed successfully, + and instead poly was split forcibly into two, + with the two parts in polys[0] and polys[1]. + *npoly = number of polygons in polys; + if *npoly > npolys, then there was not enough space. + *npoly_try = attempted number of polygons. + Return value: -1 if error occurred; + 0 for a normal return; + 1 if poly was split forcibly when no boundary could be lassoed; + can only occur if force_split = 1. +*/ +int part_poly(polygon *poly, int npolys, polygon *polys[/*npolys*/], long double mtol, int all_oneboundary, int adjust_lasso, int force_split, int *npoly, int *npoly_try) +{ +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + static polygon *extracap = 0x0; + const int do_vcirc = 1; + const int per = 0; + const int nve = 2; + const int itmax = 30; + int dnp, found, i, ier, iev, ip, it, iv, ivm, ivmax_that, ivmax_this, ivmin_that, ivmin_this, nev, nev0, np, nret, nv, nvm; + int *ipv, *gp, *ev; + long double *angle; + vec *ve, *vm; + long double *cmvmin, *cmvmax, *cmpmin, *cmpmax; + vec *vmax, *vmin; + long double cmbest, cme, cmforce, dth, dthbest, dthforce, dthm, dthp, s, th, thm, tol; + long double cmpmax_all, cmpmin_all, cmvmax_that, cmvmax_this, cmvmin_that, cmvmin_this, thmax_that, thmax_this, thmin_that, thmin_this; + vec v, vmbest, vmforce; + + /* initialize return value to normal */ + nret = 0; + + /* initialize number of polygon parts in polys to zero */ + *npoly = 0; + + /* initialize attempted number of polygon parts to zero */ + *npoly_try = 0; + + /* vertices and centres of edges of polygon */ + tol = mtol; + ier = gverts(poly, do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier) return(-1); + + /* no boundaries */ + if (nev == 0) return(nret); + + /* polygon has just 1 connected boundary */ + if (nev == 1) { + if (all_oneboundary == 0) { + return(nret); + } else if (all_oneboundary == 1) { + /* polygon has not too many caps */ + if (poly->np <= nv + 1) return(nret); + } + } + + /* barycentres of connected boundaries of polygon */ + ier = vmidc(poly, nv, nve, ve, ipv, ev, &nvm, &vm); + if (ier == -1) return(-1); + + /* number of polygons to try to split into */ + *npoly_try = nvm; + + /* initialize lasso to be used to force split */ + if (force_split) dthforce = -4.; + + /* attempt to partition polygon around each barycentre vm[ivm] */ + for (ivm = 0; ivm < nvm; ivm++) { + + /* initialize best lasso so far */ + if (force_split) dthbest = -4.; + + /* repeat until find isolating lasso */ + it = 0; + do { + + /* points on each edge nearest to and farthest from vm[ivm] */ + ier = gvlims(poly, do_vcirc, &tol, vm[ivm], &nv, &vmin, &vmax, &cmvmin, &cmvmax, &cmpmin, &cmpmax, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + if (ier) break; + + /* distances that exclude/enclose all circles */ + cmpmin_all = 2.; + cmpmax_all = 0.; + for (ip = 0; ip < poly->np; ip++) { + if (cmpmin[ip] <= cmpmin_all) { + cmpmin_all = cmpmin[ip]; + } + if (cmpmax[ip] >= cmpmax_all) { + cmpmax_all = cmpmax[ip]; + } + } + + /* distances that exclude/enclose this connected boundary */ + ivmax_this = -1; + ivmin_this = -1; + cmvmin_this = 2.; + cmvmax_this = 0.; + for (iv = (ivm == 0)? 0 : ev[ivm - 1]; iv < ev[ivm]; iv++) { + if (cmvmin[iv] <= cmvmin_this) { + ivmin_this = iv; + cmvmin_this = cmvmin[iv]; + } + if (cmvmax[iv] >= cmvmax_this) { + ivmax_this = iv; + cmvmax_this = cmvmax[iv]; + } + } + + /* distances that exclude/enclose other connected boundaries */ + ivmin_that = -1; + ivmax_that = -1; + cmvmin_that = 2.; + cmvmax_that = 0.; + for (iev = 0; iev < nev; iev++) { + if (iev == ivm) continue; + for (iv = (iev == 0)? 0 : ev[iev - 1]; iv < ev[iev]; iv++) { + if (cmvmin[iv] <= cmvmin_that) { + ivmin_that = iv; + cmvmin_that = cmvmin[iv]; + } + if (cmvmax[iv] >= cmvmax_that) { + ivmax_that = iv; + cmvmax_that = cmvmax[iv]; + } + } + } + + /* angles corresponding to cmmin_this, cmvmax_this, cmvmin_that, and cmvmax_that */ + thmin_this = 2. * asinl(sqrtl(cmvmin_this / 2.)); + thmax_this = 2. * asinl(sqrtl(cmvmax_this / 2.)); + thmin_that = 2. * asinl(sqrtl(cmvmin_that / 2.)); + thmax_that = 2. * asinl(sqrtl(cmvmax_that / 2.)); + + dthp = thmin_that - thmax_this; + dthm = thmin_this - thmax_that; + + dth = (dthp >= dthm)? dthp : dthm; + + /* found lasso that isolates this connected boundary of polygon */ + if (dth >= - tol) { + + /* if (it >= 10) printf("%21.15Lg %21.15Lg %21.15Lg %4d %2d%21.15Lg %21.15Lg %21.15Lg %21.15Lg %21.15Lg %21.15Lg\n", vm[ivm][0], vm[ivm][1], vm[ivm][2], ivm, it, thmin_this, thmax_this, thmin_that, thmax_that, dthp, dthm); */ + + /* thmin_that >= thmax_this - tol */ + if (dthp >= dthm) { + /* isolating lasso */ + th = (thmax_this + thmin_that) / 2.; + switch (adjust_lasso) { + /* as tight as possible */ + case 0: thm = thmax_this; break; + /* for balkanize: tiny angles give garea problems */ + case 1: thm = thmax_this + .001; break; + /* for ransack: want tight lasso */ + case 2: thm = thmax_this * 1.05; break; + } + /* tighten lasso */ + if (th > thm) th = thm; + if (th < PI) { + s = sinl(th / 2.); + cme = 2. * s * s; + } else { + cme = 2.; + } + + /* discard lasso that completely encloses all circles */ + if (cme >= cmpmax_all) { + /* printf("%21.15Lg %21.15Lg %21.15Lg %21.15Lg\n", vm[ivm][0], vm[ivm][1], vm[ivm][2], cme); */ + /* decrement number of polygons to try for */ + (*npoly_try)--; + /* break out of search loop */ + break; + } + + /* thmin_this >= thmax_that - tol */ + } else { + /* isolating lasso */ + th = (thmax_that + thmin_this) / 2.; + switch (adjust_lasso) { + /* as tight as possible */ + case 0: thm = thmin_this; break; + /* for balkanize: tiny angles give garea problems */ + case 1: thm = thmin_this - .001; break; + /* for ransack: want tight lasso */ + case 2: thm = thmin_this / 1.05; break; + } + /* tighten lasso */ + if (th < thm) th = thm; + if (th > 0.) { + s = sinl(th / 2.); + cme = 2. * s * s; + } else { + cme = 0.; + } + + /* discard lasso that completely encloses all circles */ + if (cme <= cmpmin_all) { + /* printf("%21.15Lg %21.15Lg %21.15Lg %21.15Lg\n", vm[ivm][0], vm[ivm][1], vm[ivm][2], cme); */ + /* decrement number of polygons to try for */ + (*npoly_try)--; + /* break out of search loop */ + break; + } + + cme = - cme; + + } + + /* not enough polygons for a new one */ + if (*npoly >= npolys) { + (*npoly)++; + return(0); + } + + /* put isolating lasso into new polygon */ + np = 1; + dnp = DNP; + ier = room_poly(&extracap, np, dnp, 0); + if (ier == -1) goto out_of_memory; + for (i = 0; i < 3; i++) { + extracap->rp[0][i] = vm[ivm][i]; + } + + extracap->cm[0] = cme; + extracap->np = 1; + + /* make sure new polygon contains enough space */ + np = poly->np + 1; + dnp = 0; + ier = room_poly(&polys[*npoly], np, dnp, 0); + if (ier == -1) goto out_of_memory; + + /* combination of poly with new circle */ + poly_poly(poly, extracap, polys[*npoly]); + + /* increment number of polygons */ + (*npoly)++; + + /* flag found isolating boundary */ + found = 1; + + /* failed to find isolating lasso */ + } else { + + dthp = thmin_that - thmin_this; + dthm = thmax_this - thmax_that; + + if (dthp >= dthm) { + /* paranoid check that ivmax_this and ivmin_that were initialized */ + if (ivmax_this == -1 || ivmin_that == -1) { + /* error should never happen */ + fprintf(stderr, "partition_poly: ivmax_this = %d ivmin_that = %d should be in interval [0, %d]\n", ivmax_this, ivmin_that, nv); + return(-1); + } + + /* record the best lasso so far */ + if (force_split) { + if (dthp > dthbest) { + dthbest = dthp; + /* circle that does not enclose connected boundary, + but does exclude other connected boundaries */ + th = (thmin_this + thmin_that) / 2.; + thm = thmin_that * .999; + if (th < thm) th = thm; + s = sinl(th / 2.); + cmbest = 2. * s * s; + for (i = 0; i < 3; i++) { + vmbest[i] = vm[ivm][i]; + } + } + } + + /* vector to this from that */ + for (i = 0; i < 3; i++) { + v[i] = vmax[ivmax_this][i] - vmin[ivmin_that][i]; + } + s = v[0] * v[0] + v[1] * v[1] + v[2] * v[2]; + /* translate centre point along vector */ + /* the 0.02 puts centre just beyond equal distance */ + for (i = 0; i < 3; i++) { + v[i] = vm[ivm][i] + ((cmvmax_this - cmvmin_that) / s + 0.02 * (it + 1)) * v[i]; + } + s = sqrtl(v[0] * v[0] + v[1] * v[1] + v[2] * v[2]); + for (i = 0; i < 3; i++) { + vm[ivm][i] = v[i] / s; + } + + } else { + /* paranoid check that ivmin_this and ivmax_that were initialized */ + if (ivmin_this == -1 || ivmax_that == -1) { + /* error should never happen */ + fprintf(stderr, "partition_poly: ivmin_this = %d ivmax_that = %d should be in interval [0, %d]\n", ivmin_this, ivmax_that, nv); + return(-1); + } + + /* record the best lasso so far */ + if (force_split) { + if (dthm > dthbest) { + dthbest = dthm; + /* circle that does not enclose connected boundary, + but does exclude other connected boundaries */ + th = PI - (thmax_this + thmax_that) / 2.; + thm = (PI - thmax_that) * .999; + if (th < thm) th = thm; + s = cosl(th / 2.); + cmbest = - 2. * s * s; + for (i = 0; i < 3; i++) { + vmbest[i] = vm[ivm][i]; + } + } + } + + /* vector to that from this */ + for (i = 0; i < 3; i++) { + v[i] = vmax[ivmax_that][i] - vmin[ivmin_this][i]; + } + s = v[0] * v[0] + v[1] * v[1] + v[2] * v[2]; + /* translate centre point along vector */ + /* the 0.02 puts centre just beyond equal distance */ + for (i = 0; i < 3; i++) { + v[i] = vm[ivm][i] + ((cmvmax_that - cmvmin_this) / s + 0.02 * (it + 1)) * v[i]; + } + s = sqrtl(v[0] * v[0] + v[1] * v[1] + v[2] * v[2]); + for (i = 0; i < 3; i++) { + vm[ivm][i] = v[i] / s; + } + + } + + /* flag failed to find isolating boundary */ + found = 0; + + } + + } while (!found && it++ < itmax); + + /* record the best lasso so far */ + if (force_split && !found) { + if (dthbest > dthforce) { + dthforce = dthbest; + cmforce = cmbest; + for (i = 0; i < 3; i++) { + vmforce[i] = vmbest[i]; + } + } + } + + } + + /* no polygons were lassoed */ + if (*npoly == 0) { + + /* go with original polygon */ + if (*npoly_try <= 1) { + *npoly_try = 0; + return(nret); + } + + /* split polygon along best circle so far, even though it is not a lasso */ + if (force_split) { + /* not enough polygons for a new one */ + if (*npoly >= npolys) { + (*npoly)++; + return(0); + } + + /* put circle into new polygon */ + np = 1; + dnp = DNP; + ier = room_poly(&extracap, np, dnp, 0); + if (ier == -1) goto out_of_memory; + for (i = 0; i < 3; i++) { + extracap->rp[0][i] = vmforce[i]; + } + extracap->cm[0] = cmforce; + extracap->np = 1; + + /* make sure new polygon contains enough space */ + np = poly->np + 1; + dnp = 0; + ier = room_poly(&polys[*npoly], np, dnp, 0); + if (ier == -1) goto out_of_memory; + + /* combination of polygon with new circle */ + poly_poly(poly, extracap, polys[*npoly]); + + /* increment number of polygons */ + (*npoly)++; + + /* flag that split was forced */ + nret = 1; + } + + } + + /* if some polygons were lassoed and others not, add complement of all new caps to polygon */ + if (*npoly > 0 && *npoly < *npoly_try) { + /* not enough polygons for a new one */ + if (*npoly >= npolys) { + (*npoly)++; + return(0); + } + + /* put complement of all new caps into new polygon */ + np = *npoly; + dnp = DNP; + ier = room_poly(&extracap, np, dnp, 0); + if (ier == -1) goto out_of_memory; + for (np = 0; np < *npoly; np++) { + ip = polys[np]->np - 1; + for (i = 0; i < 3; i++) { + extracap->rp[np][i] = polys[np]->rp[ip][i]; + } + extracap->cm[np] = - polys[np]->cm[ip]; + } + extracap->np = *npoly; + + /* make sure new polygon contains enough space */ + np = poly->np + *npoly; + dnp = 0; + ier = room_poly(&polys[*npoly], np, dnp, 0); + if (ier == -1) goto out_of_memory; + + /* poly with complement of new caps from other polygons */ + poly_poly(poly, extracap, polys[*npoly]); + + /* increment number of polygons */ + (*npoly)++; + } + + /* trim new polygons to suppress obviously coincident caps */ + for (ip = 0; ip < *npoly; ip++) { + trim_poly(polys[ip]); + } + + return(nret); + + /* ---------------- error returns ---------------- */ + out_of_memory: + fprintf(stderr, "part_poly: failed to allocate memory for polygon of %d caps\n", np + dnp); + return(-1); +} diff --git a/src/pi.h b/src/pi.h new file mode 100644 index 0000000..8cf43ec --- /dev/null +++ b/src/pi.h @@ -0,0 +1,6 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef PI +#define PI (atanl(1.)*4.) +#endif diff --git a/src/pi.par b/src/pi.par new file mode 100644 index 0000000..99daa3b --- /dev/null +++ b/src/pi.par @@ -0,0 +1,4 @@ +c----------------------------------------------------------------------- + real*10 PI + parameter (PI=3.141592653589793238462643383279502884197_10) +c diff --git a/src/pix2vec_nest.s.f b/src/pix2vec_nest.s.f new file mode 100644 index 0000000..cd6b260 --- /dev/null +++ b/src/pix2vec_nest.s.f @@ -0,0 +1,236 @@ +! Standalone HEALPix subroutine converted to f77 by J C Hill 07/13/06 +! Get the original at http://healpix.jpl.nasa.gov +! a f 'f88 pix2vecnest.f' + + !========================================================================= + subroutine pix2vec_nest(nside, ipix, vector_x, vector_y, + & vector_z, vertex_n_x, vertex_n_y, vertex_n_z, vertex_e_x, + & vertex_e_y, vertex_e_z, vertex_s_x, vertex_s_y, vertex_s_z, + & vertex_w_x, vertex_w_y, vertex_w_z) + !========================================================================= + ! renders vector (x,y,z) coordinates of the nominal pixel center + ! for the pixel number ipix (NESTED scheme) + ! given the map resolution parameter nside + ! also returns the (x,y,z) position of the 4 pixel vertices (=corners) + ! in the order N,E,S,W + !========================================================================= + IMPLICIT none + INTEGER ipix, nside + REAL*10 vector_x, vector_y, vector_z, vertex_n_x, + & vertex_n_y, vertex_n_z, vertex_e_x, vertex_e_y, + & vertex_e_z, vertex_s_x, vertex_s_y, vertex_s_z, + & vertex_w_x, vertex_w_y, vertex_w_z + + INTEGER npix, npface, ipf, ip_low, ip_trunc, ip_med, + & ip_hi, jrt, jr, nr, jpt, jp, kshift, nl4, ns_max + parameter(ns_max=8192) ! 2^13 : largest nside allowed + REAL*10 z, fn, fact1, fact2, sth, phi, PI + parameter(PI=3.141592653589793238462643383279502884197_10) + INTEGER pix2x(0:1023), pix2y(0:1023) + INTEGER ix, iy, face_num + ! common /xy_nest/ ix, iy, face_num ! can be useful to calling routine + + INTEGER jrll(1:12) + INTEGER jpll(1:12) + + REAL*10 phi_nv, phi_wv, phi_sv, phi_ev, phi_up, phi_dn, + & z_nv, z_sv, sth_nv, sth_sv, hdelta_phi + INTEGER iphi_mod, iphi_rat, kpix, jpix, ix_mk, + & iy_mk, ip_mk, id_mk, i + ! LOGICAL do_vertex ! this is unnecessary, since we will always want the vertices + !------------------------------------------------------------------------ + if (nside.lt.1 .or. nside.gt.ns_max) stop 'nside out of range' + npix = 12*nside**2 ! total number of pixels + if (ipix.lt.0 .or. ipix.gt.npix-1) stop 'ipix out of range' + + do 10 i = 0, 1023 + pix2x(i) = 0 + pix2y(i) = 0 + 10 continue + + ! coordinate of the lowest corner of each face, in unit of nside + jrll(1) = 2 + jrll(2) = 2 + jrll(3) = 2 + jrll(4) = 2 + jrll(5) = 3 + jrll(6) = 3 + jrll(7) = 3 + jrll(8) = 3 + jrll(9) = 4 + jrll(10) = 4 + jrll(11) = 4 + jrll(12) = 4 + + ! coordinate of the lowest corner of each face, in unit of nside/2 + jpll(1) = 1 + jpll(2) = 3 + jpll(3) = 5 + jpll(4) = 7 + jpll(5) = 0 + jpll(6) = 2 + jpll(7) = 4 + jpll(8) = 6 + jpll(9) = 1 + jpll(10) = 3 + jpll(11) = 5 + jpll(12) = 7 + + ! initializes the array for the pixel number -> (x,y) mapping + if (pix2x(1023).le.0) then + ! constructs the array giving x and y in the face from pixel number + ! for the nested (quad-cube like) ordering of pixels + ! + ! the bits corresponding to x and y are interleaved in the pixel number + ! one breaks up the pixel number by even and odd bits + + ! cc cf block data data pix2x(1023) /0/ + ! + ! print *, 'initiate pix2xy' + do kpix = 0,1023 ! pixel number + jpix = kpix + ix_mk = 0 + iy_mk = 0 + ip_mk = 1 ! bit position (in x and y) + ! do while (jpix/=0) ! go through all the bits + do + if (jpix.eq.0) exit ! go through all the bits +! id_mk = jpix ! this and the next 4 lines are equivalent to id_mk=MODULO(jpix,2) +! 10 continue +! if (id_mk.ge.2) id_mk = id_mk - 2 +! if (id_mk.lt.0) id_mk = id_mk + 2 +! if (id_mk.ge.2 .or. id_mk.lt.0) goto 10 ! bit value (in kpix), goes in ix_mk + id_mk = MOD(jpix,2) + jpix = jpix/2 + ix_mk = id_mk*ip_mk + ix_mk + +! id_mk = jpix ! this and the next 4 lines are equivalent to id_mk=MODULO(jpix,2) +! 20 continue +! if (id_mk.ge.2) id_mk = id_mk - 2 +! if (id_mk.lt.0) id_mk = id_mk + 2 +! if (id_mk.ge.2 .or. id_mk.lt.0) goto 20 ! bit value (in kpix), goes in iy_mk + id_mk = MOD(jpix,2) + jpix = jpix/2 + iy_mk = id_mk*ip_mk + iy_mk + + ip_mk = 2*ip_mk ! next bit (in x and y) + enddo + pix2x(kpix) = ix_mk ! in 0,31 + pix2y(kpix) = iy_mk ! in 0,31 + enddo + endif + + fn = DBLE(nside) + fact1 = 1.0_10/(3.0_10*fn*fn) + fact2 = 2.0_10/(3.0_10*fn) + nl4 = 4*nside + + ! finds the face, and the number in the face + npface = nside**2 + + face_num = ipix/npface ! face number in {0,11} + ipf = MOD(ipix,npface) ! pixel number in the face {0,npface-1} + + ! finds the x,y on the face (starting from the lowest corner) + ! from the pixel number + ip_low = MOD(ipf,1024) ! content of the last 10 bits + ip_trunc = ipf/1024 ! truncation of the last 10 bits + ip_med = MOD(ip_trunc,1024) ! content of the next 10 bits + ip_hi = ip_trunc/1024 ! content of the high weight 10 bits + + ix = 1024*pix2x(ip_hi) + 32*pix2x(ip_med) + pix2x(ip_low) + iy = 1024*pix2y(ip_hi) + 32*pix2y(ip_med) + pix2y(ip_low) + + ! transforms this in (horizontal, vertical) coordinates + jrt = ix + iy ! 'vertical' in {0,2*(nside-1)} + jpt = ix - iy ! 'horizontal' in {-nside+1,nside-1} + + ! computes the z coordinate on the sphere + jr = jrll(face_num+1)*nside - jrt - 1 ! ring number in {1,4*nside-1} + + nr = nside ! equatorial region (the most frequent) + z = (2*nside-jr)*fact2 + kshift = MOD(jr - nside, 2) + + z_nv = (2*nside-jr+1)*fact2 + z_sv = (2*nside-jr-1)*fact2 + if (jr.eq.nside) then ! northern transition + z_nv = 1.0_10 - (nside-1)**2 * fact1 + elseif (jr.eq.3*nside) then ! southern transition + z_sv = -1.0_10 + (nside-1)**2 * fact1 + endif + + if (jr.lt.nside) then ! north pole region + nr = jr + z = 1.0_10 - nr*nr*fact1 + kshift = 0 + z_nv = 1.0_10 - (nr-1)**2 * fact1 + z_sv = 1.0_10 - (nr+1)**2 * fact1 + elseif (jr.gt.3*nside) then ! south pole region + nr = nl4 - jr + z = -1.0_10 + nr*nr*fact1 + kshift = 0 + z_nv = -1.0_10 + (nr+1)**2 * fact1 + z_sv = -1.0_10 + (nr-1)**2 * fact1 + endif + + ! computes the phi coordinate on the sphere, in [0,2Pi] + jp = (jpll(face_num+1)*nr + jpt + 1 + kshift)/2 ! 'phi' number in the ring in {1,4*nr} + if (jp.gt.nl4) jp = jp - nl4 + if (jp.lt.1) jp = jp + nl4 + + phi = (jp - (kshift+1)*0.5_10) * (PI/(2.0_10*nr)) + + sth = SQRT((1.0_10-z)*(1.0_10+z)) + vector_x = sth * COS(phi) + vector_y = sth * SIN(phi) + vector_z = z + + phi_nv = phi + phi_sv = phi + + phi_up = 0.0_10 + iphi_mod = MOD(jp-1,nr) ! in {0,1,... nr-1} + iphi_rat = (jp-1) / nr ! in {0,1,2,3} + if (nr.gt.1) phi_up=(PI/2.0_10)*(iphi_rat+iphi_mod/(DBLE(nr-1))) + phi_dn =(PI/2.0_10)*(iphi_rat+(iphi_mod+1)/(DBLE(nr+1))) + if (jr.lt.nside) then ! North polar cap + phi_nv = phi_up + phi_sv = phi_dn + elseif (jr.gt.3*nside) then ! South polar cap + phi_nv = phi_dn + phi_sv = phi_up + elseif (jr.eq.nside) then ! North transition + phi_nv = phi_up + elseif (jr.eq.3*nside) then ! South transition + phi_sv = phi_up + endif + + hdelta_phi = PI / (4.0_10*nr) + + ! west vertex + phi_wv = phi - hdelta_phi + vertex_w_x = sth * COS(phi_wv) + vertex_w_y = sth * SIN(phi_wv) + vertex_w_z = z + + ! east vertex + phi_ev = phi + hdelta_phi + vertex_e_x = sth * COS(phi_ev) + vertex_e_y = sth * SIN(phi_ev) + vertex_e_z = z + + ! north vertex + sth_nv = SQRT((1.0_10-z_nv)*(1.0_10+z_nv)) + vertex_n_x = sth_nv * COS(phi_nv) + vertex_n_y = sth_nv * SIN(phi_nv) + vertex_n_z = z_nv + + ! south vertex + sth_sv = SQRT((1.0_10-z_sv)*(1.0_10+z_sv)) + vertex_s_x = sth_sv * COS(phi_sv) + vertex_s_y = sth_sv * SIN(phi_sv) + vertex_s_z = z_sv + + return + end subroutine pix2vec_nest ! pix2vec_nest diff --git a/src/pixelize.c b/src/pixelize.c new file mode 100644 index 0000000..12ae3f8 --- /dev/null +++ b/src/pixelize.c @@ -0,0 +1,506 @@ +/*------------------------------------------------------------------------------ + © M E C Swanson 2005 + ------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" +//#include <mcheck.h> + +/* getopt options */ +const char *optstr = "dqm:s:e:v:p:P:i:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +typedef struct +{ + int pixel_loop_level; + int pix, n, base_poly; +} pixel_log; + + + +/* local functions */ +void usage(void); +#ifdef GCC +int pixelize(int npoly, polygon *[npoly], int npolys, polygon *[npolys]); +int pixel_loop(pixel_log *log, int pix, int n, polygon *[n], int out_max, polygon *[out_max]); + +#else +int pixelize(int npoly, polygon *[/*npoly*/], int npolys, polygon *[/*npolys*/]); +int pixel_loop(pixel_log *log, int pix, int n, polygon *[/*n*/], int out_max, polygon *[/*out_max*/]); + +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys, i, res_max_temp; + char scheme_temp; + polygon **polys; + polys=polys_global; + + // mtrace(); + + /* default output format */ + fmt.out = keywords[POLYGON]; + /* default is to renumber output polygons with old id numbers */ + fmt.newid = 'o'; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- pixelize ----------------\n"); + + // snap angles + scale(&axtol, axunit, 's'); + scale(&btol, bunit, 's'); + scale(&thtol, thunit, 's'); + axunit = 's'; + bunit = 's'; + thunit = 's'; + // msg("snap angles: axis %Lg%c latitude %Lg%c edge %Lg%c\n", axtol, axunit, btol, bunit, thtol, thunit); + scale(&axtol, axunit, 'r'); + scale(&btol, bunit, 'r'); + scale(&thtol, thunit, 'r'); + axunit = 'r'; + bunit = 'r'; + thunit = 'r'; + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + msg("pixelization scheme %c, maximum resolution %d\n", scheme, res_max); + msg("maximum number of polygons allowed in each pixel: %d\n", polys_per_pixel); + scheme_temp=scheme; + res_max_temp=res_max; + + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if(scheme!=scheme_temp || res_max!=res_max_temp){ + msg("warning: pixelization information in input file is being discarded\n"); + scheme=scheme_temp; + res_max=res_max_temp; + } + + /* pixelize polygons */ + npolys = pixelize(npoly, polys, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + + pixelized=1; + if(polys_per_pixel>0) res_max=-1; + + /* write polygons */ + ifile = argc - 1; + npolys = wrmask(argv[ifile], &fmt, npolys, &polys[npoly]); + if (npolys == -1) exit(1); + /* memmsg(); */ + + for(i=0;i<npoly+npolys;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ + */ +void usage(void) +{ + printf("usage:\n"); + // printf("pixelize [-d] [-q] [-a<a>[u]] [-b<a>[u]] [-t<a>[u]] [-y<r>] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-P[scheme][<r>][,<p>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); + printf("pixelize [-d] [-q] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-P[scheme][<p>][,<r>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ + */ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Pixelize: split polygons against a pre-defined pixel map such that each polygon is in only one pixel + + Input: npoly = number of polygons. + poly = array of pointers to polygons. + npolys = maximum number of output polygons. + Output: polys = array of pointers to polygons. + Return value: number of disjoint connected polygons, + or -1 if error occurred. +*/ +int pixelize(int npoly, polygon *poly[/*npoly*/], int npolys, polygon *polys[/*npolys*/]) +{ + /* part_poly should lasso one-boundary polygons only if they have too many caps */ +#define ALL_ONEBOUNDARY 1 + /* how part_poly should tighten lasso */ +#define ADJUST_LASSO 1 + /* part_poly should force polygon to be split even if no part can be lassoed */ +#define FORCE_SPLIT 1 + /* partition_poly should overwrite all original polygons */ +#define OVERWRITE_ORIGINAL 2 +#define WARNMAX 8 + char *snapped_polys = 0x0; + int isnap,j, nadj; + int dn, dnp, failed, i, ier, inull, ip, iprune, m, n, np; + + msg("pruning input polygons\n"); + + /* start by pruning all input polygons */ + np = 0; + inull = 0; + for (i = 0; i < npoly; i++) { + iprune = prune_poly(poly[i], mtol); + /* error */ + if (iprune == -1) { + fprintf(stderr, "pixelize: initial prune failed at polygon %d\n", poly[i]->id); + return(-1); + } + /* zero area polygon */ + if (iprune >= 2) { + if (WARNMAX > 0 && inull == 0) msg("warning from pixelize: the following polygons have zero area & are being discarded:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt.newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } else { + np++; + } + } + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) { + msg("pixelize: %d polygons with zero area are being discarded.\n", inull); + } + + /* number of polygons */ + msg("pixelizing %d polygons ...\n", np); + + /* set all input polygons to be in pixel 0 (whole sky)*/ + inull=0; + for (i = 0; i < npoly; i++) { + if(poly[i]->pixel!=0){ + poly[i]->pixel = 0; + if(WARNMAX>0 && inull ==0) msg("warning from pixelize: following polygons are being re-set to be in pixel 0:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt.newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } + } + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) { + msg("pixelize: %d polygons have been re-set to be in pixel 0.\n", inull); + } + + /* nullify all output polygons */ + for (i = 0; i < npolys; i++) { + polys[i] = 0x0; + } + + msg("pixelize stage 1 (fragment each polygon so it is in only one pixel):\n"); + + /*call recursive pixel_loop to split polygons into pixels*/ + n=pixel_loop(0,0,npoly,poly,npolys,polys); + if(n==-1) return(-1); + + dnp=n-np; + np=n; + + msg("added %d polygons to make %d\n", dnp, np); + + /* partition disconnected polygons into connected parts */ + msg("pixelize stage 2 (partition disconnected polygons into connected parts):\n"); + m = n; + dnp = 0; + ip = 0; + failed = 0; + for (i = 0; i < m; i++) { + if ((i%100)==0) { + printf(" %d / %d \r", i, m); + fflush(stdout);; + } + /* skip null polygons */ + if (!polys[i] || (polys[i]->np > 0 && polys[i]->cm[0] == 0.)) continue; + /* partition disconnected polygons */ + ier = partition_poly(&polys[i], npolys - n, &polys[n], mtol, ALL_ONEBOUNDARY, ADJUST_LASSO, FORCE_SPLIT, OVERWRITE_ORIGINAL, &dn); + /* error */ + if (ier == -1) { + fprintf(stderr, "pixelize: UHOH at polygon %d; continuing ...\n", (fmt.newid == 'o')? polys[i]->id : ip); + continue; + /* return(-1); */ + /* failed to partition polygon into desired number of parts */ + } else if (ier == 1) { + fprintf(stderr, "pixelize: failed to partition polygon %d fully; partitioned it into %d parts\n", (fmt.newid == 'o')? polys[i]->id : ip, dn + 1); + failed++; + } + /* increment index of next subset of fragments */ + n += dn; + /* increment polygon count */ + np += dn; + dnp += dn; + /* check whether exceeded maximum number of polygons */ + if (n > npolys) { + fprintf(stderr, "pixelize: total number of polygons exceeded maximum %d\n", npoly + npolys); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + return(-1); + } + ip++; + } + msg("added %d polygons to make %d\n", dnp, np); + + if (failed > 0) { + msg("pixelize: failed to split %d polygons into desired number of connected parts\n", failed); + msg(".............................................................................\n"); + msg("Failure to split polygon probably means:\n"); + msg("either (1) you forgot to run snap on all your input polygon files;\n"); + msg(" or (2) the polygon is too small for the numerics to cope with;\n"); + msg(" or (3) you have a weird-shaped polygon.\n"); + msg("You may ignore this warning message if the weights of polygons in the input\n"); + msg("polygon file(s) are already correct, and you do not want to reweight them.\n"); + msg("Similarly, you may ignore this warning message if you do want to reweight the\n"); + msg("polygons, but the weights of the different parts of each unsplit polygon are\n"); + msg("the same. If you want to reweight the different parts of an unsplit polygon\n"); + msg("with different weights, then you will need to split that polygon by hand.\n"); + msg("Whatever the case, the output file of pixelized polygons constitutes\n"); + msg("a valid mask with each polygon in only one pixel, and is safe to use.\n"); + msg(".............................................................................\n"); + } + + if(n!=-1){ + /* sort polygons by pixel number */ + poly_sort(n, polys, 'p'); + } + + /* assign new polygon id numbers in place of inherited ids */ + if (fmt.newid == 'n') { + for (i = 0; i < n; i++) { + polys[i]->id = i; + } + } + + if (fmt.newid == 'p') { + for (i = 0; i < n; i++) { + polys[i]->id = polys[i]->pixel; + } + } + + + return(n); +} + +/* + Function pixel_loop takes a list of all of the polygons in the input pixel and then splits + them into the four child pixels of the input pixel. It then recursively calls itself on + each of the child pixels, until the desired level of pixelization is reached. + Inputs: + pix: input pixel number + n = number of polygons. + input = array of pointers to polygons. + out_max = maximum number of output polygons. + Output: + output = array of pointers to polygons. + Return value: number of polygons written to output array, + or -1 if error occurred. +*/ + + +void print_log_pixel(pixel_log *log) +{ + if (log->pixel_loop_level < 4) + { + fprintf(stderr, "Pixelizing: pix=%5d n=%5d level=%3d\r", log->pix, log->n, log->pixel_loop_level); + fflush(stderr); + } +} + +int pixel_loop(pixel_log *log, int pix, int n, polygon *input[/*n*/], int out_max, polygon *output[/*out_max*/]){ + int *child_pix,children; + int i,j,k,m,out,nout; + int ier, iprune, np; + polygon *pixel; + polygon **poly; + pixel_log new_log; + + if (log == 0) + { + new_log.pixel_loop_level = 0; + new_log.base_poly = 0; + new_log.pix = 0; + } + else + { + new_log = *log; + } + + + new_log.pixel_loop_level++; + new_log.n = n; + + //allocate memory for work array of polygon pointers + poly=(polygon **) malloc(sizeof(polygon *) * n); + if(!poly){ + fprintf(stderr, "pixel_loop: failed to allocate memory for %d polygon pointers\n",n); + return(-1); + } + + // allocate memory for child_pix array + if(pix==0 && scheme=='d'){ + child_pix=(int *) malloc(sizeof(int) * 117); + children=117; + if(!child_pix){ + fprintf(stderr, "pixel_loop: failed to allocate memory for 117 integers\n"); + return(-1); + } + } + else{ + child_pix=(int *) malloc(sizeof(int) * 4); + children=4; + if(!child_pix){ + fprintf(stderr, "pixel_loop: failed to allocate memory for %d integers\n", 4); + return(-1); + } + } + + get_child_pixels(pix, child_pix, scheme); + out=0; + + print_log_pixel(&new_log); + for(i=0;i<children;i++){ + /*get the current child pixel*/ + pixel=get_pixel(child_pix[i], scheme); + + if(!pixel){ + fprintf(stderr, "error in pixel_loop: could not get pixel %d\n", child_pix[i]); + return(-1); + } + + /*loop through input polygons to find the ones that overlap with current child pixel*/ + for(j=0;j<n;j++){ + /* skip null polygons */ + if (input[j]->np > 0 && input[j]->cm[0] == 0.){ + poly[j] = 0x0; + continue; + } + + np=input[j]->np+pixel->np; + poly[j]=new_poly(np); + if(!poly[j]){ + fprintf(stderr, "error in pixel_loop: failed to allocate memory for polygon of %d caps\n", np); + return(-1); + } + /*set poly[j] to the intersection of input[j] and current child pixel*/ + poly_poly(input[j],pixel,poly[j]); + poly[j]->pixel=pixel->pixel; + + iprune = prune_poly(poly[j], mtol); + if (iprune == -1) { + fprintf(stderr, "pixelize: failed to prune polygon for pixel %d; continuing ...\n", poly[j]->pixel); + //return(-1); + } + /*if polygon is null, get rid of it*/ + if (iprune >= 2) { + free_poly(poly[j]); + poly[j] = 0x0; + } + } + + /*copy down non-null polygons*/ + k=0; + for(j=0;j<n;j++){ + if(poly[j]){ + poly[k++]=poly[j]; + } + } + m=k; + /*nullify the rest of the array, but don't free, since pointers have been copied above*/ + for(j=m;j<n;j++){ + poly[j]=0x0; + } + + /*if we're below the max resolution, recursively call pixel_loop on the current child pixel */ + if(m>polys_per_pixel && get_res(child_pix[i],scheme)<res_max){ + //printf("calling pixel loop for pixel %d with %d polygons\n",child_pix[i],m); + new_log.base_poly = 0;//out; + new_log.pix = i; + + nout=pixel_loop(&new_log, child_pix[i],m,poly,out_max-out,&output[out]); + if(nout==-1) return(-1); + + new_log.base_poly = 0;//(log == 0) ? 0 : log->base_poly; + new_log.pix = (log == 0) ? 0 : log->pix; + out+=nout; + } + else{ + for(k=0;k<m;k++){ + /* check whether exceeded maximum number of polygons */ + if (out >= out_max) { + fprintf(stderr, "pixel_loop: total number of polygons exceeded maximum %d\n", NPOLYSMAX); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + return(-1); + } + /*make sure output polygon has enough room */ + ier = room_poly(&output[out], poly[k]->np, DNP, 0); + if (ier == -1) { + fprintf(stderr, "error in pixel_loop: failed to allocate memory for polygon of %d caps\n", poly[i]->np + DNP); + return(-1); + } + + /*copy polygon to output array*/ + copy_poly(poly[k],output[out]); + out++; + } + } + /*free up memory for next child pixel*/ + + free_poly(pixel); + for(j=0;j<n;j++){ + free_poly(poly[j]); + } + } + free(child_pix); + free(poly); + return out; +} diff --git a/src/pixelmap.c b/src/pixelmap.c new file mode 100644 index 0000000..c0c0408 --- /dev/null +++ b/src/pixelmap.c @@ -0,0 +1,289 @@ +/*------------------------------------------------------------------------------ +© M E C Swanson 2006 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqm:s:e:v:p:P:i:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int pixelmap(int *npoly, polygon *[*npoly]); +#else +int pixelmap(int *npoly, polygon *[/**npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nadj, nfiles, npoly, npolys, res_max_temp,i; + char scheme_temp; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + /* default is to renumber output polygons with pixel numbers as id numbers */ + fmt.newid = 'p'; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- pixelmap ----------------\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* save res_max as defined on command line rather than using value from file*/ + /* value of scheme in file will override scheme defined on command line */ + res_max_temp=res_max; + scheme_temp=scheme; + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + res_max=res_max_temp; + msg("pixelization scheme %c, making map at resolution %d\n", scheme, res_max); + + if (snapped==0 || balkanized==0) { + fprintf(stderr, "Error: input polygons must be snapped and balkanized before using pixelmap.\n"); + fprintf(stderr, "If your polygons are already snapped and balkanized, add the 'snapped' and\n'balkanized' keywords at the beginning of each of your input polygon files.\n"); + exit(1); + } + + /* pixelmap polygons */ + nadj = pixelmap(&npoly, polys); + if (nadj == -1) exit(1); + + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("pixelmap [-d] [-q] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-P[scheme][<p>][,<r>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Take pixelized polygons, find the average weight within each pixel, and return a set of polygons consisting of the pixels weighted with the average weight. + + Input: poly = array of pointers to polygons. + npoly = pointer to number of polygons. + Output: polys = array of pointers to polygons; + Return value: number of polygons discarded by pixelmapping, + or -1 if error occurred. +*/ +int pixelmap(int *npoly, polygon *poly[/**npoly*/]) +{ + int i, j, nadj, k, kstart,kend,numpix; + int *start; + int *total; + int *parent_pixels; + int begin, end, p,max_pixel,min_pixel, ier, verb,res1,res2; + long double tol,area, tot_area; + long double *av_weight; + long double *av_weight0; + + poly_sort(*npoly,poly,'p'); + min_pixel = poly[0]->pixel; + max_pixel = poly[*npoly-1]->pixel+1; + res1=get_res(min_pixel,scheme); + res2=get_res(max_pixel,scheme); + + if(res1<res_max){ + fprintf(stderr,"pixelmap: there are pixels in the mask with a lower resolution than the desired pixelmap resolution %d. The desired pixelmap resolution can be set with the -P option.\n",res_max); + fprintf(stderr,"Before using pixelmap, use pixelize with the -P0,r option to pixelize the entire mask to the desired resolution r.\n"); + return(-1); + } + + + /* allocate memory for pixel info arrays start and total */ + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "pixelmap: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "pixelmap: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(*npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "pixelmap: error building pixel index lists\n"); + return(-1); + } + + //allocate memory for parent pixels array + parent_pixels = (int *) malloc(sizeof(int) * (res2+1)); + if (!parent_pixels) { + fprintf(stderr, "pixelmap: failed to allocate memory for %d integers\n", res2+1); + return(-1); + } + + //kstart=number of first pixel at desired output resolution + //kend=number of last pixel at desired output resolution + if(res_max==-1){ + kstart=pixel_start(res1,scheme); + kend=pixel_start(res2+1,scheme)-1; + } + else{ + kstart=pixel_start(res_max,scheme); + kend=pixel_start(res_max+1,scheme)-1; + } + av_weight0= (long double *) malloc(sizeof(long double) * (kend-kstart+1) ); + if (!av_weight0) { + fprintf(stderr, "pixelmap: failed to allocate memory for %d integers\n", kend-kstart+1 ); + return(-1); + } + //make av_weight an array indexed by the pixel number + av_weight=av_weight0-kstart; + + //set av_weight array to 0 initially + for(k=kstart;k<=kend;k++){ + av_weight[k]=0; + } + + nadj = 0; + verb=1; + + /*find average weight of polygons within each pixel*/ + for(p=min_pixel;p<max_pixel;p++){ + begin=start[p]; + end=start[p]+total[p]; + ier=get_parent_pixels(p,parent_pixels,scheme); + if(ier) return(-1); + + //set k to the pixel at the desired output resolution, or to the pixel number if using + //existing resolution + + k=(res_max==-1) ? p : parent_pixels[res_max]; + + for (i = begin; i < end; i++) { + if (!poly[i]) continue; + tol=mtol; + ier = garea(poly[i], &tol, verb, &area); + if(ier==1 || ier == -1){ + fprintf(stderr, "error %d in garea in polygon %d\n", ier, poly[i]->id); + continue; + } + + av_weight[k]+=poly[i]->weight * area; + } + } + + //replace polygons in input array with non-zero weight pixels + j=0; + for(k=kstart;k<=kend;k++){ + if(av_weight[k]==0) continue; + free_poly(poly[j]); + poly[j]=get_pixel(k,scheme); + tol=mtol; + ier = garea(poly[j], &tol, verb, &tot_area); + if(ier==1 || ier == -1){ + fprintf(stderr, "pixelmap: error in garea in pixel %d\n",p); + continue; + } + poly[j]->weight=av_weight[k]/tot_area; + j++; + if(j> *npoly ){ + fprintf(stderr,"pixelmap: number of pixels with non-zero weight exceeds number of polygons.\n"); + fprintf(stderr, "Try running unify on your mask to remove zero-weight polygons before using pixelmap.\n"); + } + } + + numpix=j; + + for(j=numpix; j< *npoly; j++){ + free_poly(poly[j]); + poly[j] = 0x0; + nadj++; + } + + *npoly=numpix; + + free(start); + free(total); + free(parent_pixels); + free(av_weight0); + + /* assign new polygon id numbers */ + if (fmt.newid == 'n') { + for (i = 0; i < *npoly; i++) { + poly[i]->id = i; + } + } + + if (fmt.newid == 'p') { + for (i = 0; i < *npoly; i++) { + poly[i]->id = poly[i]->pixel; + } + } + + /* advise */ + msg("pixelmap: %d pixels in map\n", numpix); + + return(nadj); +} diff --git a/src/places.c b/src/places.c new file mode 100644 index 0000000..a9507d7 --- /dev/null +++ b/src/places.c @@ -0,0 +1,19 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Round x to n decimal places. +*/ +long double places(long double x, int n) +{ + int i; + + for (i = 0; i < n; i++) x = x * 10.; + x = rint(x); + for (i = 0; i < n; i++) x = x / 10.; + + return(x); +} diff --git a/src/poly2hpx.c b/src/poly2hpx.c new file mode 100644 index 0000000..17ab8eb --- /dev/null +++ b/src/poly2hpx.c @@ -0,0 +1,286 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <errno.h> +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" +#include "healpix/chealpix.h" + +/* getopt options */ +const char *optstr = "dqu:p:P:Wi:"; + +/* allocate polygons as a global array */ +polygon *poly_global[NPOLYSMAX]; + +/* declared in rdmask */ +extern inputfile file; + +/* local functions */ +void usage(void); +#ifdef GCC +int poly2hpx(long, char *, format *, int npoly, polygon *[npoly]); +#else +int poly2hpx(long, char *, format *, int npoly, polygon *[/*npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys,i; + polygon **poly; + poly=poly_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least two input and one output filename required as arguments */ + if (argc - optind < 3) { + if (optind > 1 || argc - optind >= 1) { + fprintf(stderr, "%s requires at least 3 arguments: polygon_infile, nside, and outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- polyid ----------------\n"); + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 2 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &poly[npoly]); + if (npolys == -1) + exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0) { + msg("WARNING: 'snapped' keyword not found in all input files.\n"); + msg("Polygons should be snapped before performing other mangle operations.\n"); + } + + /* polygon id numbers */ + long nside = strtol(argv[argc - 2], 0, 10); + if (nside == 0 && errno == EINVAL) { + msg("Invalid NSIDE"); + exit(0); + } + npolys = poly2hpx(nside, argv[argc - 1], &fmt, npoly, poly); + if (npolys == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(poly[i]); + } + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("poly2hpx [-d] [-q] [-i<f>] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] [-P[scheme][<p>][,<r>]] [-W] polygon_infile1 [polygon_infile2 ...] nside outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Id numbers of polygons containing az, el positions. + The az, el positions are read from in_filename, + and the results are written to out_filename. + Implemented as interpretive read/write, to permit interactive behaviour. + + Input: in_filename = name of file to read from; + "" or "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + poly = array of pointers to polygons. + npoly = number of polygons in poly array. + Return value: number of lines written, + or -1 if error occurred. +*/ +int poly2hpx(long nside, char *out_filename, format *fmt, int npoly, polygon *poly[/*npoly*/]) +{ +#define AZEL_STR_LEN 32 + char input[] = "input", output[] = "output"; + char *word, *next; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int i, idmax, idmin, idwidth, ird, len, nid, nids, nid0, nid2, np; + int *id; + long double *weight; + long pix, npix; + azel v; + char *out_fn; + FILE *outfile; + int *start; + int *total; + int *parent_pixels; + int p, res, max_pixel, ier; + int old_pct = -1; + float *hpx_map; + + max_pixel= poly[npoly-1]->pixel; + res_max=get_res(max_pixel, scheme); + max_pixel=pixel_start(res_max+1,scheme); + + /* allocate memory for pixel info arrays start and total */ + printf("res_max=%d, max_pixel=%d\n",res_max,max_pixel); + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "poly2hpx: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "poly2hpx: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + parent_pixels = (int *) malloc(sizeof(int) * (res_max+1)); + if (!parent_pixels) { + fprintf(stderr, "poly2hpx: failed to allocate memory for %d integers\n", res_max+1); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "poly2hpx: error building pixel index lists\n"); + return(-1); + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (i = 0; i < npoly; i++) { + if (!poly[i]) continue; + if (poly[i]->id < idmin) idmin = poly[i]->id; + if (poly[i]->id > idmax) idmax = poly[i]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* write header */ + v.az = 0.; + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + len = strlen(az_str); + if (fmt->outunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunit); + sprintf(el_str, "el(%c)", fmt->outunit); + } + + /* interpretive read/write loop */ + np = 0; + nid = 0; + nids = 0; + nid0 = 0; + nid2 = 0; + npix = nside2npix(nside); + hpx_map = (float *) malloc(sizeof(float) * npix); + if (hpx_map == 0) { + fprintf(stderr, "poly2hpx: error allocating healpix map\n"); + return(-1); + } + + for (pix = 0; pix < npix; pix++) { + double phi, theta; + int pct; + + pct = pix*100L/npix; + if (pct != old_pct) { + printf("Progress: %d %%\n", pct); + old_pct = pct; + } + + hpx_map[pix] = 0; + pix2ang_ring(nside, pix, &theta, &phi); + + v.el = 0.5*M_PI - theta; + v.az = phi; + + //find out what pixel the az el point is in at the maximum resolution + p=which_pixel(v.az, v.el, res_max, scheme); + //get the list of all the possible parent pixels + get_parent_pixels(p, parent_pixels, scheme); + + nid=0; + for(res=res_max;res>=0;res--){ + p=parent_pixels[res]; + //if this pixel isn't in the polygon list, go to next parent pixel + if(total[p]==0) + continue; + // id numbers of the polygons containing position az, el + nid = poly_id(total[p], &poly[start[p]], v.az, v.el, &id, &weight); + } + + if(polyid_weight==1) { + for (i = 0; i < nid; i++) { + hpx_map[pix] += weight[i]; + } + } else { + hpx_map[pix] = nid; + } + + /* increment counters of results */ + np++; + nids += nid; + if (nid == 0) { + nid0++; + } else if (nid >= 2) { + nid2++; + } + } + + /* advise */ + if (nid0 > 0) msg("%d points were not inside any polygon\n", nid0); + if (nid2 > 0) msg("%d points were inside >= 2 polygons\n", nid2); + + if (outfile != stdout) { + if(polyid_weight==1){ + msg("polyid: %d weights at %d positions written to %s\n", nids, np, out_fn); + } else { + msg("polyid: %d id numbers at %d positions written to %s\n", nids, np, out_fn); + } + } + + printf("Writing to %s\n", out_filename); + // Clobber the file + unlink(out_filename); + write_healpix_map (hpx_map, nside, out_filename, 0, "E"); + + free(start); + free(total); + free(parent_pixels); + free(hpx_map); + + return(np); +} diff --git a/src/poly2poly.c b/src/poly2poly.c new file mode 100644 index 0000000..7a4ecaf --- /dev/null +++ b/src/poly2poly.c @@ -0,0 +1,275 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include <math.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqm:j:J:k:K:ns:e:v:p:i:o:z:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int intersect_poly(int npoly1, polygon *[npoly1], int npoly2, polygon *[npoly2], long double); +#else +int intersect_poly(int npoly1, polygon *[/*npoly1*/], int npoly2, polygon *[/*npoly2*/], long double); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, ipoly, nfiles, npoly, npolys, i; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + + /* parse arguments */ + parse_args(argc, argv); + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- poly2poly ----------------\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale (&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale (&mtol, munit, 'r'); + munit = 'r'; + } + + /* weight limits */ + if (is_weight_min && is_weight_max) { + /* min <= max */ + if (weight_min <= weight_max) { + msg("will keep only polygons with weights inside [%Lg, %Lg]\n", weight_min, weight_max); + /* min > max */ + } else { + msg("will keep only polygons with weights >= %Lg or <= %Lg\n", weight_min, weight_max); + msg(" (only polygons with weights outside (%Lg, %Lg))\n", weight_max, weight_min); + } + } else if (is_weight_min) { + msg("will keep only polygons with weights >= %Lg\n", weight_min); + } else if (is_weight_max) { + msg("will keep only polygons with weights <= %Lg\n", weight_max); + } + /* area limits */ + if (is_area_min && is_area_max) { + /* min <= max */ + if (area_min < area_max) { + msg("will keep only polygons with areas inside [%Lg, %Lg]\n", area_min, area_max); + /* min > max */ + } else { + msg("will keep only polygons with areas >= %Lg or <= %Lg\n", area_min, area_max); + msg(" (only polygons with areas outside (%Lg, %Lg))\n", area_max, area_min); + } + } else if (is_area_min) { + msg("will keep only polygons with areas >= %Lg\n", area_min); + } else if (is_area_max) { + msg("will keep only polygons with areas <= %Lg\n", area_max); + } + /* id limits */ + if (is_id_min && is_id_max) { + /* min <= max */ + if (id_min < id_max) { + msg("will keep only polygons with ids inside [%d, %d]\n", id_min, id_max); + /* min > max */ + } else { + msg("will keep only polygons with ids >= %d or <= %d\n", id_min, id_max); + msg(" (only polygons with ids outside (%d, %d))\n", id_max, id_min); + } + } else if (is_id_min) { + msg("will keep only polygons with areas >= %d\n", id_min); + } else if (is_id_max) { + msg("will keep only polygons with areas <= %d\n", id_max); + } + /* pixel limits */ + if (is_pixel_min && is_pixel_max) { + /* min <= max */ + if (pixel_min < pixel_max) { + msg("will keep only polygons with pixel numbers inside [%d, %d]\n", pixel_min, pixel_max); + /* min > max */ + } else { + msg("will keep only polygons with pixel numbers >= %d or <= %d\n", pixel_min, pixel_max); + msg(" (only polygons with pixel numbers outside (%d, %d))\n", pixel_max, pixel_min); + } + } else if (is_pixel_min) { + msg("will keep only polygons with pixel numbers >= %d\n", pixel_min); + } else if (is_pixel_max) { + msg("will keep only polygons with pixel numbers <= %d\n", pixel_max); + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + /* intersect polygons of infile1 with those of subsequent infiles */ + if (ifile > optind && intersect) { + npoly = intersect_poly(npoly, polys, npolys, &polys[npoly], mtol); + if (npoly == -1) exit(1); + /* increment number of polygons */ + } else { + npoly += npolys; + } + } + if (nfiles >= 2 && !intersect) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* apply new weight to output polygons */ + if (survey != 0) { + FILE *fw = fopen(survey, "rt"); + double weight_val, prevw = 0; + for (ipoly = 0; ipoly < npoly; ipoly++) { + if (fscanf(fw, "%lg", &weight_val) != 1) + weight_val = prevw; + + polys[ipoly]->weight = weight_val; + } + fclose(fw); + } + + /* apply new id numbers to output polygons */ + if (fmt.newid == 'n') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + polys[ipoly]->id = ipoly; + } + } + + if (fmt.newid == 'p') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + polys[ipoly]->id = polys[ipoly]->pixel; + } + } + + /* write polygons */ + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("poly2poly [-d] [-q] [-m<a>[u]] [-j[<min>][,<max>]] [-J[<min>][,<max>]] [-k[min][,<max>]] [-K[min][,<max>]] [-n] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [-z<weight list>] [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Intersect polygons of poly1 with any polygon(s) of poly2 having the + same id number. + + This subroutine implements the -n option of poly2poly. +*/ +int intersect_poly(int npoly1, polygon *poly1[/*npoly1*/], int npoly2, polygon *poly2[/*npoly2*/], long double mtol) +{ + int ier, inull, iprune, i, j, k, np; + + /* intersect each poly1 with any poly2 having same id number */ + for (i = 0; i < npoly1; i++) { + for (j = 0; j < npoly2; j++) { + if (poly1[i]->id == poly2[j]->id && poly1[i]->pixel == poly2[j]->pixel ) { + /* make sure poly1 contains enough space for intersection */ + np = poly1[i]->np + poly2[j]->np; + ier = room_poly(&poly1[i], np, 0, 1); + if (ier == -1) goto out_of_memory; + + /* intersection of poly1 and poly2 */ + poly_poly(poly1[i], poly2[j], poly1[i]); + } + } + } + + /* free poly2 polygons */ + for (j = 0; j < npoly2; j++) { + free_poly(poly2[j]); + poly2[j] = 0x0; + } + + /* prune poly1 polygons */ + j = 0; + inull = 0; + for (i = 0; i < npoly1; i++) { + iprune = prune_poly(poly1[i], mtol); + if (iprune == -1) { + fprintf(stderr, "intersect_poly: failed to prune polygon %d; continuing ...\n", (fmt.newid == 'o')? poly1[i]->id : j); + } + if (iprune >= 2) { + free_poly(poly1[i]); + poly1[i] = 0x0; + inull++; + } else { + j++; + } + } + + /*copy down non-null polygons*/ + k=0; + for(i = 0; i < npoly1; i++){ + if(poly1[i]){ + poly1[k++]=poly1[i]; + } + } + /*after copying non-null polygons, k should be equal to j */ + if(k!=j){ + fprintf(stderr, "intersect_poly: should be left with %d non-null polygons, but actually have %d\n",j,k); + } + + /*nullify the rest of the array, but don't free, since pointers have been copied above*/ + for(i=j; i < npoly1; i++){ + poly1[i]=0x0; + } + + if (inull > 0) msg("%d intersected polygons have zero area, and are being discarded\n", inull); + npoly1 = j; + + return(npoly1); + + /* ---------------- error returns ---------------- */ + out_of_memory: + fprintf(stderr, "intersect_poly: failed to allocate memory for polygon of %d caps\n", np); + return(-1); +} diff --git a/src/poly_id.c b/src/poly_id.c new file mode 100644 index 0000000..f4ae0c3 --- /dev/null +++ b/src/poly_id.c @@ -0,0 +1,78 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Id numbers of polygons containing position az, el. + + Input: poly = array of pointers to npoly polygons. + npoly = number of polygons in poly array. + az, el = angular position in radians. + Output: id_p = pointer to array containing id numbers of polygons; + the required memory is allocated. + Return value: number of polygons that contain az, el position. +*/ +int poly_id(int npoly, polygon *poly[/*npoly*/], long double az, long double el, int **id_p, long double **weight_p) +{ +/* number of extra polygon id numbers to allocate, to allow for expansion */ +#define DNID 16 + static int nidmax = 0; + static int *id = 0x0; + static long double *weight = 0x0; + + int ipoly, nid; + long double rp[3]; + + /* unit vector corresponding to angular position az, el */ + rp[0] = cosl(el) * cosl(az); + rp[1] = cosl(el) * sinl(az); + rp[2] = sinl(el); + + nid = 0; + + /* keep trying till the id array is big enough */ + do { + /* make sure that allocated id array contain enough space */ + if (!id || nid > nidmax) { + if (id) free(id); + if (weight) free(weight); + id = (int *) malloc(sizeof(int) * (nid + DNID)); + weight = (long double *) malloc(sizeof(long double) * (nid + DNID)); + if (!id) { + fprintf(stderr, "poly_id: failed to allocate memory for %d ints\n", nid + DNID); + return(-1); + } + if (!weight) { + fprintf(stderr, "poly_id: failed to allocate memory for %d long doubles\n", nid + DNID); + return(-1); + } + nidmax = nid + DNID; + } + + nid = 0; + /* do each polygon in turn */ + for (ipoly = 0; ipoly < npoly; ipoly++) { + /* id number of each polygon that contains az, el position */ + if (gptin(poly[ipoly], rp)) { + if (nid < nidmax){ + id[nid] = poly[ipoly]->id; + weight[nid] = poly[ipoly]->weight; + } + nid++; + } + } + + } while (nid > nidmax); + + /* point id_p at id array */ + *id_p = id; + /* point weight_p at weight array */ + *weight_p = weight; + + /* number of polygons containing az, el position */ + return(nid); +} diff --git a/src/poly_sort.c b/src/poly_sort.c new file mode 100644 index 0000000..468105e --- /dev/null +++ b/src/poly_sort.c @@ -0,0 +1,88 @@ +/*------------------------------------------------------------------------------ +© M E C Swanson 2005 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include "manglefn.h" + +/*polygon comparison functions*/ +int poly_cmp_pixel(polygon **poly1, polygon **poly2) +{ + int pixel=(*poly1)->pixel - (*poly2)->pixel; + return(pixel); +} +int poly_cmp_id(polygon **poly1, polygon **poly2) +{ + int id=(*poly1)->id - (*poly2)->id; + return(id); +} +int poly_cmp_weight(polygon **poly1, polygon **poly2) +{ + long double weight=(*poly1)->weight - (*poly2)->weight; + return(weight); +} + +/*polygon sorting function + sorts an array polys of n polygon pointers by either pixel number ('p'), + id number ('i') or weight ('w'). +*/ +void poly_sort(int npoly, polygon *poly[],char key){ + if(key=='p'){ + mysort(poly, npoly, sizeof(polygon *),poly_cmp_pixel); + } + else if(key=='i'){ + mysort(poly, npoly, sizeof(polygon *),poly_cmp_id); + } + else if(key=='w'){ + mysort(poly, npoly, sizeof(polygon *),poly_cmp_weight); + } + else{ + fprintf(stderr,"sort key %c not recognized. Array can't be sorted\n", key); + } + +} + +/* Function pixel_list generates arrays start[] and total[] from a polygon array which has been + sorted by pixel number. + inputs: + npoly: number of polygons in polys + poly[]: array of pointers to polygons (must be sorted by pixel number) + max_pixel: highest allowed pixel number in the polygon array + outputs: + start[k] contains the starting index for the polygons in pixel k + total[k] contains the total number of polygons in pixel k + returns 0 if successful, -1 if there's an error + + */ +int pixel_list(int npoly, polygon *poly[], int max_pixel, int start[], int total[]){ + int i,j,k,k_old; + + /* initialize output arrays */ + + for(i=0;i<max_pixel;i++){ + start[i]=0; + total[i]=0; + } + k_old=-1; + for(j=0;j<npoly;j++){ + k=poly[j]->pixel; + if(k<k_old){ + fprintf(stderr, "Error in pixel_list: polygon array not sorted. Please use poly_sort first.\n"); + return(-1); + } + if(k>max_pixel){ + fprintf(stderr, "Error in pixel_list: polygon %d is in pixel %d > max_pixel %d\n", j, k, max_pixel); + return(-1); + } + + if(k==k_old){ + total[k]++; + } + else if(k>k_old){ + start[k]=j; + total[k]++; + } + k_old=k; + } + return(0); +} + diff --git a/src/polygon.h b/src/polygon.h new file mode 100644 index 0000000..059c7df --- /dev/null +++ b/src/polygon.h @@ -0,0 +1,19 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef POLYGON_H +#define POLYGON_H + +typedef long double vec[3]; + +typedef struct polygon_ { /* polygon structure */ + int np; /* number of caps of polygon */ + int npmax; /* dimension of allocated rp and cm arrays */ + vec *rp; /* pointer to array rp[np][3] of axis coords */ + long double *cm; /* pointer to array cm[np] of 1 - cosl(theta) */ + int id; /* id number of polygon */ + int pixel; /* pixel that polygon is in */ + long double weight; /* weight of polygon */ +} polygon; + +#endif /* POLYGON_H */ diff --git a/src/polyid.c b/src/polyid.c new file mode 100644 index 0000000..fa9a3fd --- /dev/null +++ b/src/polyid.c @@ -0,0 +1,335 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqu:p:P:W0"; + +/* allocate polygons as a global array */ +polygon *poly_global[NPOLYSMAX]; + +/* declared in rdmask */ +extern inputfile file; + +/* local functions */ +void usage(void); +#ifdef GCC +int poly_ids(char *, char *, format *, int npoly, polygon *[npoly]); +#else +int poly_ids(char *, char *, format *, int npoly, polygon *[/*npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys,i; + polygon **poly; + poly=poly_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least two input and one output filename required as arguments */ + if (argc - optind < 3) { + if (optind > 1 || argc - optind >= 1) { + fprintf(stderr, "%s requires at least 3 arguments: polygon_infile, azel_infile, and outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- polyid ----------------\n"); + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 2 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &poly[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0) { + msg("WARNING: 'snapped' keyword not found in all input files.\n"); + msg("Polygons should be snapped before performing other mangle operations.\n"); + } + + /* polygon id numbers */ + npolys = poly_ids(argv[argc - 2], argv[argc - 1], &fmt, npoly, poly); + if (npolys == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(poly[i]); + } + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("polyid [-d] [-q] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] [-P[scheme][<p>][,<r>]] [-W] polygon_infile1 [polygon_infile2 ...] azel_infile outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Id numbers of polygons containing az, el positions. + The az, el positions are read from in_filename, + and the results are written to out_filename. + Implemented as interpretive read/write, to permit interactive behaviour. + + Input: in_filename = name of file to read from; + "" or "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + poly = array of pointers to polygons. + npoly = number of polygons in poly array. + Return value: number of lines written, + or -1 if error occurred. +*/ +int poly_ids(char *in_filename, char *out_filename, format *fmt, int npoly, polygon *poly[/*npoly*/]) +{ +#define AZEL_STR_LEN 32 + char input[] = "input", output[] = "output"; + char *word, *next; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int i, idmax, idmin, idwidth, ird, len, nid, nids, nid0, nid2, np; + int *id; + long double *weight; + azel v; + char *out_fn; + FILE *outfile; + int *start; + int *total; + int *parent_pixels; + int p, res, max_pixel, ier; + char tmp_str[255]; // Bad bad + max_pixel= poly[npoly-1]->pixel; + res_max=get_res(max_pixel, scheme); + max_pixel=pixel_start(res_max+1,scheme); + + /* allocate memory for pixel info arrays start and total */ + sprintf(tmp_str, "res_max=%d, max_pixel=%d\n",res_max,max_pixel); + msg(tmp_str); + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "polyid: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "polyid: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + parent_pixels = (int *) malloc(sizeof(int) * (res_max+1)); + if (!parent_pixels) { + fprintf(stderr, "polyid: failed to allocate memory for %d integers\n", res_max+1); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "poly_ids: error building pixel index lists\n"); + return(-1); + } + + /* open in_filename for reading */ + if (!in_filename || strcmp(in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", in_filename); + return(-1); + } + file.name = in_filename; + } + file.line_number = 0; + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "cannot open %s for writing\n", out_filename); + return(-1); + } + out_fn = out_filename; + } + + /* advise angular units */ + msg("will take units of input az, el angles in %s to be ", file.name); + switch (fmt->inunit) { +#include "angunit.h" + } + msg("\n"); + if (fmt->outunit != fmt->inunit) { + msg("units of output az, el angles will be "); + switch (fmt->outunit) { +#include "angunit.h" + } + msg("\n"); + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (i = 0; i < npoly; i++) { + if (!poly[i]) continue; + if (poly[i]->id < idmin) idmin = poly[i]->id; + if (poly[i]->id > idmax) idmax = poly[i]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* write header */ + v.az = 0.; + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + len = strlen(az_str); + if (fmt->outunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunit); + sprintf(el_str, "el(%c)", fmt->outunit); + } + if (verbose) { + fprintf(outfile, "%*s %*s", len, az_str, len, el_str); + if (npoly > 0){ + if(polyid_weight==1) { + fprintf(outfile, " polygon_weights"); + } + else{ + fprintf(outfile, " polygon_ids"); + } + } + fprintf(outfile, "\n"); + } + + /* interpretive read/write loop */ + np = 0; + nid = 0; + nids = 0; + nid0 = 0; + nid2 = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + + /* read <az> */ + word = file.line; + ird = rdangle(word, &next, fmt->inunit, &v.az); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* read <el> */ + word = next; + ird = rdangle(word, &next, fmt->inunit, &v.el); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* convert az and el from input units to radians */ + scale_azel(&v, fmt->inunit, 'r'); + + //find out what pixel the az el point is in at the maximum resolution + p=which_pixel(v.az, v.el, res_max, scheme); + //get the list of all the possible parent pixels + get_parent_pixels(p, parent_pixels, scheme); + + nid=0; + for(res=res_max;res>=0;res--){ + p=parent_pixels[res]; + //if this pixel isn't in the polygon list, go to next parent pixel + if(total[p]==0) continue; + // id numbers of the polygons containing position az, el + nid = poly_id(total[p], &poly[start[p]], v.az, v.el, &id, &weight); + } + + /* convert az and el from radians to output units */ + scale_azel(&v, 'r', fmt->outunit); + + /* write result */ + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(outfile, "%s %s", az_str, el_str); + for (i = 0; i < nid; i++) { + if(polyid_weight==1){ + fprintf(outfile, " %.18Lg", weight[i]); + } else{ + fprintf(outfile, " %*d", idwidth, id[i]); + } + } + fprintf(outfile, "\n"); + fflush(outfile); + + /* increment counters of results */ + np++; + nids += nid; + if (nid == 0) { + nid0++; + } else if (nid >= 2) { + nid2++; + } + } + + /* advise */ + if (nid0 > 0) msg("%d points were not inside any polygon\n", nid0); + if (nid2 > 0) msg("%d points were inside >= 2 polygons\n", nid2); + + if (outfile != stdout) { + if(polyid_weight==1){ + msg("polyid: %d weights at %d positions written to %s\n", nids, np, out_fn); + } else { + msg("polyid: %d id numbers at %d positions written to %s\n", nids, np, out_fn); + } + } + + free(start); + free(total); + free(parent_pixels); + + return(np); +} diff --git a/src/polysort.h b/src/polysort.h new file mode 100644 index 0000000..8d775b5 --- /dev/null +++ b/src/polysort.h @@ -0,0 +1,22 @@ +/*------------------------------------------------------------------------------ +© M E C Swanson 2008 +------------------------------------------------------------------------------*/ +/* determines which sorting function to use depending on OS */ +#ifndef POLYSORT_H +#define POLYSORT_H + +#ifdef LINUX +#define mysort qsort +#endif +#ifdef SUN +#define mysort qsort +#endif +#ifdef MACOSX +#define mysort mergesort +#endif + +#ifndef mysort +#define mysort qsort +#endif + +#endif /* POLYSORT_H */ diff --git a/src/progress.c b/src/progress.c new file mode 100644 index 0000000..af267ff --- /dev/null +++ b/src/progress.c @@ -0,0 +1,28 @@ +#include <stdio.h> +#include <math.h> +#include "progress.h" + +void progress_start(struct progress_state *state, const char *msg, int N) +{ + state->msg = msg; + state->N = N; + state->old_p = -1; +} + +void progress(struct progress_state *state, int i) +{ + int new_p = (int)floor((float)i/state->N*100); + + if (new_p == state->old_p) + return; + + printf("%s: %d %% \r", state->msg, new_p); + fflush(stdout); + + state->old_p = new_p; +} + +void progress_finish(struct progress_state *state) +{ + printf("\n"); +} diff --git a/src/progress.h b/src/progress.h new file mode 100644 index 0000000..a776d32 --- /dev/null +++ b/src/progress.h @@ -0,0 +1,15 @@ +#ifndef MANGLE_PROGRESS_H +#define MANGLE_PROCESS_H + +struct progress_state +{ + const char *msg; + int N; + int old_p; +}; + +extern void progress_start(struct progress_state *state, const char *msg, int N); +extern void progress(struct progress_state *state, int i); +extern void progress_finish(struct progress_state *state); + +#endif diff --git a/src/prune_poly.c b/src/prune_poly.c new file mode 100644 index 0000000..5177574 --- /dev/null +++ b/src/prune_poly.c @@ -0,0 +1,234 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Remove all superfluous caps from polygon. + + If all you want to do is to stop garea, gspher et al from complaining, + then use trim_poly(), not prune_poly(). + + After suppressing obviously superfluous caps with trim_poly(), + which makes garea et al happy, prune_poly applies garea to detect whether + there are any redundant caps enclosing the entire polygon, in which case it + removes those caps, in addition to removing caps suppressed by trim_poly(). + + Null polygons are replaced with a single null cap. + Note that a polygon with no caps is the whole sphere, not a null polygon. + + Input: poly is a pointer to a polygon. + mtol = initial angular tolerance in radians + within which to merge multiple intersections. + Output: poly with all superfluous caps removed; + the number of caps is changed. + Return value: -1 if error; + 0 if nothing changed; + 1 if something changed; + 2 if nothing changed, and polygon is null; + 3 if polygon was changed to null polygon. +*/ +int prune_poly(polygon *poly, long double mtol) +{ + int i, ier, ip, iret, jp, verb; + long double area, area_tot, cm, tol; + + /* first cut */ + iret = trim_poly(poly); + + /* trim_poly detected null polygon */ + if (iret >= 2) return(iret); + + /* area of intersection */ + tol = mtol; + //if(tol > 0.01) printf("prune_poly: tol = %Lf\n", tol); + verb = 1; + ier = garea(poly, &tol, verb, &area_tot); + if (ier) { + printf("prune_poly: received error message from garea, mtol = %Lf\n", tol); + return(-1); + } + + /* null polygon */ + if (area_tot == 0.) { + poly->rp[0][0] = 0.; + poly->rp[0][1] = 0.; + poly->rp[0][2] = 1.; + poly->cm[0] = 0.; + poly->np = 1; + return(3); + } + + /* test whether suppressing cap changes area or not */ + verb = 0; + for (ip = 0; ip < poly->np; ip++) { + if (poly->cm[ip] >= 2.) continue; /* cap is already superfluous */ + cm = poly->cm[ip]; /* save latitude */ + poly->cm[ip] = 2.; /* suppress cap */ + tol = mtol; + //if(tol > 0.01) printf("prune_poly: tol = %Lf\n", tol); + ier = garea(poly, &tol, verb, &area); /* area sans cap */ + if (ier == -1) { + printf("prune_poly: received error message from garea\n"); + return(-1); + } + if (ier || area != area_tot) { /* cap affects area */ + poly->cm[ip] = cm; /* so restore cap */ + if(ier) printf("prune_poly: omission of a cap caused garea failure, so cap is being restored\n"); + } + } + + /* remove superfluous caps */ + ip = 0; + for (jp = 0; jp < poly->np; jp++) { + /* copy down cap */ + if (poly->cm[jp] < 2.) { + for (i = 0; i < 3; i++) { + poly->rp[ip][i] = poly->rp[jp][i]; + } + poly->cm[ip] = poly->cm[jp]; + ip++; + /* skip superfluous cap */ + } else { + iret = 1; + } + } + poly->np = ip; + + return(iret); +} + +/*------------------------------------------------------------------------------ + Suppress obviously superfluous caps from polygon, + by setting cm = 2 for second of two coincident caps. + In addition, detect null caps (those which contain nothing), + and complementary caps (those which exclude each other, + in which case replace the polygon with a single null cap. + + Two caps are considered coincident if their axes (rp) and latitudes (cm) + are EXACTLY equal. Caps with axes pointing in opposite directions are + not detected. + + Two caps are considered complementary if their axes (rp) are EXACTLY equal, + and their latitudes (cm) are EXACTLY opposing (cm of one is -cm of the other). + Axes pointing in opposite directions are not detected. + + All this makes garea, gspher et al happy, provided that near coincident caps, + including those with axes pointing in opposite directions, have been + modified by `snap' to coincide exactly, with coaligned axes. + + Input: poly is a pointer to a polygon. + Output: poly with obviously superfluous caps suppressed; + the number and order of caps remains unchanged + UNLESS polygon is replaced by null polygon. + Return value: 0 if nothing changed; + 1 if one or more caps were suppressed; + 2 if nothing changed, and polygon is null; + 3 if polygon was changed to null polygon. +*/ +int trim_poly(polygon *poly) +{ + int ip, iret, jp; + + /* initialize return value to no change */ + iret = 0; + + /* check for cap which excludes everything */ + for (jp = 0; jp < poly->np; jp++) { + if (poly->cm[jp] == 0. || poly->cm[jp] <= -2.) { + if (poly->np == 1 /* polygon is already single null cap */ + && poly->rp[0][0] == 0. + && poly->rp[0][1] == 0. + && poly->rp[0][2] == 1. + && poly->cm[0] == 0.) { + return(2); + } else { /* change polygon to single null cap */ + poly->rp[0][0] = 0.; + poly->rp[0][1] = 0.; + poly->rp[0][2] = 1.; + poly->cm[0] = 0.; + poly->np = 1; + return(3); + } + } + } + + /* for each cap jp, check for coincident caps */ + for (jp = 0; jp < poly->np; jp++) { + /* don't check superfluous cap */ + if (poly->cm[jp] >= 2.) continue; + for (ip = jp+1; ip < poly->np; ip++) { + /* don't check superfluous cap */ + if (poly->cm[ip] >= 2.) continue; + /* cap axes coincide */ + if (poly->rp[ip][0] == poly->rp[jp][0] + && poly->rp[ip][1] == poly->rp[jp][1] + && poly->rp[ip][2] == poly->rp[jp][2]) { + /* suppress coincident cap ip */ + if (poly->cm[ip] == poly->cm[jp]) { + poly->cm[ip] = 2.; + iret = 1; + } else if (poly->cm[ip] == - poly->cm[jp]) { + /* complementary cap means polygon is null */ + poly->rp[0][0] = 0.; + poly->rp[0][1] = 0.; + poly->rp[0][2] = 1.; + poly->cm[0] = 0.; + poly->np = 1; + return(3); + } + } + } + } + + return(iret); +} + +/*------------------------------------------------------------------------------ + Suppress obviously superfluous caps from polygon, + by setting cm = 2 for second of two coincident caps. + + Similar to trim_poly(), but does not attempt to detect null or + complementary caps. + + Two caps are considered coincident if their axes (rp) and latitudes (cm) + are EXACTLY equal. Caps with axes pointing in opposite directions are + not detected. + + In general this is not enough to make garea, gspher et al happy. + + Input: poly is a pointer to a polygon. + Output: poly with obviously superfluous caps suppressed; + the number and order of caps remains unchanged. + Return value: 0 if nothing changed; + 1 if one or more caps were suppressed. +*/ +int touch_poly(polygon *poly) +{ + int ip, iret, jp; + + /* initialize return value to no change */ + iret = 0; + + /* for each cap jp, check for coincident caps */ + for (jp = 0; jp < poly->np; jp++) { + /* don't check superfluous cap */ + if (poly->cm[jp] >= 2.) continue; + for (ip = jp+1; ip < poly->np; ip++) { + /* don't check superfluous cap */ + if (poly->cm[ip] >= 2.) continue; + /* cap axes coincide */ + if (poly->rp[ip][0] == poly->rp[jp][0] + && poly->rp[ip][1] == poly->rp[jp][1] + && poly->rp[ip][2] == poly->rp[jp][2]) { + /* suppress coincident cap ip */ + if (poly->cm[ip] == poly->cm[jp]) { + poly->cm[ip] = 2.; + iret = 1; + } + } + } + } + + return(iret); +} diff --git a/src/radian.par b/src/radian.par new file mode 100644 index 0000000..c7de286 --- /dev/null +++ b/src/radian.par @@ -0,0 +1,5 @@ +c----------------------------------------------------------------------- + include 'pi.par' + real*10 RADIAN + parameter (RADIAN=180._10/PI) +c diff --git a/src/ransack.c b/src/ransack.c new file mode 100644 index 0000000..7f39bbe --- /dev/null +++ b/src/ransack.c @@ -0,0 +1,602 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqm:c:r:s:e:u:p:"; + +/* allocate polygons as a global array */ +polygon *poly_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int ransack(char *, format *, int, int npolysmax, polygon *[npolysmax]); +int lasso_poly(polygon **, int npolys, polygon *[npolys], long double, int *); +#else +int ransack(char *, format *, int, int npolysmax, polygon *[/*npolysmax*/]); +int lasso_poly(polygon **, int npolys, polygon *[/*npolys*/], long double, int *); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, np, npoly, npolys,i; + polygon **poly; + poly=poly_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind >= 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile, and outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- ransack ----------------\n"); + + /* advise data format */ + advise_fmt(&fmt); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* warn about seed not being set */ + if (seed_read == 0) { + msg("warning: seed was not set on command line: using default seed %d\n", seed); + } + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &poly[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0 || balkanized==0) { + msg("WARNING: 'snapped' and 'balkanized' keywords not found in all input files.\n"); + msg("Running ransack on polygons that are not snapped and balkanized may give misleading results.\n"); + } + + /* random points in polygons */ + ifile = argc - 1; + np = ransack(argv[ifile], &fmt, npoly, NPOLYSMAX, poly); + if (np == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(poly[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("ransack [-d] [-q] [-c<seed>] [-r<n>] [-m<a>[u]] [-s<n>] [-e<n>] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] [-i<f>[<n>][u]] polygon_infile1 [polygon_infile2 ...] outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Generate random az, el positions within mask defined by poly. + The results are written to out_filename. + + Input: out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + npoly = number of polygons in poly array. + npolysmax = maximum number of polygons in poly array. + poly = array of pointers to polygons. + mtol = initial tolerance angle for multiple intersections. + Return value: number of random points generated, + or -1 if error occurred. +*/ +int ransack(char *out_filename, format *fmt, int npoly, int npolysmax, polygon *poly[/*npolysmax*/]) +{ +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 +/* length of state vector for random number generator */ +#define STATELEN 256 + static char state[STATELEN], stateo[STATELEN]; +#define AZEL_STR_LEN 32 + char output[] = "output"; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int dnp, dnwl, i, idmin, idmax, idwidth, ier, in, inull, ip, ipmin, ipoly, iprune, irandom, lassoed, np, nwl, tries, verb, width, k; + int *dlasso=0x0, *lasso=0x0; + long double area, cmmin, cmi, phi, rpoly, si, tol, w, wcum, x, y, z; + long double *wpoly; + vec rp, xi, yi; + azel v; + char *out_fn; + FILE *outfile; + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "ransack: cannot open %s for writing\n", out_filename); + goto error; + } + out_fn = out_filename; + } + + /* advise angular units */ + if (fmt->outunit != fmt->inunit) { + msg("units of output az, el angles will be "); + switch (fmt->outunit) { +#include "angunit.h" + } + msg("\n"); + } + + /* initialize random number generator used by ransack() */ + initstate(seed, state, STATELEN); + /* initialize random number generator used by ikrand() */ + initstate(seed, stateo, STATELEN); + + /* prune polygons, discarding those with zero weight * area */ + msg("pruning %d polygons ...\n", npoly); + ier = 0; + inull = 0; + np = 0; + for (ipoly = 0; ipoly < npoly; ipoly++) { + /* zero weight polygon */ + if (poly[ipoly]->weight == 0.) { + inull++; + free_poly(poly[ipoly]); + poly[ipoly] = 0x0; + } else { + /* prune polygon */ + iprune = prune_poly(poly[ipoly], mtol); + /* error */ + if (iprune == -1) { + ier++; + free_poly(poly[ipoly]); + poly[ipoly] = 0x0; + fprintf(stderr, "ransack: failed to prune polygon %d; discard it\n", ipoly); + /* goto error; */ + /* zero area polygon */ + } else if (iprune >= 2) { + inull++; + free_poly(poly[ipoly]); + poly[ipoly] = 0x0; + } else { + np++; + } + } + } + /*copy down non-null polygons*/ + k=0; + for(ipoly = 0; ipoly < npoly; ipoly++){ + if(poly[ipoly]){ + poly[k++]=poly[ipoly]; + } + } + /*after copying non-null polygons, k should be equal to np */ + if(k!=np){ + fprintf(stderr, "ransack: should be left with %d non-null polygons, but actually have %d\n",np,k); + } + + /*nullify the rest of the array, but don't free, since pointers have been copied above*/ + for(ipoly=np; ipoly < npoly; ipoly++){ + poly[ipoly]=0x0; + } + + if (ier > 0) { + msg("discarding %d unprunable polygons\n", ier); + } + if (inull > 0) { + msg("discarding %d polygons with zero weight * area\n", inull); + } + /* number of polygons with finite weight * area */ + npoly = np; + + /* no polygons */ + if (npoly == 0) { + fprintf(stderr, "ransack: no polygons to generate random points inside!\n"); + goto error; + } + + /* pre-lasso polygons if there are many random points */ + if (nrandom >= npoly) { + msg("lassoing %d polygons ...\n", npoly); + + /* lasso each polygon */ + np = npoly; + for (ipoly = 0; ipoly < npoly; ipoly++) { + ier = lasso_poly(&poly[ipoly], npolysmax - np, &poly[np], mtol, &dnp); + if (ier == -1) { + fprintf(stderr, "ransack: UHOH at polygon %d; continuing ...\n", poly[ipoly]->id); + } + + /* lassoed polygons are an improvement over original polygon */ + if (dnp > 0) { + /* check whether exceeded maximum number of polygons */ + if (np + dnp > npolysmax) { + fprintf(stderr, "ransack: total number of polygons exceeded maximum %d\n", npolysmax); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + goto error; + } + + /* decrement dnp by 1 */ + dnp--; + + /* increment number of polygons */ + np += dnp; + + /* move last polygon part into poly[ipoly] */ + free_poly(poly[ipoly]); + poly[ipoly] = poly[np]; + poly[np] = 0x0; + } + } + + /* revised number of polygons */ + npoly = np; + + /* flag that all polygons have been lassoed */ + lassoed = 1; + + /* two few random points to make it worth pre-lassoing */ + } else { + /* flag that all polygons have not been lassoed */ + lassoed = 0; + + } + + /* allocate memory for wpoly array */ + nwl = npoly; + wpoly = (long double *) malloc(sizeof(long double) * nwl); + if (!wpoly) { + fprintf(stderr, "ransack: failed to allocate memory for %d long doubles\n", nwl); + goto error; + } + if (!lassoed) { + /* allocate memory for lasso and dlasso arrays */ + lasso = (int *) malloc(sizeof(int) * nwl); + if (!lasso) { + fprintf(stderr, "ransack: failed to allocate memory for %d ints\n", nwl); + goto error; + } + dlasso = (int *) malloc(sizeof(int) * nwl); + if (!dlasso) { + fprintf(stderr, "ransack: failed to allocate memory for %d ints\n", nwl); + goto error; + } + + /* initialize dlasso array to zero */ + for (ipoly = 0; ipoly < nwl; ipoly++) dlasso[ipoly] = 0; + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (ipoly = 0; ipoly < npoly; ipoly++) { + if (poly[ipoly]->id < idmin) idmin = poly[ipoly]->id; + if (poly[ipoly]->id > idmax) idmax = poly[ipoly]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* write header */ + wrangle(0., fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + width = strlen(az_str); + if (fmt->outunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunit); + sprintf(el_str, "el(%c)", fmt->outunit); + } + fprintf(outfile, "%*s\t%*s\t%*s\n", width, az_str, width, el_str, idwidth, "id"); + + /* accept error messages from garea */ + /* unprunable polygons were already discarded, so garea should give no errors */ + verb = 1; + + /* cumulative area times weight of polygons */ + w = 0.; + for (ipoly = 0; ipoly < npoly; ipoly++) { + /* skip null polygons */ + if (poly[ipoly]) { + /* area of polygon */ + tol = mtol; + ier = garea(poly[ipoly], &tol, verb, &area); + if (ier) goto error; + /* accumulate weight times area */ + w += poly[ipoly]->weight * area; + } + wpoly[ipoly] = w; + } + wcum = w; + + /* random points */ + if (strcmp(out_fn, output) != 0) { + msg("generating %d random points from seed %u in %d polygons ...\n", nrandom, seed, npoly); + } + for (irandom = 0; irandom < nrandom; irandom++) { + + /* random number in interval [0, 1) wcum */ + setstate(state); + rpoly = drandom() * wcum; + setstate(stateo); + + /* which polygon to put random point in */ + ipoly = search(npoly, wpoly, rpoly); + + /* guard against roundoff */ + if (ipoly >= npoly) { + fprintf(stderr, "ransack: %d should be < %d (i.e. %.15Lg < %.15Lg)\n", ipoly, npoly, rpoly, wpoly[npoly - 1]); + ipoly = npoly - 1; + } + + /* all polygons have not been lassoed */ + if (!lassoed) { + + /* polygon has not yet been lassoed */ + if (dlasso[ipoly] == 0) { + + /* lasso polygon */ + ier = lasso_poly(&poly[ipoly], npolysmax - np, &poly[np], mtol, &dnp); + if (ier == -1) { + fprintf(stderr, "ransack: UHOH at polygon %d; continuing ...\n", poly[ipoly]->id); + } + + /* go with original polygon */ + if (dnp == 0) { + /* lasso, dlasso */ + lasso[ipoly] = ipoly; + dlasso[ipoly] = 1; + + /* lassoed polygons are an improvement over original */ + } else { + /* check whether exceeded maximum number of polygons */ + if (np + dnp > npolysmax) { + fprintf(stderr, "ransack: total number of polygons exceeded maximum %d\n", npolysmax); + fprintf(stderr, "if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + goto error; + } + + /* just one lassoed polygon */ + if (dnp == 1) { + /* move last polygon part into poly[ipoly] */ + free_poly(poly[ipoly]); + poly[ipoly] = poly[np]; + poly[np] = 0x0; + + /* lasso, dlasso */ + lasso[ipoly] = ipoly; + dlasso[ipoly] = 1; + + /* more than one lassoed polygon */ + } else { + /* enlarge memory for wpoly, lasso, and dlasso arrays */ + if (np + dnp > nwl) { + dnwl = dnp + 1024; + wpoly = (long double *) realloc(wpoly, sizeof(long double) * (nwl + dnwl)); + if (!wpoly) { + fprintf(stderr, "ransack: failed to reallocate memory for %d long doubles\n", nwl + dnwl); + goto error; + } + lasso = (int *) realloc(lasso, sizeof(int) * (nwl + dnwl)); + if (!lasso) { + fprintf(stderr, "ransack: failed to reallocate memory for %d ints\n", nwl + dnwl); + goto error; + } + dlasso = (int *) realloc(dlasso, sizeof(int) * (nwl + dnwl)); + if (!dlasso) { + fprintf(stderr, "ransack: failed to reallocate memory for %d ints\n", nwl + dnwl); + goto error; + } + + /* initialize new part of lasso and dlasso arrays to inconsistent values */ + for (ipoly = nwl; ipoly < nwl + dnwl; ipoly++) lasso[ipoly] = 1; + for (ipoly = nwl; ipoly < nwl + dnwl; ipoly++) dlasso[ipoly] = 0; + + /* revised size of wpoly, lasso, and dlasso arrays */ + nwl += dnwl; + } + + /* lasso, dlasso */ + lasso[ipoly] = np; + dlasso[ipoly] = dnp; + + /* cumulative weight times area of lassoed polygons */ + w = (ipoly == 0)? 0. : wpoly[ipoly-1]; + for (ip = np; ip < np + dnp; ip++) { + /* area of polygon */ + tol = mtol; + ier = garea(poly[ip], &tol, verb, &area); + if (ier) goto error; + /* accumulate area times weight */ + w += poly[ip]->weight * area; + wpoly[ip] = w; + } + + /* increment number of polygons */ + np += dnp; + } + + } + + } + + /* polygon was partitioned into at least two */ + if (dlasso[ipoly] >= 2) { + /* which polygon to put random point in */ + ip = search(dlasso[ipoly], &wpoly[lasso[ipoly]], rpoly); + + /* guard against roundoff */ + if (ip >= lasso[ipoly] + dlasso[ipoly]) { + fprintf(stderr, "ransack: %d should be < %d (i.e. %.15Lg < %.15Lg)\n", ip, lasso[ipoly] + dlasso[ipoly], rpoly, wpoly[lasso[ipoly] + dlasso[ipoly] - 1]); + ip = lasso[ipoly] + dlasso[ipoly] - 1; + } + + /* revised polygon number to put random point in */ + ipoly = ip; + } + } + + /* smallest cap of polygon */ + cmminf(poly[ipoly], &ipmin, &cmmin); + + /* random point within polygon */ + tries = 0; + do { + tries++; + /* random point within smallest cap */ + setstate(state); + phi = TWOPI * drandom(); + cmi = cmmin * drandom(); + setstate(stateo); + /* coordinates of random point in cap frame */ + si=sqrtl(cmi * (2. - cmi)); + x = si * cosl(phi); + y = si * sinl(phi); + z = 1. - cmi; + /* polygon has caps */ + if (poly[ipoly]->np > 0) { + if (poly[ipoly]->cm[ipmin] < 0.) z = -z; + /* Cartesian axes with z-axis along cap axis */ + gaxisi_(poly[ipoly]->rp[ipmin], xi, yi); + /* coordinates of random point */ + for (i = 0; i < 3; i++) rp[i] = x * xi[i] + y * yi[i] + z * poly[ipoly]->rp[ipmin][i]; + /* whether random point is inside polygon */ + in = gptin(poly[ipoly], rp); + /* polygon has no caps, so is the whole sphere */ + } else { + rp[0] = x; + rp[1] = y; + rp[2] = z; + in = 1; + } + } while (!in); + + /* convert unit vector to az, el */ + rp_to_azel(rp, &v); + v.az -= floorl(v.az / TWOPI) * TWOPI; + + /* convert az and el from radians to output units */ + scale_azel(&v, 'r', fmt->outunit); + + /* write result */ + wrangle(v.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(outfile, "%s\t%s\t%*d\n", az_str, el_str, idwidth, poly[ipoly]->id); + /* fprintf(outfile, "%s %s %d %d %d %Lg %Lg %Lg %Lg %d %d\n", az_str, el_str, irandom, ipoly, tries, wcum, rpoly / wcum, area, TWOPI * cmmin / area, ipmin, poly[ipoly]->np); */ + + } + + /* advise */ + if (outfile != stdout) { + msg("ransack: %d random positions written to %s\n", nrandom, out_fn); + } + + return(nrandom); + + /* error returns */ + error: + return(-1); +} + +/*------------------------------------------------------------------------------ + Lasso polygon, + keeping the lassoed parts only if the sum of the areas of lassos is + sufficiently less than the area of the tightest cap of the original polygon. + + Output: *np = number of lassoed parts; + = 0 to retain original polygon. + Return value: same as partition_poly: + -1 if error occurred; + 0 ok; + 1 if *poly was only partially partioned. +*/ +int lasso_poly(polygon **poly, int npolys, polygon *polys[/*npolys*/], long double mtol, int *np) +{ +/* part_poly should lasso all one-boundary polygons */ +#define ALL_ONEBOUNDARY 2 +/* how part_poly should tighten lasso */ +#define ADJUST_LASSO 2 +/* part_poly should not force polygon to be split even if no part can be lassoed */ +#define FORCE_SPLIT 0 +/* partition_poly should never overwrite original polygons */ +#define OVERWRITE_ORIGINAL 0 + int ier, ip, ipmin; + long double cmmin, cmmino, cmmint; + + /* area/(2 pi) of smallest cap of polygon */ + cmminf(*poly, &ipmin, &cmmino); + + /* lasso polygon */ + ier = partition_poly(poly, npolys, polys, mtol, ALL_ONEBOUNDARY, ADJUST_LASSO, FORCE_SPLIT, OVERWRITE_ORIGINAL, np); + + /* polygon was successfully lassoed */ + if (ier == 0) { + if (*np > 0) { + /* not enough polygons */ + if (*np > npolys) return(0); + + /* area/(2 pi) of combined smallest caps of lassoed polygon */ + cmmint = 0.; + for (ip = 0; ip < *np; ip++) { + cmminf(polys[ip], &ipmin, &cmmin); + cmmint += cmmin; + } + + /* lassoed polygons are a genuine improvement */ + if ((*np == 1 && cmmint < cmmino) || cmmint <= .9 * cmmino) { + + /* lassoed polygons are too large to bother with */ + } else { + *np = 0; + + } + } + + } else { + *np = 0; + } + + return(ier); +} diff --git a/src/rasterize.c b/src/rasterize.c new file mode 100644 index 0000000..086f2fb --- /dev/null +++ b/src/rasterize.c @@ -0,0 +1,374 @@ +/*-------------------------------------------------------------------- +(C) J C Hill 2006 +--------------------------------------------------------------------*/ +#include <stdio.h> +#include <string.h> +#include <unistd.h> +#include <math.h> +#include <stdlib.h> +#include "pi.h" +#include "manglefn.h" +#include "defaults.h" +#include "progress.h" + +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + +/* getopt options */ +const char *optstr = "dqa:b:t:y:m:s:e:p:i:o:H"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int rasterize(int nhealpix_poly, int npoly, polygon *[npoly], int nweights, long double [nweights]); +#else +int rasterize(int nhealpix_poly, int npoly, polygon *[/*npoly*/], int nweights, long double [/*nweights*/]); +#endif + +/*-------------------------------------------------------------------- + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys, nhealpix_poly, nhealpix_polys, j, k, nweights, nweight; + long double *weights; + + polygon **polys; + polys=polys_global; + + /* default output format */ + //fmt.out = keywords[HEALPIX_WEIGHT]; + fmt.out = keywords[POLYGON]; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least two input and one output filenames required as arguments */ + if (argc - optind < 3) { + if (optind > 1 || argc - optind == 1 || argc - optind == 2) { + fprintf(stderr, "%s requires at least 3 arguments: polygon_infile1, polygon_infile2, and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- rasterize ----------------\n"); + + /* snap angles */ + scale(&axtol, axunit, 's'); + scale(&btol, bunit, 's'); + scale(&thtol, thunit, 's'); + axunit = 's'; + bunit = 's'; + thunit = 's'; + msg("snap angles: axis %Lg%c latitude %Lg%c edge %Lg%c\n", axtol, axunit, btol, bunit, thtol, thunit); + scale(&axtol, axunit, 'r'); + scale(&btol, bunit, 'r'); + scale(&thtol, thunit, 'r'); + axunit = 'r'; + bunit = 'r'; + thunit = 'r'; + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons from polygon_infile1 (healpix pixels, or some other 'rasterizer' pixels) */ + /* the id numbers of these polygons should match the pixel numbers of this pixelization scheme; + for example, if you are using HEALPix, the id numbers should match the HEALPix pixel numbers + in the NESTED scheme */ + nhealpix_poly = 0; + ifile = optind; + nhealpix_polys = rdmask(argv[ifile], &fmt, NPOLYSMAX - nhealpix_poly, &polys[nhealpix_poly]); + if (nhealpix_polys == -1) exit(1); + nhealpix_poly += nhealpix_polys; + + if (nhealpix_poly == 0) { + msg("STOP\n"); + exit(0); + } + + /* Input rasterizer polygons need not be balkanized if they are non-overlapping by construction, + which is the case for the HEALPix polygons. This is a special case - all other mangle functions + that require balkanization require all input files to be balkanized. To avoid getting an error + here, increment the 'balkanized' counter here if the rasterizer polygons are not balkanized. */ + if (balkanized == 0) { + balkanized++; + } + + /* set nweights equal to maximum id number in rasterizer file */ + nweights = 0; + for (k = 0; k < nhealpix_poly; k++) { + if (polys[k]->id >= nweights) nweights = polys[k]->id+1; + } + + /* read polygons from polygon_infile2, polygon_infile3, etc. */ + npoly = nhealpix_poly; + nfiles = argc - 2 - optind; + for (ifile = optind + 1; ifile < optind + 1 + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read from mask files\n", npoly-nhealpix_poly); + } + if (npoly-nhealpix_poly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0 || balkanized==0) { + fprintf(stderr, "Error: input polygons must be snapped and balkanized before rasterization.\n"); + fprintf(stderr, "If your polygons are already snapped and balkanized, add the 'snapped' and\n'balkanized' keywords at the beginning of each of your input polygon files.\n"); + exit(1); + } + + + /* allocate memory for weights array */ + weights = (long double *) malloc(sizeof(long double) * (nweights)); + if (!weights) { + fprintf(stderr, "rasterize: failed to allocate memory for %d long doubles\n", nweights); + exit(1); + } + + /* initialize weights array to 0 */ + for (k = 0; k < nweights; k++) weights[k] = 0.; + + /* rasterize */ + nweight = rasterize(nhealpix_poly, npoly, polys, nweights, weights); + if (nweight == -1) exit(1); + + /* copy new weights to original rasterizer polygons */ + printf("RAST: copy weights\n"); + for (k = 0; k < nhealpix_poly; k++) { + int id = polys[k]->id - 1; + if (id >= nweights) + continue; + polys[k]->weight = weights[id]; + } + + + ifile = argc - 1; + printf("RAST: save weights\n"); + if (strcmp(fmt.out, "healpix_weight") == 0) { + nweight = wr_healpix_weight(argv[ifile], &fmt, nweights, weights); + if (nweight == -1) exit(1); + } + else { + nweight = wrmask(argv[ifile], &fmt, nhealpix_poly, polys); + if (nweight == -1) exit(1); + } + + /* free array */ + for(k = 0; k < npoly; k++){ + free_poly(polys[k]); + } + + return(0); + +} + +/*------------------------------------------------------------------------- +*/ +void usage(void) +{ + printf("usage:\n"); + printf("rasterize [-d] [-q] [-a<a>[u]] [-b<a>[u]] [-t<a>[u]] [-y<r>] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn] [-p[+|-][<n>]] [-i<f>[<n>][u]] [-o<f>[u]] [-H] polygon_infile1 polygon_infile2 [polygon_infile3 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------- +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------- + Rasterize a mask of input polygons against a mask of rasterizer polygons. + + Input: nhealpix_poly = number of rasterizer polygons. + npoly = total number of polygons in input array. + polys = array of pointers to polygons. + nweights = number of weights in output array. + Output: weights = array of rasterizer weights. + Return value: number of weights in array, + or -1 if error occurred. +*/ + +int rasterize(int nhealpix_poly, int npoly, polygon *polys[/*npoly*/], int nweights, long double weights[/*nweights*/]) +{ + int min_pixel, max_pixel, ier, ier_h, ier_i, i, j, ipix, ipoly, begin_r, end_r, begin_m, end_m, verb, np, iprune; + int *start_r, *start_m, *total_r, *total_m; + long double *areas, area_h, area_i, tol; + struct progress_state pstate; + + static polygon *polyint = 0x0; + + /* make sure weights are all zero for rasterizer pixels */ + for (i = 0; i < nhealpix_poly; i++) { + polys[i]->weight = 0.; + } + + /* allocate memory for rasterizer areas array */ + areas = (long double *) malloc(sizeof(long double) * (nweights)); + if (!areas) { + fprintf(stderr, "rasterize: failed to allocate memory for %d long doubles\n", nweights); + exit(1); + } + + /* initialize rasterizer areas array to 0 */ + for (i = 0; i < nweights; i++) areas[i] = 0.; + + /* allow error messages from garea */ + verb = 1; + + /* find areas of rasterizer pixels for later use */ + progress_start(&pstate, "RAST", nhealpix_poly); + for (j = 0; j < nhealpix_poly; j++) { + int id; + + progress(&pstate, i); + id = polys[j]->id; + if (id > nweights) + continue; + tol = mtol; + ier_h=0; + ier_h = garea(polys[j], &tol, verb, &area_h); + if (ier_h == 1) { + fprintf(stderr, "fatal error in garea\n"); + exit(1); + } + if (ier_h == -1) { + fprintf(stderr, "failed to allocate memory in garea\n"); + exit(1); + } + areas[id-1] += area_h; + } + progress_finish(&pstate); + + /* sort arrays by pixel number */ + printf("\nRAST: Sort by pixel number\n"); + poly_sort(nhealpix_poly, polys, 'p'); + poly_sort(npoly-nhealpix_poly, &(polys[nhealpix_poly]), 'p'); + + /* allocate memory for pixel info arrays start_r, start_m, total_r, and total_m */ + min_pixel = polys[0]->pixel; + max_pixel = (polys[nhealpix_poly-1]->pixel+1>polys[npoly-1]->pixel+1)?(polys[nhealpix_poly-1]->pixel+1):(polys[npoly-1]->pixel+1); + start_r = (int *) malloc(sizeof(int) * max_pixel); + if (!start_r) { + fprintf(stderr, "rasterize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + start_m = (int *) malloc(sizeof(int) * max_pixel); + if (!start_m) { + fprintf(stderr, "rasterize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total_r = (int *) malloc(sizeof(int) * max_pixel); + if (!total_r) { + fprintf(stderr, "rasterize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total_m = (int *) malloc(sizeof(int) * max_pixel); + if (!total_m) { + fprintf(stderr, "rasterize: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* build lists of starting indices of each pixel and total number of polygons in each pixel */ + ier = pixel_list(nhealpix_poly, polys, max_pixel, start_r, total_r); + if (ier == -1) { + fprintf(stderr, "rasterize: error building pixel index lists for rasterizer polygons\n"); + return(-1); + } + + ier = pixel_list(npoly-nhealpix_poly, &(polys[nhealpix_poly]), max_pixel, start_m, total_m); + if (ier == -1) { + fprintf(stderr, "rasterize: error building pixel index lists for input mask polygons\n"); + return(-1); + } + + /* correction due to the start_m array's offset */ + for (i = min_pixel; i < max_pixel; i++) { + start_m[i] += nhealpix_poly; + } + + /* compute intersection of each input mask polygon with each rasterizer polygon */ + printf("RAST: Compute intersection\n"); + progress_start(&pstate, "RAST", max_pixel); + for (ipix = min_pixel; ipix < max_pixel; ipix++) { + progress(&pstate, ipix); + begin_r = start_r[ipix]; + end_r = start_r[ipix] + total_r[ipix]; + begin_m = start_m[ipix]; + end_m = start_m[ipix] + total_m[ipix]; + + for (ipoly = begin_m; ipoly < end_m; ipoly++) { + /* disregard any null polygons */ + if (!polys[ipoly]) continue; + + for (i = begin_r; i < end_r; i++) { + + /* make sure polyint contains enough space for intersection */ + np = polys[ipoly]->np + polys[i]->np; + ier = room_poly(&polyint, np, DNP, 0); + if (ier == -1) goto out_of_memory; + + poly_poly(polys[ipoly], polys[i], polyint); + + /* suppress coincident boundaries, to make garea happy */ + iprune = trim_poly(polyint); + + /* intersection of polys[ipoly] and polys[i] is null polygon */ + if (iprune >= 2) area_i = 0.; + + else { + tol = mtol; + ier_i = garea(polyint, &tol, verb, &area_i); + if (ier_i == 1) { + fprintf(stderr, "fatal error in garea\n"); + return(-1); + } + if (ier_i == -1) { + fprintf(stderr, "failed to allocate memory in garea\n"); + return(-1); + } + } + + weights[(polys[i]->id)-1] += (area_i)*(polys[ipoly]->weight); + } + } + } + progress_finish(&pstate); + + for (i=0; i<nweights; i++) { + if(areas[i]!=0){ + weights[i] = weights[i]/areas[i]; + } + else{ + weights[i]=0; + fprintf(stderr,"WARNING: rasterize: area of rasterizer polygon %d is zero. Assigning zero weight.\n",i); + } + } + + return(i+1); + + /* ----- error return ----- */ + out_of_memory: + fprintf(stderr, "rasterize: failed to allocate memory for polygon of %d caps\n", np + DNP); + return(-1); + +} diff --git a/src/rdangle.c b/src/rdangle.c new file mode 100644 index 0000000..3f3536a --- /dev/null +++ b/src/rdangle.c @@ -0,0 +1,64 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Read angle from word. + + Input: word = pointer to string. + unit = units of angle; + this is needed to detect 'h' unit [hms(RA) & dms(Dec)], + not to change the units of the angle, which is unchanged. + Output: *next = pointer to character immediately after word; + *next may be the same pointer as word. + angle = angle. + Return value: 1 = ok, + otherwise error. +*/ +int rdangle(char *word, char **next, char unit, long double *angle) +{ + const char *blank = " \t\n\r"; + const char *number = "+-.0123456789eE"; + + int i, ird, sgn; + unsigned int deg, min; + long double sec; + char *ch; + + /* find first non-blank character */ + ch = word; + while (*ch && strchr(blank, *ch)) ch++; + if (!*ch) return(0); + + /* units are hours, minutes, seconds (Right Ascension) + and degrees, minutes, seconds (Declination) */ + if (unit == 'h') { + sgn = 1; + if (*ch == '-') { + sgn = -1; + ch++; + } + ird = sscanf(ch, "%d %d %Lf", °, &min, &sec); + *angle = sgn * ((sec/60. + min)/60. + deg); + for (i = 0; i < ird; i++) { + while (*ch && strchr(blank, *ch)) ch++; + while (*ch && strchr(number, *ch)) ch++; + } + if (ird == 3) { + ird = 1; + } else { + ird = 0; + } + } else { + ird = sscanf(ch, "%Lf", angle); + while (*ch && strchr(number, *ch)) ch++; + } + + /* point next at character after word */ + *next = ch; + + return(ird); +} diff --git a/src/rdline.c b/src/rdline.c new file mode 100644 index 0000000..3b37f56 --- /dev/null +++ b/src/rdline.c @@ -0,0 +1,70 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "inputfile.h" + +/*------------------------------------------------------------------------------ + Read line into buffer, expanding memory as needed. + + Input: file = pointer to inputfile structure. + Return value: 1 = ok; + 0 = EOF; + -1 = error. +*/ +int rdline(inputfile *file) +{ +#define BUFSIZE0 64 +#define WHERE fprintf(stderr, "rdline: at line %d of %s:", file->line_number, file->name) + char *line_new; + + /* adjust bufsize to desired number of characters to read */ + if (file->end > 0 && file->bufsize != file->end + 1) { + if (file->line) free(file->line); + file->line = 0x0; + file->bufsize = file->end + 1; + } + + /* allocate memory for line buffer */ + if (!file->line) { + if (file->bufsize <= 0) file->bufsize = BUFSIZE0; + file->line = (char *) malloc(sizeof(char) * file->bufsize); + if (!file->line) { + WHERE; + fprintf(stderr, " line too long (%zd characters)\n", file->bufsize); + return(-1); + } + } + + /* read line of data */ + if (!fgets(file->line, file->bufsize, file->file)) return(0); + + /* increment line number */ + file->line_number++; + + /* expand memory for line buffer if necessary */ + if (file->end == 0) { + while (file->line[strlen(file->line) - 1] != '\n') { + file->bufsize *= 2; + line_new = (char *) malloc(sizeof(char) * file->bufsize); + if (!line_new) { + WHERE; + fprintf(stderr, " line too long (%zd characters)\n", file->bufsize); + return(-1); + } + strncpy(line_new, file->line, file->bufsize/2 - 1); + free(file->line); + file->line = line_new; + if (!fgets(file->line + file->bufsize/2 - 1, file->bufsize/2 + 1, file->file)) { + WHERE; + fprintf(stderr, " missing newline at EOF\n"); + return(0); + } + } + } + + /* success */ + return(1); +} diff --git a/src/rdmask.c b/src/rdmask.c new file mode 100644 index 0000000..df9c7a5 --- /dev/null +++ b/src/rdmask.c @@ -0,0 +1,1441 @@ +/*------------------------------------------------------------------------------ + (C)A J S Hamilton 2001 + ------------------------------------------------------------------------------*/ +/*------------------------------------------------------------------------------ +This subroutine recognizes the following formats: + +<keyword> <id> ( <int> caps, <long double> weight ... + +polygon +------- +polygon <id> ( <n> caps, <long double> weight): +<rp_00> <rp_10> <rp_20> <cm_0> +<rp_01> <rp_11> <rp_21> <cm_1> +... +<rp_0n> <rp_1n> <rp_2n> <cm_n> +Each rp_i is a unit vector defining the north polar axis of the cap, +while cm = 1 - cosl(theta) defines the cap latitude, theta being the polar angle. +Positive cm designates the region north of the latitude, +while negative cm designates the region south of the latitude. + +circle +------ +<az_0> <el_0> <th_0> ... <az_n> <el_n> <th_n> +Each circle is defined by the azimuth and elevation of its axis, +and by the angular radius, the polar angle theta, of the circle about that axis. + +vertices +-------- +<az_0> <el_0> <az_1> <el_1> ... <az_n> <el_n> +Each vertex is defined by an azimuth and an elevation, +and they are joined by great circles. +The vertices wind right-handedly about the enclosed region, as in + 3 0 + 2 1 + <- az <- +with elevation increasing upward, and azimuth increasing to the LEFT +(as it does when you look at the sky with the north pole at zenith). +A rectangle would join the vertices 0 to 3 above as + 0 azmin 1 elmin 2 azmax 3 elmax 0 +There MUST be at least 3 vertices: a polygon bounded by 1 vertex +is ill-defined, and a polygon bounded by 2 vertices is null. +The interior angle at each vertex MUST be <= 180 deg (convex). + +edges +----- +<az_0> <el_0> <az_1> <el_1> ... <az_n> <el_n> +This is like vertices, but with the addition of one or more points on each edge. +The vertices and edge-points wind right-handedly about the polygon, as in + 0 + 5 1 + 4 3 2 + <- az <- +with elevation increasing upward, and azimuth increasing to the LEFT +(as it does when you look at the sky with the north pole at zenith). + +rectangle +--------- +<azmin_0> <azmax_0> <elmin_0> <elmax_0> ... <azmin_n> <azmax_n> <elmin_n> <elmax_n> +Each rectangle is bounded by a minimum and maximum azimuth and elevation. +The azimuthal extent of the rectangle MUST NOT exceed 180 deg. + +healpix_weight +-------------- +<weight> +Simply a list of the weight of each HEALPix pixel at some resolution (i.e., nside); we read in +these weights and tack them onto the correct HEALPix polygon. +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "inputfile.h" +#include "manglefn.h" +#include "rwbinpoly.h" + +#define WHERE fprintf(stderr, "rdmask: at line %d of %s:", file.line_number, file.name) + +inputfile file = { + '\0', /* input name */ + 0x0, /* input file stream */ + '\0', /* line buffer */ + 512, /* size of line buffer (will expand as necessary) */ + 0, /* line number */ + 0 /* maximum number of characters to read (0 = no limit) */ +}; + +static int blankline = 0; /* blank lines encountered where numbers expected */ + +/* dictionary of keywords */ +extern char *keywords[]; + +/* min, max weights to keep (only used here in healpix_weight; other formats + discard these unwanted polygons in wrmask.c) */ +extern int is_weight_min, is_weight_max; + +/* min, max areas to keep (only used here in healpix_weight; other formats + discard these unwanted polygons in wrmask.c) */ +extern int is_area_min, is_area_max; + +/* global pixelization variables */ +extern int res_max; +extern char scheme; +extern int pixelized; +extern int snapped; +extern int balkanized; + +/* counter for input files*/ +extern int infiles; + +/* local functions */ +char *get_keyword(char *, char **, format *); +int new_fmt(char *, char **, format *); +char *get_word(char *, const char *, int, size_t *); +int get_n(format *, char *); +int get_nang(format *fmt, char *, int); +polygon *get_text_poly(format *); +polygon *rd_poly(format *, inputfile *); +polygon *rd_hpix(format *, inputfile *); +polygon *rd_circ(format *, inputfile *); +polygon *rd_edge(format *, inputfile *); +polygon *rd_rect(format *, inputfile *); +int process_next_entry_text(format *fmt, inputfile *thisfile, polygon **poly); +int process_next_entry_binary(format *fmt, inputfile *thisfile, polygon **poly); +int process_next_entry_healpix(format *fmt, inputfile *thisfile, polygon **poly); + + +int process_next_entry_text(format *fmt, inputfile *thisfile, polygon **poly) +{ + format in_fmt; + int ird; + char *line_rest, *word; + + *poly = 0; + + /* store original contents of fmt */ + copy_format(fmt, &in_fmt); + + /* read line of data */ + ird = rdline(thisfile); + /* serious error */ + if (ird == -1) goto error; + /* EOF */ + if (ird == 0) return 0; + + /* look for keyword as first word in line */ + word = get_keyword(thisfile->line, &line_rest, fmt); + /* initialize to new format */ + if (word) ird = new_fmt(word, &line_rest, fmt); + if (ird == -1) goto error; + + /* read polygon */ + if ((word && fmt->single) || (!word && !fmt->single)) { + *poly = get_text_poly(fmt); + } + + return 1; + +error: + + /* restore format as it was on input */ + copy_format(&in_fmt, fmt); + return(-1); +} + +/*------------------------------------------------------------------------------ + Read mask of polygons from file. + + The format is determined by a keyword and associated parameters. + The format may or may not be initialized by the calling program. + Reading continues in the current format until a line is read + whose first word is a keyword. + If a keyword is encountered, the format is changed accordingly. + + Input: name = name of file to read from; + "" or "-" means read from standard input. + fmt = pointer to format structure. + npolys = maximum number of polygons to read. + Output: polys = polygons read. + Return value: number of polygons read, + or -1 if error occurred. +*/ +int rdmask(char *name, format *fmt, int npolys, polygon *polys[/*npolys*/]) +{ + char *input = "input"; + polygon *poly; + int npoly = 0; + int (*process_next_entry)(format *, inputfile *, polygon **); + int ird; + format in_fmt; + int file_required; + + /* store original contents of fmt */ + copy_format(fmt, &in_fmt); + + fmt->id = 0; + fmt->pixel = 0; + + if (fmt->in == keywords[BINARY_POLYGON]) + { + process_next_entry = &process_next_entry_binary; + file_required = 1; + } + else if (fmt->in == keywords[HEALPIX_WEIGHT]) + { + if (fmt->auto_healpix > 0) + { + process_next_entry = &process_next_entry_healpix; + file_required = 0; + } + else + { + process_next_entry = &process_next_entry_text; + file_required = 1; + } + } + else + { + file_required = 1; + process_next_entry = &process_next_entry_text; + } + + if (file_required) + { + /* open name for reading */ + if (!name || strcmp(name, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(name, "r"); + if (!file.file) { + fprintf(stderr, "rdmask: cannot open %s for reading\n", name); + return(-1); + } + file.name = name; + } + } + else + { + file.name = "[INTERNAL]"; + } + file.line_number = 0; + file.end = fmt->end; + + /* read data until hit EOF */ + while (1) { + ird = process_next_entry(fmt, &file, &poly); + /* serious error */ + if (ird == -1) goto error; + /* EOF */ + if (ird == 0) break; + + if (poly) { + if (npoly >= npolys) { + fprintf(stderr, "rdmask: number of polygons exceeds maximum %d\n", NPOLYSMAX); + fprintf(stderr, " if you need more space, enlarge NPOLYSMAX in defines.h, and recompile\n"); + goto error; + } + polys[npoly] = poly; + npoly++; + } + } + infiles++; + + /* for HEALPix weights, only 1 input file allowed (if you have multiple files, + just combine them)*/ + if(fmt->in == keywords[HEALPIX_WEIGHT] && infiles >= 2) { + fprintf(stderr, "error: only 1 input file allowed for HEALPix_weight format!\n"); + fprintf(stderr, "combine your HEALPix_weight files into one file before running any commands\n"); + return(-1); + } + + /* check whether too few HEALPix weights were read */ + if(fmt->in == keywords[HEALPIX_WEIGHT] && fmt->id < fmt->nweights) { + fprintf(stderr, "error: the number of HEALPix weights in the input file is less than %d (or the file does not end in a newline)\n", fmt->nweights); + goto error; + } + + /* if there are pixelized files, make sure all files are pixelized */ + if(pixelized>0 && infiles!=pixelized){ + fprintf(stderr, "error: some input files are pixelized and some are not.\n"); + fprintf(stderr, "all input files must have consistent pixelization.\n"); + goto error; + } + /* if there are snapped files, make sure all files are snapped */ + if(snapped>0 && infiles!=snapped){ + msg("WARNING: some input files are snapped and some are not.\n"); + snapped=0; + } + /* if there are balkanized files, make sure all files are balkanized */ + if(balkanized>0 && infiles!=balkanized){ + msg("WARNING: some input files are balkanized and some are not.\n"); + balkanized=0; + } + + /* advise */ + msg("%d polygons read from %s\n", npoly, file.name); + + /* close file */ + if (file_required && file.file != stdin) fclose(file.file); + + /* warn about all blank file */ + if (npoly == 0 && blankline > 0) { + msg("Is format correct? Maybe check -s<n> -e<n> -i<f>[<n>][u] command line options?\n"); + } + + /* restore format as it was on input */ + copy_format(&in_fmt, fmt); + + return(npoly); + + /* ---------------- error returns ---------------- */ + error: + + /* restore format as it was on input */ + copy_format(&in_fmt, fmt); + + return(-1); +} + +/*------------------------------------------------------------------------------ + Determine whether first word in string is a keyword. + + Input: str = string. + Output: *str_rest = string following keyword. + Return value: pointer to string containing keyword, + or null if no match. +*/ +char *get_keyword(char *str, char **str_rest, format *fmt) +{ + const char *blank = " \t\n\r"; + char *c = 0; + int id, ird, n; + + char *word; + int ikey; + size_t word_len; + + /* first word in str */ + word = get_word(str, blank, 0, &word_len); + if (!word) return(0x0); + + /* compare first word in str against keywords */ + for (ikey = 0; keywords[ikey]; ikey++) { + if (strncmp(word, keywords[ikey], strlen(keywords[ikey])) == 0) { + *str_rest = word + word_len; + return(keywords[ikey]); + } + } + + /* format not yet specified, or spolygon */ + if (!fmt->in || strcmp(fmt->in, "spolygon") == 0) { + /* check for line starting with 2 integers, indicating spolygon format */ + c = (char *)malloc(100); + ird = sscanf(str, "%d %d%[ \t\n]", &id, &n, c); + free(c); + c = 0; + if (ird == 3 && n >= 0) { + *str_rest = word; + return(keywords[SPOLYGON]); + } + } + + /* check for possibly truncated keyword */ + for (ikey = 0; keywords[ikey]; ikey++) { + if (strlen(word) >= 4 && strncmp(word, keywords[ikey], 4) == 0) { + msg("at line %d of %s: is %.*s supposed to be the keyword %s ?\n", file.line_number, file.name, word_len, word, keywords[ikey]); + } + } + + /* no match */ + return(0x0); +} + +/*------------------------------------------------------------------------------ + Change format according to contents of line_rest. + + Input: keyword = keyword of new format. + *line_rest = string containing possible arguments of format. + fmt = pointer to format structure. + Output: contents of format structure fmt revised. + Return value: 0 = ok; + -1 = error. +*/ +int new_fmt(char *keyword, char **line_rest, format *fmt) +{ + /* const char *Region_fmt = "%d ( %d caps, %d holes):"; */ + const char *Region_fmt = "%d%*[^0-9]%d%*[^0-9]%d"; + /* const char *generic_fmt = "%d ( %d caps, %Lf weight ...:"; */ + //const char *generic_fmt = "%d%*[^0-9]%d%*[^0-9-.]%Lf"; + //const char *edges_fmt = "%d%*[^0-9]%d%*[^0-9]%d%*[^0-9-.]%Lf"; + const char *healpix_weight_fmt = "%d"; + const char *skip_fmt = "%d"; + const char *end_fmt = "%d"; + const char *unit_fmt = " %c"; + const char *pix_fmt = "%d%c"; + char *word; + char *blank = " \t\n\r"; + int ird, iscan, nholes, i, flag; + size_t word_len; + long double temp_pixel; + int res_max_temp; + char scheme_temp; + + /* defaults */ + fmt->id = 0; + fmt->pixel = 0; + fmt->weight = 1.; + fmt->rd_poly_function = 0; + + iscan=0; + + /* Regions */ + if (strcmp(keyword, "Region") == 0) { + fmt->in = keyword; + ird = 0; + word = *line_rest; + do { + word = get_word(word, blank, 0, &word_len); + if (!word) break; + switch (ird) { + case 0: iscan = sscanf(word, "%d", &fmt->id); break; + case 1: iscan = sscanf(word, "%d", &fmt->n); break; + case 2: iscan = sscanf(word, "%d", &nholes); break; + } + if (iscan == 1) ird++; + word += word_len; + } while (word && ird < 3); + if (ird != 3) { + WHERE; + fprintf(stderr, " expecting line of format:\n"); + fprintf(stderr, " %s %s\n", keyword, Region_fmt); + return(-1); + } + /* format defines only one polygon */ + fmt->single = 1; + + /* healpix_weight */ + } else if (strcmp(keyword, "healpix_weight") == 0) { + fmt->in = keyword; + if(is_weight_min || is_weight_max) { + fprintf(stderr, "error: -j option invalid for HEALPix_weight format!\n"); + fprintf(stderr, "if you want to discard certain weights, just set them to 0 in the input file\n"); + return(-1); + } + if(is_area_min || is_area_max) { + fprintf(stderr, "error: -k option invalid for HEALPix_weight format!\n"); + fprintf(stderr, "HEALPix pixels are equal-area, so area limits serve no purpose\n"); + return(-1); + } + fmt->n = 1; + fmt->single = 0; + ird = 0; + word = *line_rest; + do { + word = get_word(word, blank, 0, &word_len); + if (!word) break; + switch (ird) { + case 0: iscan = sscanf(word, "%d", &fmt->nweights); break; + } + if (iscan == 1) ird++; + word += word_len; + } while (word && ird < 1); + if (ird != 1) { + WHERE; + fprintf(stderr, " expecting line of format:\n"); + fprintf(stderr, "%s %s\n", keyword, healpix_weight_fmt); + return(-1); + } + /* catch wrongly-formatted healpix_weight input file */ + if(fmt->nweights == 0) { + fprintf(stderr, "error: input file contains 0 weights???\n"); + fprintf(stderr, "need line of format:\n"); + fprintf(stderr, "%s %s\n", keyword, healpix_weight_fmt); + return(-1); + } + /* check whether nweights is a valid number based on the HEALPix pixelization scheme */ + for (i=1; i<=8192; i=2*i) { + if (12*powl(i,2) == fmt->nweights) { + flag = 1; + break; + } + else { + flag = 0; + continue; + } + } + if (fmt->nweights == 1) flag = 1; + if (flag == 0) { + fprintf(stderr, "error: input file does not contain a valid number of weights according\n"); + fprintf(stderr, "to the HEALPix pixelization scheme (see http://healpix.jpl.nasa.gov)\n"); + return(-1); + } + + /* polygons, spolygons, circles, rectangles, vertices */ + } else if (strcmp(keyword, "polygon") == 0 + || strcmp(keyword, "spolygon") == 0 + || strcmp(keyword, "circle") == 0 + || strcmp(keyword, "edges") == 0 + || strcmp(keyword, "rectangle") == 0 + || strcmp(keyword, "vertices") == 0) { + fmt->in = keyword; + if (strcmp(keyword, "edges") == 0) { + ird = 0; + word = *line_rest; + do { + word = get_word(word, blank, 0, &word_len); + if (!word) break; + switch (ird) { + case 0: iscan = sscanf(word, "%d", &fmt->id); break; + case 1: iscan = sscanf(word, "%d", &fmt->innve); break; + case 2: iscan = sscanf(word, "%d", &fmt->n); break; + case 3: iscan = sscanf(word, "%Lf", &fmt->weight); break; + } + if (iscan == 1) ird++; + word += word_len; + } while (word && ird < 4); + /* default number of edges per line is variable (fmt->n = 0) */ + if (ird < 3) fmt->n = 0; + /* default number of points/edge is 2 */ + if (ird < 2) fmt->innve = 2; + } else { + ird = 0; + word = *line_rest; + do { + word = get_word(word, blank, 0, &word_len); + if (!word) break; + switch (ird) { + case 0: iscan = sscanf(word, "%d", &fmt->id); break; + case 1: iscan = sscanf(word, "%d", &fmt->n); break; + case 2: iscan = sscanf(word, "%Lf", &fmt->weight); break; + case 3: + /* checks to see if 3rd number is an integer - if it is, assume its a pixel number */ + iscan = sscanf(word, "%Lf", &temp_pixel); + fmt->pixel=(floorl(temp_pixel)-temp_pixel==0) ? (int)temp_pixel :0; + break; + } + if (iscan == 1) ird++; + word += word_len; + } while (word && ird < 4); + if (ird < 2) { + /* polygon format requires at least 2 integer arguments */ + if (strcmp(keyword, "polygon") == 0 || strcmp(keyword, "spolygon") == 0) { + WHERE; + fprintf(stderr, " expecting two integers <id> <number_of_caps> following keyword %s\n", keyword); + return(-1); + /* default number of objects per line is variable (fmt->n = 0) */ + } else { + fmt->n = 0; + } + } + } + /* format defines only one polygon */ + if (strcmp(keyword, "polygon") == 0 || strcmp(keyword, "spolygon") == 0) { + fmt->single = 1; + /* if number of objects per line is explicitly set to 0, + interpret as allsky, and allow only one allsky polygon */ + } else if (ird >= ((strcmp(keyword, "edges") == 0)? 3 : 2) && fmt->n == 0) { + fmt->single = 1; + /* format may apply to many polygons */ + } else { + fmt->single = 0; + /* for rectangles, require 1 rectangle per line */ + if (strcmp(keyword, "rectangle") == 0) fmt->n = 1; + } + /* number of angles to read per object */ + if (strcmp(keyword, "circle") == 0) { + fmt->nn = 3; + } else if (strcmp(keyword, "edges") == 0) { + fmt->nn = 2; + } else if (strcmp(keyword, "rectangle") == 0) { + fmt->nn = 4; + } else if (strcmp(keyword, "vertices") == 0) { + fmt->innve = 1; + fmt->nn = 2; + } + + /* skip */ + } else if (strcmp(keyword, "skip") == 0) { + ird = sscanf(*line_rest, skip_fmt, &fmt->skip); + if (ird != 1) { + WHERE; + fprintf(stderr, " expecting integer following keyword skip\n"); + return(-1); + } + + /* end */ + } else if (strcmp(keyword, "end") == 0) { + ird = sscanf(*line_rest, end_fmt, &fmt->end); + if (ird != 1) { + WHERE; + fprintf(stderr, " expecting integer following keyword end\n"); + return(-1); + } + file.end = fmt->end; + + /* angular units */ + } else if (strcmp(keyword, "unit") == 0) { + ird = sscanf(*line_rest, unit_fmt, &fmt->inunitp); + if (ird != 1) { + WHERE; + fprintf(stderr, " expecting character (one of %s) following keyword unit\n", UNITS); + return(-1); + } else if (!strchr(UNITS, fmt->inunitp)) { + WHERE; + fprintf(stderr, " unit %c must be one of %s\n", fmt->inunitp, UNITS); + return(-1); + } + + } else if (strcmp(keyword, "graphics") == 0) { + WHERE; + fprintf(stderr, " %s format can only be written, not read\n", keyword); + return(-1); + + /* + } else if (strcmp(keyword, "area") == 0 + || (strcmp(keyword, "id") == 0) + || (strcmp(keyword, "midpoint") == 0) + || (strcmp(keyword, "weight") == 0)) { + WHERE; + fprintf(stderr, " %s format can only be written, not read\n", keyword); + return(-1); + */ + + /*parse pixelization information (from line like "pixelization 7s" for example) */ + } else if (strcmp(keyword, "pixelization") == 0) { + + ird = sscanf(*line_rest, pix_fmt, &res_max_temp, &scheme_temp); + if (ird != 2) { + WHERE; + fprintf(stderr, " expecting integer and character (one of %s) following keyword pixelization\n", SCHEMES); + return(-1); + } else if (!strchr(SCHEMES, scheme_temp)) { + WHERE; + fprintf(stderr, " scheme %c must be one of %s\n", scheme_temp, SCHEMES); + return(-1); + } + + /* if previously read file has already provided pixelization info, check for compatibility */ + if(pixelized>0){ + if(scheme_temp!=scheme || res_max!=res_max_temp){ + fprintf(stderr, " Pixelization %d%c incompatible with pixelization %d%c of previous file. Pixelize files to be combined later using the same resolution and scheme.\n", res_max_temp, scheme_temp,res_max,scheme); + return(-1); + } + if(res_max==-1 || res_max_temp==-1){ + fprintf(stderr, " Files pixelized adaptively cannot be combined later. To use the adaptive pixelization feature, combine files before pixelization.\n"); + return(-1); + } + } + /* if this is the first set of pixelization info encountered, set scheme and res_max to provided values */ + else{ + if(res_max_temp==-1){ + msg("Input polygons are pixelized adaptively using scheme %c\n",scheme_temp); + } + else{ + msg("Input polygons are pixelized to resolution %d using scheme %c\n",res_max_temp,scheme_temp); + } + scheme=scheme_temp; + res_max=res_max_temp; + } + pixelized++; + } else if (strcmp(keyword, "snapped") == 0) { + snapped++; + } else if (strcmp(keyword, "balkanized") == 0) { + balkanized++; + } + + + + return(0); +} + +/*------------------------------------------------------------------------------ + Extract word from string. + + Input: str = string from which word is to be extracted. + s = string of characters allowed in word. + in = 1 to treat s as allowed characters, + 0 to treat s as NOT-allowed characters, i.e. as blanks. + Output: *word_len = length of first allowed sequence in line. + Return value: pointer to first allowed character of line, + or null if there is no allowed sequence. +*/ +char *get_word(char *str, const char *s, int in, size_t *word_len) +{ + char *first, *last; + + /* check for null string */ + if (!str) return(0x0); + + /* first allowed character */ + if (in) { + for (first = str; *first && !strchr(s, *first); first++); + } else { + for (first = str; *first && strchr(s, *first); first++); + } + + /* nothing in str */ + if (!*first) return(0x0); + + /* last allowed character */ + if (in) { + for (last = first + 1; *last && strchr(s, *last); last++); + } else { + for (last = first + 1; *last && !strchr(s, *last); last++); + } + + /* length of word */ + *word_len = last - first; + + /* pointer to word in str */ + return(first); +} + +/*------------------------------------------------------------------------------ + Read integer number of thingys from 1st integer in line. + + Input: fmt = pointer to format structure. + lin = string containing the line. + Return value: integer number of thingys, + or 0 if error. +*/ +int get_n(format *fmt, char *lin) +{ +#define WARNMAX 3 + char *blank = " \t\n\r"; + char *plural = "s"; + static int warn = 0; + char *ch; + int n; + + /* find next non-blank character */ + for (ch = lin; *ch && strchr(blank, *ch); ch++); + if (!*ch) return(0); + /* check word is an integer, followed by at least one blank */ + while (*ch && strchr("0123456789", *ch)) ch++; + if (!*ch) { + WHERE; + fprintf(stderr, " expecting more numbers after first integer on line\n"); + warn++; + if (warn >= WARNMAX) { + fprintf(stderr, " We have a problem, Heuston.\n"); + exit(1); + } + return(0); + } + if (!strchr(blank, *ch)) { + WHERE; + if (fmt->in[strlen(fmt->in) - 1] == 's') { + strcpy(plural, ""); + } else { + strcpy(plural, "s"); + } + fprintf(stderr, " for variable length format, 1st number on line should be an integer;\n"); + fprintf(stderr, " to set fixed length format with <n> %s%s, use -%c<n>\n", + fmt->in, plural, fmt->in[0]); + warn++; + if (warn >= WARNMAX) { + fprintf(stderr, " We have a problem, Heuston.\n"); + exit(1); + } + return(0); + } + + /* read integer */ + sscanf(lin, "%d", &n); + + return(n); +} + +/*------------------------------------------------------------------------------ + Read number of angles in line. + + Input: fmt = pointer to format structure. + lin = string containing the line. + nh = only first nh of fmt->nn angles may be in hms(RA) dms(Dec) format. + Return value: integer number of angles. +*/ +int get_nang(format *fmt, char *lin, int nh) +{ + char unit; + char *next, *word; + int i, iang, ird; + long double angle; + + word = lin; + iang = 0; + ird = 0; + /* read each angle till get to end of line */ + do { + for (i = 0; i < fmt->nn; i++) { + unit = fmt->inunitp; + /* assume only first two angles per set can be in hms dms format */ + if (i >= nh && fmt->inunitp == 'h') unit = 'd'; + ird = rdangle(word, &next, unit, &angle); + if (ird != 1) { + /* skip over `comment' line */ + if (iang == 0 || (iang == 1 && fmt->inunitp != 'h')) { + blankline++; + return (0); + /* got to end of line with right number of angles */ + } else if (i == 0) { + break; + /* got to end of line but the number of angle is wrong */ + } else { + WHERE; + fprintf(stderr, " expecting number of angles divisible by %d, found %d angles\n", fmt->nn, iang); + exit(1); + } + } + /* increment angle count */ + iang++; + /* point word to next word */ + word = next; + } + } while (ird == 1); + + return(iang); +} + +/*------------------------------------------------------------------------------ + Set the polygon reading function depending on in. Much faster though with + one indirection. + */ +void setup_rd_fmt(format *fmt) +{ + if (fmt->in == 0) + return; + + if (strcmp(fmt->in, "Region") == 0 + || strcmp(fmt->in, "polygon") == 0 + || strcmp(fmt->in, "spolygon") == 0) { + fmt->rd_poly_function = &rd_poly; + /* healpix_weight */ + } else if (strcmp(fmt->in, "healpix_weight") == 0) { + fmt->rd_poly_function = &rd_hpix; + /* circle */ + } else if (strcmp(fmt->in, "circle") == 0) { + fmt->rd_poly_function = &rd_circ; + /* edges or vertices */ + } else if (strcmp(fmt->in, "edges") == 0 + || strcmp(fmt->in, "vertices") == 0) { + fmt->rd_poly_function = &rd_edge; + /* rectangle */ + } else if (strcmp(fmt->in, "rectangle") == 0) { + fmt->rd_poly_function = &rd_rect; + } +} + +/*------------------------------------------------------------------------------ + Get polygon from data in specified format. + + Input: fmt = pointer to format structure. + Return value: pointer to polyon. +*/ +polygon *get_text_poly(format *fmt) +{ + int i; + polygon *poly = 0x0; + + if (!fmt || !fmt->in) return(0x0); + if (fmt->rd_poly_function == 0) + setup_rd_fmt(fmt); + + /* blank out first skip characters of line */ + for (i = 0; i < fmt->skip && file.line[i]; i++) file.line[i] = ' '; + + /* Region or polygon */ + poly = fmt->rd_poly_function(fmt, &file); + + if (poly) { + /* id number */ + poly->id = fmt->id; + /* pixel number */ + poly->pixel = fmt->pixel; + /* weight */ + poly->weight = fmt->weight; + } + + return(poly); +} + +/*------------------------------------------------------------------------------ + Read polygon defined by caps rp and cm as used by garea, gspher et al + <rp_0> <rp_1> <rp_2> <cm> + + Input: fmt = pointer to format structure. + Return value: pointer to polyon. +*/ +polygon *rd_poly(format *fmt, inputfile *thisfile) +{ + int ip, ird; + polygon *poly = 0x0; + + /* allocate memory for new polygon */ + poly = new_poly(fmt->n); + if (!poly) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of %d caps\n", fmt->n); + return(0x0); + } + + /* read caps */ + poly->np = fmt->n; + for (ip = 0; ip < fmt->n; ip++) { + /* read line of data */ + ird = rdline(thisfile); + /* serious error */ + if (ird == -1) exit(1); + /* EOF */ + if (ird == 0) { + WHERE; + fprintf(stderr, " unexpected EOF: expecting 4 reals\n"); + free_poly(poly); + exit(1); + } + /* read rp and cm of cap from line */ + ird = sscanf(thisfile->line, "%Lf %Lf %Lf %Lf", + &poly->rp[ip][0], &poly->rp[ip][1], &poly->rp[ip][2], &poly->cm[ip]); + if (ird != 4) { + WHERE; + fprintf(stderr, " expecting 4 reals\n"); + free_poly(poly); + exit(1); + } + } + + return(poly); +} + +/*------------------------------------------------------------------------------ + Read polygon from HEALPix weights; in other words, simply read in the weights + from the input file and use get_healpix_poly to assign each to the correct + HEALPix polygon. + + Input: fmt = pointer to format structure. + Return value: pointer to polygon. +*/ + +polygon *rd_hpix(format *fmt, inputfile *thisfile) +{ + int nweight, ird, nside; + polygon *poly; + long double weight; + + if(fmt->nweights == 0) return(0x0); + + if (fmt->n == 1) nweight = fmt->n; + else { + fprintf(stderr, "there should only be one weight per line\n"); + return(0x0); + } + + /* too few weights in line*/ + if (nweight < 0) { + WHERE; + fprintf(stderr, " discarding polygon: supposedly line contains %d weights??\n", nweight); + return(0x0); + } + + /* allocate memory for new polygon */ + poly = new_poly(5); + if (!poly) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of 5 caps\n"); + return(0x0); + } + + /* read weight from line */ + ird = sscanf(thisfile->line, "%Lf", &weight); + /* comment line at top of input file */ + if (ird != 1 && fmt->id == 0) { + return(0x0); + } + /* blank/junk lines at EOF */ + if(ird != 1 && fmt->id > (fmt->nweights - 1)) { + return(0x0); + } + /* blank/junk lines in middle of weights */ + if (ird != 1 && fmt->id < fmt->nweights) { + return(0x0); + } + /* EOF */ + if (ird == -1) { + WHERE; + fprintf(stderr, " unexpected EOF: expecting 1 real\n"); + free_poly(poly); + exit(1); + } + /* incorrect line */ + if (ird != 1) { + WHERE; + fprintf(stderr, " expecting 1 real\n"); + free_poly(poly); + exit(1); + } + + /* check whether fmt->nweights (i.e., total number of HEALPix polygons + at this nside) has been exceeded; note that fmt->id starts at 0 */ + if(ird == 1 && fmt->id > (fmt->nweights - 1)) { + fprintf(stderr, "error: the number of HEALPix weights in the input file is greater than %d\n", fmt->nweights); + exit(1); + } + + nside = get_nside(fmt->nweights); + + /* calculate correct HEALPix polygon */ + poly = get_healpix_poly(nside, fmt->id); + if(!poly){ + fprintf(stderr, " error in calculating HEALPix polygon vertices\n"); + return(0x0); + } + poly->weight = weight; + + if(ird == 1 && (poly->cm[0] != 0 || poly->cm[1] != 0)) { + fmt->id++; + fmt->pixel = 0; + fmt->weight = poly->weight; + } + + return(poly); + +} + +/*------------------------------------------------------------------------------ + Read polygon from circles, each defined by + <azimuth> <elevation> <radius> + + Input: fmt = pointer to format structure. + Return value: pointer to polyon. +*/ +polygon *rd_circ(format *fmt, inputfile *thisfile) +{ + char unit; + char *next, *word; + int i, iang, icirc, ird, ncirc; + long double angle[3]; + polygon *poly = 0x0; + + /* point word to start of line */ + word = thisfile->line; + + /* number of circles */ + if (fmt->n > 0 || fmt->single == 1) { + ncirc = fmt->n; + /* read number of circles from contents of line */ + } else { + ncirc = get_nang(fmt, word, 2) / fmt->nn; + if (ncirc == 0) return(0x0); + } + + /* too few circles */ + if (ncirc < 0) { + WHERE; + fprintf(stderr, " discarding polygon: supposedly line contains %d circles??\n", ncirc); + return(0x0); + } + + /* allocate memory for new polygon */ + poly = new_poly(ncirc); + if (!poly) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of %d caps\n", ncirc); + return(0x0); + } + + /* read circles */ + iang = 0; + poly->np = ncirc; + for (icirc = 0; icirc < ncirc; icirc++) { + /* read azimuth, elevation, radius of axis of circle from line */ + for (i = 0; i < 3; i++) { + unit = fmt->inunitp; + if (i == 2 && fmt->inunitp == 'h') unit = 'd'; + ird = rdangle(word, &next, unit, &angle[i]); + if (ird != 1) { + if (iang == 0 || (iang == 1 && fmt->inunitp != 'h')) { + blankline++; + } else { + WHERE; + fprintf(stderr, " expecting %d, found %d angles\n", + fmt->nn * ncirc, iang); + exit(1); + } + free_poly(poly); + return(0x0); + } + /* scale angle to radians */ + if (i == 1 && fmt->inunitp == 'h') unit = 'd'; + scale(&angle[i], unit, 'r'); + /* increment angle count */ + iang++; + /* point word to next word */ + word = next; + } + /* unnaturally small or large radius may indicate a problem */ + if (fabsl(angle[2]) > PI) { + WHERE; + if (icirc > 0) fprintf(stderr, " %d'th", icirc + 1); + fprintf(stderr, " circle has radius %.16Lg deg", places(angle[2] * 180./PI, 14)); + if (angle[2] < -PI) { + fprintf(stderr, " < 180 deg\n"); + } else if (angle[2] > PI) { + fprintf(stderr, " > 180 deg\n"); + } + } + /* convert azimuth, elevation, radius to rp, cm */ + circ_to_rpcm(angle, poly->rp[icirc], &poly->cm[icirc]); + } + + return(poly); +} + +/*------------------------------------------------------------------------------ + Read polygon from vertices and edge-points + <az_0> <el_0> <az_1> <el_1> ... <az_n> <el_n> + + Input: fmt = pointer to format structure. + Return value: pointer to polyon. +*/ +polygon *rd_edge(format *fmt, inputfile *thisfile) +{ +/* whether to allow a polygon with a single cap to be specified with one edge */ +#define ONEEDGESPECIAL 1 +/* number of extra edges to allocate, to allow for expansion */ +#define DNV 4 + static vertices *vert = 0x0; + static int *ev = 0x0; + + const char *blank = " \t\n\r"; + char unit; + char *next, *word; + int anti, i, iang, iedge, iev, ird, iv, ive, ivert, nedge, nv, nve, nvert, reverse; + long double *angle; + long double az, el; + polygon *poly = 0x0; + + /* point word to start of line */ + word = thisfile->line; + + /* hack to deal with points winding left- not right-handedly */ + reverse = 0; + /* check for 'r' which says to reverse order of points */ + while (*word && strchr(blank, *word)) word++; + if (*word && *word == 'r') { + reverse = 1; + word++; + /* require 'r' to be followed by a blank, to be safe */ + if (!*word || !strchr(blank, *word)) return(0x0); + } + + /* no edges per line */ + if (fmt->innve == 0) return(0x0); + + /* number of edges */ + if (fmt->n > 0 || fmt->single == 1) { + nedge = fmt->n; + /* read number of edges from contents of line */ + } else { + nedge = get_nang(fmt, word, fmt->nn) / (fmt->nn * fmt->innve); + if (nedge == 0) return(0x0); + } + + /* on input each edge contains fmt->innve points */ + nvert = fmt->innve * nedge; + + if (fmt->innve == 1) { + /* impossible number of vertices */ + if (nvert < 3) { + WHERE; + fprintf(stderr, " discarding polygon"); + if (nvert < 0) { + fprintf(stderr, " supposedly with %d vertices??\n", nvert); + } else if (nvert == 0) { + fprintf(stderr, ": a polygon with 0 vertices is ill-defined\n"); + } else if (nvert == 1) { + fprintf(stderr, ": a polygon with 1 vertex is ill-defined\n"); + } else if (nvert == 2) { + fprintf(stderr, ": a polygon with 2 vertices is null\n"); + } + return(0x0); + } + } else { + /* impossible number of edges */ + if (nedge <= 0) { + WHERE; + fprintf(stderr, " discarding polygon"); + if (nedge < 0) { + fprintf(stderr, " supposedly with %d edges??\n", nedge); + } else if (nedge == 0) { + fprintf(stderr, ": a polygon with 0 edges is ill-defined\n"); + } + return(0x0); + } + } + + /* only 1 point per edge */ + if (fmt->innve == 1) { + nve = 1; + /* keep only 2 points per edge */ + } else { + nve = 2; + /* keep extra point if only one edge but > 2 points per edge */ + if (ONEEDGESPECIAL && nedge == 1 && fmt->innve > 2) nve = 3; + } + nv = nve * nedge; + + /* ensure that vert contains enough space */ + if (!vert || vert->nvmax < nv) { + free_vert(vert); + vert = new_vert(nv + fmt->innve * DNV); + if (!vert) { + WHERE; + fprintf(stderr, " failed to allocate memory for vertices structure of %d vertices\n", nv + fmt->innve * DNV); + return(0x0); + } + if (!ev) free(ev); + ev = (int *)malloc(sizeof(int) * (nv + fmt->innve * DNV)); + } + /* number of points in vertices structure */ + vert->nv = nv; + + /* read contents of line into vertices structure */ + iang = 0; + ivert = 0; + iv = -1; + iev = 0; + ev[iev] = 0; + for (iedge = 0; iedge < nedge; iedge++) { + for (ive = 0; ive < fmt->innve; ive++) { + for (i = 0; i < 2; i++) { + unit = fmt->inunitp; + angle = (i == 0)? &az : ⪙ + ird = rdangle(word, &next, unit, angle); + if (ird != 1) { + if (iang == 0 || (iang == 1 && fmt->inunitp != 'h')) { + blankline++; + } else { + WHERE; + fprintf(stderr, "expecting %d, found %d angles on line %d of %s\n", + fmt->nn * fmt->innve * nedge, iang, file.line_number, file.name); + exit(1); + } + return(0x0); + } + /* scale angle to radians */ + if (i == 1 && fmt->inunitp == 'h') unit = 'd'; + scale(angle, unit, 'r'); + /* increment angle count */ + iang++; + /* point word at next word */ + word = next; + } + /* phase azimuth to previous */ + if (iv >= 0) az -= rint((az - vert->v[iv].az) / TWOPI) * TWOPI; + /* pass angle to appropriate element of vertices structure */ + if (ive == 0) { + iv++; + /* first point is vertex */ + vert->v[iv].az = az; + vert->v[iv].el = el; + /* intialize midpoint to equal vertex */ + if (nve >= 2) { + iv++; + vert->v[iv].az = az; + vert->v[iv].el = el; + } + } else { + /* update midpoint if previous midpoint was same as vertex */ + if (vert->v[iv - 1].az == vert->v[iv].az + && vert->v[iv - 1].el == vert->v[iv].el) { + vert->v[iv].az = az; + vert->v[iv].el = el; + } + /* extra point if want 3 points and this is last edge point */ + if (nve >= 3 && ive == fmt->innve - 1) { + iv++; + vert->v[iv].az = az; + vert->v[iv].el = el; + } + } + /* number of points read so far */ + ivert++; + /* number of points on this connected boundary */ + ev[iev] = iv + 1; + } + + /* point word at next non-blank character */ + while (*word && strchr(blank, *word)) word++; + /* detect separate boundary on new line */ + if (iedge < nedge - 1 && *word == '\n') { + /* read line of data */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(0x0); + /* EOF */ + if (ird == 0) { + WHERE; + fprintf(stderr, "expecting %d, found %d angles on line %d of %s\n", + fmt->nn * fmt->innve * nedge, iang, file.line_number, file.name); + exit(1); + } + /* disallow reverse hack */ + if (reverse) { + WHERE; + fprintf(stderr, " reverse hack not supported for multi-boundary polygons\n"); + return(0x0); + } + /* point word to start of line */ + word = file.line; + /* skip first skip characters of line */ + for (i = 0; i < fmt->skip && *word; i++) word++; + /* increment boundary counter */ + iev++; + } + } + + /* reverse order of points */ + if (reverse) { + for (iv = 0; iv < nv/2; iv++) { + az = vert->v[iv].az; + vert->v[iv].az = vert->v[nv - 1 - iv].az; + vert->v[nv - 1 - iv].az = az; + el = vert->v[iv].el; + vert->v[iv].el = vert->v[nv - 1 - iv].el; + vert->v[nv - 1 - iv].el = el; + } + } + + /* make polygon with nedge boundaries */ + poly = new_poly(nedge); + if (!poly) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of %d caps\n", nedge); + return(0x0); + } + + /* convert vertices structure to polygon */ + edge_to_poly(vert, nve, ev, poly); + + /* check whether vertices are in antipodes */ + anti = antivert(vert, poly); + + /* vertices in antipodes */ + if (anti == 1) { + WHERE; + fprintf(stderr, " warning:"); + fprintf(stderr, " polygon %d may have its vertices ordered left- instead of right-handedly\n", fmt->id); + } + + return(poly); +} + +/*------------------------------------------------------------------------------ + Read polygon from rectangles, each defined by + <azmin> <azmax> <elmin> <elmax> + + Input: fmt = pointer to format structure. + Return value: pointer to polyon. +*/ +polygon *rd_rect(format *fmt, inputfile *thisfile) +{ + char unit; + char *next, *word; + int i, iang, irect, ird, nrect; + long double angle[4]; + polygon *poly = 0x0; + polygon *poly_rect = 0x0; + + /* point word to start of line */ + word = thisfile->line; + + /* number of rectangles */ + if (fmt->n > 0 || fmt->single == 1) { + nrect = fmt->n; + /* read number of rectangles from contents of line */ + } else { + nrect = get_nang(fmt, word, fmt->nn) / fmt->nn; + if (nrect == 0) return(0x0); + } + + /* too few rectangles */ + if (nrect < 0) { + WHERE; + fprintf(stderr, " discarding polygon: supposedly line contains %d rectangles??\n", nrect); + return(0x0); + } + + /* allocate memory for new polygon */ + poly = new_poly(4 * nrect); + if (!poly) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of %d caps\n", + 4 * nrect); + return(0x0); + } + poly->np=0; + + /* read rectangles */ + iang = 0; + for (irect = 0; irect < nrect; irect++) { + /* read azmin, azmax, elmin, elmax of rectangle from line */ + for (i = 0; i < 4; i++) { + unit = fmt->inunitp; + ird = rdangle(word, &next, unit, &angle[i]); + if (ird != 1) { + if (iang == 0 || (iang == 1 && fmt->inunitp != 'h')) { + blankline++; + } else { + fprintf(stderr, " expecting %d, found %d angles on line %d of %s\n", + fmt->nn * nrect, iang, file.line_number, file.name); + } + free_poly(poly); + return(0x0); + } + /* scale angle to radians */ + if (i >= 2 && fmt->inunitp == 'h') unit = 'd'; + scale(&angle[i], unit, 'r'); + /* increment angle count */ + iang++; + /* point word to next word */ + word = next; + } + + poly_rect=new_poly(4); + if (!poly_rect) { + WHERE; + fprintf(stderr, " failed to allocate memory for polygon of 4 caps\n"); + return(0x0); + } + + rect_to_poly(angle, poly_rect); + if(!poly_rect){ + WHERE; + fprintf(stderr, " error in rect_to_poly: polygon is NULL.\n"); + return(0x0); + } + poly_poly(poly,poly_rect,poly); + free_poly(poly_rect); + } + return(poly); +} diff --git a/src/rdmask_.c b/src/rdmask_.c new file mode 100644 index 0000000..a02e6cf --- /dev/null +++ b/src/rdmask_.c @@ -0,0 +1,25 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include "manglefn.h" +#include "defaults.h" + +/* global declaration of polygons here */ +int npolys; +polygon *polys[NPOLYSMAX]; + +/*------------------------------------------------------------------------------ + Simplified fortran interface to rdmask routine. + call rdmask() +*/ +void rdmask_(void) +{ + char name[256]; + + printf(" enter INPUT polygon file:\n"); + scanf("%256s", name); + npolys = rdmask(name, &fmt, NPOLYSMAX, polys); + if (npolys == -1) exit(1); +} diff --git a/src/rdspher.c b/src/rdspher.c new file mode 100644 index 0000000..aa27784 --- /dev/null +++ b/src/rdspher.c @@ -0,0 +1,90 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "manglefn.h" + +#define WHERE fprintf(stderr, "rdspher: at line %d of %s\n", line_number, fn) + +/*------------------------------------------------------------------------------ + Read spherical harmonics. + + Input: filename = name of file to read from; + "" or "-" means read from standard input. + lmax = maximum harmonic number. + w = array containing harmonics. + Return value: number of (complex) harmonics read, + or -1 if error occurred. +*/ +int rdspher(char *filename, int *lmax_p, harmonic **w_p) +{ + char input[] = "input"; + char *fn; + static harmonic *w; + int i, im, iscan, iw, lmax, nw; + FILE *file; + + /* open filename for reading */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdin; + fn = input; + } else { + file = fopen(filename, "r"); + if (!file) { + fprintf(stderr, "rdspher: cannot open %s for reading\n", filename); + return(-1); + } + fn = filename; + } + + /* read number of harmonics */ + iscan = fscanf(file, "%d %d %d", &lmax, &im, &nw); + if (iscan != 3) { + fprintf(stderr, "rdspher: at line 1 of %s\n", fn); + fprintf(stderr, " expecting 3 integers\n"); + return(-1); + } + msg("lmax = %d in %s\n", lmax, fn); + + if (lmax > *lmax_p) lmax = *lmax_p; + + /* allocate memory for array containing spherical harmonics */ + w = (harmonic *) malloc(sizeof(harmonic) * NW); + if (!w) { + fprintf(stderr, "rdspher: failed to allocate memory for %d harmonics\n", NW); + return(-1); + } + + /* zero harmonics */ + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) { + w[iw][i] = 0.; + } + } + + /* read harmonics */ + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < im; i++) { + iscan = fscanf(file, "%Lg", &w[iw][i]); + if (iscan != 1) { + fprintf(stderr, "rdspher: error reading line %d of %s\n", iw + 2, fn); + return(-1); + } + } + } + + /* advise */ + msg("harmonics up to lmax = %d read from %s\n", lmax, filename); + + /* close file */ + if (file != stdin) fclose(file); + + /* point lmax_p at maximum harmonic */ + *lmax_p = lmax; + /* point w_p at spherical harmonics */ + *w_p = w; + + return(NW); +} diff --git a/src/rotate.c b/src/rotate.c new file mode 100644 index 0000000..0b63bdd --- /dev/null +++ b/src/rotate.c @@ -0,0 +1,277 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "inputfile.h" +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqf:u:p:"; + +/* local functions */ +void usage(void); +int rotate(char *, char *, format *); +void rotate_azel(format *, azel *, azel *); + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int itr, np; + + /* parse arguments */ + parse_args(argc, argv); + /* parse option <fopt> to -f<fopt> */ + if (fopt) itr = parse_fopt(); + + /* one input and one output filename required as arguments */ + if (argc - optind != 2) { + if (optind > 1 || argc - optind >= 1) { + fprintf(stderr, "%s requires 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- rotate ----------------\n"); + + /* rotate */ + np = rotate(argv[argc - 2], argv[argc - 1], &fmt); + if (np == -1) exit(1); + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("rotate [-d] [-q] [-f[<inframe>[,<outframe>]|<azn>,<eln>,<azp>[u]]] [-u<inunit>[,<outunit>]] [-p[+|-][<n>]] azel_infile azel_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ +*/ +#include "parse_fopt.c" + +/*------------------------------------------------------------------------------ + Rotate az, el positions from one frame to another. + The az, el positions are read from in_filename, + and rotated az, el positions are written to out_filename. + Implemented as interpretive read/write, to permit interactive behaviour. + + Input: in_filename = name of file to read from; + "" or "-" means read from standard input. + out_filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + Return value: number of lines written, + or -1 if error occurred. +*/ +int rotate(char *in_filename, char *out_filename, format *fmt) +{ +#ifndef BUFSIZE +# define BUFSIZE 64 +#endif +#define AZEL_STR_LEN 32 + static inputfile file = { + '\0', /* input filename */ + 0x0, /* input file stream */ + '\0', /* line buffer */ + BUFSIZE, /* size of line buffer (will expand as necessary) */ + 0, /* line number */ + 0 /* maximum number of characters to read (0 = no limit) */ + }; + char input[] = "input", output[] = "output"; + char *word, *next; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int ird, len, np; + long double circle; + azel vi, vf; + char *out_fn; + FILE *outfile; + + /* open in_filename for reading */ + if (!in_filename || strcmp(in_filename, "-") == 0) { + file.file = stdin; + file.name = input; + } else { + file.file = fopen(in_filename, "r"); + if (!file.file) { + fprintf(stderr, "cannot open %s for reading\n", in_filename); + return(-1); + } + file.name = in_filename; + } + file.line_number = 0; + + /* open out_filename for writing */ + if (!out_filename || strcmp(out_filename, "-") == 0) { + outfile = stdout; + out_fn = output; + } else { + outfile = fopen(out_filename, "w"); + if (!outfile) { + fprintf(stderr, "cannot open %s for writing\n", out_filename); + return(-1); + } + out_fn = out_filename; + } + + /* advise custom transformation */ + if (fmt->outframe == -1) { + /* multiple transformation */ + if (strchr(fopt, ':')) { + msg(" -f%s is equivalent to\n", fopt); + msg(" -f%.16Lg,%.16Lg,%.16Lg%c\n", + places(fmt->azn, 14), places(fmt->eln, 14), places(fmt->azp, 14), fmt->trunit); + /* single transformation */ + } else { + msg("rotate -f%.16Lg,%.16Lg,%.16Lg%c\n", + fmt->azn, fmt->eln, fmt->azp, fmt->trunit); + } + /* advise standard transformation */ + } else if (fmt->inframe != fmt->outframe) { + msg("rotate from %s to %s\n", + frames[fmt->inframe], frames[fmt->outframe]); + msg(" -f%s,%s is equivalent to\n", + frames[fmt->inframe], frames[fmt->outframe]); + msg(" -f%.16Lg,%.16Lg,%.16Lg%c\n", + places(fmt->azn, 14), places(fmt->eln, 14), places(fmt->azp, 14), fmt->trunit); + } + + /* angular units */ + msg("will take units of input az, el angles in %s to be ", file.name); + switch (fmt->inunit) { +#include "angunit.h" + } + msg("\n"); + if (fmt->outunit != fmt->inunit) { + msg("units of output az, el angles will be "); + switch (fmt->outunit) { +#include "angunit.h" + } + msg("\n"); + } + + /* write header */ + vf.az = 0.; + wrangle(vf.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + len = strlen(az_str); + if (fmt->outunit == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunit); + sprintf(el_str, "el(%c)", fmt->outunit); + } + fprintf(outfile, "%*s %*s\n", len, az_str, len, el_str); + + /* interpretive read/write loop */ + np = 0; + while (1) { + /* read line */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) return(-1); + /* EOF */ + if (ird == 0) break; + + /* read <az> */ + word = file.line; + ird = rdangle(word, &next, fmt->inunit, &vi.az); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* read <el> */ + word = next; + ird = rdangle(word, &next, fmt->inunit, &vi.el); + /* skip header */ + if (ird != 1 && np == 0) continue; + /* otherwise exit on unrecognized characters */ + if (ird != 1) break; + + /* identity: treat specially to avoid loss of precision in scaling */ + if (fmt->inframe == fmt->outframe) { + /* output angles = input angles */ + vf.az = vi.az; + vf.el = vi.el; + + circle = 360.; + scale(&circle, 'd', fmt->inunit); + + /* phase az */ + switch (fmt->outphase) { + case '+': if (vf.az < 0.) vf.az += circle; break; + case '-': if (vf.az > circle / 2.) vf.az -= circle; break; + } + + /* convert az and el from input to output units */ + scale_azel(&vf, fmt->inunit, fmt->outunit); + + /* normal rotation */ + } else { + /* convert az and el from input units to degrees */ + scale_azel(&vi, fmt->inunit, 'd'); + + /* rotate az and el */ + rotate_azel(fmt, &vi, &vf); + + /* phase az */ + switch (fmt->outphase) { + case '+': if (vf.az < 0.) vf.az += 360.; break; + case '-': if (vf.az > 180.) vf.az -= 360.; break; + } + + /* convert az and el from degrees to output units */ + scale_azel(&vf, 'd', fmt->outunit); + } + + /* write result */ + wrangle(vf.az, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(vf.el, fmt->outunit, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(outfile, "%s %s\n", az_str, el_str); + fflush(outfile); + + /* increment counters of results */ + np++; + } + + if (outfile != stdout) { + msg("rotate: %d positions written to %s\n", np, out_fn); + } + + return(np); +} + +/*------------------------------------------------------------------------------ + Interface to fortran routines that actually do the rotation. +*/ +void rotate_azel(format *fmt, azel *vi, azel *vf) +{ + /* custom */ + if (fmt->outframe == -1) { + azel_(&vi->az, &vi->el, &fmt->azn, &fmt->eln, &fmt->azp, &vf->az, &vf->el); + + /* built-ins */ + } else { + fframe_(&fmt->inframe, &vi->az, &vi->el, &fmt->outframe, &vf->az, &vf->el); + + } +} diff --git a/src/rrcoeffs.c b/src/rrcoeffs.c new file mode 100644 index 0000000..a300bc4 --- /dev/null +++ b/src/rrcoeffs.c @@ -0,0 +1,237 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include <math.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqm:s:e:i:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int rrcoeffs(int npoly, polygon *[npoly], long double *, long double [2], long double[2]); +#else +int rrcoeffs(int npoly, polygon *[/*npoly*/], long double *, long double [2], long double[2]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys, nws,i; + long double area, bound[2], vert[2]; + polygon **polys; + polys=polys_global; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile, and outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- rrcoeffs ----------------\n"); + + msg("WARNING: coefficients 2 and 3 may be incorrect because the contribution from point abutments between polygons is not yet implemented.\n"); + msg("However, coefficients 0 and 1 are good.\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* area, bound, and vert of region */ + npoly = rrcoeffs(npoly, polys, &area, bound, vert); + if (npoly == -1) exit(1); + + /* advise area */ + msg("area of (weighted^2) region is %.15Lg str\n", area); + + /* write polygons */ + ifile = argc - 1; + nws = wrrrcoeffs(argv[ifile], area, bound, vert); + if (nws == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("rrcoeffs [-d] [-q] [-l<n>] [-m<a>[u]] [-s<n>] [-e<n>] [-i<f>[<n>][u]] polygon_infile1 [polygon_infile2 ...] outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Coefficients of series expansion of correlation <WW> at angular separation th + <WW> = 2 pi area + - 4 bound[0] sinl(th/2) + + 2 vert[0] sin^2(th/2) + + (2/3 bound[1] + 8/9 vert[1]) sin^3(th/2) + ... + + Return value: number of polygons for which area, bound, and vert were computed. + or -1 if error occurred. +*/ +int rrcoeffs(int npoly, polygon *poly[/*npoly*/], long double *area, long double bound[2], long double vert[2]) +{ + int ier, ip, ipoly, jp, jpoly, ndone, ner, np; + long double darea, dbound[2], dvert[2], toli, tolj, ww; + harmonic dw[1]; + polygon *polyij = 0x0; + + /* initialize area, bound, and vert to zero */ + *area = 0.; + bound[0] = 0.; + bound[1] = 0.; + vert[0] = 0.; + vert[1] = 0.; + + ndone = 0; + ner = 0; + lmax = 0; + + /* each polygon */ + for (ipoly = 0; ipoly < npoly; ipoly++) { + ww = poly[ipoly]->weight * poly[ipoly]->weight; + + /* zero weight polygon requires no computation */ + if (ww == 0.) { + ndone++; + continue; + + /* contribution to correlation from self-correlation of polygons */ + } else { + /* compute area, bound, and vert */ + toli = mtol; + ier = gspher(poly[ipoly], lmax, &toli, &darea, dbound, dvert, dw); + if (ier == -1) return(-1); + + } + + /* computation failed */ + if (ier) { + ner++; + fprintf(stderr, "rrcoeffs: computation failed for polygon %d; discard it\n", ipoly); + + /* success */ + } else { + ndone++; + /* increment area, bound, and vert */ + *area += darea * ww; + bound[0] += dbound[0] * ww; + bound[1] += dbound[1] * ww; + vert[0] += dvert[0] * ww; + vert[1] += dvert[1] * ww; + + } + + /* contribution to correlation from abutting polygons */ + for (jpoly = 0; jpoly < ipoly; jpoly++) { + ww = - 2. * poly[ipoly]->weight * poly[jpoly]->weight; + if (ww == 0.) continue; + + /* look for boundary dividing poly[ipoly] and poly[jpoly] */ + for (ip = 0; ip < poly[ipoly]->np; ip++) { + + for (jp = 0; jp < poly[jpoly]->np; jp++) { + + /* poly[ipoly] and poly[jpoly] abut along a common boundary */ + if (poly[ipoly]->cm[ip] == - poly[jpoly]->cm[jp] + && poly[ipoly]->rp[ip][0] == poly[jpoly]->rp[jp][0] + && poly[ipoly]->rp[ip][1] == poly[jpoly]->rp[jp][1] + && poly[ipoly]->rp[ip][2] == poly[jpoly]->rp[jp][2]) { + + /* make sure polyij contains enough space for intersection */ + np = poly[ipoly]->np + poly[jpoly]->np; + ier = room_poly(&polyij, np, DNP, 0); + if (ier == -1) { + fprintf(stderr, "rrcoeffs: failed to allocate memory for polygon of %d caps\n", np + DNP); + return(-1); + } + + /* make polygon which is the intersection of the 2 polygons */ + poly_poly(poly[ipoly], poly[jpoly], polyij); + + /* suppress abutting boundary from poly[jpoly] */ + polyij->cm[poly[ipoly]->np + jp] = 2.; + + /* compute bound and vert */ + tolj = toli; + ier = gphbv(polyij, poly[ipoly]->np, ip, &tolj, dbound, dvert); + if (ier == -1) return(-1); + + /* increment bound and vert */ + bound[0] += dbound[0] * ww; + bound[1] += dbound[1] * ww; + vert[0] += dvert[0] * ww; + vert[1] += dvert[1] * ww; + + } + + } + + } + + } + + } + + /* advise */ + if (ner > 0) { + msg("discarded %d polygons for which computations failed\n", ner); + } + msg("area, bound, and vert accumulated for %d weighted polygons\n", ndone); + + return(ndone); +} diff --git a/src/rrderiv.s.f b/src/rrderiv.s.f new file mode 100644 index 0000000..6a46a8d --- /dev/null +++ b/src/rrderiv.s.f @@ -0,0 +1,17 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine rrderiv(nd,phi,a,da) + common /rrdervc/ czeta,szeta,cm1,cm2, +c * +c * Integrand of angular pair integral +c * + sphi=sin(phi) + cphi=cos(phi) + cn1z2=cth1*czeta+sth1*szeta*cphi + sn1z2=1-cn1z2**2 + if (sn1z2.le.0._10) then + da=0._10 + else + sn1z2=sqrt(sn1z2) + endif diff --git a/src/rwbinpoly.c b/src/rwbinpoly.c new file mode 100644 index 0000000..e4302c0 --- /dev/null +++ b/src/rwbinpoly.c @@ -0,0 +1,184 @@ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "inputfile.h" +#include "manglefn.h" +#include "rwbinpoly.h" + +typedef struct +{ + int np, pixel, id; + long double weight; +} polygon_header; + +/* global pixelization variables */ +extern int res_max; +extern char scheme; +extern int pixelized; +extern int snapped; +extern int balkanized; + +/* initial angular tolerance within which to merge multiple intersections */ +extern long double mtol; + +/* suppress error messages from garea */ +extern int verb; + + +int process_next_entry_binary(format *fmt, inputfile *thisfile, polygon **poly) +{ + format in_fmt; + int ird; + char *line_rest, *word; + polygon_header ph; + + if (fmt->id == 0) + { + int npolyw, this_pixel, this_snapped, this_balkanized, res_max_temp; + char scheme_temp; + + // No header has been read. Read it. + + fmt->id = 1; + + fread(&npolyw, sizeof(int), 1, thisfile->file); + fread(&this_pixel, sizeof(int), 1, thisfile->file); + fread(&res_max_temp, sizeof(int), 1, thisfile->file); + fread(&scheme_temp, sizeof(char), 1, thisfile->file); + fread(&this_snapped, sizeof(int), 1, thisfile->file); + fread(&this_balkanized, sizeof(int), 1, thisfile->file); + + if (this_pixel) + { + if (pixelized > 0) { + if(scheme_temp!=scheme || res_max!=res_max_temp){ + fprintf(stderr, " Pixelization %d%c incompatible with pixelization %d%c of previous file. Pixelize files to be combined later using the same resolution and scheme.\n", res_max_temp, scheme_temp,res_max,scheme); + return(-1); + } + if(res_max==-1 || res_max_temp==-1){ + fprintf(stderr, " Files pixelized adaptively cannot be combined later. To use the adaptive pixelization feature, combine files before pixelization.\n"); + return(-1); + } + } else { + res_max = res_max_temp; + scheme = scheme_temp; + } + fprintf(stderr, "input is pixelized (%d,%c)\n", res_max_temp, scheme_temp); + pixelized++; + } + if (this_snapped) + { + fprintf(stderr, "input snapped\n"); + snapped++; + } + if (this_balkanized) + { + fprintf(stderr, "input balkanized\n"); + balkanized++; + } + if (pixelized > 0) + { + } + + fmt->nweights = npolyw; + + } + + *poly = 0; + + /* store original contents of fmt */ + copy_format(fmt, &in_fmt); + + if (feof(thisfile->file)) + return 0; + + if (fread(&ph, sizeof(polygon_header), 1, thisfile->file) == 0) + return 0; + + if (feof(thisfile->file)) + return 0; + + *poly = new_poly(ph.np); + + (*poly)->np = ph.np; + (*poly)->pixel = ph.pixel; + (*poly)->id = ph.id; + (*poly)->weight = ph.weight; + if (fread((*poly)->rp, sizeof(vec), ph.np, thisfile->file) != ph.np) + return -1; + + if (fread((*poly)->cm, sizeof(long double), ph.np, thisfile->file) != ph.np) + return -1; + + return 1; +} + +int wr_bin_poly(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + int ier, ip, ipoly, nbadarea, npoly; + long double area, tol; + FILE *file; + polygon_header ph; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_poly: cannot open %s for writing\n", filename); + return(-1); + } + } + + + fwrite(&npolyw, sizeof(int), 1, file); + fwrite(&pixelized, sizeof(int), 1, file); + fwrite(&res_max, sizeof(int), 1, file); + fwrite(&scheme, sizeof(char), 1, file); + fwrite(&snapped, sizeof(int), 1, file); + fwrite(&balkanized, sizeof(int), 1, file); + + npoly = 0; + nbadarea = 0; + + for (ipoly = 0; ipoly < npolys; ipoly++) + { + + if (!polys[ipoly]) + continue; + + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "wr_poly: area of polygon %d is incorrect\n", polys[ipoly]->id); + nbadarea++; + } + + + ph.np = polys[ipoly]->np; + ph.id = polys[ipoly]->id; + ph.pixel = polys[ipoly]->pixel; + ph.weight = polys[ipoly]->weight; + fwrite(&ph, sizeof(ph), 1, file); + fwrite(polys[ipoly]->rp, sizeof(vec), ph.np, file); + fwrite(polys[ipoly]->cm, sizeof(long double), ph.np, file); + } + + /* warn about polygons with incorrect area */ + if (nbadarea > 0) { + msg("%d polygons have incorrect area, but kept\n", nbadarea); + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} diff --git a/src/rwbinpoly.h b/src/rwbinpoly.h new file mode 100644 index 0000000..54724f4 --- /dev/null +++ b/src/rwbinpoly.h @@ -0,0 +1,16 @@ +#ifndef MANGLE_RWBINPOLY_H_INCLUDED +#define MANGLE_RWBINPOLY_H_INCLUDED + + +typedef struct _polygon_header_t +{ + int pixel, id; + short np; + long double weight; +} polygon_header_t; + + +int process_next_entry_binary(format *fmt, inputfile *thisfile, polygon **poly); + + +#endif // MANGLE_RWBINPOLY_H_INCLUDED diff --git a/src/rwhealpix.c b/src/rwhealpix.c new file mode 100644 index 0000000..536fb3d --- /dev/null +++ b/src/rwhealpix.c @@ -0,0 +1,28 @@ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "inputfile.h" +#include "manglefn.h" + + +int process_next_entry_healpix(format *fmt, inputfile *thisfile, polygon **poly) +{ + long Nside = fmt->auto_healpix; + long Npix = 12*Nside*Nside; + + if (fmt->id == Npix) + return 0; + + *poly = get_healpix_poly(fmt->auto_healpix, fmt->id); + + (*poly)->weight = 0; + if ((*poly)->cm[0] != 0 || (*poly)->cm[1] != 0) { + fmt->id++; + fmt->pixel = 0; + fmt->weight = 0; + (*poly)->id = fmt->id; + } + + return 1; +} diff --git a/src/scale.c b/src/scale.c new file mode 100644 index 0000000..3b83ede --- /dev/null +++ b/src/scale.c @@ -0,0 +1,81 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Convert angle from specified unit to specified unit. +*/ +void scale(long double *angle, char from, char to) +{ + /* scale from specified unit to arcseconds */ + switch (from) { + case 'r': + *angle = *angle * RADIAN; + break; + case 'h': + *angle = *angle * HOUR; + break; + case 'd': + case '°': + *angle = *angle * DEGREE; + break; + case 'm': + case '\'': + case '´': + *angle = *angle * MINUTE; + break; + case 's': + case '"': + case '¨': + default: + *angle = *angle * SECOND; + break; + } + + /* scale from arcseconds to specified unit */ + switch (to) { + case 'r': + *angle = *angle / RADIAN; + break; + case 'h': + *angle = *angle / HOUR; + break; + case 'd': + case '°': + *angle = *angle / DEGREE; + break; + case 'm': + case '\'': + case '´': + *angle = *angle / MINUTE; + break; + case 's': + case '"': + case '¨': + default: + *angle = *angle / SECOND; + break; + } +} + +/*------------------------------------------------------------------------------ + Scale azel structure to desired units. +*/ +void scale_azel(azel *v, char from, char to) +{ + scale(&v->az, from, to); + scale(&v->el, (from == 'h')? 'd' : from, (to == 'h')? 'd' : to); +} + +/*------------------------------------------------------------------------------ + Scale vertices structure to desired units. +*/ +void scale_vert(vertices *vert, char from, char to) +{ + int iv; + + for (iv = 0; iv < vert->nv; iv++) { + scale_azel(&vert->v[iv], from, to); + } +} diff --git a/src/sdsspix.c b/src/sdsspix.c new file mode 100644 index 0000000..1fe6d61 --- /dev/null +++ b/src/sdsspix.c @@ -0,0 +1,1033 @@ +/*-------------------------------------------------------------------- +Imported from SDSSPix software by J C Hill 08/14/06. +Get the original at http://lahmu.phyast.pitt.edu/~scranton/SDSSPix/ +--------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <math.h> +#include "manglefn.h" + +unsigned long nx0, ny0; +long double pi, deg2Rad, rad2Deg, strad2Deg, etaOffSet; +long double surveyCenterRA, surveyCenterDEC, node, etaPole; + +void assign_parameters() +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg, etaOffSet; + extern long double surveyCenterRA, surveyCenterDEC, node, etaPole; + + /* With these base resolutions, we can achieve nearly equal area pixels, with + nearly square pixels at lambda = 30 degrees. A resolution factor of + 4 gives us pixels as wide as a stripe. The seeing/reddening/sky maps + are made with resolution=256. */ + + nx0 = 36; + ny0 = 13; + + pi = 2.0*asinl(1.0); + deg2Rad = pi/180.0; + rad2Deg = 180.0/pi; + strad2Deg = 360.0*360.0/(4.0*pi*pi); + + /* These parameters are necessary for translation of LAMBDA-ETA coordinates + into x-y-z vectors in a way consistent with translations from RA-DEC. We + also need etaOffSet to compensate for the fact that the stripes stradle + the ETA = 0 meridian, rather than being bounded by it. */ + + etaOffSet = 1.25; + surveyCenterRA = 185.0; + surveyCenterDEC = 32.5; + node = deg2Rad*(surveyCenterRA - 90.0); + etaPole = deg2Rad*surveyCenterDEC; +} + +void pix2ang(int resolution, unsigned long pixnum, long double *lambda, long double *eta) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + long nx, ny, i, j; + + /* This module takes a pixel index and converts it into LAMBDA-ETA + coordinates. Notice that we require that -180 < ETA < 180 and use the + offset in ETA. + + Also in IDL: pix2ang.pro + */ + + nx = nx0*resolution; + ny = ny0*resolution; + + j = pixnum/nx; + i = pixnum - nx*j; + + *eta = rad2Deg*(2.0*pi*(i+0.5))/nx + etaOffSet; + if (*eta >= 180.0) *eta -= 360.0; + *lambda = 90.0 - rad2Deg*acosl(1.0-2.0*(j+0.5)/ny); +} + +void ang2pix(int resolution, long double lambda, long double eta, unsigned long *pixnum) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + unsigned long nx, ny, i, j; + long double eta2; + + /* The complement to pix2ang, this module converts LAMBDA-ETA to pixel + index. This single number uniquely identifies a pixel on the sky. + + Again, we need to subtract off the etaOffSet to make the coordinate + system work. + + Also in IDL: ang2pix.pro +*/ + + nx = nx0*resolution; + ny = ny0*resolution; + + eta -= etaOffSet; + + eta *= deg2Rad; + + if (eta >= 0.0) { + eta2 = eta; + } else { + eta2 = eta + 2.0*pi; + } + + i = nx*eta2/(2.0*pi); + + lambda = (90.0 - lambda)*deg2Rad; + + if (lambda >= pi) { + j = ny - 1; + } else { + j = ny*((1.0 - cosl(lambda))/2.0); + } + + *pixnum = nx*j + i; +} + +void pix2ang_radec(int resolution, unsigned long pixnum, long double *ra, long double *dec) { + + void csurvey2eq(long double lambda, long double eta, long double *ra, long double *dec); + long double lam, eta, ra_tmp, dec_tmp; + + /* Same as pix2ang, but returning RA-DEC coordinates instead of LAMBDA-ETA */ + + pix2ang(resolution,pixnum,&lam,&eta); + + csurvey2eq(lam,eta,&ra_tmp,&dec_tmp); + + *ra = ra_tmp; + *dec = dec_tmp; +} + +void ang2pix_radec(int resolution, long double ra, long double dec, unsigned long *pixnum) { + + void eq2csurvey(long double ra, long double dec, long double *lambda, long double *eta); + unsigned long tmp_pixnum; + long double lambda, eta; + + /* Same as ang2pix, but taking RA-DEC coordinates instead of LAMBDA-ETA */ + + eq2csurvey(ra,dec,&lambda,&eta); + + ang2pix(resolution,lambda,eta,&tmp_pixnum); + + *pixnum = tmp_pixnum; +} + +void csurvey2eq(long double lambda, long double eta, long double *ra, long double *dec) { + + long double x, y, z; + + /* Conversion from LAMBDA-ETA to RA-DEC coordinates */ + + x = -1.0*sinl(lambda*deg2Rad); + y = cosl(lambda*deg2Rad)*cosl(eta*deg2Rad+etaPole); + z = cosl(lambda*deg2Rad)*sinl(eta*deg2Rad+etaPole); + + *ra = (atan2l(y,x) + node)/deg2Rad; + *dec = asinl(z)/deg2Rad; +} + +void eq2csurvey(long double ra, long double dec, long double *lambda, long double *eta) { + + long double x, y, z; + + /* Conversion from RA-DEC to LAMBDA-ETA coordinates */ + + x = cosl(deg2Rad*ra-node)*cosl(deg2Rad*dec); + y = sinl(deg2Rad*ra-node)*cosl(deg2Rad*dec); + z = sinl(deg2Rad*dec); + + *lambda = -1.0*asinl(x)/deg2Rad; + *eta = (atan2l(z,y) - etaPole)/deg2Rad; + + if (*eta < -180.0) *eta += 360.0; + if (*eta > 180.0) *eta -= 360.0; +} + +/* void downsample(int resolution, gsl_matrix *inmap, gsl_matrix *outmap) +{ + extern unsigned long nx0, ny0; + unsigned long i, j, nx, ny; + + nx = nx0*resolution; + ny = ny0*resolution; + + for (i=0;i<nx/2;i++) { + for (j=0;j<ny/2;j++) { + outmap->data[i*outmap->tda+j] = + 0.25*(inmap->data[2*i*inmap->tda+2*j] + + inmap->data[2*i*inmap->tda+2*j+1] + + inmap->data[(2*i+1)*inmap->tda+2*j] + + inmap->data[(2*i+1)*inmap->tda+2*j+1]); + } + } +} */ + +/* void upsample(int resolution, gsl_matrix *inmap, gsl_matrix *outmap) +{ + extern unsigned long nx0, ny0; + unsigned long i, j, nx, ny; + + nx = nx0*resolution; + ny = ny0*resolution; + + for (i=0;i<nx;i++) { + for (j=0;j<ny;j++) { + outmap->data[2*i*outmap->tda+2*j] = inmap->data[i*inmap->tda+j]; + outmap->data[2*i*outmap->tda+2*j+1] = inmap->data[i*inmap->tda+j]; + outmap->data[(2*i+1)*outmap->tda+2*j] = inmap->data[i*inmap->tda+j]; + outmap->data[(2*i+1)*outmap->tda+2*j+1] = inmap->data[i*inmap->tda+j]; + } + } +} */ + +void superpix(int hi_resolution, unsigned long hi_pixnum, + int lo_resolution, unsigned long *lo_pixnum) +{ + extern unsigned long nx0, ny0; + unsigned long nx_hi, ny_hi, nx_lo, ny_lo, i, j, ratio; + + /* Takes pixel index at high resolution and returns the pixel which contains + it at a lower resolution. + + Also in IDL: superpix.pro + */ + + if (hi_resolution < lo_resolution) { + printf("Can't go from low resolution to higher resolution.\n"); + exit(1); + } + + if (lo_resolution == 0) *lo_pixnum = 0; + else { + nx_hi = nx0*hi_resolution; + ny_hi = ny0*hi_resolution; + nx_lo = nx0*lo_resolution; + ny_lo = ny0*lo_resolution; + + ratio = hi_resolution/lo_resolution; + + j = hi_pixnum/nx_hi; + i = hi_pixnum - nx_hi*j; + + i /= ratio; + j /= ratio; + + *lo_pixnum = nx_lo*j + i; + } +} + +void subpix(int resolution, unsigned long pixnum, unsigned long *sub_pixnum1, + unsigned long *sub_pixnum2, unsigned long *sub_pixnum3, + unsigned long *sub_pixnum4) +{ + extern unsigned long nx0, ny0; + unsigned long nx_hi, ny_hi, nx_lo, ny_lo, i, j; + + /* Reverse of superpix. + + **Only works for long doubled resolution** + + */ + + + nx_hi = 2*nx0*resolution; + ny_hi = 2*ny0*resolution; + nx_lo = nx0*resolution; + ny_lo = ny0*resolution; + + j = pixnum/nx_lo; + i = pixnum - nx_lo*j; + + *sub_pixnum1 = nx_hi*(2*j) + 2*i; + *sub_pixnum2 = nx_hi*(2*j) + 2*i + 1; + *sub_pixnum3 = nx_hi*(2*j + 1) + 2*i; + *sub_pixnum4 = nx_hi*(2*j + 1) + 2*i + 1; + +} + +void pix_bound(int resolution, unsigned long pixnum, + long double *lammin, long double *lammax, long double *etamin, long double *etamax) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + unsigned long nx, ny, i, j; + + /* Returns ETA-LAMBDA boundaries for a given pixel index. + + Also in IDL: pix_bound.pro + + */ + + nx = nx0*resolution; + ny = ny0*resolution; + + j = pixnum/nx; + i = pixnum - nx*j; + + *etamin = rad2Deg*(2.0*pi*i)/nx + etaOffSet; + if (*etamin >= 180.0) *etamin -= 360.0; + *etamax = rad2Deg*(2.0*pi*(i+1))/nx + etaOffSet; + if (*etamax >= 180.0) *etamax -= 360.0; + *lammin = 90.0 - rad2Deg*acosl(1.0 - 2.0*(j+1)/ny); + *lammax = 90.0 - rad2Deg*acosl(1.0 - 2.0*j/ny); + +} + +long double pix_area(int resolution, unsigned long pixnum) +{ + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + long double lammin, lammax, etamin, etamax; + + /* Returns the area of a given pixel index and resolution */ + + pix_bound(resolution,pixnum,&lammin,&lammax,&etamin,&etamax); + + return strad2Deg*(deg2Rad*(etamax-etamin))* + (sinl(deg2Rad*lammax)-sinl(deg2Rad*lammin)); +} + +void pix2xyz(int resolution, unsigned long pixnum, + long double *x, long double *y, long double *z) +{ + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + extern long double surveyCenterRA, surveyCenterDEC, node, etaPole; + long double lam, eta; + + pix2ang(resolution,pixnum,&lam,&eta); + + *x = -1.0*sinl(lam*deg2Rad); + *y = cosl(lam*deg2Rad)*cosl(eta*deg2Rad+etaPole); + *z = cosl(lam*deg2Rad)*sinl(eta*deg2Rad+etaPole); +} + +void area_index(int resolution, long double lammin, long double lammax, long double etamin, + long double etamax, unsigned long *x_min, unsigned long *x_max, + unsigned long *y_min, unsigned long *y_max) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + void ang2pix(int resolution, long double lambda, long double eta, + unsigned long *pixnum); + unsigned long nx, ny, pixnum; + + /* Given a range in LAMBDA and ETA, returns the x-y boundaries. Pixel + indices in this range can be found by taking + + nx = nx0*resolution; + ny = ny0*resolution; + + n_pixel = (x_max - x_min + 1)*(y_max - y_min + 1); + + index_array = gsl_vector_long_alloc(n_pixel); + + k = 0; + for (j=y_min;j<=y_max;j++) { + for (i=x_min;i<=x_max;i++) { + index_array->data[k] = nx*j + i; + k++; + } + } + + Also in IDL: area_index.pro + */ + + + nx = nx0*resolution; + ny = ny0*resolution; + + ang2pix(resolution,lammax,etamin,&pixnum); + *y_min = pixnum/nx; + *x_min = pixnum - nx*(*y_min); + + ang2pix(resolution,lammin,etamax,&pixnum); + *y_max = pixnum/nx; + *x_max = pixnum - nx*(*y_max); + + *y_min += 1; + *y_max -= 1; + +} + +void area_index_stripe(int resolution, int stripe, + unsigned long *x_min, unsigned long *x_max, + unsigned long *y_min, unsigned long *y_max) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + void ang2pix(int resolution, long double lambda, long double eta, + unsigned long *pixnum); + void primary_bound(int stripe, long double *lammin, long double *lammax, + long double *etamin, long double *etamax); + unsigned long nx, ny, pixnum; + long double lammin, lammax, etamin, etamax; + + + /* Similar to area_index, but this returns the x-y range of the pixels in + the primary region of a given stripe. + + Also in IDL: area_index_stripe.pro + */ + + nx = nx0*resolution; + ny = ny0*resolution; + + primary_bound(stripe,&lammin,&lammax,&etamin,&etamax); + + /*printf("Stripe %i: %Lf %Lf %Lf %Lf\n",stripe, + lammin,lammax,etamin,etamax);*/ + + ang2pix(resolution,lammax,etamin,&pixnum); + *y_min = pixnum/nx; + *x_min = pixnum - nx*(*y_min); + + ang2pix(resolution,lammin,etamax,&pixnum); + *y_max = pixnum/nx; + *x_max = pixnum - nx*(*y_max); + + *y_min += 1; + *y_max -= 1; + + /* printf("Found %u (%u x %u) pixels within stripe boundary...\n", + (*x_max - *x_min + 1)*(*y_max - *y_min + 1), + (*x_max - *x_min + 1),(*y_max - *y_min + 1));*/ + +} + +/* void sort_mask_resolution(gsl_vector_int *resolution_array, + gsl_vector_ulong *pixnum_array, unsigned long n_mask) +{ + gsl_permutation *pixel_index; + gsl_vector_ulong *tmp_pixnum_array; + gsl_vector_int *tmp_resolution_array; + unsigned long i, j; + + tmp_pixnum_array = gsl_vector_ulong_alloc(n_mask); + tmp_resolution_array = gsl_vector_int_alloc(n_mask); + pixel_index = gsl_permutation_alloc(n_mask); + + gsl_sort_vector_int_index(pixel_index,resolution_array); + + for (i=0;i<n_mask;i++) { + j = pixel_index->data[i]; + tmp_pixnum_array->data[i] = pixnum_array->data[j]; + tmp_resolution_array->data[i] = resolution_array->data[j]; + } + + for (i=0;i<n_mask;i++) { + pixnum_array->data[i] = tmp_pixnum_array->data[i]; + resolution_array->data[i] = tmp_resolution_array->data[i]; + } + + gsl_vector_int_free(tmp_resolution_array); + gsl_vector_ulong_free(tmp_pixnum_array); + gsl_permutation_free(pixel_index); + +} + +void sort_mask_pixnum(gsl_vector_ulong *pixnum_array, + gsl_vector_int *resolution_array, unsigned long n_mask, + gsl_vector_int *resolution_region_array, + gsl_vector_ulong *resolution_start_array, + gsl_vector_ulong *resolution_finish_array, int n_res) +{ + unsigned long i, j, k, n, n_sub_mask; + gsl_vector_ulong *tmp_pixnum_array, *total_pixnum_array; + gsl_permutation *pixel_index; + + total_pixnum_array = gsl_vector_ulong_alloc(n_mask); + + for (k=0;k<n_res;k++) { + if (resolution_start_array->data[k] == resolution_finish_array->data[k]) { + j = resolution_start_array->data[k]; + total_pixnum_array->data[j] = pixnum_array->data[j]; + } else { + n_sub_mask = resolution_finish_array->data[k] - + resolution_start_array->data[k] + 1; + + tmp_pixnum_array = gsl_vector_ulong_alloc(n_sub_mask); + pixel_index = gsl_permutation_alloc(n_sub_mask); + + j = resolution_start_array->data[k]; + for (i=0;i<n_sub_mask;i++) { + tmp_pixnum_array->data[i] = pixnum_array->data[j]; + j++; + } + + gsl_sort_vector_ulong_index(pixel_index,tmp_pixnum_array); + + j = resolution_start_array->data[k]; + for (i=0;i<n_sub_mask;i++) { + n = pixel_index->data[i]; + total_pixnum_array->data[j] = tmp_pixnum_array->data[n]; + j++; + } + + gsl_vector_ulong_free(tmp_pixnum_array); + gsl_permutation_free(pixel_index); + } + } + + for (i=0;i<n_mask;i++) + pixnum_array->data[i] = total_pixnum_array->data[i]; + + gsl_vector_ulong_free(total_pixnum_array); + +} + +int find_n_res(gsl_vector_int *resolution_array, unsigned long n_mask) +{ + int n_res, resolution; + unsigned long i, not_sorted; + + n_res = 0; + not_sorted = 0; + + for (i=1;i<n_mask;i++) { + if (resolution_array->data[i-1] > resolution_array->data[i]) { + not_sorted = 1; + } + } + + if (not_sorted == 1) { + n_res = -1; + } else { + resolution = resolution_array->data[0]; + n_res = 1; + for (i=1;i<n_mask;i++) { + if (resolution_array->data[i] != resolution) { + n_res++; + resolution = resolution_array->data[i]; + } + } + } + + return n_res; +} + +long find_n_superpix(int superpix_resolution, gsl_vector_ulong *pixnum_array, + gsl_vector_int *resolution_array, unsigned long n_mask) +{ + gsl_vector_ulong *superpix_array; + unsigned long superpixnum; + unsigned long n_superpix; + unsigned long i,j,k; + + n_superpix = 0; + + superpix_array = gsl_vector_ulong_alloc(n_mask); + + for (i=0;i<n_mask;i++) + superpix(resolution_array->data[i],pixnum_array->data[i], + superpix_resolution,&superpix_array->data[i]); + + gsl_sort_vector_ulong(superpix_array); + + n_superpix = 1; + for (i=1;i<n_mask;i++) { + if (superpix_array->data[i] != superpix_array->data[i-1]) { + n_superpix++; + } + } + + return n_superpix; +} + + +void find_resolution_bounds(gsl_vector_int *resolution_array, + unsigned long n_mask, + gsl_vector_int *resolution_region_array, + gsl_vector_ulong *resolution_start_array, + gsl_vector_ulong *resolution_finish_array) +{ + unsigned long i, n_res; + + resolution_region_array->data[0] = resolution_array->data[0]; + resolution_start_array->data[0] = 0; + resolution_finish_array->data[0] = 0; + n_res = 0; + + for (i=1;i<n_mask;i++) { + if (resolution_array->data[i] == resolution_array->data[i-1]) { + resolution_finish_array->data[n_res] = i; + } else { + n_res++; + resolution_region_array->data[n_res] = resolution_array->data[i]; + resolution_start_array->data[n_res] = i; + resolution_finish_array->data[n_res] = i; + } + } +} + +void find_superpix_bounds(gsl_vector_ulong *superpix_array, + unsigned long n_mask, + gsl_vector_ulong *superpix_region_array, + gsl_vector_ulong *superpix_start_array, + gsl_vector_ulong *superpix_finish_array) +{ + unsigned long i, n_superpix; + + superpix_region_array->data[0] = superpix_array->data[0]; + superpix_start_array->data[0] = 0; + superpix_finish_array->data[0] = 0; + n_superpix = 0; + + for (i=1;i<n_mask;i++) { + if (superpix_array->data[i] == superpix_array->data[i-1]) { + superpix_finish_array->data[n_superpix] = i; + } else { + n_superpix++; + superpix_region_array->data[n_superpix] = superpix_array->data[i]; + superpix_start_array->data[n_superpix] = i; + superpix_finish_array->data[n_superpix] = i; + } + } +} + + +void make_resolution_struct(gsl_vector_ulong *pixnum_array, + gsl_vector_int *resolution_array, + unsigned long n_pixel, + resolution_struct *res_struct, int n_res) +{ + unsigned long i,j; + gsl_vector_ulong *resolution_start_array, *resolution_finish_array; + gsl_vector_int *resolution_region_array; + int k; + + resolution_region_array = gsl_vector_int_alloc(n_res); + resolution_start_array = gsl_vector_ulong_alloc(n_res); + resolution_finish_array = gsl_vector_ulong_alloc(n_res); + + find_resolution_bounds(resolution_array,n_pixel,resolution_region_array, + resolution_start_array,resolution_finish_array); + + sort_mask_pixnum(pixnum_array,resolution_array,n_pixel, + resolution_region_array,resolution_start_array, + resolution_finish_array,n_res); + + for (k=0;k<n_res;k++) { + res_struct[k].start = resolution_start_array->data[k]; + res_struct[k].finish = resolution_finish_array->data[k]; + res_struct[k].n_pixel = + res_struct[k].finish - res_struct[k].start + 1; + res_struct[k].resolution = resolution_region_array->data[k]; + printf("%u pixels with resolution of %i\n",res_struct[k].n_pixel, + res_struct[k].resolution); + res_struct[k].pixnum = gsl_vector_ulong_alloc(res_struct[k].n_pixel); + j = res_struct[k].start; + for (i=0;i<res_struct[k].n_pixel;i++) { + res_struct[k].pixnum->data[i] = pixnum_array->data[j]; + j++; + } + } + + gsl_vector_int_free(resolution_region_array); + gsl_vector_ulong_free(resolution_start_array); + gsl_vector_ulong_free(resolution_finish_array); + +} + +void make_superpix_struct(int superpix_resolution, + gsl_vector_ulong *pixnum_array, + gsl_vector_int *resolution_array, + unsigned long n_pixel, + superpixnum_struct *superpix_struct, + unsigned long n_superpix) +{ + unsigned long i,j, k; + gsl_vector_ulong *superpix_start_array, *superpix_finish_array; + gsl_vector_ulong *superpix_region_array, *tmp_pixnum_array, *superpix_array; + gsl_vector_ulong *tmp_superpix_array; + gsl_vector_int *tmp_resolution_array; + gsl_permutation *pixel_index; + + superpix_region_array = gsl_vector_ulong_alloc(n_superpix); + superpix_start_array = gsl_vector_ulong_alloc(n_superpix); + superpix_finish_array = gsl_vector_ulong_alloc(n_superpix); + superpix_array = gsl_vector_ulong_alloc(n_pixel); + tmp_superpix_array = gsl_vector_ulong_alloc(n_pixel); + tmp_pixnum_array = gsl_vector_ulong_alloc(n_pixel); + tmp_resolution_array = gsl_vector_int_alloc(n_pixel); + pixel_index = gsl_permutation_alloc(n_pixel); + + + for (i=0;i<n_pixel;i++) { + superpix(resolution_array->data[i],pixnum_array->data[i], + superpix_resolution,&superpix_array->data[i]); + printf("%d\n",superpix_array->data[i]); + } + + gsl_sort_vector_ulong_index(pixel_index,superpix_array); + + for (i=0;i<n_pixel;i++) { + k = pixel_index->data[i]; + tmp_resolution_array->data[i] = resolution_array->data[k]; + tmp_pixnum_array->data[i] = pixnum_array->data[k]; + tmp_superpix_array->data[i] = superpix_array->data[k]; + } + + for (i=0;i<n_pixel;i++) { + resolution_array->data[i] = tmp_resolution_array->data[i]; + pixnum_array->data[i] = tmp_pixnum_array->data[i]; + superpix_array->data[i] = tmp_superpix_array->data[i]; + } + + gsl_vector_ulong_free(tmp_superpix_array); + gsl_vector_ulong_free(tmp_pixnum_array); + gsl_vector_int_free(tmp_resolution_array); + gsl_permutation_free(pixel_index); + + printf("Finding superpix bounds...\n"); + + find_superpix_bounds(superpix_array,n_pixel,superpix_region_array, + superpix_start_array,superpix_finish_array); + + for (k=0;k<n_superpix;k++) { + printf("%d %d %d\n",superpix_start_array->data[k], + superpix_finish_array->data[k],superpix_region_array->data[k]); + superpix_struct[k].n_pixel = + superpix_finish_array->data[k] - superpix_start_array->data[k] + 1; + superpix_struct[k].resolution = superpix_resolution; + superpix_struct[k].superpixnum = superpix_region_array->data[k]; + + tmp_pixnum_array = gsl_vector_ulong_alloc(superpix_struct[k].n_pixel); + tmp_resolution_array = gsl_vector_int_alloc(superpix_struct[k].n_pixel); + pixel_index = gsl_permutation_alloc(superpix_struct[k].n_pixel); + + j = 0; + for (i=superpix_start_array->data[k]; + i<=superpix_finish_array->data[k];i++) { + tmp_resolution_array->data[j] = resolution_array->data[i]; + j++; + } + + gsl_sort_vector_int_index(pixel_index,tmp_resolution_array); + + for (i=0;i<superpix_struct[k].n_pixel;i++) { + j = pixel_index->data[i] + superpix_start_array->data[k]; + tmp_pixnum_array->data[i] = pixnum_array->data[j]; + tmp_resolution_array->data[i] = resolution_array->data[j]; + printf("%i %u\n",tmp_resolution_array->data[i], + tmp_pixnum_array->data[i]); + } + + superpix_struct[k].n_res = + find_n_res(tmp_resolution_array, superpix_struct[k].n_pixel); + + printf("Found %i resolutions in superpixel %u\n", + superpix_struct[k].n_res,k); + + if (!(superpix_struct[k].res_struct= + malloc(superpix_struct[k].n_res*sizeof(resolution_struct)))) { + printf("Couldn't allocate memory...\n"); + exit(1); + } + + make_resolution_struct(tmp_pixnum_array, tmp_resolution_array, + superpix_struct[k].n_pixel, + superpix_struct[k].res_struct, + superpix_struct[k].n_res); + + gsl_vector_ulong_free(tmp_pixnum_array); + gsl_vector_int_free(tmp_resolution_array); + gsl_permutation_free(pixel_index); + } + + gsl_vector_ulong_free(superpix_region_array); + gsl_vector_ulong_free(superpix_start_array); + gsl_vector_ulong_free(superpix_finish_array); + gsl_vector_ulong_free(superpix_array); + + +} + +void rand_pixel_position(int resolution, unsigned long pixnum, + long double *lambda, long double *eta) +{ + extern unsigned long nx0, ny0; + extern long double pi, deg2Rad, rad2Deg, strad2Deg; + void pix_bound(int resolution, unsigned long pixnum, + long double *lammin, long double *lammax, + long double *etamin, long double *etamax); + long double z_min, z, z_length, lammin, lammax, etamin, etamax, eta_length; + + pix_bound(resolution,pixnum,&lammin,&lammax,&etamin,&etamax); + + eta_length = etamax - etamin; + z_min = sinl(deg2Rad*lammin); + z_length = 2.0/(ny0*resolution); + + *eta = eta_length*gsl_rng_uniform(mt19937_rand) + etamin; + z = z_length*gsl_rng_uniform(mt19937_rand) + z_min; + *lambda = asinl(z)/deg2Rad; + +} +*/ + +long double stripe_inclination(int stripe) +{ + return 2.5*(stripe-10); +} + +void primary_bound(int stripe, long double *lammin, long double *lammax, + long double *etamin, long double *etamax) +{ + long double inc; + long double stripe_inclination(int stripe); + + inc = stripe_inclination(stripe); + + *etamin = inc - 32.5 - 1.25 + 0.0000001; + *etamax = inc - 32.5 + 1.25 - 0.0000001; + + *lammin = 10000.0; + *lammax = -10000.0; + + if (stripe == 9) { + *lammin = -58.8; + *lammax = 53.5; + } + if (stripe == 10) { + *lammin = -63.0; + *lammax = 64.95; + } + if (stripe == 11) { + *lammin = -60.4; + *lammax = 55.2; + } + if (stripe == 12) { + *lammin = -64.1; + *lammax = 56.6; + } + if (stripe == 13) { + *lammin = -62.15; + *lammax = 57.8; + } + if (stripe == 14) { + *lammin = -62.4; + *lammax = 58.9; + } + if (stripe == 15) { + *lammin = -64.95; + *lammax = 59.8; + } + if (stripe == 16) { + *lammin = -63.1; + *lammax = 60.6; + } + if (stripe == 17) { + *lammin = -63.4; + *lammax = 61.2; + } + if (stripe == 18) { + *lammin = -63.6; + *lammax = 61.8; + } + if (stripe == 19) { + *lammin = -63.7; + *lammax = 62.3; + } + if (stripe == 20) { + *lammin = -63.8; + *lammax = 62.7; + } + if (stripe == 21) { + *lammin = -63.7; + *lammax = 63.1; + } + if (stripe == 22) { + *lammin = -63.7; + *lammax = 63.3; + } + if (stripe == 23) { + *lammin = -63.5; + *lammax = 63.5; + } + if (stripe == 24) { + *lammin = -63.3; + *lammax = 63.7; + } + if (stripe == 25) { + *lammin = -63.1; + *lammax = 63.7; + } + if (stripe == 26) { + *lammin = -62.7; + *lammax = 63.8; + } + if (stripe == 27) { + *lammin = -64.75; + *lammax = 63.7; + } + if (stripe == 28) { + *lammin = -65.55; + *lammax = 63.6; + } + if (stripe == 29) { + *lammin = -62.8; + *lammax = 63.4; + } + if (stripe == 30) { + *lammin = -63.0; + *lammax = 63.1; + } + if (stripe == 31) { + *lammin = -60.4; + *lammax = 62.8; + } + if (stripe == 32) { + *lammin = -60.0; + *lammax = 63.35; + } + if (stripe == 33) { + *lammin = -60.0; + *lammax = 61.9; + } + if (stripe == 34) { + *lammin = -59.25; + *lammax = 61.8; + } + if (stripe == 35) { + *lammin = -55.2; + *lammax = 60.95; + } + if (stripe == 36) { + *lammin = -53.6; + *lammax = 61.65; + } + if (stripe == 37) { + *lammin = -52.3; + *lammax = 58.8; + } + if (stripe == 76) { + *lammin = -27.95; + *lammax = 48.5; + } + if (stripe == 82) { + *lammin = -60.0; + *lammax = 60.0; + } + if (stripe == 86) { + *lammin = -61.8; + *lammax = 55.7; + } + + if (*lammin > 1000.0) *lammin = -60.0; + if (*lammax < -1000.0) *lammax = 60.0; +} +/* +void hunt(gsl_vector *xx, long double x, long *jlo) +{ + long up, down, mid, n; + int ascnd; + + n = xx->size; + + if ((x < xx->data[0]) || (x > xx->data[n-1])) { + if (x < xx->data[0]) { + *jlo = n+1; + } else { + *jlo = n-1; + } + } else { + + down = -1; + up = n; + + while (up-down > 1) { + mid = down + (up-down)/2; + if (x >= xx->data[mid]) { + down = mid; + } else { + up = mid; + } + } + *jlo = down; + } + +} + + +void ihunt(gsl_vector_int *xx, int x, long *jlo) +{ + long up, down, mid, n; + int ascnd; + + n = xx->size; + + if ((x < xx->data[0]) || (x > xx->data[n-1])) { + *jlo = n+1; + } else { + + down = -1; + up = n; + + while (up-down > 1) { + mid = down + (up-down)/2; + if (x >= xx->data[mid]) { + down = mid; + } else { + up = mid; + } + } + *jlo = down; + } + +} + + +void lhunt(gsl_vector_ulong *xx, unsigned long x, unsigned long *jlo) +{ + long up, down, mid, n; + int ascnd; + + n = xx->size; + + if ((x < xx->data[0]) || (x > xx->data[n-1])) { + *jlo = n+1; + } else { + + down = -1; + up = n; + + while (up-down > 1) { + mid = down + (up-down)/2; + if (x >= xx->data[mid]) { + down = mid; + } else { + up = mid; + } + } + *jlo = down; + } + +} + +*/ diff --git a/src/search.c b/src/search.c new file mode 100644 index 0000000..f6dcc24 --- /dev/null +++ b/src/search.c @@ -0,0 +1,42 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Find position within ordered array by binary chop. + Assumes points are uncorrelated between calls + (otherwise it would be better to start search from previous point). + + Return value: i such that array[i-1] <= point < array[i] + 0 if point < array[0] + n if point >= array[n-1] +*/ +int search(int n, long double array[/*n*/], long double point) +{ + int i, im, ip; + + /* point below minimum */ + if (point < array[0]) { + return(0); + + /* point above maximum */ + } else if (point >= array[n-1]) { + return(n); + + /* point between limits */ + } else { + im = 0; + ip = n-1; + /* binary chop */ + while (im + 1 < ip) { + i = (im + ip) / 2; + if (point < array[i]) { + ip = i; + } else if (point >= array[i]) { + im = i; + } + }; + return(ip); + } +} diff --git a/src/snap.c b/src/snap.c new file mode 100644 index 0000000..7d67512 --- /dev/null +++ b/src/snap.c @@ -0,0 +1,245 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "progress.h" +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqSa:b:t:y:m:s:e:v:p:i:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int snap(int npoly, polygon *poly[npoly]); +#else +int snap(int npoly, polygon *poly[/*npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nadj, nfiles, npoly, npolys, i; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + /* default is to renumber output polygons with old id numbers */ + fmt.newid = 'o'; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- snap ----------------\n"); + + /* snap angles */ + scale(&axtol, axunit, 's'); + scale(&btol, bunit, 's'); + scale(&thtol, thunit, 's'); + axunit = 's'; + bunit = 's'; + thunit = 's'; + msg("snap angles: axis %Lg%c latitude %Lg%c edge %Lg%c\n", axtol, axunit, btol, bunit, thtol, thunit); + scale(&axtol, axunit, 'r'); + scale(&btol, bunit, 'r'); + scale(&thtol, thunit, 'r'); + axunit = 'r'; + bunit = 'r'; + thunit = 'r'; + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* adjust boundaries of polygons */ + nadj = snap(npoly, polys); + if(nadj==-1) exit(1); + + snapped=1; + + /* write polygons */ + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("snap [-d] [-q] [-S] [-a<a>[u]] [-b<a>[u]] [-t<a>[u]] [-y<r>] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Make almost coincident caps of polygons coincide. + + Input: npoly = number of polygons to snap. + *poly[npoly] = array of npoly pointers to polygon structures. + Return value: number of caps adjusted. +*/ +int snap(int npoly, polygon *poly[/*npoly*/]) +{ +#define WARNMAX 8 + int i, j, ip, inull, iprune, nadj, dnadj, warnmax; + int *start; + int *total; + int p, max_pixel, ier; + long double r; + struct progress_state pstate; + + /* start by sorting polygons by pixel number*/ + poly_sort(npoly,poly,'p'); + + /* allocate memory for pixel info arrays start and total */ + /* if only self-snapping, don't use pixelization */ + max_pixel=(selfsnap)? 1 : poly[npoly-1]->pixel+1; + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "snap_polys: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "snap_polys: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* if we're only doing self-snapping, don't use the pixelization info */ + if(selfsnap){ + start[0]=0; + total[0]=npoly; + } + else{ + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "snap: error building pixel index lists\n"); + return(-1); + } + } + + /*turn off warning messages if using more than one pixel*/ + warnmax= (max_pixel<=1) ? WARNMAX : 0; + + /* ensure that rp is a unit vector for all polygon caps*/ + for (i = 0; i < npoly; i++) { + for(ip=0; ip<poly[i]->np; ip++){ + r = 0.; + for (j = 0; j < 3; j++) r += poly[i]->rp[ip][j] * poly[i]->rp[ip][j]; + if (r != 1.) { + r = sqrt(r); + for (j = 0; j < 3; j++) poly[i]->rp[ip][j] /= r; + } + } + } + + /* snap edges of polygons to each other */ + nadj=0; + progress_start(&pstate, "SNAP", max_pixel); + for(p=0;p<max_pixel;p++){ + progress(&pstate, p); + if(total[p]==0) continue; + dnadj=snap_polys(&fmt, total[p], &poly[start[p]], selfsnap, axtol, btol, thtol, ytol, mtol,((selfsnap)? warnmax : warnmax/2),0x0); + if(dnadj==-1) return(-1); + nadj+=dnadj; + } + progress_finish(&pstate); + + /* prune polygons */ + inull = 0; + progress_start(&pstate, "SNAP_PRUNE", npoly); + for (i = 0; i < npoly; i++) { + progress(&pstate, i); + iprune = prune_poly(poly[i], mtol); + if (iprune >= 2) { + if (WARNMAX > 0 && inull == 0) + msg("warning from snap: the following polygons have zero area:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt.newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } + } + progress_finish(&pstate); + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) msg("snap: %d snapped polygons have zero area (but are being retained)\n", inull); + + /* assign new polygon id numbers */ + if (fmt.newid == 'n') { + for (i = 0; i < npoly; i++) { + poly[i]->id = i; + } + } + + if (fmt.newid == 'p') { + for (i = 0; i < npoly; i++) { + poly[i]->id = poly[i]->pixel; + } + } + + + msg("snap: total of %d caps adjusted\n", nadj); + + return(nadj); +} diff --git a/src/snap_poly.c b/src/snap_poly.c new file mode 100644 index 0000000..2b5c0ab --- /dev/null +++ b/src/snap_poly.c @@ -0,0 +1,358 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Make almost coincident caps of polygons coincide. + + Input: fmt = pointer to format structure. + npoly = number of polygons to snap. + *poly[npoly] = array of npoly pointers to polygon structures. + selfsnap = 0 to snap edges of all polygons against each other, + 1 to snap edges of polygons only against edges of same polygon. + axtol = angle in radians [actually 2 sinl(angle/2)]: + if angle twixt polar axes of caps <= axtol, + then make axis of poly2 cap + exactly parallel to axis of poly1 cap. + btol = angle in radians: + if two axes of caps of poly1 and poly2 are parallel, + and if angle between latitudes of caps <= btol, + then make latitude of poly2 cap + exactly equal to latitude of poly1 cap. + thtol = edge tolerance in radians. + ytol = edge to length tolerance; + if the two vertices and centre point of an edge of poly2 are + all closer to a boundary of poly1 than the lesser of + (1) thtol, and + (2) ytol times the length of the edge, + and if in addition at least one of the three points lies + inside poly1 (sans said boundary), + then make boundary of the poly2 cap equal to that of poly1. + mtol = initial tolerance angle for multiple intersections in radians. + warnmax = number of times to advise about individual polygon edges being snapped. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + snapped_poly = array of 0 or 1 flagging which polygons were snapped. + set to 0x0 on input to ignore. + Return value: number of caps adjusted. +*/ +int snap_polys(format *fmt, int npoly, polygon *poly[/*npoly*/], int selfsnap, long double axtol, long double btol, long double thtol, long double ytol, long double mtol, int warnmax, char snapped_poly[/*npoly*/]) +{ + int dnadj, dnadjo, i, j, nadj, pass, snapped, stuck, warn; + + /* initialize snapped polygon flag to zero */ + if (snapped_poly) { + for (i = 0; i < npoly; i++) snapped_poly[i] = 0; + } + + nadj = 0; + + /* snap repeatedly, until no more caps snap together */ + pass = 0; + stuck = 0; + dnadj = 0; + do { + /* snap caps of each pair of polygons in turn, including self-pairs */ + pass++; + dnadjo = dnadj; + dnadj = 0; + warn = 0; + if (axtol >= 0. || btol >= 0.) { + for (i = 0; i < npoly; i++) { + for (j = i; ((selfsnap)? j == i : j < npoly); j++) { + snapped = snap_poly(poly[i], poly[j], axtol, btol); + if(snapped==-1){ + fprintf(stderr, "snap_polys: error in snap_poly for polys %d and %d in pixel %d\n",i,j,poly[i]->pixel); + return(-1); + } + + if (snapped) { + if (warnmax < 0) { + if (warn == 0) + msg("snap_polys stage 1 pass %d: caps of the following polygons were snapped together:\n", pass); + if (warn < warnmax) { + if (selfsnap) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else { + msg(" (%d %d)", (fmt->newid == 'o')? poly[i]->id : i, (fmt->newid == 'o')? poly[j]->id : j); + } + } else if (warn == warnmax) { + msg(" ... more\n"); + } + } + if (snapped_poly) { + snapped_poly[i] = 1; + snapped_poly[j] = 1; + } + dnadj += snapped; + warn++; + } + } + } + } + if (warnmax > 0 && warn > 0 && warn <= warnmax) msg("\n"); + nadj += dnadj; + if ((nadj > 0 || !selfsnap) && warnmax) msg("snap_polys stage 1 (axes, latitudes) pass %d: %d caps adjusted\n", pass, dnadj); + /* avoid infinite loop */ + if (pass > 1 && dnadj >= dnadjo) stuck++; + } while (dnadj && stuck < 2); + if (dnadj) { + if(poly[0]->pixel > 0){ + fprintf(stderr, "snap_polys stage 1: stuck in a loop in pixel %d. continuing ...\n",poly[0]->pixel); + } + else{ + fprintf(stderr, "snap_polys stage 1: seem to be stuck in a loop ... exit\n"); + } + } + + /* trim polygons */ + for (i = 0; i < npoly; i++) { + trim_poly(poly[i]); + } + + /* snap repeatedly, until no more caps snap together */ + pass = 0; + stuck = 0; + dnadj = 0; + do { + /* snap edges of each polygon to caps of each polygon in turn */ + pass++; + dnadjo = dnadj; + dnadj = 0; + warn = 0; + if (thtol >= 0. && ytol >= 0.) { + for (i = 0; i < npoly; i++) { + for (j = ((selfsnap)? i : 0); ((selfsnap)? j == i : j < npoly); j++) { + snapped = snap_polyth(poly[i], poly[j], thtol, ytol, mtol); + if(snapped==-1){ + fprintf(stderr, "snap_polys: error in snap_poly for polys %d and %d in pixel %d\n",i,j,poly[i]->pixel); + return(-1); + } + if (snapped) { + if (warnmax > 0) { + if (warn == 0) + msg("snap_polys stage 2 pass %d: caps of the following polygons were snapped together:\n", pass); + if (warn < warnmax) { + if (selfsnap) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else { + msg(" (%d %d)", (fmt->newid == 'o')? poly[i]->id : i, (fmt->newid == 'o')? poly[j]->id : j); + } + } else if (warn == warnmax) { + msg(" ... more\n"); + } + } + if (snapped_poly) { + snapped_poly[i] = 1; + snapped_poly[j] = 1; + } + dnadj += snapped; + warn++; + } + } + } + } + if (warnmax > 0 && warn > 0 && warn <= warnmax) msg("\n"); + nadj += dnadj; + if ((nadj > 0 || !selfsnap) && warnmax) msg("snap_polys stage 2 (edges) pass %d: %d caps adjusted\n", pass, dnadj); + /* avoid infinite loop */ + if (pass > 1 && dnadj >= dnadjo) stuck++; + } while (dnadj && stuck < 2); + if (dnadj) { + if(poly[0]->pixel > 0){ + fprintf(stderr, "snap_polys stage 2: stuck in a loop in pixel %d. continuing ...\n",poly[0]->pixel); + } + else{ + fprintf(stderr, "snap_polys stage 2: seem to be stuck in a loop ... exit\n"); + } + } + return(nadj); +} + +/*------------------------------------------------------------------------------ + Make almost coincident caps of 2 polygons coincide. + Caps of poly2 are adjusted to equal those of poly1. + + Input: poly1, poly2 = pointers to polygon structures. + axtol = angle in radians [actually 2 sinl(angle/2)]: + if angle twixt polar axes of caps <= axtol, + then make axis of poly2 cap + exactly parallel to axis of poly1 cap. + btol = angle in radians: + if two axes of caps of poly1 and poly2 are parallel, + and if angle between latitudes of caps <= btol, + then make latitude of poly2 cap + exactly equal to latitude of poly1 cap. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + Return value: number of caps adjusted. +*/ +int snap_poly(polygon *poly1, polygon *poly2, long double axtol, long double btol) +{ + int adjusted, ip, ip1, ip2, nadj, sp; + long double cm, dl, drp, dx, dy, dz; + + nadj = 0; + for (ip1 = 0; ip1 < poly1->np; ip1++) { /* for each cap of poly1 ... */ + /* superfluous cap */ + if (poly1->cm[ip1] == 0. || fabsl(poly1->cm[ip1]) >= 2.) continue; + for (ip2 = 0; ip2 < poly2->np; ip2++) { /* ... and each cap of poly2 */ + /* superfluous cap */ + if (poly2->cm[ip2] == 0. || fabsl(poly2->cm[ip2]) >= 2.) continue; + for (ip = 0; ip < 2; ip++) { /* check rp2 = +- rp1 */ + adjusted = 0; + sp = (ip == 0)? 1 : -1; + /* [2 sinl(alpha/2)]^2, where alpha is angle twixt axes */ + dx = poly2->rp[ip2][0] - sp * poly1->rp[ip1][0]; + dy = poly2->rp[ip2][1] - sp * poly1->rp[ip1][1]; + dz = poly2->rp[ip2][2] - sp * poly1->rp[ip1][2]; + drp = sqrtl(dx * dx + dy * dy + dz * dz); + if (drp <= axtol) { /* axes are nearly parallel */ + if (!(poly2->rp[ip2][0] == sp * poly1->rp[ip1][0] + && poly2->rp[ip2][1] == sp * poly1->rp[ip1][1] + && poly2->rp[ip2][2] == sp * poly1->rp[ip1][2])) { + /* make axis of poly2 cap exactly parallel to poly1 + (made exactly equal below if caps nearly coincide) */ + poly2->rp[ip2][0] = sp * poly1->rp[ip1][0]; + poly2->rp[ip2][1] = sp * poly1->rp[ip1][1]; + poly2->rp[ip2][2] = sp * poly1->rp[ip1][2]; + adjusted = 1; + } + /* angle between latitudes of caps */ + if (sp == 1) { /* axes are aligned */ + dl = 2. * (asinl(sqrtl(fabsl(poly2->cm[ip2]) / 2.)) + - asinl(sqrtl(fabsl(poly1->cm[ip1]) / 2.))); + } else { /* axes are anti-aligned */ + dl = 2. * (asinl(sqrtl((2. - fabsl(poly2->cm[ip2])) / 2.)) + - asinl(sqrtl(fabsl(poly1->cm[ip1]) / 2.))); + } + if (fabsl(dl) <= btol) { /* caps nearly coincide */ + if (sp == -1) { + /* reflect axis of poly2 cap */ + poly2->rp[ip2][0] = - poly2->rp[ip2][0]; + poly2->rp[ip2][1] = - poly2->rp[ip2][1]; + poly2->rp[ip2][2] = - poly2->rp[ip2][2]; + adjusted = 1; + } + /* set latitude of poly2 cap equal to poly1 */ + cm = (poly2->cm[ip2] >= 0.)? + sp * fabsl(poly1->cm[ip1]): + - sp * fabsl(poly1->cm[ip1]); + if (poly2->cm[ip2] != cm) { + poly2->cm[ip2] = cm; + adjusted = 1; + } + } + if (adjusted) { + nadj++; + /* no need to test other direction */ + break; + } + } + } + } + } + return(nadj); +} +/*------------------------------------------------------------------------------ + Snap edge of poly2 to cap boundary of poly1. + Caps of poly2 are adjusted to equal those of poly1. + + Input: poly1, poly2 = pointers to polygon structures. + thtol = edge tolerance in radians. + ytol = edge to length tolerance; + if the two vertices and centre point of an edge of poly2 are + all closer to a boundary of poly1 than the lesser of + (1) thtol, and + (2) ytol times the length of the edge, + and if in addition at least one of the three points lies + inside poly1 (sans said boundary), + then make boundary of the poly2 cap equal to that of poly1. + mtol = initial tolerance angle for multiple intersections in radians. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + Return value: number of caps adjusted, + or -1 if error occurred. +*/ +int snap_polyth(polygon *poly1, polygon *poly2, long double thtol, long double ytol, long double mtol) +{ + const int per = 0; + const int nve = 2; + + int adjusted, do_vcirc, i, ier, in, ip1, ip2, iv, ivp, nadj, nev, nev0, nv; + int *ipv, *gp, *ev; + long double cm, cm1, dth, dthmax, sp, tol; + long double *angle; + vec *v, *ve; + + /* vertices and centres of edges of poly2 */ + do_vcirc = 0; + tol = mtol; + ier = gverts(poly2, do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier != 0) return(-1); + + /* convert angle of each edge to scalar length angle * sinl(theta) */ + for (iv = 0; iv < nv; iv++) { + ip2 = ipv[iv]; + cm = fabsl(poly2->cm[ip2]); + angle[iv] = angle[iv] * sqrtl(cm * (2. - cm)); + } + + nadj = 0; + /* for each edge of poly2 ... */ + for (iv = 0; iv < nv; iv++) { + ivp = (iv + 1) % nv; + ip2 = ipv[iv]; + + /* ... and each axis of poly1 */ + for (ip1 = 0; ip1 < poly1->np; ip1++) { + adjusted = 0; + + /* distance from edge of poly2 to cap of poly1 */ + cm1 = poly1->cm[ip1]; + poly1->cm[ip1] = 2.; /* suppress cap of poly1 */ + in = 0; + dthmax = 0.; + for (i = 0; i < 3; i++) { + /* vertex, centre point, vertex of edge of poly2 */ + v = &ve[(iv * nve + i) % (nv * nve)]; + in |= gptin(poly1, *v); /* in if any one point is in */ + cm = cmij(*v, poly1->rp[ip1]); + dth = 2. * (sqrtl(cm/2.) - sqrtl(fabsl(cm1/2.))); + dth = fabsl(dth); /* angle from point to cap of poly1 */ + if (dth > dthmax) dthmax = dth; + } + poly1->cm[ip1] = cm1; /* restore cap of poly1 */ + + /* three points of poly2 edge are all close to boundary of poly1 */ + if (in && dthmax <= thtol && dthmax <= ytol * angle[iv]) { + sp = poly1->rp[ip1][0] * poly2->rp[ip2][0] + poly1->rp[ip1][1] * poly2->rp[ip2][1] + poly1->rp[ip1][2] * poly2->rp[ip2][2]; + sp = (sp >= 0.)? 1. : -1.; + if (!(poly2->rp[ip2][0] == poly1->rp[ip1][0] + && poly2->rp[ip2][1] == poly1->rp[ip1][1] + && poly2->rp[ip2][2] == poly1->rp[ip1][2])) { + /* make axis of poly2 cap exactly equal to that of poly1 */ + poly2->rp[ip2][0] = poly1->rp[ip1][0]; + poly2->rp[ip2][1] = poly1->rp[ip1][1]; + poly2->rp[ip2][2] = poly1->rp[ip1][2]; + adjusted = 1; + } + /* set latitude of poly2 cap equal to that of poly1 */ + cm = (poly2->cm[ip2] >= 0.)? + sp * fabsl(poly1->cm[ip1]): + - sp * fabsl(poly1->cm[ip1]); + if (poly2->cm[ip2] != cm) { + poly2->cm[ip2] = cm; + adjusted = 1; + } + if (adjusted) nadj++; + } + + } + + } + + /* trim adjusted polygon */ + if (nadj > 0) trim_poly(poly2); + + return(nadj); +} diff --git a/src/snap_poly_test.c b/src/snap_poly_test.c new file mode 100644 index 0000000..3d0a421 --- /dev/null +++ b/src/snap_poly_test.c @@ -0,0 +1,352 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Make almost coincident caps of polygons coincide. + + Input: fmt = pointer to format structure. + npoly = number of polygons to snap. + *poly[npoly] = array of npoly pointers to polygon structures. + selfsnap = 0 to snap edges of all polygons against each other, + 1 to snap edges of polygons only against edges of same polygon. + axtol = angle in radians [actually 2 sinl(angle/2)]: + if angle twixt polar axes of caps <= axtol, + then make axis of poly2 cap + exactly parallel to axis of poly1 cap. + btol = angle in radians: + if two axes of caps of poly1 and poly2 are parallel, + and if angle between latitudes of caps <= btol, + then make latitude of poly2 cap + exactly equal to latitude of poly1 cap. + thtol = edge tolerance in radians. + ytol = edge to length tolerance; + if the two vertices and centre point of an edge of poly2 are + all closer to a boundary of poly1 than the lesser of + (1) thtol, and + (2) ytol times the length of the edge, + and if in addition at least one of the three points lies + inside poly1 (sans said boundary), + then make boundary of the poly2 cap equal to that of poly1. + mtol = initial tolerance angle for multiple intersections in radians. + warnmax = number of times to advise about individual polygon edges being snapped. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + snapped_poly = array of 0 or 1 flagging which polygons were snapped. + set to 0x0 on input to ignore. + Return value: number of caps adjusted. +*/ +int snap_polys(format *fmt, int npoly, polygon *poly[/*npoly*/], int selfsnap, long double axtol, long double btol, long double thtol, long double ytol, long double mtol, int warnmax, char snapped_poly[/*npoly*/]) +{ + int dnadj, dnadjo, i, j, nadj, pass, snapped, stuck, warn; + + /* initialize snapped polygon flag to zero */ + if (snapped_poly) { + for (i = 0; i < npoly; i++) snapped_poly[i] = 0; + } + + nadj = 0; + + /* snap repeatedly, until no more caps snap together */ + pass = 0; + stuck = 0; + dnadj = 0; + do { + /* snap caps of each pair of polygons in turn, including self-pairs */ + pass++; + dnadjo = dnadj; + dnadj = 0; + warn = 0; + if (axtol >= 0. || btol >= 0.) { + for (i = 0; i < npoly; i++) { + for (j = i; ((selfsnap)? j == i : j < npoly); j++) { + snapped = snap_poly(poly[i], poly[j], axtol, btol); + if (snapped) { + if (warnmax) { + if (warn == 0) + msg("snap_polys stage 1 pass %d: caps of the following polygons were snapped together:\n", pass); + if (warn < warnmax) { + if (selfsnap) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else { + msg(" (%d %d)", (fmt->newid == 'o')? poly[i]->id : i, (fmt->newid == 'o')? poly[j]->id : j); + } + } else if (warn == warnmax) { + msg(" ... more\n"); + } + } + if (snapped_poly) { + snapped_poly[i] = 1; + snapped_poly[j] = 1; + } + dnadj += snapped; + warn++; + } + } + } + } + if (warnmax > 0 && warn > 0 && warn <= warnmax) msg("\n"); + nadj += dnadj; + if ((nadj > 0 || !selfsnap) && warnmax) msg("snap_polys stage 1 (axes, latitudes) pass %d: %d caps adjusted\n", pass, dnadj); + /* avoid infinite loop */ + if (pass > 1 && dnadj >= dnadjo) stuck++; + } while (dnadj && stuck < 2); + if (dnadj) { + if(poly[0]->pixel==0){ + fprintf(stderr, "snap_polys: seem to be stuck in a loop ... exit\n"); + } + else{ + fprintf(stderr, "snap_polys stage 1: stuck in a loop in pixel %d. continuing ...\n",poly[0]->pixel); + } + } + + /* trim polygons */ + for (i = 0; i < npoly; i++) { + trim_poly(poly[i]); + } + + /* snap repeatedly, until no more caps snap together */ + pass = 0; + stuck = 0; + dnadj = 0; + do { + /* snap edges of each polygon to caps of each polygon in turn */ + pass++; + dnadjo = dnadj; + dnadj = 0; + warn = 0; + if (thtol >= 0. && ytol >= 0.) { + for (i = 0; i < npoly; i++) { + for (j = ((selfsnap)? i : 0); ((selfsnap)? j == i : j < npoly); j++) { + snapped = snap_polyth(poly[i], poly[j], thtol, ytol, mtol); + if (snapped) { + if (warnmax > 0) { + if (warn == 0) + msg("snap_polys stage 2 pass %d: caps of the following polygons were snapped together:\n", pass); + if (warn < warnmax) { + if (selfsnap) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else { + msg(" (%d %d)", (fmt->newid == 'o')? poly[i]->id : i, (fmt->newid == 'o')? poly[j]->id : j); + } + } else if (warn == warnmax) { + msg(" ... more\n"); + } + } + if (snapped_poly) { + snapped_poly[i] = 1; + snapped_poly[j] = 1; + } + dnadj += snapped; + warn++; + } + } + } + } + if (warnmax > 0 && warn > 0 && warn <= warnmax) msg("\n"); + nadj += dnadj; + if ((nadj > 0 || !selfsnap) && warnmax) msg("snap_polys stage 2 (edges) pass %d: %d caps adjusted\n", pass, dnadj); + /* avoid infinite loop */ + if (pass > 1 && dnadj >= dnadjo) stuck++; + } while (dnadj && stuck < 2); + if (dnadj) { + if(poly[0]->pixel==0){ + fprintf(stderr, "snap_polys: seem to be stuck in a loop ... exit\n"); + } + else{ + fprintf(stderr, "snap_polys stage 2: stuck in a loop in pixel %d. continuing ...\n",poly[0]->pixel); + } + } + return(nadj); +} + +/*------------------------------------------------------------------------------ + Make almost coincident caps of 2 polygons coincide. + Caps of poly2 are adjusted to equal those of poly1. + + Input: poly1, poly2 = pointers to polygon structures. + axtol = angle in radians [actually 2 sinl(angle/2)]: + if angle twixt polar axes of caps <= axtol, + then make axis of poly2 cap + exactly parallel to axis of poly1 cap. + btol = angle in radians: + if two axes of caps of poly1 and poly2 are parallel, + and if angle between latitudes of caps <= btol, + then make latitude of poly2 cap + exactly equal to latitude of poly1 cap. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + Return value: number of caps adjusted. +*/ +int snap_poly(polygon *poly1, polygon *poly2, long double axtol, long double btol) +{ + int adjusted, ip, ip1, ip2, nadj, sp; + long double cm, dl, drp, dx, dy, dz; + + nadj = 0; + for (ip1 = 0; ip1 < poly1->np; ip1++) { /* for each cap of poly1 ... */ + /* superfluous cap */ + if (poly1->cm[ip1] == 0. || fabsl(poly1->cm[ip1]) >= 2.) continue; + for (ip2 = 0; ip2 < poly2->np; ip2++) { /* ... and each cap of poly2 */ + /* superfluous cap */ + if (poly2->cm[ip2] == 0. || fabsl(poly2->cm[ip2]) >= 2.) continue; + for (ip = 0; ip < 2; ip++) { /* check rp2 = +- rp1 */ + adjusted = 0; + sp = (ip == 0)? 1 : -1; + /* [2 sinl(alpha/2)]^2, where alpha is angle twixt axes */ + dx = poly2->rp[ip2][0] - sp * poly1->rp[ip1][0]; + dy = poly2->rp[ip2][1] - sp * poly1->rp[ip1][1]; + dz = poly2->rp[ip2][2] - sp * poly1->rp[ip1][2]; + drp = sqrtl(dx * dx + dy * dy + dz * dz); + if (drp <= axtol) { /* axes are nearly parallel */ + if (!(poly2->rp[ip2][0] == sp * poly1->rp[ip1][0] + && poly2->rp[ip2][1] == sp * poly1->rp[ip1][1] + && poly2->rp[ip2][2] == sp * poly1->rp[ip1][2])) { + /* make axis of poly2 cap exactly parallel to poly1 + (made exactly equal below if caps nearly coincide) */ + poly2->rp[ip2][0] = sp * poly1->rp[ip1][0]; + poly2->rp[ip2][1] = sp * poly1->rp[ip1][1]; + poly2->rp[ip2][2] = sp * poly1->rp[ip1][2]; + adjusted = 1; + } + /* angle between latitudes of caps */ + if (sp == 1) { /* axes are aligned */ + dl = 2. * (asinl(sqrtl(fabsl(poly2->cm[ip2]) / 2.)) + - asinl(sqrtl(fabsl(poly1->cm[ip1]) / 2.))); + } else { /* axes are anti-aligned */ + dl = 2. * (asinl(sqrtl((2. - fabsl(poly2->cm[ip2])) / 2.)) + - asinl(sqrtl(fabsl(poly1->cm[ip1]) / 2.))); + } + if (fabsl(dl) <= btol) { /* caps nearly coincide */ + if (sp == -1) { + /* reflect axis of poly2 cap */ + poly2->rp[ip2][0] = - poly2->rp[ip2][0]; + poly2->rp[ip2][1] = - poly2->rp[ip2][1]; + poly2->rp[ip2][2] = - poly2->rp[ip2][2]; + adjusted = 1; + } + /* set latitude of poly2 cap equal to poly1 */ + cm = (poly2->cm[ip2] >= 0.)? + sp * fabsl(poly1->cm[ip1]): + - sp * fabsl(poly1->cm[ip1]); + if (poly2->cm[ip2] != cm) { + poly2->cm[ip2] = cm; + adjusted = 1; + } + } + if (adjusted) { + nadj++; + /* no need to test other direction */ + break; + } + } + } + } + } + return(nadj); +} +/*------------------------------------------------------------------------------ + Snap edge of poly2 to cap boundary of poly1. + Caps of poly2 are adjusted to equal those of poly1. + + Input: poly1, poly2 = pointers to polygon structures. + thtol = edge tolerance in radians. + ytol = edge to length tolerance; + if the two vertices and centre point of an edge of poly2 are + all closer to a boundary of poly1 than the lesser of + (1) thtol, and + (2) ytol times the length of the edge, + and if in addition at least one of the three points lies + inside poly1 (sans said boundary), + then make boundary of the poly2 cap equal to that of poly1. + mtol = initial tolerance angle for multiple intersections in radians. + Output: adjusted caps of poly2 (i.e. poly2->rp, poly2->cm). + Return value: number of caps adjusted, + or -1 if error occurred. +*/ +int snap_polyth(polygon *poly1, polygon *poly2, long double thtol, long double ytol, long double mtol) +{ + const int per = 0; + const int nve = 2; + + int adjusted, do_vcirc, i, ier, in, ip1, ip2, iv, ivp, nadj, nev, nev0, nv; + int *ipv, *gp, *ev; + long double cm, cm1, dth, dthmax, sp, tol; + long double *angle; + vec *v, *ve; + + // vertices and centres of edges of poly2 + do_vcirc = 0; + tol = mtol; + ier = gverts(poly2, do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier != 0) return(-1); + + // convert angle of each edge to scalar length angle * sinl(theta) + for (iv = 0; iv < nv; iv++) { + ip2 = ipv[iv]; + cm = fabsl(poly2->cm[ip2]); + angle[iv] = angle[iv] * sqrtl(cm * (2. - cm)); + } + + nadj = 0; + + // for each edge of poly2 ... + for (iv = 0; iv < nv; iv++) { + ivp = (iv + 1) % nv; + ip2 = ipv[iv]; + + // ... and each axis of poly1 + for (ip1 = 0; ip1 < poly1->np; ip1++) { + adjusted = 0; + + // distance from edge of poly2 to cap of poly1 + cm1 = poly1->cm[ip1]; + poly1->cm[ip1] = 2.; // suppress cap of poly1 + in = 0; + dthmax = 0.; + + for (i = 0; i < 3; i++) { + // vertex, centre point, vertex of edge of poly2 + v = &ve[(iv * nve + i) % (nv * nve)]; //doesn't segfault without this line + in |= gptin(poly1, *v); // in if any one point is in doesn't segfault without this line + cm = cmij(*v, poly1->rp[ip1]); // doesn't segfault without this line + dth = 2. * (sqrtl(cm/2.) - sqrtl(fabsl(cm1/2.))); + dth = fabsl(dth); // angle from point to cap of poly1 + if (dth > dthmax) dthmax = dth; + } + poly1->cm[ip1] = cm1; // restore cap of poly1 + + + // three points of poly2 edge are all close to boundary of poly1 + + if (in && dthmax <= thtol && dthmax <= ytol * angle[iv]) { + sp = poly1->rp[ip1][0] * poly2->rp[ip2][0] + poly1->rp[ip1][1] * poly2->rp[ip2][1] + poly1->rp[ip1][2] * poly2->rp[ip2][2]; + sp = (sp >= 0.)? 1. : -1.; + if (!(poly2->rp[ip2][0] == poly1->rp[ip1][0] + && poly2->rp[ip2][1] == poly1->rp[ip1][1] + && poly2->rp[ip2][2] == poly1->rp[ip1][2])) { + // make axis of poly2 cap exactly equal to that of poly1 + poly2->rp[ip2][0] = poly1->rp[ip1][0]; + poly2->rp[ip2][1] = poly1->rp[ip1][1]; + poly2->rp[ip2][2] = poly1->rp[ip1][2]; + adjusted = 1; + } + // set latitude of poly2 cap equal to that of poly1 + cm = (poly2->cm[ip2] >= 0.)? + sp * fabsl(poly1->cm[ip1]): + - sp * fabsl(poly1->cm[ip1]); + if (poly2->cm[ip2] != cm) { + poly2->cm[ip2] = cm; + adjusted = 1; + } + if (adjusted) nadj++; + } + + } + } + + // trim adjusted polygon + if (nadj > 0) trim_poly(poly2); + + return(nadj); +} diff --git a/src/snappolys.c b/src/snappolys.c new file mode 100644 index 0000000..8d714ac --- /dev/null +++ b/src/snappolys.c @@ -0,0 +1,109 @@ +/*----------------------------------------------------------------------------- +© A J S Hamilton 2001 +-----------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Make almost coincident caps of polygons coincide. + + Input: npoly = number of polygons to snap. + *poly[npoly] = array of npoly pointers to polygon structures. + mtol = tolerance angle for multiple intersections. + fmt = pointer to format structure. + axtol, btol, thtol, ytol = tolerance angles (see documentation). + selfsnap = determines whether or not to snap edges only against edges of + the same polygon. + Return value: number of caps adjusted. +*/ +int snap(int npoly, polygon *poly[/*npoly*/], long double mtol, format *fmt, long double axtol, long double btol, long double thtol, long double ytol, int selfsnap) +{ +#define WARNMAX 8 + int i, inull, iprune, nadj, dnadj, warnmax; + int *start; + int *total; + int p, max_pixel, ier; + + /* start by sorting polygons by pixel number*/ + poly_sort(npoly,poly,'p'); + + /* allocate memory for pixel info arrays start and total */ + /* if only self-snapping, don't use pixelization */ + max_pixel=(selfsnap)? 1 : poly[npoly-1]->pixel+1; + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "snap_polys: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "snap_polys: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* if we're only doing self-snapping, don't use the pixelization info */ + if(selfsnap){ + start[0]=0; + total[0]=npoly; + } + else{ + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "snap: error building pixel index lists\n"); + return(-1); + } + } + + /*turn off warning messages if using more than one pixel*/ + warnmax= (max_pixel<=1) ? WARNMAX : 0; + + /* snap edges of polygons to each other */ + nadj=0; + for(p=0;p<max_pixel;p++){ + if(total[p]==0) continue; + dnadj=snap_polys(fmt, total[p], &poly[start[p]], selfsnap, axtol, btol, thtol, ytol, mtol,((selfsnap)? warnmax : warnmax/2),0x0); + if(dnadj==-1) return(-1); + nadj+=dnadj; + } + + /* prune polygons */ + inull = 0; + for (i = 0; i < npoly; i++) { + iprune = prune_poly(poly[i], mtol); + if (iprune >= 2) { + if (WARNMAX > 0 && inull == 0) + msg("warning from snap: the following polygons have zero area:\n"); + if (inull < WARNMAX) { + msg(" %d", (fmt->newid == 'o')? poly[i]->id : i); + } else if (inull == WARNMAX) { + msg(" ... more\n"); + } + inull++; + } + } + if (WARNMAX > 0 && inull > 0 && inull <= WARNMAX) msg("\n"); + if (inull > 0) msg("snap: %d snapped polygons have zero area (but are being retained)\n", inull); + + /* assign new polygon id numbers */ + if (fmt->newid == 'n') { + for (i = 0; i < npoly; i++) { + poly[i]->id = i; + } + } + + if (fmt->newid == 'p') { + for (i = 0; i < npoly; i++) { + poly[i]->id = poly[i]->pixel; + } + } + + + msg("snap: total of %d caps adjusted\n", nadj); + + return(nadj); +} diff --git a/src/split_poly.c b/src/split_poly.c new file mode 100644 index 0000000..7e7a737 --- /dev/null +++ b/src/split_poly.c @@ -0,0 +1,249 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include <math.h> +#include "manglefn.h" + +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + +/*------------------------------------------------------------------------------ + If poly1 overlaps poly2, split poly1 into two parts. + + If poly3 is null on input, then the appropriate return value is returned, + but poly1 is not actually split. + + Input: *poly1, poly2 are 2 polygons. + mtol = initial angular tolerance within which to merge multiple intersections. + Output: If **poly3 is not null on input, then: + *poly1 and *poly3 are 2 split polygons of poly1, if poly1 is split, + with *poly1 the part outside poly2, + and *poly3 the part intersecting poly2; + *poly1 and *poly3 remain untouched if poly1 is not split. + If **poly3 is null on input, then *poly1 remains untouched. + Return value: -1 = error occurred; + 0 = poly1 and poly2 have zero intersection; + 1 = poly2 fully encloses poly1; + 2 = poly2 splits poly1 into two. +*/ +int split_poly(polygon **poly1, polygon *poly2, polygon **poly3, long double mtol, char bmethod) +{ + polygon *poly = 0x0, *poly4 = 0x0; + int ier, ip, iprune, np, np1, verb; + long double area, area_tot, cm, tol; + + /* poly2 is whole sphere, therefore contains poly1 */ + if (poly2->np == 0){ + /* set weight according to balkanization scheme: */ + if(bmethod=='l'){ + //do nothing - this is the default behavior + } + else if(bmethod=='a'){ + (*poly1)->weight=(*poly1)->weight + poly2->weight; + } + else if(bmethod=='n'){ + (*poly1)->weight=((*poly1)->weight > poly2->weight)? poly2->weight : (*poly1)->weight ; + } + else if(bmethod=='x'){ + (*poly1)->weight=((*poly1)->weight > poly2->weight)? (*poly1)->weight : poly2->weight ; + } + else{ + fprintf(stderr, "error in split_poly: balkanize method %c not recognized.\n", bmethod); + return(-1); + } + return(1); + } + + /* make sure poly contains enough space for intersection */ + np = (*poly1)->np + poly2->np; + ier = room_poly(&poly, np, DNP, 0); + if (ier == -1) goto out_of_memory; + + /* intersection of poly1 and poly2 */ + poly_poly(*poly1, poly2, poly); + + /* suppress coincident boundaries, to make garea happy */ + iprune = trim_poly(poly); + + /* intersection of poly1 and poly2 is null polygon */ + if (iprune >= 2) return(0); + + /* area of intersection */ + tol = mtol; + verb = 1; + ier = garea(poly, &tol, verb, &area_tot); + if (ier) goto error; + + /* poly1 and poly2 have zero intersection */ + if (area_tot == 0.) return(0); + + /* number of caps of poly1 */ + np1 = (*poly1)->np; + + /* find boundary of poly2 which intersects poly1 */ + verb = 0; + + for (ip = 0; ip < poly2->np; ip++) { + + cm = poly->cm[np1 + ip]; + poly->cm[np1 + ip] = 2.; /* suppress boundary to be tested */ + tol = mtol; + ier = garea(poly, &tol, verb, &area); /* area of intersection sans boundary */ + poly->cm[np1 + ip] = cm; /* restore tested boundary */ + + if (area > area_tot) { /* boundary intersects poly1 */ + /* poly2 splits poly1, but do not actually split */ + if (!poly3) return(2); + + /* number of caps of poly1 with extra boundary */ + np = np1 + 1; + + /* make sure poly3 contains enough space */ + ier = room_poly(poly3, np, DNP, 0); + + if (ier == -1) goto out_of_memory; + + /* poly3 is intersection of poly1 and ip'th cap of poly2 */ + poly_polyn(*poly1, poly2, ip, 1, *poly3); + + /* prune poly3 */ + iprune = prune_poly(*poly3, mtol); + if (iprune == -1) goto error; + /* poly3 may be null because of roundoff: skip to next cap */ + if (iprune >= 2) continue; + + /* make sure poly4 contains enough space */ + ier = room_poly(&poly4, np, DNP, 1); + if (ier == -1) goto out_of_memory; + + /* poly4 is intersection of poly1 and complement of ip'th cap of poly2 */ + poly_polyn(*poly1, poly2, ip, -1, poly4); + + /* prune poly4 */ + iprune = prune_poly(poly4, mtol); + if (iprune == -1) goto error; + /* poly4 may be null because of roundoff: skip to next cap */ + if (iprune >= 2) continue; + + /* make sure poly1 contains enough space */ + np = poly4->np; + ier = room_poly(poly1, np, DNP, 0); + if (ier == -1) goto out_of_memory; + + /* copy poly4 into poly1 */ + copy_poly(poly4, *poly1); + + /* poly1 successfully split into poly1 and poly3 */ + /* set weight according to balkanization scheme: */ + if(bmethod=='l'){ + //do nothing - this is the default behavior + } + else if(bmethod=='a'){ + (*poly3)->weight=(*poly1)->weight + poly2->weight; + } + else if(bmethod=='n'){ + (*poly3)->weight=((*poly1)->weight > poly2->weight)? poly2->weight : (*poly1)->weight ; + } + else if(bmethod=='x'){ + (*poly3)->weight=((*poly1)->weight > poly2->weight)? (*poly1)->weight : poly2->weight ; + } + else{ + fprintf(stderr, "error in split_poly: balkanize method %c not recognized.\n", bmethod); + return(-1); + } + + return(2); + + } else if (area < area_tot) { + /* area should be >= area_tot because suppressing a boundary of poly should always increase its area; + but this can happen because of roundoff */ + //fprintf(stderr, "split_poly: area %.16Lg of polygon with boundary %d suppressed should be >= area %.16Lg of polygon\n", area, ip, area_tot); + } + } + + /* poly2 contains poly1 */ + /* set weight according to balkanization scheme: */ + if(bmethod=='l'){ + //do nothing - this is the default behavior + } + else if(bmethod=='a'){ + (*poly1)->weight=(*poly1)->weight + poly2->weight; + } + else if(bmethod=='n'){ + (*poly1)->weight=((*poly1)->weight > poly2->weight)? poly2->weight : (*poly1)->weight ; + } + else if(bmethod=='x'){ + (*poly1)->weight=((*poly1)->weight > poly2->weight)? (*poly1)->weight : poly2->weight ; + } + else{ + fprintf(stderr, "error in split_poly: balkanize method %c not recognized.\n", bmethod); + return(-1); + } + return(1); + + /* ---------------- error returns ---------------- */ + error: + return(-1); + + out_of_memory: + fprintf(stderr, "split_poly: failed to allocate memory for polygon of %d caps\n", np + DNP); + return(-1); +} + +/*------------------------------------------------------------------------------ + Fragment poly1 into several disjoint polygons, + each of which is either wholly outside or wholly inside poly2. + + Input: *poly1, poly2 are 2 polygons. + discard = 0 to retains all parts of poly1; + = 1 to discard intersection of poly1 with poly2. + npolys = maximum number of polygons available in polys array. + mtol = initial angular tolerance within which to merge multiple intersections. + Output: *poly1 and polys[i], i = 0 to npoly - 1, + are disjoint polygons of poly1; + all but the last polygon lie outside poly2; + if discard = 0: + if poly1 intersects poly2, then the last polygon, + polys[npoly - 1] (or *poly1 if npoly = 0), + is the intersection of poly1 and poly2; + if discard = 1: + if poly1 intersects poly2, then the last+1 polygon, + polys[npoly], + is the discarded intersection of poly1 and poly2; + if poly1 lies entirely inside poly2 (so npoly = 0), + then *poly1 is set to null. + Return value: npoly = number of disjoint polygons, excluding poly1, + or -1 if error occurred in split_poly(). +*/ +int fragment_poly(polygon **poly1, polygon *poly2, int discard, int npolys, polygon *polys[/*npolys*/], long double mtol, char bmethod) +{ + int npoly, nsplit; + polygon **poly; + + /* iteratively subdivide polygons of poly1 */ + npoly = 0; + poly = poly1; + while (1) { + /* check space is available */ + if (npoly >= npolys) return(npoly + 1); + /* split */ + nsplit = split_poly(poly, poly2, &polys[npoly], mtol, bmethod); + /* error */ + if (nsplit == -1) return(-1); + /* done */ + if (nsplit == 0 || nsplit == 1) { + if (nsplit == 1 && discard) { + if (npoly == 0) { + free_poly(*poly); + *poly = 0x0; + } else { + npoly--; + } + } + return(npoly); + } + poly = &polys[npoly++]; + } + +} diff --git a/src/strcmpl.c b/src/strcmpl.c new file mode 100644 index 0000000..337a1fc --- /dev/null +++ b/src/strcmpl.c @@ -0,0 +1,62 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <ctype.h> +#include <stdlib.h> +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Compare strings converted to lower case. +*/ +int strcmpl(const char *s1, const char *s2) +{ + int iret; + size_t l, len1, len2; + char *l1, *l2; + + len1 = strlen(s1) + 1; + len2 = strlen(s2) + 1; + + l1 = (char *) malloc(sizeof(char) * len1); + l2 = (char *) malloc(sizeof(char) * len2); + + for (l = 0; l < len1; l++) *(l1 + l) = tolower(*(s1 + l)); + for (l = 0; l < len2; l++) *(l2 + l) = tolower(*(s2 + l)); + + iret = strcmp(l1, l2); + + free(l1); + free(l2); + + return(iret); +} + +/*------------------------------------------------------------------------------ + Compare first n, at most, characters of strings converted to lower case. +*/ +int strncmpl(const char *s1, const char *s2, size_t n) +{ + int iret; + size_t l, len1, len2; + char *l1, *l2; + + len1 = strlen(s1) + 1; + len2 = strlen(s2) + 1; + + if (len1 > n) len1 = n; + if (len2 > n) len2 = n; + + l1 = (char *) malloc(sizeof(char) * len1); + l2 = (char *) malloc(sizeof(char) * len2); + + for (l = 0; l < len1; l++) *(l1 + l) = tolower(*(s1 + l)); + for (l = 0; l < len2; l++) *(l2 + l) = tolower(*(s2 + l)); + + iret = strncmp(l1, l2, n); + + free(l1); + free(l2); + + return(iret); +} diff --git a/src/strdict.c b/src/strdict.c new file mode 100644 index 0000000..3e6207b --- /dev/null +++ b/src/strdict.c @@ -0,0 +1,78 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Does string match (the initial characters of) any element of dictionary? + + Input: str = pointer to string. + dict = pointer to dictionary of strings; + last element of dictionary must be a null string. + Return value: index of matching element, or + -1 if no match, or + -2 if ambiguous. +*/ +int strdict(char *str, char *dict[]) +{ + int i, match; + + /* initialize to no match */ + match = -1; + /* go through each string in dictionary */ + for (i = 0; dict[i]; i++) { + if (strncmp(str, dict[i], strlen(str)) == 0) { + /* exact match */ + if (strcmp(str, dict[i]) == 0) { + match = i; + break; + /* match */ + } else if (match == -1) { + match = i; + /* ambiguous */ + } else { + match = -2; + break; + } + } + } + return (match); +} + +/*------------------------------------------------------------------------------ + Does string match, irrespective of case, + (the initial characters of) any element of dictionary? + + Input: str = pointer to string. + dict = pointer to dictionary of strings; + last element of dictionary must be a null string. + Return value: index of matching element, or + -1 if no match, or + -2 if ambiguous. +*/ +int strdictl(char *str, char *dict[]) +{ + int i, match; + + /* initialize to no match */ + match = -1; + /* go through each string in dictionary */ + for (i = 0; dict[i]; i++) { + if (strncmpl(str, dict[i], strlen(str)) == 0) { + /* exact match */ + if (strcmpl(str, dict[i]) == 0) { + match = i; + break; + /* match */ + } else if (match == -1) { + match = i; + /* ambiguous */ + } else { + match = -2; + break; + } + } + } + return (match); +} diff --git a/src/test.c b/src/test.c new file mode 100644 index 0000000..f40218b --- /dev/null +++ b/src/test.c @@ -0,0 +1,181 @@ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <math.h> +#include "manglefn.h" +#include "defaults.h" + +#define ARGLEN 10 +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +int main(int argc, char *argv[]) +{ + int ifile, ipoly, nfiles, npoly; + + int i, pixel, res, n, m, pixel_num; + long double ra, dec; + char scheme; + int *child_pix; + int children; + int *parent_pix; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + + + /* + if(argc<5){ + msg("enter the arguments for which_pixel as command line arguments:\n ra, dec, resolution, and pixelization scheme.\n"); + exit(1); + } + else{ + ra=atof(argv[1]); + dec=atof(argv[2]); + res=atoi(argv[3]); + scheme=argv[4][0]; + + scale(&ra, 'd', 'r'); + scale(&dec, 'd','r'); + + pixel = which_pixel(ra,dec,res,scheme); + printf("pixel=%i\n",pixel); + return(0); + } + */ + + + /* + if(argc<3){ + msg("enter the arguments for get_child_pixels as command line arguments:\n pixel number and pixelization scheme.\n"); + exit(1); + } + else{ + pixel_num=atoi(argv[1]); + scheme=argv[2][0]; + + //allocate memory for child_pix array + if(scheme=='d' && pixel_num==0){ + child_pix=(int *) malloc(sizeof(int) * 117); + children=117; + if(!child_pix){ + fprintf(stderr, "get_child_pixels: failed to allocate memory for %d integers\n", 117); + return(-1); + } + } + else{ + child_pix=(int *) malloc(sizeof(int) * 4); + children=4; + if(!child_pix){ + fprintf(stderr, "get_child_pixels: failed to allocate memory for %d integers\n", 4); + return(-1); + } + } + + get_child_pixels(pixel_num,child_pix,scheme); + printf("parent pixel = %d\n", pixel_num); + + for(i=0;i<children;i++){ + printf("child pixel %d = %d\n", i+1, child_pix[i]); + } + return(0); + } + */ + + /* + if(argc<3){ + msg("enter the arguments for get_parent_pixels as command line arguments:\n pixel number and pixelization scheme.\n"); + exit(1); + } + else{ + pixel_num=atoi(argv[1]); + scheme=argv[2][0]; + res=get_res(pixel_num, scheme); + printf("res=%d\n",res); + + if(pixel_num==0 && scheme=='d'){ + parent_pix = (int *) malloc(sizeof(int) * (168)); + if (!parent_pix){ + fprintf(stderr, "test: failed to allocate memory for 168 integers\n"); + exit(1); + } + } + else{ + parent_pix = (int *) malloc(sizeof(int) * (res+1)); + if (!parent_pix) { + fprintf(stderr, "test: failed to allocate memory for %d integers\n", res); + exit(1); + } + } + get_parent_pixels(pixel_num,parent_pix,scheme); + printf("child pixel = %d\nparent pixels =", pixel_num); + for(i=0;i<res;i++){ + printf(" %d, ",parent_pix[i]); + } + printf("and %d\n",parent_pix[res]); + free(parent_pix); + return(0); + } + + */ + + + + if(argc<4){ + msg("enter as command line arguments:\n resolution, pixelization scheme, and name of output file\n"); + return(1); + } + else{ + res=atoi(argv[1]); + scheme=argv[2][0]; + + if(scheme=='s'){ + npoly=powl(4,res); + } + + if(scheme=='d'){ + if(res==0) npoly=1; + else if(res==1) npoly=117; + else{ + npoly=468*powl(4,res-2); + } + } + + npoly=1; + polys[0]=get_pixel(400, scheme); + + /* for(ipoly=0;ipoly<npoly;ipoly++){ + //pixel_num=ipoly+(int)((powl(4,res)+1)/3); + pixel_num=ipoly+pixel_start(res, scheme); + polys[ipoly]=get_pixel(pixel_num,scheme); + + m=ipoly % (int)(powl(2,res)); + n=(ipoly-m)/powl(2,res); + + // polys[ipoly]->weight=(n+m) % 2; + polys[ipoly]->id=ipoly; + polys[ipoly]->weight=(long double)ipoly/(long double)npoly; + } + */ + + ifile = argc - 1; + + advise_fmt(&fmt); + + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + + if (npoly == -1) exit(1); + + for(ipoly=0;ipoly<npoly;ipoly++){ + free_poly(polys[ipoly]); + } + + + return(0); + } + + + +} diff --git a/src/twodf100k.f b/src/twodf100k.f new file mode 100644 index 0000000..82fd6be --- /dev/null +++ b/src/twodf100k.f @@ -0,0 +1,1429 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + real*10 function twodf100k(ra,dec) + real*10 ra,dec +c +c parameters + include 'pi.par' + real*10 RADIAN + parameter (RADIAN=180._10/PI) +c data variables +C logical init +C real magcut +c local (automatic) variables + real rar,decr,compl,maglim +c * +c * Completeness of 30 June 2001 2dF 100k galaxy survey. +c * This is an interface to +c * the 2dFGRS mask software by Peder Norberg and Shaun Cole. +c * +c * WARNING: +c * There is a hard-wired magnitude cut. +c * Comment it out if you don't want it. +c * +c Input: ra, dec = RA & Dec (B1950) in degrees. +c Output: twodf100k: 0 = empty to 1 = complete. +c +C data init /.true./ +c This magnitude cut gives the maximum number of survivors +C data magcut /19.27/ + +c convert from real*10 degrees to real*4 radians + rar=ra + decr=dec + if (rar.lt.0.) rar=rar+360. + if (rar.lt.0.) rar=rar+360. + rar=rar/RADIAN + decr=decr/RADIAN +c +c the 2dFGRS mask software by Peder Norberg and Shaun Cole + call in_2df_mask(rar,decr,compl,maglim) + +c compl = -1. means the position is outside the main 2dF boundary + if (compl.eq.-1.) then + twodf100k=0._10 + +c compl = -2. means the position is inside a drill hole + elseif (compl.eq.-2.) then + twodf100k=0._10 + +c discard fields with limiting magnitude brighter than magcut +C COMMENT THIS OUT IF YOU DON'T WANT IT +C elseif (maglim.lt.magcut) then +C if (init) then +C write (*,'(" WARNING from twodf100k: USING HARD-WIRED MAGNITUDE CU +C *T OF ",f5.2)') magcut +C init=.false. +C endif +C twodf100k=0._10 + +c standard + else + +c completeness + twodf100k=compl + +c magnitude limit +c twodf100k=maglim + + endif + +c completeness: round to 8 decimal places + twodf100k=dble(nint(twodf100k*1.e8_10))/1.e8_10 + +c print *,ra,dec,compl,maglim,twodf100k +c + return + end +c +c======================================================================= +c +c The remaining code below is (with minor modifications) +c the mask_compl.f subroutine provided by the 2dFGRS team +c in the 30 June 2001 public release of data at +c http://www.mso.anu.edu.au/2dFGRS/Public/Release/index.html +c +c The minor modifications are options to read/write +c formatted as well as fortran unformatted data. +c +c The documentation at +c http://www.mso.anu.edu.au/2dFGRS/Public/Release/Masks/index.html +c states the following: +c +c 2. Copyright and use of the mask codes +c As a user of the mask codes, we request that you observe the following guidelines: +c The code provided here has been written by several members of the 2dFGRS team. +c Peder Norberg and Shaun Cole (University of Durham, UK) wrote the +c software used to create the survey masks. +c If you use any part of this 2dFGRS software, please acknowledge +c "the 2dFGRS mask software by Peder Norberg and Shaun Cole". +c This code is supplied as-is (i.e. we do not support any modifications +c to the file mask_compl.f containing the subroutines) and without guarantees +c - use it with caution and report any bugs. +c Read all of this documentation before trying to use the code! +c +c----------------------------------------------------------------------------- +c For a given position in ra & dec, this subroutine tells if this +c position is inside the 2df_mask or not, by returning the actual +c completeness. It returns in the same time the corresponding +c magnitude limit. + + subroutine in_2df_mask(ra,dec,compl,maglim) +*************************************variables******************************** + implicit none + + real ra,dec,compl,maglim + + integer np_x,np_y + parameter (np_x=1800,np_y=600) + integer np_xx,np_yy,ifirst,ix,iy,np,sgn + real rpix(np_x,np_y),magpix(np_x,np_y),x,y,z,rx,ry + character name_mask*20,last_reg*3,reg*3 + save ifirst,np_xx,np_yy,np,rpix,magpix,last_reg + data ifirst/1/ +****************************************************************************** + +c Everytime check which region one points to: either ngp, sgp or ran + call which_reg(ra,dec,reg) + + if (reg.eq.'ran') then + call in_2df_ran(ra,dec,compl,maglim) + return + endif + +c On the first call, the program reads the mask + if ((ifirst.eq.1).or.(last_reg.ne.reg)) then + ifirst=0 + last_reg=reg + name_mask='mask.'//reg//'.dat' + call read_mask(rpix,np_xx,np_yy,name_mask,np_x,np_y,np) + name_mask='maglim.'//reg//'.dat' + call read_mask(magpix,np_xx,np_yy,name_mask,np_x,np_y,np) +c write(0,*) 'Read masks for ',reg,' region!' + endif + + call radec_xyz(ra,dec,x,y,z) + call eq_2dfrx(np,x,y,z,rx,ry,sgn) + call rx_ix_map(rx,ry,ix,iy) + + if ((ix.ge.1).and.(ix.le.np_xx).and. + : (iy.ge.1).and.(iy.le.np_yy)) then + compl=rpix(ix,iy) + maglim=magpix(ix,iy) + else + compl= -1.0 !default value (i.e. outside 2dF boundary) + maglim=-2.0 !default value (i.e. outside 2dF boundary) + endif + + return + end + +c----------------------------------------------------------------------------- +c For a given position in ra & dec, this subroutine tells if this +c position is inside one of the used random fields or not, by returning +c the actual completeness of the field. + + subroutine in_2df_ran(ra,dec,compl,maglim) +*************************************variables******************************** + implicit none + + real ra,dec,compl,maglim + + integer nmax,NP,NPX,NPY + real theta_min + parameter (nmax=98,NP=2400,NPX=50,NPY=50,theta_min=1.014) + logical in + integer i,ifirst,nb_field,io + real costheta,costheta_r,costheta_min,xc(nmax),yc(nmax),zc(nmax) + &, comp(nmax),r,x,y,z,magpix(nmax,NPX,NPY) + character name_mask*20 + data ifirst/1/ + save ifirst,nb_field,xc,yc,zc,comp,costheta_min,magpix +****************************************************************************** + +c On the first call, reads the file containing the random fields + if (ifirst.eq.1) then + ifirst=0 + name_mask='mask.ran.dat' + call ran2df_cen_used(nb_field,xc,yc,zc,comp,name_mask) + name_mask='maglim.ran.dat' + call readranmask(name_mask,NPX,NPY,nmax,magpix) + costheta_min=cos(theta_min*atan(1.)/45.) +c write(0,*) 'Read mask for ran region!' + endif + + i=0 + in=.false. + call radec_xyz(ra,dec,x,y,z) + r=sqrt(x**2+y**2+z**2) + costheta_r=costheta_min*r + do while ((.not.in).and.(i.lt.nb_field)) + i=i+1 + costheta=(x*xc(i)+y*yc(i)+z*zc(i)) + if (costheta.gt.costheta_r) then ! We use here the fact the random + in=.true. ! fields doesn't overlapp with + endif ! each other... + enddo + + if (in) then + call holes_2df_xyz(x,y,z,io) +c compl=comp(i)*real(io) ! io = 0 if in a hole; 1 otherwise + if (io.eq.0) then + compl=-2. ! default value in holes + maglim=-2. ! default value when not specified + else + compl=comp(i) + call get_maglimran(NP,NPX,NPY,x,y,z,xc(i),yc(i),zc(i),maglim + &, nmax,magpix,i) + endif + + + else + compl=-1. ! default value (ie. outside 2dF boundary) + maglim=-2. ! default value (when not specified) + endif + + return + end + +c---------------------------------------------------------------------------- +c Given x,y,z position and centre of the corresponding random field, +c returns the magnitude limit at that position + subroutine get_maglimran(NP,NPX,NPY,x,y,z,xc,yc,zc,maglim + &, nmax,magpix,ifield) + + implicit none + + integer NP,NPX,NPY,nmax,ifield + real x,y,z,xc,yc,zc,maglim,magpix(nmax,NPX,NPY) + + intrinsic max,min + + integer sgn,ixc_min,iyc_min,ix,iy + real rx,ry + +c integer ifirst,max_ix,max_iy,min_ix,min_iy,inum +c data ifirst/-1/ +c save ifirst,max_ix,max_iy,min_ix,min_iy,inum + +c if (ifirst.eq.-1) then +c ifirst=0 +c inum=0 +c max_ix=0 +c min_ix=NPX +c max_iy=0 +c min_iy=NPY +c endif + +c ifirst=ifirst+1 + call eq_2dfrx(NP,xc,yc,zc,rx,ry,sgn) + call bound_map_ran(NPX,NPY,rx,ry,ixc_min,iyc_min) + + call eq_2dfrx(NP,x,y,z,rx,ry,sgn) + call rx_ix_map(rx,ry,ix,iy) + + ix=min(max(1,ix-ixc_min),NPX) + iy=min(max(1,iy-iyc_min),NPY) +c ix = ix-ixc_min +c iy = iy-iyc_min +c if ((ix.ge.1).and.(ix.le.NPX).and.(iy.ge.1).and.(iy.le.NPY)) then + maglim=magpix(ifield,ix,iy) +c else +c write(*,*) 'ix=',ix,'iy=',iy,ifield +c max_ix=max(ix,max_ix) +c min_ix=min(ix,min_ix) +c max_iy=max(iy,max_iy) +c min_iy=min(iy,min_iy) +c maglim=1.0 +c inum=inum+1 +c endif +c +c if (ifirst.ge.57012) then +c write(*,*) ifirst,inum,max_ix,max_iy,min_ix,min_iy +c endif + + return + end + +c---------------------------------------------------------------------------- +c Given ra & dec determines which region to look at + subroutine which_reg(ra,dec,reg) +*************************************variables******************************** + implicit none + + real ra,dec + character reg*(*) + + real EPS + parameter (EPS=1.e-5) + integer i,ifirst,nb_strip,nb_stripsgp,nb_stripngp + real ra_min(4),ra_max(4),dec_min(4),dec_max(4) + data ifirst/1/ + save ra_min,ra_max,dec_min,dec_max,nb_strip,nb_stripsgp + &, nb_stripngp,ifirst +****************************************************************************** + + if (ifirst.eq.1) then + ifirst=0 + nb_stripsgp=3 + nb_stripngp=4 + nb_strip=5 +c SGP strips + ra_min(1)= 5.711590 ! 21h49m + ra_max(1)= 0.911935 ! 3h29m + dec_min(1)= -0.479966 ! -27.5 deg + dec_max(1)= -0.392699 ! -22.5 deg + ra_min(2)= 5.670138 ! 21h39.5m + ra_max(2)= 0.975203 ! 3h43.5m + dec_min(2)= -0.567232 ! -32.5 deg + dec_max(2)= -0.479966 ! -27.5 deg + ra_min(3)= 5.707227 ! 21h48m + ra_max(3)= 0.890118 ! 3h24m + dec_min(3)= -0.654498 ! -37.5 deg + dec_max(3)= -0.567232 ! -32.5 deg +c NGP strips + ra_min(4)= 2.574361 ! 9h50m + ra_max(4)= 3.883358 ! 14h50m + dec_min(4)= -0.130900 ! -7.5 deg + dec_max(4)= +0.043633 ! +2.5 deg +c Make boundaries more secure + do i=1,4 + ra_min(i)=ra_min(i)-EPS + ra_max(i)=ra_max(i)+EPS + dec_min(i)=dec_min(i)-EPS + dec_max(i)=dec_max(i)+EPS + enddo + endif + + i=0 + do while (i.lt.nb_stripsgp) + i=i+1 + if (((ra_min(i).le.ra).or.(ra_max(i).ge.ra)).and. + & (dec_min(i).le.dec).and.(dec_max(i).ge.dec)) then + i=nb_strip + reg='sgp' + endif + enddo + + do while (i.lt.nb_stripngp) + i=i+1 + if ((ra_min(i).le.ra).and.(ra_max(i).ge.ra).and. + & (dec_min(i).le.dec).and.(dec_max(i).ge.dec)) then + i=nb_strip + reg='ngp' + endif + enddo + + if (i.ne.nb_strip) reg='ran' + + return + end + +c---------------------------------------------------------------------------- +c Subroutine to read the 2dF mask +c + subroutine read_mask(mask,np_xx,np_yy,name_mask,np_x,np_y,np) +*************************************variables******************************** + implicit none + + integer np_x,np_y,np_xx,np_yy,np + real mask(np_x,np_y) + character name_mask*(*) + + integer ix,iy + + integer access,lnblnk + character*1 go + character*128 dat + logical NP_set,ok + logical ex + character*3 re +****************************************************************************** + + dat=name_mask(1:lnblnk(name_mask))//'.fmt' + + ok=.false. + +c try unformatted + inquire(FILE=name_mask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name_mask,' r').eq.0) then + open(11,file=name_mask,status='old',form='unformatted') + rewind(11) + read(11,end=200,err=200) np_xx,np_yy + ok=NP_set(np_xx,np_yy,np,0) + if (.not.ok) then + print *,'try formatted version of file instead ...' + close(11) + goto 200 + endif + ok=.false. + if ((np_xx.gt.np_x).or.(np_yy.gt.np_y)) then + write(0,*) 'Dimension of the mask too big!' + write(0,*) ' Mask: NPX= ',np_xx,' NPY= ',np_yy + print *,'try formatted version of file instead ...' + close(11) + goto 200 + endif + do ix=1,np_xx + read(11,end=200,err=200) (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values read from ', + * name_mask(1:lnblnk(name_mask)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(11,file=dat) +C write(11,'(2i8)') np_xx,np_yy +C do ix=1,np_xx +C write (11,'(5g16.8)') (mask(ix,iy),iy=1,np_yy) +C enddo +C print *,np_xx,' x',np_yy,' values written to ', +C * dat(1:lnblnk(dat)) +C close(11) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(11,file=dat) + rewind(11) + read(11,'(2i8)') np_xx,np_yy + ok=NP_set(np_xx,np_yy,np,0) + if (.not.ok) goto 300 + ok=.false. + if ((np_xx.gt.np_x).or.(np_yy.gt.np_y)) then + write(0,*) 'Dimension of the mask too big!' + write(0,*) ' Mask: NPX= ',np_xx,' NPY= ',np_yy + close(11) + goto 300 + endif + do ix=1,np_xx + read (11,'(5g16.8)') (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values read from ', + * dat(1:lnblnk(dat)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=name_mask, EXIST=ex) + if (.not.ex) then +c if (access(name_mask,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(11,file=name_mask,form='unformatted') + write(11) np_xx,np_yy + do ix=1,np_xx + write(11) (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values written to from ', + * name_mask(1:lnblnk(name_mask)) + close(11) + endif + 250 continue + endif + + endif +c + return +c +c error + 300 print *,'failed to read unformatted data from ', + * name_mask(1:lnblnk(name_mask)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=name_mask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name_mask,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c---------------------------------------------------------------------------- + subroutine readranmask(namemask,NPX,NPY,nbf,rpix) + +c This subroutine reads the mask stored in the file name_mask. +c N.B.: This subroutine contains the same stuff as mask_2df, but has the +c advantage of giving back also sgn! + + implicit none + + integer nbf,NPX,NPY + real rpix(nbf,NPX,NPY) + character namemask*(*) + + integer i,j,k,npxx,npyy,nbff + + integer access,lnblnk + character*1 go + character*128 dat + logical ok + logical ex + character*3 re + + ok=.false. + + dat=namemask(1:lnblnk(namemask))//'.fmt' + +c try unformatted + inquire(FILE=namemask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(namemask,' r').eq.0) then + open(unit=14,file=namemask,status='old',form='unformatted') + rewind(14) + read(14,end=200,err=200) nbff,npxx,npyy + if ((npxx.ne.NPX).or.(npyy.ne.NPY).or.(nbff.ne.nbf)) then + write(*,*) 'Wrong dimensions for ran mask. Should have:' + & , npxx,npyy,nbff + print *,'try formatted version of file instead ...' + close(14) + goto 200 + endif + do k=1,nbff + do i=1,npxx + read(14,end=200,err=200) (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values read from ',namemask(1:lnblnk(namemask)) + ok=.true. + close(14) + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(14,file=dat) +C write(14,'(3i8)') nbff,npxx,npyy +C do k=1,nbff +C do i=1,npxx +C write (14,'(5g16.8)') (rpix(k,i,j),j=1,npyy) +C enddo +C enddo +C print *,nbff,' x',npxx,' x',npyy, +C * ' values written to ',dat(1:lnblnk(dat)) +C close(14) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(unit=14,file=dat) + rewind(14) + read(14,'(3i8)') nbff,npxx,npyy + if ((npxx.ne.NPX).or.(npyy.ne.NPY).or.(nbff.ne.nbf)) then + write(*,*) 'Wrong dimensions for ran mask. Should have:' + & , npxx,npyy,nbff + goto 300 + endif + do k=1,nbff + do i=1,npxx + read (14,'(5g16.8)') (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values read from ',dat(1:lnblnk(dat)) + close(14) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=namemask, EXIST=ex) + if (.not.ex) then +c if (access(namemask,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(14,file=namemask,form='unformatted') + write(14) nbff,npxx,npyy + do k=1,nbff + do i=1,npxx + write (14) (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values written to ',namemask(1:lnblnk(namemask)) + close(14) + endif + 250 continue + endif + + endif +c + return +c +c error + 300 print *,'failed to read unformatted data from ', + * namemask(1:lnblnk(namemask)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=namemask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(namemask,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c----------------------------------------------------------------------------- +c This subroutine reads the used 2dF random field centres from the file +c name, which contains also the overall completeness of the field (with +c respect to the underlying density field). Read the information written +c by write_ran2df_cen. + subroutine ran2df_cen_used(nb_field,xc,yc,zc,comp,name) +*************************************variables******************************** + implicit none + + integer nb_field + real xc(*),yc(*),zc(*),comp(*) + character name*(*) + + integer i + + integer access,lnblnk + character*1 go + character*128 dat + logical ok + logical ex + character*3 re + +****************************************************************************** + + dat=name(1:lnblnk(name))//'.fmt' + + ok=.false. + +c try unformatted + inquire(FILE=name, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name,' r').eq.0) then + open(unit=11,file=name,status='old',form='unformatted') + rewind(11) + read(11,end=200,err=200) nb_field + read(11,end=200,err=200) (xc(i),i=1,nb_field) + read(11,end=200,err=200) (yc(i),i=1,nb_field) + read(11,end=200,err=200) (zc(i),i=1,nb_field) + read(11,end=200,err=200) (comp(i),i=1,nb_field) + print *,nb_field,' x y z w values read from ', + * name(1:lnblnk(name)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(11,file=dat) +C write(11,'(i8," fields")') nb_field +C do i=1,nb_field +C write (11,'(4g16.8)') xc(i),yc(i),zc(i),comp(i) +C enddo +C print *,nb_field,' lines written to ',dat(1:lnblnk(dat)) +C close(11) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(11,file=dat) + rewind(11) + read(11,'(i8)') nb_field + do i=1,nb_field + read (11,'(4g16.8)') xc(i),yc(i),zc(i),comp(i) + enddo + print *,nb_field,' lines read from ',dat(1:lnblnk(dat)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=name, EXIST=ex) + if (.not.ex) then +c if (access(name,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(unit=11,file=name,form='unformatted') + write(11) nb_field + write(11) (xc(i),i=1,nb_field) + write(11) (yc(i),i=1,nb_field) + write(11) (zc(i),i=1,nb_field) + write(11) (comp(i),i=1,nb_field) + close(11) + print *,nb_field,' x y z w values written to ', + * name(1:lnblnk(name)) + endif + 250 continue + endif + + endif + + return +c +c error + 300 print *,'failed to read unformatted data from ', + * name(1:lnblnk(name)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=name, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c----------------------------------------------------------------------------- +c Convert an equatorial cartesian coordinate to the rx,ry pixel +c coordinate used for the 2df mask. This subroutine is valid for both +c sgp and ngp elements. +c +c + subroutine eq_2dfrx(NP,x,y,z,rx,ry,sgn) +*************************************variables******************************** + implicit none + intrinsic abs + real x,y,z,r,PI,EPS + parameter (EPS=3.e-13) + integer ifirst,sgn,NP,ix_min,iy_min + real racen,sc,deccen,rx,ry + double precision costheta + real xc,yc,zc,phi,dec_gc,ra_gc,xgc,ygc,zgc,sintheta_2 + & ,xgp,ygp,zgp,xx,yy,zz,phi0 + save ifirst,sc,xc,yc,zc,xgc,ygc,zgc,xgp,ygp,zgp,phi0,PI !ix_min,iy_min + data ifirst/1/ +****************************************************************************** + +c On the first call define the values which define the +c centre, orientation and scale of the transformation + if (ifirst.eq.1) then + ifirst=0 + PI= atan(1.)*4. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + sc = 120.0*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) +c This is a direction perpendicular to above but otherwise +c arbitrary provided that the phi0 has then been correctly +c set to be the offset between this arbitrary direction and +c that used for the projection of the APM SGP region + ra_gc = -94.40593*PI/180.0 + dec_gc = -28.90771*PI/180.0 + phi0=236.97694*PI/180.0 + xgc=cos(dec_gc)*cos(ra_gc) + ygc=cos(dec_gc)*sin(ra_gc) + zgc=sin(dec_gc) +c Generate the mutually perpendicular unit vector via +c the cross product + xgp = yc*zgc-zc*ygc + ygp = zc*xgc-xc*zgc + zgp = xc*ygc-yc*xgc + endif + +c Section utilized on each call +c Find components in the new 3D Cartesian system + r=sqrt(x**2+y**2+z**2) + zz=(x*xc+y*yc+z*zc) + xx=(x*xgc+y*ygc+z*zgc) + yy=(x*xgp+y*ygp+z*zgp) + +c Compute corresponding spherical polar angles + costheta= abs(dble(zz)/dble(r)) + sgn=int(sign(1.,zz/r)) ! tells if x,y,z is in the ngp or sgp region + phi=phi0-atan2(yy,xx) + if (phi.gt.2.0*PI) phi=phi-2.0*PI + +c Apply the Zenithal Equal Area Projection + if (sngl(dble(1.0)-costheta).ge.EPS) then + sintheta_2=sngl(dsqrt(dble(0.5)*(dble(1.0)-costheta))) + else + sintheta_2=0. + endif + r=2.*sintheta_2 !If sc changes, change this like:r=sintheta_2/sin(sc/4.) + +c convert to x,y coordinate + xx=-r*sin(phi)*real(NP)*0.5 + yy= r*cos(phi)*real(NP)*0.5 + + call bound_map_2df(NP,sgn,ix_min,iy_min) + + rx=xx+0.5*real(NP)-1.*real(ix_min) + ry=-yy+0.5*real(NP)-1.*real(iy_min) + + return + end + +c----------------------------------------------------------------------------- +c Convert the pixel postion rx,ry to ra and dec. +c This subroutine is the inverse of eq_2dfrx. Works for both ngp and sgp, +c as long as the sgn is given (respectively by -1 and 1). + + subroutine inv_eq_2dfrx(NP,rx,ry,sgn,x,y,z) +************************************variables********************************* + implicit none + intrinsic abs + real x,y,z,r,PI,EPS,EPS2,a(3,3),PI_hf,PI_3hf + parameter (EPS=3.e-13) + integer ifirst,sgn,NP,iy_min,ix_min + real racen,sc,deccen,costheta,rx,ry,delta_phi + & ,xc,yc,zc,phi,dec_gc,ra_gc,xgc,ygc,zgc,sintheta_2 + & ,xgp,ygp,zgp,xx,yy,zz,phi0 + save ifirst,sc,phi0,PI,EPS2,a,PI_hf,PI_3hf,xc,yc,zc !ix_min,iy_min + data ifirst/1/ +****************************************************************************** + +c On the first call define the values which define the +c centre, orientation and scale of the transformation + if (ifirst.eq.1) then + ifirst=0 + EPS2=sqrt(0.5*EPS) + PI= atan(1.)*4. + PI_hf=PI/2. + PI_3hf=3.*PI/2. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + sc = 120.0*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) +c This is a direction perpendicular to above but otherwise +c arbitrary provided that the phi0 has then been correctly +c set to be the offset between this arbitrary direction and +c that used for the projection of the APM SGP region + ra_gc = -94.40593*PI/180.0 + dec_gc = -28.90771*PI/180.0 + phi0=236.97694*PI/180.0 + xgc=cos(dec_gc)*cos(ra_gc) + ygc=cos(dec_gc)*sin(ra_gc) + zgc=sin(dec_gc) +c Generate the mutually perpendicular unit vector via +c the cross product + xgp = yc*zgc-zc*ygc + ygp = zc*xgc-xc*zgc + zgp = xc*ygc-yc*xgc +c Define Matrix a which is the inverse (transpose) of the base matrix + a(1,1)=xc + a(1,2)=xgc + a(1,3)=xgp + a(2,1)=yc + a(2,2)=ygc + a(2,3)=ygp + a(3,1)=zc + a(3,2)=zgc + a(3,3)=zgp + endif + +c Section utilized on each call + call bound_map_2df(NP,sgn,ix_min,iy_min) + + xx=rx+1.*real(ix_min)-0.5*real(NP) + yy=-ry-1.*real(iy_min)+0.5*real(NP) + + if ((xx.eq.0.).and.(yy.eq.0.)) then + x=xc*real(sgn) + y=yc*real(sgn) + z=zc*real(sgn) + return + endif + + phi=atan2(-xx,yy)+2.*PI + if (xx.eq.0.) then + r=yy/(cos(phi)*real(NP)*0.5) + else if (yy.eq.0.) then + r=-xx/(sin(phi)*real(NP)*0.5) + else if ( ((sgn.eq. 1).and.(abs(xx).gt.50.)) + & .or.((sgn.eq.-1).and.(abs(yy).lt.50.))) then + r=-xx/(sin(phi)*real(NP)*0.5) + else + r=yy/(cos(phi)*real(NP)*0.5) + endif + + sintheta_2=r*0.5!If sc changes, change like this:sintheta_2=r*sin(sc/4.) + if (sintheta_2.gt.EPS2) then + costheta=sngl((dble(1.)-dble(2.*sintheta_2**2)))*real(sgn) + else + costheta=1.*real(sgn) + endif + + zz=costheta + if (zz.gt.1.) zz= 1. ! rounding error corrections + if (zz.lt.-1.) zz=-1. + + delta_phi=phi0-phi + if (delta_phi.lt.0.) delta_phi=delta_phi+2.*PI + if ((delta_phi.le.PI_hf).or.(delta_phi.ge.PI_3hf)) then ! xx is positive + xx=sqrt((1.-zz**2)/(1.+tan(delta_phi)**2)) + yy=xx*tan(delta_phi) + else ! xx is negative + xx=-sqrt((1.-zz**2)/(1.+tan(delta_phi)**2)) + yy=xx*tan(delta_phi) + endif + + x=a(1,1)*zz+a(1,2)*xx+a(1,3)*yy + y=a(2,1)*zz+a(2,2)*xx+a(2,3)*yy + z=a(3,1)*zz+a(3,2)*xx+a(3,3)*yy + + return + end + +c----------------------------------------------------------------------------- +c This subroutine contains the boundaries of the sgp and ngp pixel map. +c It returns the ix_min and iy_min which are the offsets of the two maps. + + subroutine bound_map_2df(NP,sgn,ix_min,iy_min) +****************************************************************************** + implicit none + + integer NP,sgn,ix_min,iy_min +****************************************************************************** + + if (sgn.eq.1) then ! use the sgp map + ix_min=NP*15/100 + iy_min=NP*44/100 + else if (sgn.eq.-1) then ! use the ngp map + ix_min=NP*7/100 + iy_min=NP*60/100 + endif + + return + end + +c---------------------------------------------------------------------------- +c This subroutine gives the right boundaries for each random field mask, ie. +c calculates the offset needed such that the pixel center of each random +c field, given by (rxc,ryc), is located at (NPX_ran/2, NPY_ran/2) . +c + subroutine bound_map_ran(NPX_ran,NPY_ran,rxc,ryc,ixc_min,iyc_min) + + implicit none + + integer NPX_ran,NPY_ran,ixc_min,iyc_min + real rxc,ryc + + integer ixc,iyc + + + call rx_ix_map(rxc,ryc,ixc,iyc) + ixc_min=ixc-int(NPX_ran/2) + iyc_min=iyc-int(NPY_ran/2) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine converts real pixel coordinates rx,ry to integer +c ix,iy pixel coordinates. + + subroutine rx_ix_map(rx,ry,ix,iy) +****************************************************************************** + implicit none + + integer ix,iy + real rx,ry +****************************************************************************** + + ix=int(rx+0.5) + iy=int(ry+0.5) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine converts integer pixel coordinates ix,iy to real +c rx,ry pixel coordinates which corresponds to the center of the pixel. + + subroutine ix_rx_map(ix,iy,rx,ry) +****************************************************************************** + implicit none + + integer ix,iy + real rx,ry +****************************************************************************** + + rx=real(ix) + ry=real(iy) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine transforms x,y & z cartesian coordinates to ra & dec. + + subroutine xyz_radec(x,y,z,ra,dec) +****************************************************************************** + implicit none + + real x,y,z,ra,dec + + real PI2 + parameter (PI2=6.2831853072) + real zz +****************************************************************************** + + zz=sqrt(x**2+y**2+z**2) + dec= asin(z/zz) + if (y.lt.0) then + ra= atan2(y,x)+PI2 + else + ra= atan2(y,x) + endif + + return + end + +c----------------------------------------------------------------------------- +c This subroutine transforms ra & dec into x,y & z cartesian coordinates. + + subroutine radec_xyz(ra,dec,x,y,z) +****************************************************************************** + implicit none + + real x,y,z,ra,dec +****************************************************************************** + + x=cos(dec)*cos(ra) + y=cos(dec)*sin(ra) + z=sin(dec) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine sets and checks that NP and NPX_NPY are correct and that +c they correspond to the value used for NPX and NPY, the dimensions of the +c pixel grid. +c N.B.: NPX_NPY is also accepted if equal to 0 (default value if not +c used!) + + logical function NP_set(NPX,NPY,NP,NPX_NPY) +****************************************************************************** + implicit none + + integer NPX,NPY,NP,NPX_NPY + + integer num +****************************************************************************** + + NP_set=.true. + + NP=NPX*4/3 + if (NP.ne.NPY*4) then + write(0,*) 'Distortion of the pixel grid: NPX= ',NPX,' NPY=' + &, NPY,' do not obey NPX=3*NPY!' + NP_set=.false. + endif + +c We check also that NPX_NPY is NPX*NPY or NPX_NPY = 0 + num=NPX*NPY + if ((num.ne.NPX_NPY).and.(NPX_NPY.ne.0)) then + write(0,*) 'Wrong dimension on NPX_NPY; should be ',num + NP_set=.false. + endif + + return + end + +c----------------------------------------------------------------------------- +c This subroutine holes_2df_xyz tells if (x,y,z) is in a hole or not, +c depending on the value of io (io=1 not in a hole; io=0 in a hole). The +c value of sgn tells if it is a position in the ngp or sgp/ran. + + subroutine holes_2df_xyz(x,y,z,io) +*************************************variables******************************** + implicit none + + integer io + real x,y,z + + intrinsic abs + + integer jf,ifirst,in,sgn + real ra,dec,racen,deccen,xc,yc,zc,PI,r,zz + save ifirst,xc,yc,zc + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + data ifirst/1/ +****************************************************************************** + + if (ifirst.eq.1) then + ifirst=0 + PI= atan(1.)*4. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) + endif + + in=0 + r=sqrt(x**2+y**2+z**2) + zz=(x*xc+y*yc+z*zc) + sgn=int(sign(1.,zz/r)) + + call initialisation(sgn) + call xyz_radec(x,y,z,ra,dec) + + if ((ra.gt.pival).and.(sgn.eq.1))then + ra=ra-tpi + endif + + call fnumber(ra,dec,jf) + + if (sgn.eq.1) then + call test_sgp_holes(ra,dec,jf,in) + else + call test_ngp_holes(ra,dec,jf,in) + endif + + io=abs(in-1) ! N.B.: in = 1 if in a hole and 0 otherwise(opposite to io) + + return + end + +c---------------------------------------------------------------------------- + subroutine initialisation(sgn) +****************************************************************************** + implicit none + + integer sgn + + integer sgn_ifirst + save sgn_ifirst + data sgn_ifirst/0/ +****************************************************************************** + + if (sgn.ne.sgn_ifirst) then + sgn_ifirst=sgn + if (sgn.eq.1) then + call sgp_mask_init + else + call ngp_mask_init + endif + endif + + return + end + +c----------------------------------------------------------------------------- +c Given ra,dec in radians returns corresponding field no. + + subroutine fnumber(rar,decr,ifield) +****************************************************************************** + implicit none + + intrinsic abs + + integer ifield + real decr,rar + + integer iygrid,ixgrid,i + real ra,dec,raminus,yspace,ygrid,xspace,xgrid,xoff,yoff + + integer*4 field0h(22) + real*4 ragaps(22), decbands(22) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + + data (ragaps(i),i=1,22)/ 0.,144.,90.,66.,52.,44.,38.,33.,30.,28., + + 26.,24.,23.,22.,21.,20.,20.,20.,20.,20.,20.,20./ + data (decbands(i),i=1,22)/-90.,-85.,-80.,-75.,-70.,-65.,-60.,-55., + + -50.,-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,0.,5.,10.,15./ + data (field0h(i),i=1,22)/1,2,12,28,50,78,111,149,193,241,293,349, + + 409,472,538,607,679,751,823,895,967,1039 / +****************************************************************************** + +c find the nearest grid centre + ra = rar*180./pival + dec = decr*180./pival + + if (dec.gt.15.) then + ifield = 0 + return + end if + + if (ra.lt.0.) ra = ra + 360. + if (ra.gt.180.) then + raminus = ra - 360. + else + raminus = ra + end if + + yspace = 5.0 + iygrid = nint(dec/5.)+19 + ygrid = decbands(iygrid) + + xspace = ragaps(iygrid) + if (abs(raminus).lt.xspace/4.0/2.0) then ! 4 for degs, 2 for half field +c it's a 0hr field + xgrid = 0. + ixgrid = 0 + else + xspace = ragaps(iygrid) / 4.0 ! in degs + ixgrid = int(ra/xspace + 0.5) + xgrid = ixgrid * xspace + end if + + ifield = field0h(iygrid) + ixgrid + xoff = ra - xgrid + if (xoff.gt.180.) xoff = xoff - 360. + yoff = dec - ygrid + + return + end + +c----------------------------------------------------------------------------- +c Initialisation of the sgp_holes positions + + subroutine sgp_mask_init +****************************************************************************** + implicit none + + integer i,j,jhole(2000),nshols,ilast,jfld + real sxhole(3,2000),syhole(3,2000) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/sgphole/sxhole,syhole,jhole,nshols + common/last_field/ilast,jfld +****************************************************************************** + + ilast = 0 + open (unit=30,file='sgpholes.lis',status='old',form='formatted') + do i=1,2000 + read(30,*,end=999) (sxhole(j,i),syhole(j,i),j=1,3),jhole(i) + enddo + 999 nshols = i-1 + close(30) + + return + end + +c----------------------------------------------------------------------------- +c Initialisation of the ngp_holes positions + + subroutine ngp_mask_init +****************************************************************************** + implicit none + + integer i,j,jhole(300),nnhols,ilast,jfld + real xnhole(3,300),ynhole(3,300) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/ngphole/xnhole,ynhole,jhole,nnhols + common/last_field/ilast,jfld +****************************************************************************** + + open (unit=30,file='ngpholes.lis',status='old',form='formatted') + do i=1,300 + read(30,*,end=999) (xnhole(j,i),ynhole(j,i),j=1,3),jhole(i) + enddo + 999 nnhols = i-1 + close(30) + + return + end + +c---------------------------------------------------------------------------- +c Returns inhol = 1 if point (xx,yy) lies in a drilled region + + subroutine test_sgp_holes(xx,yy,jf,inhol) +****************************************************************************** + implicit none + + integer jf,inhol + real xx,yy + + intrinsic abs,max,min + + integer j,jhole(2000),nholes + real xhole(3,2000),yhole(3,2000),dx,dy,dx1,dy1,dx2,dy2,x0,y0,a1,a2 + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/sgphole/xhole,yhole,jhole,nholes +****************************************************************************** + + inhol = 0 + do j = 1,nholes + if (jhole(j).ne.jf) goto 124 + x0 = xhole(1,j) + y0 = yhole(1,j) + + if(y0.eq.yhole(3,j)) then ! It's a square hole + if(xx.le.min(x0,xhole(3,j)).or.xx.ge.max(x0,xhole(3,j))) + & goto 124 ! speed-up + end if + dx = xx-x0 + dy = yy-y0 + dx1 = xhole(2,j)-x0 + dy1 = yhole(2,j)-y0 + dx2 = xhole(3,j)-x0 + dy2 = yhole(3,j)-y0 + + if (abs(dx2).gt.0) then + a1 = (dx*dy2 - dy*dx2)/(dx1*dy2 - dy1*dx2) + a2 = (dx - a1*dx1)/dx2 + if (0.le.a1.and.a1.le.1.and.0.le.a2.and.a2.le.1) then + inhol = 1 + return + end if + end if + 124 continue + end do ! loop over holes + + return + end + +c----------------------------------------------------------------------------- +c Returns inhol = 1 if point (xx,yy) lies in a drilled region + + subroutine test_ngp_holes(xx,yy,jf,inhol) +****************************************************************************** + implicit none + + integer jf,inhol + real xx,yy + + intrinsic abs,max,min + + integer j,jhole(300),nholes + real xhole(3,300),yhole(3,300),dx,dy,dx1,dy1,dx2,dy2,x0,y0,a1,a2 + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/ngphole/xhole,yhole,jhole,nholes +****************************************************************************** + + inhol = 0 + do j = 1,nholes + if (jhole(j).ne.jf) goto 123 + x0 = xhole(1,j) + y0 = yhole(1,j) + if(y0.eq.yhole(3,j)) then ! It's a square hole + if(xx.le.min(x0,xhole(3,j)).or.xx.ge.max(x0,xhole(3,j))) + & goto 123 ! speed-up + end if + dx = xx-x0 + dy = yy-y0 + dx1 = xhole(2,j)-x0 + dy1 = yhole(2,j)-y0 + dx2 = xhole(3,j)-x0 + dy2 = yhole(3,j)-y0 + + if (abs(dx2).gt.0) then + a1 = (dx*dy2 - dy*dx2)/(dx1*dy2 - dy1*dx2) + a2 = (dx - a1*dx1)/dx2 + if (0.le.a1.and.a1.le.1.and.0.le.a2.and.a2.le.1) then + inhol = 1 + return + end if + end if + 123 continue + end do ! loop over holes + + return + end + +c----------------------------------------------------------------------------- diff --git a/src/twodf230k.f b/src/twodf230k.f new file mode 100644 index 0000000..6c99ddf --- /dev/null +++ b/src/twodf230k.f @@ -0,0 +1,1434 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + real*10 function twodf230k(ra,dec) + real*10 ra,dec +c +c parameters + include 'pi.par' + real*10 RADIAN + parameter (RADIAN=180._10/PI) +c data variables +C logical init +C real magcut +c local (automatic) variables + real rar,decr,compl,maglim +c * +c * Completeness of 30 June 2001 2dF 100k galaxy survey. +c * This is an interface to +c * the 2dFGRS mask software by Peder Norberg and Shaun Cole. +c +c * WARNING: +c * There is a hard-wired magnitude cut. +c * Comment it out if you don't want it. +c * +c Input: ra, dec = RA & Dec (B1950) in degrees. +c Output: twodf230k: 0 = empty to 1 = complete. +c +C data init /.true./ +c This magnitude cut gives the maximum number of survivors +C data magcut /19.27/ + +c convert from real*10 degrees to real*4 radians + rar=ra + decr=dec + if (rar.lt.0.) rar=rar+360. + if (rar.lt.0.) rar=rar+360. + rar=rar/RADIAN + decr=decr/RADIAN +c +c the 2dFGRS mask software by Peder Norberg and Shaun Cole + call in_2df_mask2(rar,decr,compl,maglim) + +c compl = -1. means the position is outside the main 2dF boundary + if (compl.eq.-1.) then + twodf230k=0._10 + +c compl = -2. means the position is inside a drill hole + elseif (compl.eq.-2.) then + twodf230k=0._10 + +c discard fields with limiting magnitude brighter than magcut +C COMMENT THIS OUT IF YOU DON'T WANT IT +C elseif (maglim.lt.magcut) then +C if (init) then +C write (*,'(" WARNING from twodf230k: USING HARD-WIRED MAGNITUDE CU +C *T OF ",f5.2)') magcut +C init=.false. +C endif +C twodf230k=0._10 + +c standard + else + +c completeness + twodf230k=compl + +c magnitude limit +c twodf230k=maglim + + endif + +c completeness: round to 8 decimal places + twodf230k=dble(nint(twodf230k*1.e8_10))/1.e8_10 + +c print *,ra,dec,compl,maglim,twodf230k +c + return + end +c +c======================================================================= +c +c The remaining code below is (with minor modifications) +c the mask_compl.f subroutine provided by the 2dFGRS team +c in the 30 June 2001 public release of data at +c http://www.mso.anu.edu.au/2dFGRS/Public/Release/index.html +c +c The minor modifications are options to read/write +c formatted as well as fortran unformatted data. +c +c The documentation at +c http://www.mso.anu.edu.au/2dFGRS/Public/Release/Masks/index.html +c states the following: +c +c 2. Copyright and use of the mask codes +c As a user of the mask codes, we request that you observe the following guidelines: +c The code provided here has been written by several members of the 2dFGRS team. +c Peder Norberg and Shaun Cole (University of Durham, UK) wrote the +c software used to create the survey masks. +c If you use any part of this 2dFGRS software, please acknowledge +c "the 2dFGRS mask software by Peder Norberg and Shaun Cole". +c This code is supplied as-is (i.e. we do not support any modifications +c to the file mask_compl.f containing the subroutines) and without guarantees +c - use it with caution and report any bugs. +c Read all of this documentation before trying to use the code! +c +c----------------------------------------------------------------------------- +c For a given position in ra & dec, this subroutine tells if this +c position is inside the 2df_mask or not, by returning the actual +c completeness. It returns in the same time the corresponding +c magnitude limit. + + subroutine in_2df_mask2(ra,dec,compl,maglim) +*************************************variables******************************** + implicit none + + real ra,dec,compl,maglim + + integer np_x,np_y + parameter (np_x=2*1800,np_y=2*600) + integer np_xx,np_yy,ifirst,ix,iy,np,sgn + real rpix(np_x,np_y),magpix(np_x,np_y),mupix(np_x,np_y) + real x,y,z,rx,ry + character name_mask*20,last_reg*3,reg*3 + save ifirst,np_xx,np_yy,np,rpix,magpix,last_reg + data ifirst/1/ +****************************************************************************** + +c Everytime check which region one points to: either ngp, sgp or ran + call which_reg2(ra,dec,reg) + + if (reg.eq.'ran') then + call in_2df_ran2(ra,dec,compl,maglim) + return + endif + +c On the first call, the program reads the mask + if ((ifirst.eq.1).or.(last_reg.ne.reg)) then + ifirst=0 + last_reg=reg + name_mask='mask.'//reg//'.dat' + call read_mask2(rpix,np_xx,np_yy,name_mask,np_x,np_y,np) + name_mask='maglim.'//reg//'.dat' + call read_mask2(magpix,np_xx,np_yy,name_mask,np_x,np_y,np) + name_mask='mumask.'//reg//'.dat' + call read_mask2(mupix,np_xx,np_yy,name_mask,np_x,np_y,np) +c write(0,*) 'Read masks for ',reg,' region!' + endif + + call radec_xyz2(ra,dec,x,y,z) + call eq_2dfrx2(np,x,y,z,rx,ry,sgn) + call rx_ix_map2(rx,ry,ix,iy) + + if ((ix.ge.1).and.(ix.le.np_xx).and. + : (iy.ge.1).and.(iy.le.np_yy)) then + compl=rpix(ix,iy) + maglim=magpix(ix,iy) + else + compl= -1.0 !default value (i.e. outside 2dF boundary) + maglim=-2.0 !default value (i.e. outside 2dF boundary) + endif + + return + end + +c----------------------------------------------------------------------------- +c For a given position in ra & dec, this subroutine tells if this +c position is inside one of the used random fields or not, by returning +c the actual completeness of the field. + + subroutine in_2df_ran2(ra,dec,compl,maglim) +*************************************variables******************************** + implicit none + + real ra,dec,compl,maglim + + integer nmax,NP,NPX,NPY + real theta_min + parameter (nmax=98,NP=2400,NPX=100,NPY=100,theta_min=1.014) + logical in + integer i,ifirst,nb_field,io + real costheta,costheta_r,costheta_min,xc(nmax),yc(nmax),zc(nmax) + &, comp(nmax),r,x,y,z,magpix(nmax,NPX,NPY),mupix(nmax,NPX,NPY) + character name_mask*20 + data ifirst/1/ + save ifirst,nb_field,xc,yc,zc,comp,costheta_min,magpix +****************************************************************************** + +c On the first call, reads the file containing the random fields + if (ifirst.eq.1) then + ifirst=0 + name_mask='mask.ran.dat' + call ran2df_cen_used2(nb_field,xc,yc,zc,comp,name_mask) + name_mask='maglim.ran.dat' + call readranmask2(name_mask,NPX,NPY,nmax,magpix) + name_mask='mumask.ran.dat' + call readranmask2(name_mask,NPX,NPY,nmax,mupix) + costheta_min=cos(theta_min*atan(1.)/45.) +c write(0,*) 'Read mask for ran region!' + endif + + i=0 + in=.false. + call radec_xyz2(ra,dec,x,y,z) + r=sqrt(x**2+y**2+z**2) + costheta_r=costheta_min*r + do while ((.not.in).and.(i.lt.nb_field)) + i=i+1 + costheta=(x*xc(i)+y*yc(i)+z*zc(i)) + if (costheta.gt.costheta_r) then ! We use here the fact the random + in=.true. ! fields doesn't overlapp with + endif ! each other... + enddo + + if (in) then + call holes_2df_xyz2(x,y,z,io) +c compl=comp(i)*real(io) ! io = 0 if in a hole; 1 otherwise + if (io.eq.0) then + compl=-2. ! default value in holes + maglim=-2. ! default value when not specified + else + compl=comp(i) + call get_maglimran2(NP,NPX,NPY,x,y,z,xc(i),yc(i),zc(i) + &, maglim,nmax,magpix,i) + endif + + + else + compl=-1. ! default value (ie. outside 2dF boundary) + maglim=-2. ! default value (when not specified) + endif + + return + end + +c---------------------------------------------------------------------------- +c Given x,y,z position and centre of the corresponding random field, +c returns the magnitude limit at that position + subroutine get_maglimran2(NP,NPX,NPY,x,y,z,xc,yc,zc,maglim + &, nmax,magpix,ifield) + + implicit none + + integer NP,NPX,NPY,nmax,ifield + real x,y,z,xc,yc,zc,maglim,magpix(nmax,NPX,NPY) + + intrinsic max,min + + integer sgn,ixc_min,iyc_min,ix,iy + real rx,ry + +c integer ifirst,max_ix,max_iy,min_ix,min_iy,inum +c data ifirst/-1/ +c save ifirst,max_ix,max_iy,min_ix,min_iy,inum + +c if (ifirst.eq.-1) then +c ifirst=0 +c inum=0 +c max_ix=0 +c min_ix=NPX +c max_iy=0 +c min_iy=NPY +c endif + +c ifirst=ifirst+1 + call eq_2dfrx2(NP,xc,yc,zc,rx,ry,sgn) + call bound_map_ran2(NPX,NPY,rx,ry,ixc_min,iyc_min) + + call eq_2dfrx2(NP,x,y,z,rx,ry,sgn) + call rx_ix_map2(rx,ry,ix,iy) + + ix=min(max(1,ix-ixc_min),NPX) + iy=min(max(1,iy-iyc_min),NPY) +c ix = ix-ixc_min +c iy = iy-iyc_min +c if ((ix.ge.1).and.(ix.le.NPX).and.(iy.ge.1).and.(iy.le.NPY)) then + maglim=magpix(ifield,ix,iy) +c else +c write(*,*) 'ix=',ix,'iy=',iy,ifield +c max_ix=max(ix,max_ix) +c min_ix=min(ix,min_ix) +c max_iy=max(iy,max_iy) +c min_iy=min(iy,min_iy) +c maglim=1.0 +c inum=inum+1 +c endif +c +c if (ifirst.ge.57012) then +c write(*,*) ifirst,inum,max_ix,max_iy,min_ix,min_iy +c endif + + return + end + +c---------------------------------------------------------------------------- +c Given ra & dec determines which region to look at + subroutine which_reg2(ra,dec,reg) +*************************************variables******************************** + implicit none + + real ra,dec + character reg*(*) + + real EPS + parameter (EPS=1.e-5) + integer i,ifirst,nb_strip,nb_stripsgp,nb_stripngp + real ra_min(4),ra_max(4),dec_min(4),dec_max(4) + data ifirst/1/ + save ra_min,ra_max,dec_min,dec_max,nb_strip,nb_stripsgp + &, nb_stripngp,ifirst +****************************************************************************** + + if (ifirst.eq.1) then + ifirst=0 + nb_stripsgp=3 + nb_stripngp=4 + nb_strip=5 +c SGP strips + ra_min(1)= 5.711590 ! 21h49m + ra_max(1)= 0.911935 ! 3h29m + dec_min(1)= -0.479966 ! -27.5 deg + dec_max(1)= -0.392699 ! -22.5 deg + ra_min(2)= 5.670138 ! 21h39.5m + ra_max(2)= 0.975203 ! 3h43.5m + dec_min(2)= -0.567232 ! -32.5 deg + dec_max(2)= -0.479966 ! -27.5 deg + ra_min(3)= 5.707227 ! 21h48m + ra_max(3)= 0.890118 ! 3h24m + dec_min(3)= -0.654498 ! -37.5 deg + dec_max(3)= -0.567232 ! -32.5 deg +c NGP strips + ra_min(4)= 2.574361 ! 9h50m + ra_max(4)= 3.883358 ! 14h50m + dec_min(4)= -0.130900 ! -7.5 deg + dec_max(4)= +0.043633 ! +2.5 deg +c Make boundaries more secure + do i=1,4 + ra_min(i)=ra_min(i)-EPS + ra_max(i)=ra_max(i)+EPS + dec_min(i)=dec_min(i)-EPS + dec_max(i)=dec_max(i)+EPS + enddo + endif + + i=0 + do while (i.lt.nb_stripsgp) + i=i+1 + if (((ra_min(i).le.ra).or.(ra_max(i).ge.ra)).and. + & (dec_min(i).le.dec).and.(dec_max(i).ge.dec)) then + i=nb_strip + reg='sgp' + endif + enddo + + do while (i.lt.nb_stripngp) + i=i+1 + if ((ra_min(i).le.ra).and.(ra_max(i).ge.ra).and. + & (dec_min(i).le.dec).and.(dec_max(i).ge.dec)) then + i=nb_strip + reg='ngp' + endif + enddo + + if (i.ne.nb_strip) reg='ran' + + return + end + +c---------------------------------------------------------------------------- +c Subroutine to read the 2dF mask +c + subroutine read_mask2(mask,np_xx,np_yy,name_mask,np_x,np_y,np) +*************************************variables******************************** + implicit none + + integer np_x,np_y,np_xx,np_yy,np + real mask(np_x,np_y) + character name_mask*(*) + + integer ix,iy + + integer access,lnblnk + character*1 go + character*128 dat + logical np_set2,ok + logical ex + character*3 re +****************************************************************************** + + dat=name_mask(1:lnblnk(name_mask))//'.fmt' + + ok=.false. + +c try unformatted + inquire(FILE=name_mask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name_mask,' r').eq.0) then + open(11,file=name_mask,status='old',form='unformatted') + rewind(11) + read(11,end=200,err=200) np_xx,np_yy + ok=np_set2(np_xx,np_yy,np,0) + if (.not.ok) then + print *,'try formatted version of file instead ...' + close(11) + goto 200 + endif + ok=.false. + if ((np_xx.gt.np_x).or.(np_yy.gt.np_y)) then + write(0,*) 'Dimension of the mask too big!' + write(0,*) ' Mask: NPX= ',np_xx,' NPY= ',np_yy + print *,'try formatted version of file instead ...' + close(11) + goto 200 + endif + do ix=1,np_xx + read(11,end=200,err=200) (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values read from ', + * name_mask(1:lnblnk(name_mask)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(11,file=dat) +C write(11,'(2i8)') np_xx,np_yy +C do ix=1,np_xx +C write (11,'(5g16.8)') (mask(ix,iy),iy=1,np_yy) +C enddo +C print *,np_xx,' x',np_yy,' values written to ', +C * dat(1:lnblnk(dat)) +C close(11) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(11,file=dat) + rewind(11) + read(11,'(2i8)') np_xx,np_yy + ok=np_set2(np_xx,np_yy,np,0) + if (.not.ok) goto 300 + ok=.false. + if ((np_xx.gt.np_x).or.(np_yy.gt.np_y)) then + write(0,*) 'Dimension of the mask too big!' + write(0,*) ' Mask: NPX= ',np_xx,' NPY= ',np_yy + close(11) + goto 300 + endif + do ix=1,np_xx + read (11,'(5g16.8)') (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values read from ', + * dat(1:lnblnk(dat)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=name_mask, EXIST=ex) + if (.not.ex) then +c if (access(name_mask,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(11,file=name_mask,form='unformatted') + write(11) np_xx,np_yy + do ix=1,np_xx + write(11) (mask(ix,iy),iy=1,np_yy) + enddo + print *,np_xx,' x',np_yy,' values written to from ', + * name_mask(1:lnblnk(name_mask)) + close(11) + endif + 250 continue + endif + + endif +c + return +c +c error + 300 print *,'failed to read unformatted data from ', + * name_mask(1:lnblnk(name_mask)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=name_mask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name_mask,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c---------------------------------------------------------------------------- + subroutine readranmask2(namemask,NPX,NPY,nbf,rpix) + +c This subroutine reads the mask stored in the file name_mask. +c N.B.: This subroutine contains the same stuff as mask_2df, but has the +c advantage of giving back also sgn! + + implicit none + + integer nbf,NPX,NPY + real rpix(nbf,NPX,NPY) + character namemask*(*) + + integer i,j,k,npxx,npyy,nbff + + integer access,lnblnk + character*1 go + character*128 dat + logical ok + logical ex + character*3 re + + ok=.false. + + dat=namemask(1:lnblnk(namemask))//'.fmt' + +c try unformatted + inquire(FILE=namemask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(namemask,' r').eq.0) then + open(unit=14,file=namemask,status='old',form='unformatted') + rewind(14) + read(14,end=200,err=200) nbff,npxx,npyy + if ((npxx.ne.NPX).or.(npyy.ne.NPY).or.(nbff.ne.nbf)) then + write(*,*) 'Wrong dimensions for ran mask. Should have:' + & , npxx,npyy,nbff + print *,'try formatted version of file instead ...' + close(14) + goto 200 + endif + do k=1,nbff + do i=1,npxx + read(14,end=200,err=200) (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values read from ',namemask(1:lnblnk(namemask)) + ok=.true. + close(14) + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(14,file=dat) +C write(14,'(3i8)') nbff,npxx,npyy +C do k=1,nbff +C do i=1,npxx +C write (14,'(5g16.8)') (rpix(k,i,j),j=1,npyy) +C enddo +C enddo +C print *,nbff,' x',npxx,' x',npyy, +C * ' values written to ',dat(1:lnblnk(dat)) +C close(14) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(unit=14,file=dat) + rewind(14) + read(14,'(3i8)') nbff,npxx,npyy + if ((npxx.ne.NPX).or.(npyy.ne.NPY).or.(nbff.ne.nbf)) then + write(*,*) 'Wrong dimensions for ran mask. Should have:' + & , npxx,npyy,nbff + goto 300 + endif + do k=1,nbff + do i=1,npxx + read (14,'(5g16.8)') (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values read from ',dat(1:lnblnk(dat)) + close(14) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=namemask, EXIST=ex) + if (.not.ex) then +c if (access(namemask,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(14,file=namemask,form='unformatted') + write(14) nbff,npxx,npyy + do k=1,nbff + do i=1,npxx + write (14) (rpix(k,i,j),j=1,npyy) + enddo + enddo + print *,nbff,' x',npxx,' x',npyy, + * ' values written to ',namemask(1:lnblnk(namemask)) + close(14) + endif + 250 continue + endif + + endif +c + return +c +c error + 300 print *,'failed to read unformatted data from ', + * namemask(1:lnblnk(namemask)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=namemask, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(namemask,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c----------------------------------------------------------------------------- +c This subroutine reads the used 2dF random field centres from the file +c name, which contains also the overall completeness of the field (with +c respect to the underlying density field). Read the information written +c by write_ran2df_cen. + subroutine ran2df_cen_used2(nb_field,xc,yc,zc,comp,name) +*************************************variables******************************** + implicit none + + integer nb_field + real xc(*),yc(*),zc(*),comp(*) + character name*(*) + + integer i + + integer access,lnblnk + character*1 go + character*128 dat + logical ok + logical ex + character*3 re + +****************************************************************************** + + dat=name(1:lnblnk(name))//'.fmt' + + ok=.false. + +c try unformatted + inquire(FILE=name, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name,' r').eq.0) then + open(unit=11,file=name,status='old',form='unformatted') + rewind(11) + read(11,end=200,err=200) nb_field + read(11,end=200,err=200) (xc(i),i=1,nb_field) + read(11,end=200,err=200) (yc(i),i=1,nb_field) + read(11,end=200,err=200) (zc(i),i=1,nb_field) + read(11,end=200,err=200) (comp(i),i=1,nb_field) + print *,nb_field,' x y z w values read from ', + * name(1:lnblnk(name)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT +C inquire(FILE=dat, EXIST=ex) +C if (.not.ex) then +Cc if (access(dat,' ').ne.0) then +C print *,'write FORMATTED values? [CR,n=no, y=yes]' +C read (*,'(a1)',end=150,err=150) go +C if (go.eq.'y'.or.go.eq.'Y') then +C open(11,file=dat) +C write(11,'(i8," fields")') nb_field +C do i=1,nb_field +C write (11,'(4g16.8)') xc(i),yc(i),zc(i),comp(i) +C enddo +C print *,nb_field,' lines written to ',dat(1:lnblnk(dat)) +C close(11) +C endif +C 150 continue +C endif + + endif + +c try formatted + 200 if (.not.ok) then + inquire(FILE=dat, EXIST=ex) + if (.not.ex) goto 300 +c if (access(dat,' ').ne.0) goto 300 + open(11,file=dat) + rewind(11) + read(11,'(i8)') nb_field + do i=1,nb_field + read (11,'(4g16.8)') xc(i),yc(i),zc(i),comp(i) + enddo + print *,nb_field,' lines read from ',dat(1:lnblnk(dat)) + close(11) + ok=.true. + +c COMMENT THIS OUT IF YOU DON'T WANT IT + inquire(FILE=name, EXIST=ex) + if (.not.ex) then +c if (access(name,' ').ne.0) then + print *,'write UNFORMATTED values? [CR,n=no, y=yes]' + read (*,'(a1)',end=250,err=250) go + if (go.eq.'y'.or.go.eq.'Y') then + open(unit=11,file=name,form='unformatted') + write(11) nb_field + write(11) (xc(i),i=1,nb_field) + write(11) (yc(i),i=1,nb_field) + write(11) (zc(i),i=1,nb_field) + write(11) (comp(i),i=1,nb_field) + close(11) + print *,nb_field,' x y z w values written to ', + * name(1:lnblnk(name)) + endif + 250 continue + endif + + endif + + return +c +c error + 300 print *,'failed to read unformatted data from ', + * name(1:lnblnk(name)) + print *,'or formatted data from ', + * dat(1:lnblnk(dat)) + inquire(FILE=name, EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(name,' r').eq.0) then + print *,'you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + endif + stop +c + end + +c----------------------------------------------------------------------------- +c Convert an equatorial cartesian coordinate to the rx,ry pixel +c coordinate used for the 2df mask. This subroutine is valid for both +c sgp and ngp elements. +c +c + subroutine eq_2dfrx2(NP,x,y,z,rx,ry,sgn) +*************************************variables******************************** + implicit none + intrinsic abs + real x,y,z,r,PI,EPS + parameter (EPS=3.e-13) + integer ifirst,sgn,NP,ix_min,iy_min + real racen,sc,deccen,rx,ry + double precision costheta + real xc,yc,zc,phi,dec_gc,ra_gc,xgc,ygc,zgc,sintheta_2 + & ,xgp,ygp,zgp,xx,yy,zz,phi0 + save ifirst,sc,xc,yc,zc,xgc,ygc,zgc,xgp,ygp,zgp,phi0,PI !ix_min,iy_min + data ifirst/1/ +****************************************************************************** + +c On the first call define the values which define the +c centre, orientation and scale of the transformation + if (ifirst.eq.1) then + ifirst=0 + PI= atan(1.)*4. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + sc = 120.0*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) +c This is a direction perpendicular to above but otherwise +c arbitrary provided that the phi0 has then been correctly +c set to be the offset between this arbitrary direction and +c that used for the projection of the APM SGP region + ra_gc = -94.40593*PI/180.0 + dec_gc = -28.90771*PI/180.0 + phi0=236.97694*PI/180.0 + xgc=cos(dec_gc)*cos(ra_gc) + ygc=cos(dec_gc)*sin(ra_gc) + zgc=sin(dec_gc) +c Generate the mutually perpendicular unit vector via +c the cross product + xgp = yc*zgc-zc*ygc + ygp = zc*xgc-xc*zgc + zgp = xc*ygc-yc*xgc + endif + +c Section utilized on each call +c Find components in the new 3D Cartesian system + r=sqrt(x**2+y**2+z**2) + zz=(x*xc+y*yc+z*zc) + xx=(x*xgc+y*ygc+z*zgc) + yy=(x*xgp+y*ygp+z*zgp) + +c Compute corresponding spherical polar angles + costheta= abs(dble(zz)/dble(r)) + sgn=int(sign(1.,zz/r)) ! tells if x,y,z is in the ngp or sgp region + phi=phi0-atan2(yy,xx) + if (phi.gt.2.0*PI) phi=phi-2.0*PI + +c Apply the Zenithal Equal Area Projection + if (sngl(dble(1.0)-costheta).ge.EPS) then + sintheta_2=sngl(dsqrt(dble(0.5)*(dble(1.0)-costheta))) + else + sintheta_2=0. + endif + r=2.*sintheta_2 !If sc changes, change this like:r=sintheta_2/sin(sc/4.) + +c convert to x,y coordinate + xx=-r*sin(phi)*real(NP)*0.5 + yy= r*cos(phi)*real(NP)*0.5 + + call bound_map_2df2(NP,sgn,ix_min,iy_min) + + rx=xx+0.5*real(NP)-1.*real(ix_min) + ry=-yy+0.5*real(NP)-1.*real(iy_min) + + return + end + +c----------------------------------------------------------------------------- +c Convert the pixel postion rx,ry to ra and dec. +c This subroutine is the inverse of eq_2dfrx2. Works for both ngp and sgp, +c as long as the sgn is given (respectively by -1 and 1). + + subroutine inv_eq_2dfrx2(NP,rx,ry,sgn,x,y,z) +************************************variables********************************* + implicit none + intrinsic abs + real x,y,z,r,PI,EPS,EPS2,a(3,3),PI_hf,PI_3hf + parameter (EPS=3.e-13) + integer ifirst,sgn,NP,iy_min,ix_min + real racen,sc,deccen,costheta,rx,ry,delta_phi + & ,xc,yc,zc,phi,dec_gc,ra_gc,xgc,ygc,zgc,sintheta_2 + & ,xgp,ygp,zgp,xx,yy,zz,phi0 + save ifirst,sc,phi0,PI,EPS2,a,PI_hf,PI_3hf,xc,yc,zc !ix_min,iy_min + data ifirst/1/ +****************************************************************************** + +c On the first call define the values which define the +c centre, orientation and scale of the transformation + if (ifirst.eq.1) then + ifirst=0 + EPS2=sqrt(0.5*EPS) + PI= atan(1.)*4. + PI_hf=PI/2. + PI_3hf=3.*PI/2. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + sc = 120.0*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) +c This is a direction perpendicular to above but otherwise +c arbitrary provided that the phi0 has then been correctly +c set to be the offset between this arbitrary direction and +c that used for the projection of the APM SGP region + ra_gc = -94.40593*PI/180.0 + dec_gc = -28.90771*PI/180.0 + phi0=236.97694*PI/180.0 + xgc=cos(dec_gc)*cos(ra_gc) + ygc=cos(dec_gc)*sin(ra_gc) + zgc=sin(dec_gc) +c Generate the mutually perpendicular unit vector via +c the cross product + xgp = yc*zgc-zc*ygc + ygp = zc*xgc-xc*zgc + zgp = xc*ygc-yc*xgc +c Define Matrix a which is the inverse (transpose) of the base matrix + a(1,1)=xc + a(1,2)=xgc + a(1,3)=xgp + a(2,1)=yc + a(2,2)=ygc + a(2,3)=ygp + a(3,1)=zc + a(3,2)=zgc + a(3,3)=zgp + endif + +c Section utilized on each call + call bound_map_2df2(NP,sgn,ix_min,iy_min) + + xx=rx+1.*real(ix_min)-0.5*real(NP) + yy=-ry-1.*real(iy_min)+0.5*real(NP) + + if ((xx.eq.0.).and.(yy.eq.0.)) then + x=xc*real(sgn) + y=yc*real(sgn) + z=zc*real(sgn) + return + endif + + phi=atan2(-xx,yy)+2.*PI + if (xx.eq.0.) then + r=yy/(cos(phi)*real(NP)*0.5) + else if (yy.eq.0.) then + r=-xx/(sin(phi)*real(NP)*0.5) + else if ( ((sgn.eq. 1).and.(abs(xx).gt.50.)) + & .or.((sgn.eq.-1).and.(abs(yy).lt.50.))) then + r=-xx/(sin(phi)*real(NP)*0.5) + else + r=yy/(cos(phi)*real(NP)*0.5) + endif + + sintheta_2=r*0.5!If sc changes, change like this:sintheta_2=r*sin(sc/4.) + if (sintheta_2.gt.EPS2) then + costheta=sngl((dble(1.)-dble(2.*sintheta_2**2)))*real(sgn) + else + costheta=1.*real(sgn) + endif + + zz=costheta + if (zz.gt.1.) zz= 1. ! rounding error corrections + if (zz.lt.-1.) zz=-1. + + delta_phi=phi0-phi + if (delta_phi.lt.0.) delta_phi=delta_phi+2.*PI + if ((delta_phi.le.PI_hf).or.(delta_phi.ge.PI_3hf)) then ! xx is positive + xx=sqrt((1.-zz**2)/(1.+tan(delta_phi)**2)) + yy=xx*tan(delta_phi) + else ! xx is negative + xx=-sqrt((1.-zz**2)/(1.+tan(delta_phi)**2)) + yy=xx*tan(delta_phi) + endif + + x=a(1,1)*zz+a(1,2)*xx+a(1,3)*yy + y=a(2,1)*zz+a(2,2)*xx+a(2,3)*yy + z=a(3,1)*zz+a(3,2)*xx+a(3,3)*yy + + return + end + +c----------------------------------------------------------------------------- +c This subroutine contains the boundaries of the sgp and ngp pixel map. +c It returns the ix_min and iy_min which are the offsets of the two maps. + + subroutine bound_map_2df2(NP,sgn,ix_min,iy_min) +****************************************************************************** + implicit none + + integer NP,sgn,ix_min,iy_min +****************************************************************************** + + if (sgn.eq.1) then ! use the sgp map + ix_min=NP*15/100 + iy_min=NP*44/100 + else if (sgn.eq.-1) then ! use the ngp map + ix_min=NP*7/100 + iy_min=NP*60/100 + endif + + return + end + +c---------------------------------------------------------------------------- +c This subroutine gives the right boundaries for each random field mask, ie. +c calculates the offset needed such that the pixel center of each random +c field, given by (rxc,ryc), is located at (NPX_ran/2, NPY_ran/2) . +c + subroutine bound_map_ran2(NPX_ran,NPY_ran,rxc,ryc,ixc_min,iyc_min) + + implicit none + + integer NPX_ran,NPY_ran,ixc_min,iyc_min + real rxc,ryc + + integer ixc,iyc + + + call rx_ix_map2(rxc,ryc,ixc,iyc) + ixc_min=ixc-int(NPX_ran/2) + iyc_min=iyc-int(NPY_ran/2) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine converts real pixel coordinates rx,ry to integer +c ix,iy pixel coordinates. + + subroutine rx_ix_map2(rx,ry,ix,iy) +****************************************************************************** + implicit none + + integer ix,iy + real rx,ry +****************************************************************************** + + ix=int(rx+0.5) + iy=int(ry+0.5) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine converts integer pixel coordinates ix,iy to real +c rx,ry pixel coordinates which corresponds to the center of the pixel. + + subroutine ix_rx_map2(ix,iy,rx,ry) +****************************************************************************** + implicit none + + integer ix,iy + real rx,ry +****************************************************************************** + + rx=real(ix) + ry=real(iy) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine transforms x,y & z cartesian coordinates to ra & dec. + + subroutine xyz_radec2(x,y,z,ra,dec) +****************************************************************************** + implicit none + + real x,y,z,ra,dec + + real PI2 + parameter (PI2=6.2831853072) + real zz +****************************************************************************** + + zz=sqrt(x**2+y**2+z**2) + dec= asin(z/zz) + if (y.lt.0) then + ra= atan2(y,x)+PI2 + else + ra= atan2(y,x) + endif + + return + end + +c----------------------------------------------------------------------------- +c This subroutine transforms ra & dec into x,y & z cartesian coordinates. + + subroutine radec_xyz2(ra,dec,x,y,z) +****************************************************************************** + implicit none + + real x,y,z,ra,dec +****************************************************************************** + + x=cos(dec)*cos(ra) + y=cos(dec)*sin(ra) + z=sin(dec) + + return + end + +c----------------------------------------------------------------------------- +c This subroutine sets and checks that NP and NPX_NPY are correct and that +c they correspond to the value used for NPX and NPY, the dimensions of the +c pixel grid. +c N.B.: NPX_NPY is also accepted if equal to 0 (default value if not +c used!) + + logical function np_set2(NPX,NPY,NP,NPX_NPY) +****************************************************************************** + implicit none + + integer NPX,NPY,NP,NPX_NPY + + integer num +****************************************************************************** + + np_set2=.true. + + NP=NPX*4/3 + if (NP.ne.NPY*4) then + write(0,*) 'Distortion of the pixel grid: NPX= ',NPX,' NPY=' + &, NPY,' do not obey NPX=3*NPY!' + np_set2=.false. + endif + +c We check also that NPX_NPY is NPX*NPY or NPX_NPY = 0 + num=NPX*NPY + if ((num.ne.NPX_NPY).and.(NPX_NPY.ne.0)) then + write(0,*) 'Wrong dimension on NPX_NPY; should be ',num + np_set2=.false. + endif + + return + end + +c----------------------------------------------------------------------------- +c This subroutine holes_2df_xyz2 tells if (x,y,z) is in a hole or not, +c depending on the value of io (io=1 not in a hole; io=0 in a hole). The +c value of sgn tells if it is a position in the ngp or sgp/ran. + + subroutine holes_2df_xyz2(x,y,z,io) +*************************************variables******************************** + implicit none + + integer io + real x,y,z + + intrinsic abs + + integer jf,ifirst,in,sgn + real ra,dec,racen,deccen,xc,yc,zc,PI,r,zz + save ifirst,xc,yc,zc + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + data ifirst/1/ +****************************************************************************** + + if (ifirst.eq.1) then + ifirst=0 + PI= atan(1.)*4. +c This is the direction of the Galactic Centre as adopted +c by Steve Maddox + racen = 12.3*PI/180.0 + deccen = -27.5*PI/180.0 + xc=cos(deccen)*cos(racen) + yc=cos(deccen)*sin(racen) + zc=sin(deccen) + endif + + in=0 + r=sqrt(x**2+y**2+z**2) + zz=(x*xc+y*yc+z*zc) + sgn=int(sign(1.,zz/r)) + + call initialisation2(sgn) + call xyz_radec2(x,y,z,ra,dec) + + if ((ra.gt.pival).and.(sgn.eq.1))then + ra=ra-tpi + endif + + call fnumber2(ra,dec,jf) + + if (sgn.eq.1) then + call test_sgp_holes2(ra,dec,jf,in) + else + call test_ngp_holes2(ra,dec,jf,in) + endif + + io=abs(in-1) ! N.B.: in = 1 if in a hole and 0 otherwise(opposite to io) + + return + end + +c---------------------------------------------------------------------------- + subroutine initialisation2(sgn) +****************************************************************************** + implicit none + + integer sgn + + integer sgn_ifirst + save sgn_ifirst + data sgn_ifirst/0/ +****************************************************************************** + + if (sgn.ne.sgn_ifirst) then + sgn_ifirst=sgn + if (sgn.eq.1) then + call sgp_mask_init2 + else + call ngp_mask_init2 + endif + endif + + return + end + +c----------------------------------------------------------------------------- +c Given ra,dec in radians returns corresponding field no. + + subroutine fnumber2(rar,decr,ifield) +****************************************************************************** + implicit none + + intrinsic abs + + integer ifield + real decr,rar + + integer iygrid,ixgrid,i + real ra,dec,raminus,yspace,ygrid,xspace,xgrid,xoff,yoff + + integer*4 field0h(22) + real*4 ragaps(22), decbands(22) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + + data (ragaps(i),i=1,22)/ 0.,144.,90.,66.,52.,44.,38.,33.,30.,28., + + 26.,24.,23.,22.,21.,20.,20.,20.,20.,20.,20.,20./ + data (decbands(i),i=1,22)/-90.,-85.,-80.,-75.,-70.,-65.,-60.,-55., + + -50.,-45.,-40.,-35.,-30.,-25.,-20.,-15.,-10.,-5.,0.,5.,10.,15./ + data (field0h(i),i=1,22)/1,2,12,28,50,78,111,149,193,241,293,349, + + 409,472,538,607,679,751,823,895,967,1039 / +****************************************************************************** + +c find the nearest grid centre + ra = rar*180./pival + dec = decr*180./pival + + if (dec.gt.15.) then + ifield = 0 + return + end if + + if (ra.lt.0.) ra = ra + 360. + if (ra.gt.180.) then + raminus = ra - 360. + else + raminus = ra + end if + + yspace = 5.0 + iygrid = nint(dec/5.)+19 + ygrid = decbands(iygrid) + + xspace = ragaps(iygrid) + if (abs(raminus).lt.xspace/4.0/2.0) then ! 4 for degs, 2 for half field +c it's a 0hr field + xgrid = 0. + ixgrid = 0 + else + xspace = ragaps(iygrid) / 4.0 ! in degs + ixgrid = int(ra/xspace + 0.5) + xgrid = ixgrid * xspace + end if + + ifield = field0h(iygrid) + ixgrid + xoff = ra - xgrid + if (xoff.gt.180.) xoff = xoff - 360. + yoff = dec - ygrid + + return + end + +c----------------------------------------------------------------------------- +c Initialisation of the sgp_holes positions + + subroutine sgp_mask_init2 +****************************************************************************** + implicit none + + integer i,j,jhole(2000),nshols,ilast,jfld + real sxhole(3,2000),syhole(3,2000) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/sgphole/sxhole,syhole,jhole,nshols + common/last_field/ilast,jfld +****************************************************************************** + + ilast = 0 + open (unit=30,file='sgpholes.lis',status='old',form='formatted') + do i=1,2000 + read(30,*,end=999) (sxhole(j,i),syhole(j,i),j=1,3),jhole(i) + enddo + 999 nshols = i-1 + close(30) + + return + end + +c----------------------------------------------------------------------------- +c Initialisation of the ngp_holes positions + + subroutine ngp_mask_init2 +****************************************************************************** + implicit none + + integer i,j,jhole(300),nnhols,ilast,jfld + real xnhole(3,300),ynhole(3,300) + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/ngphole/xnhole,ynhole,jhole,nnhols + common/last_field/ilast,jfld +****************************************************************************** + + open (unit=30,file='ngpholes.lis',status='old',form='formatted') + do i=1,300 + read(30,*,end=999) (xnhole(j,i),ynhole(j,i),j=1,3),jhole(i) + enddo + 999 nnhols = i-1 + close(30) + + return + end + +c---------------------------------------------------------------------------- +c Returns inhol = 1 if point (xx,yy) lies in a drilled region + + subroutine test_sgp_holes2(xx,yy,jf,inhol) +****************************************************************************** + implicit none + + integer jf,inhol + real xx,yy + + intrinsic abs,max,min + + integer j,jhole(2000),nholes + real xhole(3,2000),yhole(3,2000),dx,dy,dx1,dy1,dx2,dy2,x0,y0,a1,a2 + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/sgphole/xhole,yhole,jhole,nholes +****************************************************************************** + + inhol = 0 + do j = 1,nholes + if (jhole(j).ne.jf) goto 124 + x0 = xhole(1,j) + y0 = yhole(1,j) + + if(y0.eq.yhole(3,j)) then ! It's a square hole + if(xx.le.min(x0,xhole(3,j)).or.xx.ge.max(x0,xhole(3,j))) + & goto 124 ! speed-up + end if + dx = xx-x0 + dy = yy-y0 + dx1 = xhole(2,j)-x0 + dy1 = yhole(2,j)-y0 + dx2 = xhole(3,j)-x0 + dy2 = yhole(3,j)-y0 + + if (abs(dx2).gt.0) then + a1 = (dx*dy2 - dy*dx2)/(dx1*dy2 - dy1*dx2) + a2 = (dx - a1*dx1)/dx2 + if (0.le.a1.and.a1.le.1.and.0.le.a2.and.a2.le.1) then + inhol = 1 + return + end if + end if + 124 continue + end do ! loop over holes + + return + end + +c----------------------------------------------------------------------------- +c Returns inhol = 1 if point (xx,yy) lies in a drilled region + + subroutine test_ngp_holes2(xx,yy,jf,inhol) +****************************************************************************** + implicit none + + integer jf,inhol + real xx,yy + + intrinsic abs,max,min + + integer j,jhole(300),nholes + real xhole(3,300),yhole(3,300),dx,dy,dx1,dy1,dx2,dy2,x0,y0,a1,a2 + + real pival,degs_rads,ramins_rads,radfac,tpi + parameter (pival=3.1415926535897) + parameter (degs_rads=pival/180.,ramins_rads=pival/720. + &, radfac=pival/10800.,tpi=2.*pival) + common/ngphole/xhole,yhole,jhole,nholes +****************************************************************************** + + inhol = 0 + do j = 1,nholes + if (jhole(j).ne.jf) goto 123 + x0 = xhole(1,j) + y0 = yhole(1,j) + if(y0.eq.yhole(3,j)) then ! It's a square hole + if(xx.le.min(x0,xhole(3,j)).or.xx.ge.max(x0,xhole(3,j))) + & goto 123 ! speed-up + end if + dx = xx-x0 + dy = yy-y0 + dx1 = xhole(2,j)-x0 + dy1 = yhole(2,j)-y0 + dx2 = xhole(3,j)-x0 + dy2 = yhole(3,j)-y0 + + if (abs(dx2).gt.0) then + a1 = (dx*dy2 - dy*dx2)/(dx1*dy2 - dy1*dx2) + a2 = (dx - a1*dx1)/dx2 + if (0.le.a1.and.a1.le.1.and.0.le.a2.and.a2.le.1) then + inhol = 1 + return + end if + end if + 123 continue + end do ! loop over holes + + return + end + +c----------------------------------------------------------------------------- diff --git a/src/twoqz.f b/src/twoqz.f new file mode 100644 index 0000000..cb28fa1 --- /dev/null +++ b/src/twoqz.f @@ -0,0 +1,308 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + real*10 function twoqz(ra,dec,verbose) + real*10 ra,dec + integer verbose +c +c parameters + integer NHEM + parameter (NHEM=2) +c externals + integer access,lnblnk +c data variables + include 'mangdir.inc' + character*24 subdir + integer unit + logical init +c local (automatic) variables + character*1 go + character*64 dat + character*128 tmpnam + integer idec,idir,ihem,ifmt,ira,found + real*4 decmn,decmx,r,ramn,ramx +c local variables to be saved + integer ndec(NHEM),nra(NHEM) + real*4 decmin(NHEM),decstep(NHEM),ramin(NHEM),rastep(NHEM) + real*4 array(4510,330,2) + save ndec,nra + save decmin,decstep,ramin,rastep + save array + logical ex + character*3 re +c * +c * Completeness of 2QZ, the April 2001 2dF 10k quasar redshift survey. +c * +c Input: ra, dec = RA & Dec in degrees. +c verbose = 0 quiet +c = 1 normal verbosity +c = 3 details (useful if twoqz is run interactively) +c Output: twoqz: 0 = empty to 1 = complete. +c +c mangle directory + include 'mangdir.data' +c subdirectory of mangle directory containing 2QZ mask data + data subdir /'masks/2qz10k'/ +c initialize on first call + data init /.true./ +c fortran unit + data unit /7/ +c +c--------read arrays + if (init) then +c each hemisphere + do 170 ihem=1,NHEM + found=0 +c try current directory, then subdirectory, then mangle directory + do 160 idir=1,3 +c try unformatted then formatted files + do 150 ifmt=1,2 +c unformatted + if (ifmt.eq.1) then + if (ihem.eq.1) then + dat='ngc_obscomp.dat' + elseif (ihem.eq.2) then + dat='sgc_obscomp.dat' + endif +c formatted + elseif (ifmt.eq.2) then + if (ihem.eq.1) then + dat='ngc_obscomp.txt' + elseif (ihem.eq.2) then + dat='sgc_obscomp.txt' + endif + endif +c current directory + if (idir.eq.1) then + tmpnam=dat +c subdirectory + elseif (idir.eq.2) then + tmpnam=subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) +c mangle directory + elseif (idir.eq.3) then + call getenv(mangenv,tmpnam) + if (found.eq.1) goto 310 + if (tmpnam.eq.' ') goto 320 + mangdir=tmpnam + tmpnam=mangdir(1:lnblnk(mangdir)) + * //'/'//subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) + endif +c found the file + inquire(FILE=tmpnam(1:lnblnk(tmpnam)), EXIST=ex, READ=re) + if (ex.and.(re.eq.'YES')) then +c if (access(tmpnam(1:lnblnk(tmpnam)),' r').eq.0) then + if (ifmt.eq.1) then + open (unit,file=tmpnam,form='unformatted', + * status='old',err=340) + else + open (unit,file=tmpnam,status='old',err=340) + endif + found=1 +c did not find the file + else +c try formatted file + if (ifmt.eq.1) goto 150 +c try another directory + if (idir.le.2) goto 160 + if (found.eq.1) goto 310 +c ran out of options + goto 330 + endif +c found the file: now read it + rewind (unit) + if (verbose.ge.1) + * print *,'reading ',tmpnam(1:lnblnk(tmpnam)),' ...' +c unformatted + if (ifmt.eq.1) then + read (unit,end=120,err=120) ramin(ihem) + read (unit,end=120,err=120) decmin(ihem) + read (unit,end=120,err=120) nra(ihem) + read (unit,end=120,err=120) ndec(ihem) + read (unit,end=120,err=120) rastep(ihem) + read (unit,end=120,err=120) decstep(ihem) + read (unit,end=120,err=120) ((array(ira,idec,ihem), + * ira=1,nra(ihem)),idec=1,ndec(ihem)) + goto 130 +c error reading unformatted file + 120 if (verbose.ge.1) + * print *,'error reading ',tmpnam(1:lnblnk(tmpnam)), + * '; retry:' +c try formatted file + goto 150 +c successful read + 130 continue +c formatted + elseif (ifmt.eq.2) then + read (unit,*,end=350,err=360) ramin(ihem) + read (unit,*,end=350,err=360) decmin(ihem) + read (unit,*,end=350,err=360) nra(ihem) + read (unit,*,end=350,err=360) ndec(ihem) + read (unit,*,end=350,err=360) rastep(ihem) + read (unit,*,end=350,err=360) decstep(ihem) + read (unit,*,end=350,err=360) ((array(ira,idec,ihem), + * ira=1,nra(ihem)),idec=1,ndec(ihem)) + endif +c close file + close (unit) +c write (*,'(2x,i8,9i12)') (ira,ira=1,10) +c do idec=1,10 +c write (*,'(i2,10g12.4)') +c * idec,(array(ira,idec,ihem),ira=1,10) +c enddo + +c option to write formatted copy + if (verbose.ge.2.and.ifmt.eq.1) then + write (*,'(" write formatted copy of ",a, + * "? [CR,n=no, y=yes]: ",$)') tmpnam(1:lnblnk(tmpnam)) + read (*,'(a1)',end=135,err=135) go + if (go.eq.' '.or.go.eq.'n'.or.go.eq.'N' + * .or.go.eq.'x'.or.go.eq.'X' + * .or.go.eq.'q'.or.go.eq.'Q') then + continue + else + if (ihem.eq.1) then + dat='ngc_obscomp.txt' + elseif (ihem.eq.2) then + dat='sgc_obscomp.txt' + endif +c current directory + if (idir.eq.1) then + tmpnam=dat +c subdirectory + elseif (idir.eq.2) then + tmpnam=subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) +c mangle directory + elseif (idir.eq.3) then + tmpnam=mangdir(1:lnblnk(mangdir)) + * //'/'//subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) + endif + open (unit,file=tmpnam,err=370) + rewind (unit) + print *,'writing ',tmpnam(1:lnblnk(tmpnam)),' ...' + write (unit,'(g16.8)',err=380) ramin(ihem) + write (unit,'(g16.8)',err=380) decmin(ihem) + write (unit,'(i8)',err=380) nra(ihem) + write (unit,'(i8)',err=380) ndec(ihem) + write (unit,'(g16.8)',err=380) rastep(ihem) + write (unit,'(g16.8)',err=380) decstep(ihem) + write (unit,'(6g16.8)',err=380)((array(ira,idec,ihem), + * ira=1,nra(ihem)),idec=1,ndec(ihem)) + close (unit) + endif + 135 continue + endif + +c option to write unformatted copy +c if (verbose.ge.2.and.ifmt.eq.2) then + if (verbose.ge.1.and.ifmt.eq.2) then + write (*,'(" write unformatted copy of ",a, + * "? [CR,n=no, y=yes]: ",$)') tmpnam(1:lnblnk(tmpnam)) + read (*,'(a1)',end=140,err=140) go + if (go.eq.' '.or.go.eq.'n'.or.go.eq.'N' + * .or.go.eq.'x'.or.go.eq.'X' + * .or.go.eq.'q'.or.go.eq.'Q') then + continue + else + if (ihem.eq.1) then + dat='ngc_obscomp.dat' + elseif (ihem.eq.2) then + dat='sgc_obscomp.dat' + endif +c current directory + if (idir.eq.1) then + tmpnam=dat +c subdirectory + elseif (idir.eq.2) then + tmpnam=subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) +c mangle directory + elseif (idir.eq.3) then + tmpnam=mangdir(1:lnblnk(mangdir)) + * //'/'//subdir(1:lnblnk(subdir)) + * //'/'//dat(1:lnblnk(dat)) + endif + open (unit,file=tmpnam,form='unformatted',err=370) + rewind (unit) + print *,'writing ',tmpnam(1:lnblnk(tmpnam)),' ...' + write (unit,err=380) ramin(ihem) + write (unit,err=380) decmin(ihem) + write (unit,err=380) nra(ihem) + write (unit,err=380) ndec(ihem) + write (unit,err=380) rastep(ihem) + write (unit,err=380) decstep(ihem) + write (unit,err=380) ((array(ira,idec,ihem), + * ira=1,nra(ihem)),idec=1,ndec(ihem)) + close (unit) + endif + 140 continue + endif +c successful read + goto 170 + 150 continue + 160 continue + 170 continue + init=.false. + endif +c--------the routine + twoqz=0._10 + do ihem=1,NHEM + decmn=decmin(ihem)-decstep(ihem)*.5_10 + decmx=decmn+decstep(ihem)*ndec(ihem) + if (dec.ge.decmn.and.dec.le.decmx) then + ramn=ramin(ihem)-rastep(ihem)*.5_10 + ramx=ramn+rastep(ihem)*nra(ihem) + ira=(ra-ramn)/360._10 + r=ra-ira*360._10 + if (r.lt.ramn) r=r+360._10 + if (verbose.ge.3) then + print *,'ra, ramin, ramax =',r,ramn,ramx + print *,'dec, decmin, decmax =',dec,decmn,decmx + endif + if (r.le.ramx) then + ira=1+int((r-ramn)/rastep(ihem)) + idec=1+int((dec-decmn)/decstep(ihem)) + if (verbose.ge.3) then + print *,'ira, idec, ihem, ra, dec =',ira,idec,ihem, + * ramin(ihem)+(ira-1)*rastep(ihem), + * decmin(ihem)+(idec-1)*decstep(ihem) + endif + twoqz=array(ira,idec,ihem) +c round to 6 sig fig + twoqz=dble(nint(twoqz*1.e6_10))/1.e6_10 + goto 200 + endif + endif + enddo + 200 continue + return +c +c--------errors + 310 print *,'twoqz: you may have a problem with endianness;' + print *,'please read HELP.unformatted in the mangle directory' + stop + 320 print *,'twoqz: can''t find ',dat(1:lnblnk(dat)) + print *,'maybe I''d find it if environment variable ', + * mangenv(1:lnblnk(mangenv)),' were set to' + print *,mangdir(1:lnblnk(mangdir)) + stop + 330 print *,'twoqz: can''t find ',dat(1:lnblnk(dat)), + * ' in directories . or ' + print *,mangdir(1:lnblnk(mangdir))//'/'//subdir(1:lnblnk(subdir)) + stop + 340 print *,'twoqz: error opening ',tmpnam(1:lnblnk(tmpnam)) + stop + 350 print *,'twoqz: premature EOF on ',tmpnam(1:lnblnk(tmpnam)) + stop + 360 print *,'twoqz: error reading ',tmpnam(1:lnblnk(tmpnam)) + stop + 370 print *,'twoqz: error opening ',tmpnam(1:lnblnk(tmpnam)) + stop + 380 print *,'twoqz: error writing to ',tmpnam(1:lnblnk(tmpnam)) + stop +c + end +c diff --git a/src/unify.c b/src/unify.c new file mode 100644 index 0000000..7197596 --- /dev/null +++ b/src/unify.c @@ -0,0 +1,429 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqm:s:e:v:p:Ui:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +int unify_poly(polygon **, polygon *); +#ifdef GCC +int unify(int *npoly, polygon *[*npoly]); +#else +int unify(int *npoly, polygon *[/**npoly*/]); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nadj, nfiles, npoly, npolys,i; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + /* default is to renumber output polygons with new id numbers */ + fmt.newid = 'n'; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + msg("---------------- unify ----------------\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + if(unpixelize){ + msg("removing pixelization info by unifying across the whole mask\n"); + } + else{ + msg("only unifying within each pixel - to unify across the whole mask, use -U\n"); + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + if (snapped==0 || balkanized==0) { + fprintf(stderr, "Error: input polygons must be snapped and balkanized before unification.\n"); + fprintf(stderr, "If your polygons are already snapped and balkanized, add the 'snapped' and\n'balkanized' keywords at the beginning of each of your input polygon files.\n"); + exit(1); + } + + + /* unify polygons */ + nadj = unify(&npoly, polys); + if (nadj == -1) exit(1); + + if(unpixelize) pixelized=0; + + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("unify [-d] [-q] [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-U] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Unify two polygons poly1 and poly2, if possible. + + Input: *poly1, poly2 = pointers to polygon structures. + Output: if poly1 and poly2 were unified, then *poly1 contains unified polygon; + if poly1 and poly2 were not unified, then *poly1 is unchanged. + Return value: -1 = error occurred; + 0 = poly1 and poly2 were not unified; + 1 = poly1 and poly2 were unified. +*/ +int unify_poly(polygon **poly1, polygon *poly2) +{ +/* number of extra caps to allocate to polygon, to allow for expansion */ +#define DNP 4 + static polygon *poly = 0x0; + + int bnd, bndin, bndout, bnd1, bnd2, i, ier, i1, i2, np, verb; + int np1, np2; + long double area, areain, tol; + polygon *polyin, *polyout; + + bnd = 0; + bnd1 = 0; + bnd2 = 0; + /* look for single boundary dividing poly1 and poly2 */ + for (i1 = 0; i1 < (*poly1)->np; i1++) { + if (bnd >= 2) break; + for (i2 = 0; i2 < poly2->np; i2++) { + if ((*poly1)->cm[i1] == - poly2->cm[i2] + && (*poly1)->rp[i1][0] == poly2->rp[i2][0] + && (*poly1)->rp[i1][1] == poly2->rp[i2][1] + && (*poly1)->rp[i1][2] == poly2->rp[i2][2]) { + bnd++; + if (bnd >= 2) break; + bnd1 = i1; + bnd2 = i2; + } + } + } + + /* poly1 and poly2 are not separated by a single boundary */ + if (bnd != 1) return(0); + + np1=(*poly1)->np; + np2=poly2->np; + np=np1+np2; + + /* make sure poly contains enough space for intersection */ + + ier = room_poly(&poly, np, DNP, 0); + if (ier == -1) goto out_of_memory; + + /* check whether areas of poly1 and poly2 equal subareas of unified poly */ + for (i = 0; i < 2; i++) { + if (i == 0) { + polyin = poly2; + polyout = *poly1; + bndin = bnd2; + bndout = poly2->np + bnd1; + } else { + polyin = *poly1; + polyout = poly2; + bndin = bnd1; + bndout = (*poly1)->np + bnd2; + } + /* area of polyin */ + tol = mtol; + verb = 1; + ier = garea(polyin, &tol, verb, &areain); + if (ier) goto error; + /* intersection of polyin and polyout (in that order!) */ + poly_poly(polyin, polyout, poly); + /* suppress coincident boundaries */ + touch_poly(poly); + /* suppress excluding boundary of unified poly */ + poly->cm[bndout] = 2.; + /* subarea of unified poly */ + verb = 0; + ier = garea(poly, &tol, verb, &area); + if (ier == -1) goto error; + if (ier || area != areain) break; + } + + /* do not unify poly1 and poly2 */ + if (ier || area != areain) return(0); + + /* suppress dividing boundary */ + poly->cm[bndin] = 2.; + + /* prune unified polygon */ + if (prune_poly(poly, mtol) == -1) return(-1); + + /* make sure poly1 contains enough space */ + np = poly->np; + ier = room_poly(poly1, np, DNP, 0); + if (ier == -1) goto out_of_memory; + + /* copy unified polygon into poly1 */ + copy_poly(poly, *poly1); + + return(1); + + /* ---------------- error returns ---------------- */ + error: + return(-1); + + out_of_memory: + fprintf(stderr, "unify_poly: failed to allocate memory for polygon of %d caps\n", np + DNP); + return(-1); +} + +/*------------------------------------------------------------------------------ + Unify polygons. + + Input: poly = array of pointers to polygons. + npoly = pointer to number of polygons. + Output: polys = array of pointers to polygons; + Return value: number of polygons unified, + or -1 if error occurred. +*/ +int unify(int *npoly, polygon *poly[/**npoly*/]) +{ +#define WARNMAX 8 + int dnadj, i, j, unified, nadj, pass, warnmax; + int *start; + int *total; + int begin, end, p, max_pixel, ier; + + /* allocate memory for pixel info arrays start and total */ + /* if unpixelizing, don't use pixelization info */ + max_pixel = (unpixelize)? 1: poly[*npoly-1]->pixel+1; + start = (int *) malloc(sizeof(int) * max_pixel); + if (!start) { + fprintf(stderr, "unify: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + total = (int *) malloc(sizeof(int) * max_pixel); + if (!total) { + fprintf(stderr, "unify: failed to allocate memory for %d integers\n", max_pixel); + return(-1); + } + + /* if we're unpixelizing, don't use the pixelization info */ + if(unpixelize){ + start[0]=0; + total[0]=*npoly; + } + else{ + /* build lists of starting indices of each pixel and total number of polygons in each pixel*/ + ier=pixel_list(*npoly, poly, max_pixel, start, total); + if (ier == -1) { + fprintf(stderr, "unify: error building pixel index lists\n"); + return(-1); + } + } + + /*turn off warning messages if using more than one pixel*/ + warnmax= (max_pixel<=1) ? WARNMAX : 0; + + nadj = 0; + + /* discard polygons that have zero weight */ + dnadj = 0; + for (i = 0; i < *npoly; i++) { + if (!poly[i]) continue; + if (poly[i]->weight == 0.) { + if (WARNMAX > 0 && dnadj == 0) + msg("unify: the following polygons have zero weight and are being discarded:\n"); + if (dnadj < WARNMAX) { + msg(" %d", poly[i]->id); + } else if (dnadj == WARNMAX) { + msg(" ... more\n"); + } + dnadj++; + free_poly(poly[i]); + poly[i] = 0x0; + } + } + if (WARNMAX > 0 && dnadj > 0 && dnadj <= WARNMAX) msg("\n"); + if (dnadj > 0) msg("unify: %d polygons with zero weight were discarded\n", dnadj); + nadj += dnadj; + + /* discard polygons that are null */ + dnadj = 0; + for (i = 0; i < *npoly; i++) { + if (!poly[i]) continue; + /* prune polygon (should really already have been done by balkanize) */ + if (prune_poly(poly[i], mtol) == -1) { + fprintf(stderr, "unify_poly: failed to prune polygon %d; continuing\n", poly[i]->id); + continue; + } + if (poly[i]->np > 0 && poly[i]->cm[0] == 0.) { + if (WARNMAX > 0 && dnadj == 0) + msg("unify: the following polygons have zero area and are being discarded:\n"); + if (dnadj < WARNMAX) { + msg(" %d", poly[i]->id); + } else if (dnadj == WARNMAX) { + msg(" ... more\n"); + } + dnadj++; + free_poly(poly[i]); + poly[i] = 0x0; + } + } + if (WARNMAX > 0 && dnadj > 0 && dnadj <= WARNMAX) msg("\n"); + if (dnadj > 0) msg("unify: %d polygons with zero area were discarded\n", dnadj); + nadj += dnadj; + + /*unify polygons within each pixel*/ + /* unify repeatedly, until no more unification occurs */ + for(p=0;p<max_pixel;p++){ + begin=start[p]; + end=start[p]+total[p]; + + pass = 0; + do { + pass++; + dnadj = 0; + /* try unifying each polygon in turn ... */ + + for (i = begin; i < end; i++) { + if (!poly[i]) continue; + + /* ... with another polygon */ + for (j = i+1; j < end; j++) { + if (!poly[j]) continue; + /* only unify polygons with the same weight */ + if (poly[i]->weight != poly[j]->weight) continue; + + /* if applying old ids, then only unify polygons with the same id */ + if (fmt.newid == 'o' && poly[i]->id != poly[j]->id) continue; + + /* try unifying polygons */ + unified = unify_poly(&poly[i], poly[j]); + if (unified == -1) { + if (warnmax/2 > 0 && dnadj > 0 && dnadj <= warnmax/2) msg("\n"); + fprintf(stderr, "unify_poly: failed to unify polygons %d & %d; continuing\n", poly[i]->id, poly[j]->id); + continue; + } + /* polygons were unified */ + if (unified) { + if(warnmax > 0){ + if (warnmax/2 > 0 && dnadj == 0) + msg("unify pass %d: the following polygons are being unified:\n", pass); + if (dnadj < warnmax/2) { + msg(" (%d %d)", poly[i]->id, poly[j]->id); + } else if (dnadj == warnmax/2) { + msg(" ... more\n"); + } + } + free_poly(poly[j]); + poly[j] = 0x0; + dnadj++; + } + } + } + if (warnmax/2 > 0 && dnadj > 0 && dnadj <= warnmax/2) msg("\n"); + if(warnmax) msg("unify pass %d: %d polygons unified\n", pass, dnadj); + nadj += dnadj; + + } while (dnadj); + } + + free(start); + free(total); + + /* copy down polygons */ + j = 0; + for (i = 0; i < *npoly; i++) { + if (poly[i]) { + poly[j] = poly[i]; + j++; + } + } + *npoly = j; + + /* assign new polygon id numbers */ + if (fmt.newid == 'n') { + for (i = 0; i < *npoly; i++) { + poly[i]->id = i; + } + } + + if (fmt.newid == 'p') { + for (i = 0; i < *npoly; i++) { + poly[i]->id = poly[i]->pixel; + } + } + + /* if unpixelizing, set all pixel numbers to zero */ + if(unpixelize) { + for (i = 0; i < *npoly; i++) { + poly[i]->pixel = 0; + } + } + + /* advise */ + msg("unify: %d polygons discarded or unified\n", nadj); + + return(nadj); +} diff --git a/src/usage.h b/src/usage.h new file mode 100644 index 0000000..fd20ad1 --- /dev/null +++ b/src/usage.h @@ -0,0 +1,105 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +/*------------------------------------------------------------------------------ + This is in-lined to ensure uniformity between all programs. +*/ + if (strchr(optstr, 'd')) printf(" -d\t\tadvise defaults and exit\n"); + + if (strchr(optstr, 'q')) printf(" -q\t\texecute quietly\n"); + + if (strchr(optstr, 'w')) printf(" -w<Wlmfile>\tname of file containing spherical harmonics\n"); + + if (strchr(optstr, 'z')) printf(" -z<survey>\tname of survey, or of file containing list of weights\n"); + + if (strchr(optstr, 'l')) printf(" -l<lmax>\tmaximum harmonic number\n"); + + if (strchr(optstr, 'g')) printf(" -g<lsmooth>\tgaussian smoothing harmonic number (0 = default = no smooth)\n"); + + if (strchr(optstr, 'c')) printf(" -c<seed>\tseed random number generator with integer <seed>\n"); + + if (strchr(optstr, 'r')) printf(" -r<n>\t\tgenerate <n> random points\n"); + + if (strchr(optstr, 'h')) printf(" -h\t\twrite only summary to output\n"); + + if (strchr(optstr, 'S')) printf(" -S\t\tself-snap: snap edges only within each polygon\n"); + + if (strchr(optstr, 'a')) printf(" -a<angle>[u]\tangle within which to snap cap axes together\n"); + + if (strchr(optstr, 'b')) printf(" -b<angle>[u]\tangle within which to snap cap latitudes together\n"); + + if (strchr(optstr, 't')) printf(" -t<angle>[u]\tangle within which to snap edge to circle\n"); + + if (strchr(optstr, 'y')) printf(" -y<ratio>\tsnap edge to circle only if closer than <ratio> x edge length\n"); + + if (strchr(optstr, 'm')) printf(" -m<angle>[u]\tangle within which close vertices are coincident\n"); + + if (strchr(optstr, 'j')) printf(" -j[min][,max]\tkeep only polygons with weight in [min, max]\n"); + + if (strchr(optstr, 'J')) printf(" -J[min][,max]\tkeep only polygons with id numbers in [min, max]\n"); + + if (strchr(optstr, 'k')) printf(" -k[min][,max]\tkeep only polygons with area in [min, max] str\n"); + + if (strchr(optstr, 'K')) printf(" -K[min][,max]\tkeep only polygons with pixel numbers in [min, max]\n"); + + if (strchr(optstr, 'n')) printf(" -n\t\tintersect polygons of infile1 with those of same id in infile2\n"); + + if (strchr(optstr, 's')) printf(" -s<n>\t\tskip first <n> characters of each line of polygon_infiles\n"); + + if (strchr(optstr, 'e')) printf(" -e<n>\t\tread only to <n>'th character of each line (0 = no limit)\n"); + + if (strchr(optstr, 'v')) { + printf(" -vo|-vn|-vp\tassign old (o) or new (n) id numbers for output polygons\n"); + printf(" \tor use pixel (p) numbers as id numbers\n"); + } + if (strchr(optstr, 'f')) { + printf(" -f\t\tlist frames\n"); + printf(" -f<in>[,<ou>]\tinput, output angular frames\n"); + printf(" -f<azn>,<eln>,<azp>[u]\n\t\t<azn>,<eln> = azimuth, elevation of new pole wrt old frame\n\t\t<azp>,<eln> = azimuth, elevation of old pole wrt new frame\n"); + } + + if (strchr(optstr, 'u')) printf(" -u<in>[,<ou>]\tr radians, d degrees, m arcmin, s arcsec, h hms(RA) & dms(Dec)\n"); + + if (strchr(optstr, 'p')) { + printf(" -p[+|-][<n>]\t<n> digits after the decimal place in output angles\n"); + printf(" \toutput azimuths in: + [0, 2 pi) or - (-pi, pi]\n"); + + } + if (strchr(optstr, 'P')) { + printf(" -P[scheme][<p>][,<r>]\tpixelization scheme: s simple or d sdsspix\n"); + printf(" \tpixelize to max resolution of <r>, with <p> polys per pixel\n"); + } + if (strchr(optstr, 'B')) { + printf(" -B[bmethod]\tmethod for combining weights in balkanize: l=last weight in polygon list,\n"); + printf(" \ta=add weights together, n=minimum weight, x=maximum weight\n"); + } + if(strchr(optstr, 'U')) { + printf(" -U\t\tremove pixelization info by unifying across whole mask\n"); + } + if(strchr(optstr, 'W')) { + printf(" -W\t\tprint weights in polyid output file rather than id numbers\n"); + } + if (strchr(optstr, 'i')) printf(" -i<f>[<n>][u]\tread polygon_infile in format <f>, with <n> objects per line\n"); + + if (strchr(optstr, 'o')) printf(" -o<f>[u]\twrite outfile in format <f>\n"); + + if (strchr(optstr, 'o') || strchr(optstr, 'i')) { + printf(" format <f>:\tc circle, e<i> edges, p polygon, r rectangle, R Region,\n"); + printf(" \ts spolygon, v vertices, b binary polygon (no autodetect)\n"); + printf(" \tinput only: h healpix_weight\n"); + } + if (strchr(optstr, 'o')) { + printf(" \toutput only: a area, g<i> graphics, i id, m midpoint, w weight\n"); + } + if (strchr(optstr, 'H')) { + printf(" -H\t\twrite output file in healpix_weight format\n"); + } + + if (strchr(optstr, 'a') || strchr(optstr, 'b') || strchr(optstr, 't') || strchr(optstr, 'i') || strchr(optstr, 'o')) + printf(" unit u:\tr radians, d degrees, m arcmin, s arcsec, h hms(RA) & dms(Dec)\n"); + + printf(" - for infile\tmeans read from stdin\n"); + + printf(" - for outfile\tmeans write to stdout\n"); + + printf("mangle documentation is at http://space.mit.edu/home/tegmark/mangle/\n"); diff --git a/src/vertices.h b/src/vertices.h new file mode 100644 index 0000000..3224dcb --- /dev/null +++ b/src/vertices.h @@ -0,0 +1,18 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#ifndef VERTICES_H +#define VERTICES_H + +typedef struct { /* azel structure */ + long double az; /* azimuth */ + long double el; /* elevation */ +} azel; + +typedef struct { /* vertices structure */ + int nv; /* number of azel vertices */ + int nvmax; /* dimension of allocated v array */ + azel *v; /* array v[nv] of azel structures */ +} vertices; + +#endif /* VERTICES_H */ diff --git a/src/vmid.c b/src/vmid.c new file mode 100644 index 0000000..ccf3871 --- /dev/null +++ b/src/vmid.c @@ -0,0 +1,293 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <math.h> +#include "manglefn.h" + +/* number of extra vertices to allocate, to allow for expansion */ +#define DNV 4 + +/*------------------------------------------------------------------------------ + Point(s) somewhere in the middle of a polygon. + The number of points is equal to the number of connected sequences of + vertices, as computed by gverts, except that if there are zero connected + sequences, then there is a single midpoint. Zero connected sequences + happens when the option to return midpoints for non-intersecting circles is + turned off in gverts, and each boundary of the polygon is a disjoint circle. + + If the connected sequences of vertices delineate holes in the polygon, + then the number of connected sequences of vertices may exceed + the number of connected parts of the polygon. In this case vmid supplies + more midpoints than there are connected parts of the polygon. + + The intention is to aim for a point (or points) squarely in the middle of + the polygon, but the algorithm, though mildly paranoid, is not cast iron. + + Designed to be called after gverts(). + + Input: poly = pointer to polygon. + mtol = initial angular tolerance in radians + within which to merge multiple intersections. + nv = number of vertices of polygon, as output by gverts(). + nve = number of points per edge, as input to gverts(); + must be even and >= 2. + ve = points on edges of polygon, as output by gverts(). + ipv = cap numbers of edges, as output by gverts(). + ev = end indices of connected sequences, as output by gverts(). + Output: *nvm = number of middle points in *vm + = max(nev, 1). + *vm_p = pointer to unit vectors giving middle points; + the required memory is allocated. + If the algorithm failed to find a point inside the polygon, + then the vector for that point is {0.,0.,0.}. + Return value: 0 if ok (even if no inside point was found); + -1 if failed to allocate memory. +*/ +int vmid(polygon *poly, long double mtol, int nv, int nve, vec ve[/*nv * nve*/], int ipv[/*nv*/], int ev[/*nv*/], int *nvm, vec **vm_p) +{ + const int do_vcirc = 1; + static int nvmmax = 0; + static vec *vm = 0x0; + + int i, ier, iev, ip, iv, ivl, ivm, ivu, neva, nev0, nva, scm; + long double angle, cm, cmbest, s, tol; + vec rp, vc, vi; + int *ipva, *gpa, *eva; + long double *cmvmin, *cmvmax, *cmpmin, *cmpmax; + vec *vmin, *vmax; + + /* make sure nve is even and >= 2 */ + if (nve < 2 || nve % 2 != 0) { + fprintf(stderr, "vmid: nve = %d must be even and >= 2\n", nve); + fprintf(stderr, "STOP\n"); + exit(1); + } + + /* number of midpoints */ + for (ivm = 0; ev[ivm] != nv; ivm++); + *nvm = ivm + 1; + + /* make sure that vm contains enough space */ + if (!vm || *nvm > nvmmax) { + if (vm) free(vm); + vm = (vec *) malloc(sizeof(vec) * (*nvm + DNV)); + if (!vm) { + fprintf(stderr, "vmid: failed to allocate memory for %d vecs\n", *nvm + DNV); + return(-1); + } + nvmmax = *nvm + DNV; + } + + /* polygon is whole sphere: choose point to be north pole */ + if (poly->np == 0) { + vm[0][0] = 0.; + vm[0][1] = 0.; + vm[0][2] = 1.; + + /* polygon has 1 cap: choose point at centre of circle */ + } else if (poly->np == 1) { + scm = (poly->cm[0] >= 0.)? 1 : -1; + for (i = 0; i < 3; i++) vm[0][i] = scm * poly->rp[0][i]; + + /* polygon has >= 2 caps */ + } else { + + /* index of central point of edge */ + iev = nve / 2; + + /* no vertices implies each boundary is a disjoint circle */ + if (nv == 0) { + /* set `edge points' equal to centres of circles */ + for (ip = 0; ip < poly->np; ip++) { /* gverts allocated enough memory for this */ + scm = (poly->cm[ip] >= 0.)? 1 : -1; + for (i = 0; i < 3; i++) ve[ip * nve + iev][i] = scm * poly->rp[ip][i]; + } + } + + /* do each connected boundary */ + for (ivm = 0; ivm < *nvm; ivm++) { + + /* initialize the midpoint to zero */ + for (i = 0; i < 3; i++) vm[ivm][i] = 0.; + + /* vertices on boundary */ + if (nv > 0) { + ivl = (ivm == 0)? 0 : ev[ivm - 1]; + ivu = ev[ivm]; + } else { /* nv = 0 */ + ivl = 0; + ivu = poly->np; /* gverts allocated enough memory for this */ + } + + /* central vector is summed vector of points at centres of edges of connected boundary */ + for (i = 0; i < 3; i++) vc[i] = 0.; + for (iv = ivl; iv < ivu; iv++) { + for (i = 0; i < 3; i++) vc[i] += ve[iv * nve + iev][i]; + } + /* length of central vector */ + s = sqrtl(vc[0]*vc[0] + vc[1]*vc[1] + vc[2]*vc[2]); + /* s = 0 can happen, though hardly ever */ + if (s == 0.) { + ip = ipv[ivl]; + scm = (poly->cm[ip] >= 0.)? 1 : -1; + for (i = 0; i < 3; i++) vc[i] = scm * poly->rp[ip][i]; + /* normalize central vector to unit length */ + } else { + for (i = 0; i < 3; i++) vc[i] /= s; + } + + /* try several possible central points, and choose the best */ + cmbest = -1.; + for (iv = ivl - 1; iv < ivu; iv++) { + /* try central vector vc to start with */ + if (iv == ivl - 1) { + /* is central vector inside polygon? */ + if (gptin(poly, vc)) { + for (i = 0; i < 3; i++) vi[i] = vc[i]; + } else { + continue; + } + /* try point on great circle joining central vector vc to centre of each edge */ + } else { + /* great circle joining centre of edge of connected boundary to central vector vc */ + rp_to_gc(ve[iv * nve + iev], vc, rp, &cm); + /* central point vi of that part of the great circle inside the polygon, one end of which is the centre of the edge of the connected boundary */ + tol = mtol; + ier = gvphi(poly, rp, cm, ve[iv * nve + iev], &tol, &angle, vi); + if (ier == -1) return(-1); + } + /* distance of central point to edges */ + tol = mtol; + ier = gvlims(poly, do_vcirc, &tol, vi, &nva, &vmin, &vmax, &cmvmin, &cmvmax, &cmpmin, &cmpmax, &ipva, &gpa, &neva, &nev0, &eva); + if (ier == -1) return(-1); + if (ier) continue; + /* closest distance of central point to edges */ + cm = 2.; + for (i = 0; i < nv; i++) { + if (cmvmin[i] < cm) cm = cmvmin[i]; + } + /* best bet so far is the point farthest from any edge */ + if (cm > cmbest) { + cmbest = cm; + for (i = 0; i < 3; i++) { + vm[ivm][i] = vi[i]; + } + } + } + + } + + } + + /* point vm_p at vm array */ + *vm_p = vm; + + return(0); +} + +/*------------------------------------------------------------------------------ + Point(s) at the barycentre of the centres of the edges of a polygon. + The point(s) may lie either inside or outside the polygon. + The number of points is equal to the number of connected sequences of + vertices, as computed by gverts, except that if there are zero connected + sequences, then there is a single point. Zero connected sequences + happens when the option to return midpoints for non-intersecting circles is + turned off in gverts, and each boundary of the polygon is a disjoint circle. + + Designed to be called after gverts(). + + Input: poly = pointer to polygon. + nv = number of vertices of polygon, as output by gverts(). + nve = number of points per edge, as input to gverts(); + ve = points at centres of edges of polygon, as output by gverts(). + ipv = cap numbers of edges, as output by gverts(). + ev = end indices of connected sequences, as output by gverts(). + Output: *nvm = number of middle points in *vm + = max(nev, 1). + *vm = pointer to unit vectors giving barycentres; + the required memory is allocated. + If the algorithm failed to find a point inside the polygon, + then the vector for that point is {0.,0.,0.}. + Return value: 0 if ok (even if no inside point was found); + -1 if failed to allocate memory. +*/ +int vmidc(polygon *poly, int nv, int nve, vec ve[/*nv * nve*/], int ipv[/*nv*/], int ev[/*nv*/], int *nvm, vec **vm_p) +{ + static int nvmmax = 0; + static vec *vm = 0x0; + + int i, iev, ip, iv, ivl, ivm, ivu; + long double s; + + /* number of midpoints */ + for (ivm = 0; ev[ivm] != nv; ivm++); + *nvm = ivm + 1; + + /* make sure that vm contains enough space */ + if (!vm || *nvm > nvmmax) { + if (vm) free(vm); + vm = (vec *) malloc(sizeof(vec) * (*nvm + DNV)); + if (!vm) { + fprintf(stderr, "vmidc: failed to allocate memory for %d vecs\n", *nvm + DNV); + return(-1); + } + nvmmax = *nvm + DNV; + } + + /* polygon is whole sphere: choose point to be north pole */ + if (poly->np == 0) { + vm[0][0] = 0.; + vm[0][1] = 0.; + vm[0][2] = 1.; + + /* polygon has 1 cap: choose point at centre of circle */ + } else if (poly->np == 1) { + for (i = 0; i < 3; i++) vm[0][i] = poly->rp[0][i]; + + /* no vertices implies each boundary is a disjoint circle */ + } else if (nv == 0) { + /* choose point at centre of 1st circle */ + for (i = 0; i < 3; i++) vm[0][i] = poly->rp[0][i]; + + /* polygon has >= 2 caps */ + } else { + + /* index of central point of edge */ + iev = nve / 2; + + /* do each connected sequence of vertices */ + for (ivm = 0; ivm < *nvm; ivm++) { + + /* vertices in connected sequence */ + ivl = (ivm == 0)? 0 : ev[ivm - 1]; + ivu = ev[ivm]; + + /* central vector is summed vector of points at centres of edges */ + for (i = 0; i < 3; i++) vm[ivm][i] = 0.; + for (iv = ivl; iv < ivu; iv++) { + for (i = 0; i < 3; i++) { + vm[ivm][i] += ve[iv * nve + iev][i]; + } + } + /* length of central vector */ + s = sqrtl(vm[ivm][0]*vm[ivm][0] + vm[ivm][1]*vm[ivm][1] + vm[ivm][2]*vm[ivm][2]); + /* s = 0 can happen, though hardly ever */ + if (s == 0.) { + ip = ipv[ivl]; + for (i = 0; i < 3; i++) vm[ivm][i] = poly->rp[ip][i]; + /* normalize central vector to unit length */ + } else { + for (i = 0; i < 3; i++) vm[ivm][i] /= s; + } + + } + + } + + /* point vm_p at vm array */ + *vm_p = vm; + + return(0); +} diff --git a/src/weight.c b/src/weight.c new file mode 100644 index 0000000..b3018ed --- /dev/null +++ b/src/weight.c @@ -0,0 +1,201 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +/* getopt options */ +const char *optstr = "dqz:m:s:e:v:p:i:o:"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +#ifdef GCC +int weight(int npoly, polygon *[npoly], char *); +#else +int weight(int npoly, polygon *[/*npoly*/], char *); +#endif + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys,i; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + /* survey must have been specified */ + if (!survey) { + fprintf(stderr, "%s requires -z<survey> option to specify the name of a survey,\n", argv[0]); + fprintf(stderr, "%*s or the name of a file containing a list of weights.\n", (int)strlen(argv[0]), ""); + fprintf(stderr, "Please look in weight_fn.c for the names of known surveys.\n"); + exit(1); + } + + msg("---------------- weight ----------------\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* weight polygons */ + npoly = weight(npoly, polys, survey); + + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("weight [-d] [-q] -z<survey> [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + +/*------------------------------------------------------------------------------ + Weight polygons. + + Input: poly = array of pointers to polygons. + npoly = pointer to number of polygons. + survey = name of survey, or of filename containing list of weights. + Output: polys = array of pointers to polygons; + Return value: number of polygons weighted, + or -1 if error occurred. +*/ +int weight(int npoly, polygon *poly[/*npoly*/], char *survey) +{ + const int per = 0; + const int nve = 2; + + int do_vcirc, i, imid, ipoly, iverts, ivm, nev, nev0, nomid, nv, nvm, nzero; + int *ipv, *gp, *ev; + long double tol; + long double *angle; + vec *ve, *vm; + azel v; + + nomid = 0; + nzero = 0; + for (ipoly = 0; ipoly < npoly; ipoly++) { + /* vertices of polygon */ + do_vcirc = 0; + tol = mtol; + iverts = gverts(poly[ipoly], do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (iverts != 0) return(-1); + /* point somewhere in the middle of the polygon */ + imid = vmid(poly[ipoly], tol, nv, nve, ve, ipv, ev, &nvm, &vm); + if (imid == -1) return(-1); + /* check found a point inside the polygon */ + imid = 0; + for (ivm = 0; ivm < nvm; ivm++) { + if (vm[ivm][0] != 0. || vm[ivm][1] != 0. || vm[ivm][2] != 0.) { + imid = 1; + if (ivm > 0) for (i = 0; i < 3; i++) vm[0][i] = vm[ivm][i]; + break; + } + } + /* found a point */ + if (imid == 1) { + /* convert unit vector to az, el */ + rp_to_azel(*vm, &v); + /* scale angles from radians to degrees */ + scale_azel(&v, 'r', 'd'); + /* weight at that point */ + poly[ipoly]->weight = weight_fn(v.az, v.el, survey); + if (poly[ipoly]->weight == 0.) nzero++; + /* failed to find a point */ + } else { + //call weight_fn to stay in right place in weight file if reading from weights from a file + weight_fn(v.az, v.el, survey); + if (nomid == 0) msg("weight: failed to find interior point for the following polygons:\n"); + msg(" %d", (fmt.newid == 'n')? ipoly : poly[ipoly]->id); + nomid++; + } + } + if (nomid > 0) msg("\n"); + if (nomid > 0) { + msg("weight: failed to find interior point for %d polygons\n", nomid); + msg("FAILURE TO FIND INTERIOR POINT PROBABLY MEANS YOU HAVE A WEIRD-SHAPED POLYGON.\n"); + msg("PLEASE FILL IN THE CORRECT WEIGHT BY HAND.\n"); + } + + /* assign new polygon id numbers in place of inherited ids */ + if (fmt.newid == 'n') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + poly[ipoly]->id = ipoly; + } + } + + if (fmt.newid == 'p') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + poly[ipoly]->id = poly[ipoly]->pixel; + } + } + + /* warn about zero weights */ + if (nzero > 0) msg("weight: %d polygons have zero weight\n", nzero); + + return(npoly); +} diff --git a/src/weight_dumb.c b/src/weight_dumb.c new file mode 100644 index 0000000..959253b --- /dev/null +++ b/src/weight_dumb.c @@ -0,0 +1,117 @@ +/*------------------------------------------------------------------------------ +* A J S Hamilton 2001 +* G Lavaux 2009-2013 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include <unistd.h> +#include "manglefn.h" +#include "defaults.h" + +static const int verb = 0; + +/* getopt options */ +const char *optstr = "dqz:m:s:e:v:p:i:o:A"; + +/* allocate polygons as a global array */ +polygon *polys_global[NPOLYSMAX]; + +/* local functions */ +void usage(void); +extern int weight_dumb(format *, int, polygon **, char *); +extern int weight_area(format *fmt, int npoly, polygon **polys, double tol); + +/*------------------------------------------------------------------------------ + Main program. +*/ +int main(int argc, char *argv[]) +{ + int ifile, nfiles, npoly, npolys,i; + polygon **polys; + polys=polys_global; + + /* default output format */ + fmt.out = keywords[POLYGON]; + + /* parse arguments */ + parse_args(argc, argv); + + /* at least one input and output filename required as arguments */ + if (argc - optind < 2) { + if (optind > 1 || argc - optind == 1) { + fprintf(stderr, "%s requires at least 2 arguments: polygon_infile and polygon_outfile\n", argv[0]); + usage(); + exit(1); + } else { + usage(); + exit(0); + } + } + + /* survey must have been specified */ + if (!survey && !weight_is_area) { + fprintf(stderr, "%s requires -z<survey> option to specify the name of a list of weights with id,\n", argv[0]); + exit(1); + } + + msg("---------------- weight_dumb ----------------\n"); + + /* tolerance angle for multiple intersections */ + if (mtol != 0.) { + scale(&mtol, munit, 's'); + munit = 's'; + msg("multiple intersections closer than %Lg%c will be treated as coincident\n", mtol, munit); + scale(&mtol, munit, 'r'); + munit = 'r'; + } + + /* advise data format */ + advise_fmt(&fmt); + + /* read polygons */ + npoly = 0; + nfiles = argc - 1 - optind; + for (ifile = optind; ifile < optind + nfiles; ifile++) { + npolys = rdmask(argv[ifile], &fmt, NPOLYSMAX - npoly, &polys[npoly]); + if (npolys == -1) exit(1); + npoly += npolys; + } + if (nfiles >= 2) { + msg("total of %d polygons read\n", npoly); + } + if (npoly == 0) { + msg("STOP\n"); + exit(0); + } + + /* weight polygons */ + if (!weight_is_area) + npoly = weight_dumb(&fmt, npoly, polys, survey); + else + npoly = weight_area(&fmt, npoly, polys, mtol); + + ifile = argc - 1; + npoly = wrmask(argv[ifile], &fmt, npoly, polys); + if (npoly == -1) exit(1); + + for(i=0;i<npoly;i++){ + free_poly(polys[i]); + } + + return(0); +} + +/*------------------------------------------------------------------------------ +*/ +void usage(void) +{ + printf("usage:\n"); + printf("weight [-A] [-d] [-q] -z<survey> [-m<a>[u]] [-s<n>] [-e<n>] [-vo|-vn|-vp] [-p[+|-][<n>]] [-i<f>[<n>][u]] [-o<f>[u]] polygon_infile1 [polygon_infile2 ...] polygon_outfile\n"); +#include "usage.h" +} + +/*------------------------------------------------------------------------------ +*/ +#include "parse_args.c" + diff --git a/src/weight_dumb_module.cpp b/src/weight_dumb_module.cpp new file mode 100644 index 0000000..85abcdf --- /dev/null +++ b/src/weight_dumb_module.cpp @@ -0,0 +1,90 @@ +#include <stdio.h> +#include <map> +#include <list> +#include <unistd.h> +#include <cstdlib> +#include "polygon.h" +#include "format.h" +#include "manglefn.h" + +extern "C" int weight_dumb(format *fmt, int npoly, polygon **poly, char *survey) +{ + FILE *fw; + int ipoly; + double w; + + std::map<int, std::list<int> > id_to_ply; + + fw = fopen(survey, "rt"); + + for (int i = 0; i < npoly; i++) + { + id_to_ply[poly[i]->id].push_back(i); + poly[i]->weight = 0; + } + + while (fscanf(fw, "%d %lf", &ipoly, &w) == 2) + { + std::list<int>& l = id_to_ply[ipoly]; + + for (std::list<int>::iterator iter = l.begin(); iter != l.end(); ++iter) + poly[*iter]->weight = w; + } + + /* assign new polygon id numbers in place of inherited ids */ + if (fmt->newid == 'n') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + poly[ipoly]->id = ipoly; + } + } + + if (fmt->newid == 'p') { + for (ipoly = 0; ipoly < npoly; ipoly++) { + poly[ipoly]->id = poly[ipoly]->pixel; + } + } + + fclose(fw); + + return(npoly); +} + + +extern "C" int weight_area(format *fmt, int npoly, polygon **polys, double mtol) +{ + static const int verb = 0; + std::map<int, std::list<int> > id_to_ply; + std::map<int, long double> ply_a; + int p; + + for (int i = 0; i < npoly; i++) + { + id_to_ply[polys[i]->id].push_back(i); + polys[i]->weight = 0; + } + + for (p = 0; p < npoly; p++) { + long double area, tol; + int ier; + + area = 1.0; + tol = mtol; + ier = garea(polys[p], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "weight_area: area of polygon %d is incorrect\n", polys[p]->id); + std::abort(); + } + + if (ply_a.find(polys[p]->id) == ply_a.end()) { + ply_a[polys[p]->id] = area; + } else { + ply_a[polys[p]->id] += area; + } + } + + for (p = 0; p < npoly; p++) { + polys[p]->weight = ply_a[polys[p]->id]; + } + return npoly; +} diff --git a/src/weight_fn.c b/src/weight_fn.c new file mode 100644 index 0000000..708761e --- /dev/null +++ b/src/weight_fn.c @@ -0,0 +1,138 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +#include "inputfile.h" +#include "manglefn.h" + +/* verbosity */ +extern int verbose; + +/*------------------------------------------------------------------------------ + Call a user-supplied weight function, + or read a user-supplied file, + to determine the weight of the region at angular position az, el in deg. +================================================================================ +In c, the user-supplied function should take the form: + +long double weight(long double *az, long double *el) + +verbose is available as a global variable that can be declared with +extern int verbose; +or you can use the msg() routine for printing messages. +================================================================================ +In fortran, the same user-supplied function should take the form +(note the trailing _ added to the function name, as is standard when +calling fortran routines from c): + + real*8 function weight_(az, el) + real*8 az, el +================================================================================ + + Input: az, el = azimuth, elevation in degrees. + survey = name of survey, or name of file containing list of weights. + Output: weight at angular position az, el; + if survey is null, then weight is set to 1. +*/ +long double weight_fn(long double az, long double el, char *survey) +{ + long double weight; + + /* null survey */ + if (!survey) { + weight = 1.; + + /* 2dF 10k quasar survey */ + } else if (strcmpl(survey, "2QZ10k") == 0) { + weight = twoqz_(&az, &el, &verbose); + + /* 2dF 100k galaxy survey */ + } else if (strcmpl(survey, "2dF100k") == 0) { + weight = twodf100k_(&az, &el); + + /* 2dF 230k galaxy survey */ + } else if (strcmpl(survey, "2dF230k") == 0) { + weight = twodf230k_(&az, &el); + + /* try reading weights from file */ + } else { + weight = rdweight(survey); + + } + + return(weight); +} + +/*------------------------------------------------------------------------------ + Try to read weight from file. + After arbitrary header lines, the file should contain a list of weights, + one weight in each line. + + If the file contains only one weight, then that weight will be returned + every time. Otherwise a new weight will be returned each time, and it is + an error if the file does not contain enough weights. + + Input: survey = name of file containing weights. + Return value: weight. +*/ +long double rdweight(char *survey) +{ +#ifndef BUFSIZE +# define BUFSIZE 64 +#endif + static int init = 0, nweight = 0; + static long double weight; + static inputfile file = { + '\0', /* input filename */ + 0x0, /* input file stream */ + '\0', /* line buffer */ + BUFSIZE, /* size of line buffer (will expand as necessary) */ + 0, /* line number */ + 0 /* maximum number of characters to read (0 = no limit) */ + }; + + int ird, iscan; + + /* first call */ + if (!init) { + /* test if survey is name of file */ + file.file = fopen(survey, "r"); + /* unknown survey */ + if (!file.file) { + fprintf(stderr, "weight_fn: unknown file or survey %s\n", survey); + fprintf(stderr, "please look in weight_fn.c for the names of known surveys\n"); + exit(1); + } + file.name = survey; + /* survey appears to be a file */ + msg("will read weights for each polygon from %s\n", survey); + init = 1; + } + + /* every call */ + if (nweight >= 0) do { + /* read line of data */ + ird = rdline(&file); + /* serious error */ + if (ird == -1) exit(1); + /* EOF */ + if (ird == 0) { + /* flag there's only one weight */ + if (nweight == 1) { + nweight = -1; + break; + /* premature EOF */ + } else { + fprintf(stderr, "weight_fn: unexpected EOF at line %d of %s\n", file.line_number, survey); + exit(1); + } + } + /* read contents of line into weight */ + iscan = sscanf(file.line, "%Lg", &weight); + nweight++; + } while (!iscan); + + return(weight); +} diff --git a/src/which_pixel.c b/src/which_pixel.c new file mode 100644 index 0000000..39b3e66 --- /dev/null +++ b/src/which_pixel.c @@ -0,0 +1,216 @@ +/*------------------------------------------------------------------------------ +© M E C Swanson 2005 +------------------------------------------------------------------------------*/ +#include <stdlib.h> +#include <math.h> +#include "pi.h" +#include "manglefn.h" + +/* Function which_pixel returns the pixel number for a given azimuth and + elevation angle. + inputs: + az: azimuth angle (in radians) + el: elevation angle (in radians) + res: desired resolution of the pixel to be returned + scheme: pixelization scheme + returns the number of the pixel containing the point, or -1 if error occurs +*/ + +int which_pixel(long double az, long double el, int res, char scheme) +{ + int n,m,pix,base_pix,i; + unsigned long pixnum; + long double az_check, el_check; + int *parent_pixels; + + if(az<0){ + az+=TWOPI; + } + + if(az>TWOPI || az<0){ + fprintf(stderr, "error in which_pixel: az must lie between 0 and 2*PI.\n"); + return(-1); + } + if(el>PIBYTWO || el<-PIBYTWO){ + fprintf(stderr, "error in which_pixel: el must lie between -PI/2 and PI/2.\n"); + return(-1); + } + if(res<0){ + fprintf(stderr, "error in which_pixel: resolution must be an integer >=0.\n"); + return(-1); + } + + + if(scheme=='s'){ + // this scheme divides up the sphere by rectangles in az and el, and is numbered + // such that the resolution is encoded in each pixel number. The whole sky is pixel 0, + // pixels 1, 2, 3, and 4 are each 1/4 of the sky (resolution 1), pixels 5-20 are each + // 1/16 of the sky (resolution 2), etc. + + + if(az==TWOPI) az=0; + n=(sinl(el)==1) ? 0 : ceill((1-sinl(el))/2*powl(2,res))-1; + + m=floorl(az/(TWOPI)*powl(2,res)); + base_pix=powl(2,res)*n+m; + pix=pixel_start(res,scheme)+base_pix; + return(pix); + } + else if(scheme=='d'){ + assign_parameters(); + if(az==TWOPI) az=0; + /* ang2pix_radec takes az and el in degrees */ + az *= (180.0/PI); + el *= (180.0/PI); + + if(res==0){ + return(0); + } + + else if(res==1){ + parent_pixels = (int *) malloc(sizeof(int) * (3)); + if(!parent_pixels){ + fprintf(stderr, "error in which_pixel: failed to allocate memory for 3 integers\n"); + return(-1); + } + + ang2pix_radec(1, az, el, &pixnum); + pix = (int)pixnum; + + i = get_parent_pixels(pix+pixel_start(2,scheme), parent_pixels, scheme); + if(i==1){ + fprintf(stderr, "error in which_pixel: get_parent_pixels failed\n"); + return(-1); + } + + return(parent_pixels[1]); + } + + else{ + ang2pix_radec((int)powl(2,res-2), az, el, &pixnum); + pix = (int)pixnum; + + /* check + pix2ang_radec((int)powl(2,res-1), pixnum, &az_check, &el_check); + printf("pix2ang_radec(pixnum = %d) = %Lf, %Lf\n", (int)pixnum, az_check, el_check); */ + + return(pix+pixel_start(res, scheme)); + } + } + else{ + fprintf(stderr, "error in which_pixel: pixel scheme %c not recognized.\n", scheme); + return(-1); + } +} + +/* Function get_parent_pixels generates a list of the parent pixels for a given child pixel. + inputs: + pix_c: number of child pixel + scheme: pixelization scheme + output: + pix_p[]: array containing parent pixels. pix_p[r] is the parent pixel of resolution r. + returns 0 on success, 1 on error +*/ + +int get_parent_pixels(int pix_c, int pix_p[], char scheme){ + int m,n,res,base_pix,i,j; + unsigned long pixp; + //long double res_d; + + if(pix_c<0){ + fprintf(stderr, "error in get_parent_pixels: %d is not a valid pixel number\n",pix_c); + return(1); + } + + res=get_res(pix_c, scheme); + if(res==-1) return (1); + + if(scheme=='s'){ + // this scheme divides up the sphere by rectangles in az and el, and is numbered + // such that the resolution is encoded in each pixel number. The whole sky is pixel 0, + // pixels 1, 2, 3, and 4 are each 1/4 of the sky (resolution 1), pixels 5-20 are each + // 1/16 of the sky (resolution 2), etc. + + base_pix=pix_c-pixel_start(res,scheme); + m=base_pix % (int)(powl(2,res)); + n=(base_pix-m)/powl(2,res); + + for(i=res;i>=0;i--){ + //put pixel number into array + pix_p[i]=pixel_start(i,scheme)+(int)(powl(2,i))*n+m; + //make child pixel into next parent pixel + n=n/2; + m=m/2; + } + return(0); + } + else if(scheme=='d'){ + assign_parameters(); + //printf("res = %d\n", res); + //printf("res1 (1) = %d\n", res1); + //if (res >= 1) { + // res_d = (long double)(logl((long double)res)/logl(2.0))+1; + // res1 = (int)(res_d + 0.1); + //} + //printf("res1 (2) = %d\n", res1); + pix_p[res]=pix_c; + for(i=res;i>2;i--){ + //printf("args to superpix: %d, %d, %d\n", (int)powl(2,i-1), pix_p[i]-pixel_start(i, scheme), (int)powl(2,i-2)); + superpix((int)powl(2,i-2), (unsigned long)pix_p[i]-(unsigned long)pixel_start(i, scheme), (int)powl(2,i-3), &pixp); + //printf("pixp = %d\n", (int)pixp); + pix_p[i-1] = (int)pixp + pixel_start(i-1, scheme); + } + for(j=0;j<=5;j++){ + for(i=118+j*72;i<=152+j*72;i+=2){ + if(pix_p[2]==i || pix_p[2]==i+1 || pix_p[2]==i+36 || pix_p[2]==i+37) pix_p[1]=(i-118-j*36)/2+1; + } + } + for(i=550;i<=585;i++){ + if(pix_p[2]==i) { + pix_p[1]=(i-114)/4; + } + } + pix_p[0]=0; + return(0); + } + else{ + fprintf(stderr, "error in get_parent_pixels: pixel scheme %c not recognized.\n", scheme); + return(1); + } +} + +/* Function pixel_start returns the starting pixel number for the pixels of a given resolution + inputs: + res: resolution + scheme: pixelization scheme + returns the starting pixel number for the set of pixels of resolution res, + or -1 if error occurs +*/ + +int pixel_start(int res, char scheme){ + + //int res1; + //long double res_d; + + if(res<0){ + fprintf(stderr, "error in pixel_start: %d not a valid resolution.\n", res); + return(-1); + } + + if(scheme=='s'){ + return ((int)((powl(4,res)-1)/3)); + } + else if(scheme=='d'){ + //res_d = (long double)(logl((long double)res)/logl(2.0))+1; + //res1 = (int)(res_d + 0.1); + //printf("pixel_start: res = %d\n", res); + if(res==0) return(0); + else if(res==1) return(1); + else return (468*(((int)powl(4,res-1)-4)/12)+118); + } + else{ + fprintf(stderr, "error in pixel_start: pixel scheme %c not recognized.\n", scheme); + return(-1); + } + +} diff --git a/src/wlm.s.f b/src/wlm.s.f new file mode 100644 index 0000000..2b07470 --- /dev/null +++ b/src/wlm.s.f @@ -0,0 +1,441 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + subroutine wlm(w,lmax1,im,nw,ri,phi,qphi,zi,ci,si,ph,dph,v) + integer lmax1,im,nw,qphi + real*10 w(im,nw),ri,phi,zi,ci,si,ph,dph,v(lmax1) +c +c parameters + real*10 HALF + parameter (HALF=1._10/2._10) + include 'pi.par' + real*10 TWOPI + parameter (TWOPI=2._10*PI) + +c largest non-overflowing 2^(DBL_MAX_EXP-1) for real*10 (from values.h) + integer DBL_MAX_EXP + parameter (DBL_MAX_EXP=1024) + +c intrinsics + intrinsic abs,max +c local variables + integer l,lm,l1,m,mmax1,mmin1,mn,mn1,mq,m1,n,nmax1,n1 + integer ed,edm,edn,ee,eem,een,ez,ezn,iez + real*10 al,al1,am,an,cm,cmp,cmphi,cnph,cp, + * d,dim,dm,dme,dn,dpe,dre,d0,d1,d2,e,ed0,em,en,e1,e2,fn,q,qq,q1, + * smphi,snph,t,z,zm,zn,zp + real*10 OVFLOW,UNFLOW +c * +c * Calculates contribution to spherical transform w(lm) +c * by boundary segment of window function w=sum w(lm)*Y(l,m). +c * See AJSH Notes V2 210. +c * +c * Definition: z(l,m)*sqrt(2*l+1)*exp(i*m*phi)=Y(l,m) (m.ge.0). +c * d(l,m,n) is matrix for rotation about cone y-axis which takes +c * the north pole (=z-axis) to cone north pole. +c * +c * Underflow: +c * Is a pain! It only matters when lmax is large, +c * and in most cases the underflow doesn't matter anway, +c * and it requires a pile of ugly coding. +c * But there are cases where it matters. +c * +c * Here's a quick argument for the Legendre polynomials. +c * z(n,n) is [sin(th)]^n up to a factor of order 1, +c * and can underflow if sin(th) is small and n is large. +c * z(l,n) is obtained by recursion from z(n,n), +c * and is `not small' for |sin(th)| > n/l +c * (the classically allowed regime), +c * so underflow causes z(l,n) to be underestimated when +c * l > n/|sin(th)| = n/[epsilon^(1/n)], +c * where epsilon is a number small enough to underflow. +c * The smallest l occurs when n = - ln(epsilon), whereat sin(th) = 1/e +c * and l = e n, with e = 2.718... being the exponential. +c * If epsilon = 2^-1023 = 1e-308, +c * then the smallest l occurs when n = 709, whereat l = 1928. +c * +c * Numerical experiment indicates that underflow sets in earlier +c * for the rotation matrix -- about l = 200, for sin(th) = 1/e. +c * +c Input: lmax1 = lmax+1 where lmax is maximum desired l of transform. +c im = 1 means compute real part of harmonics only; +c 2 means compute both real and imaginary parts. +c Note a region has pure real harmonics if it has mirror +c symmetry through x-z plane. +c nw = [(lmax+1)*(lmax+2)]/2 +c ri,phi,zi = axis of segment cone in cylindrical coordinates. +c qphi: use phi+qphi*pi/2 in place of phi, +c for better precision near phi = integer*pi/2 . +c ci,si = cos and sin of opening angle of segment cone. +c ph = azimuthal angle of centre point of segment, +c zero being such that rotation from z-axis to cone axis +c is about cone's y-axis. +c dph = azimuthal angle subtended by segment. +c Input/Output: w(i,lm) = spherical transform +c w(i,lm), i=1,im, lm=l*(l+1)/2+m+1, l=0,lmax, m=0,l; +c w(1,lm) is real part, w(2,lm) is imaginary part; +c w(i,lm) is ADDED to input w(i,lm). +c Note w(l,-m)=(-)^m*[Complex conjugate of w(l,m)], just as +c Y(l,-m)=(-)^m*[Complex conjugate of Y(l,m)]. +c Work array: v should be dimensioned at least lmax1 +c + if (lmax1.le.0) goto 300 + if (dph.eq.0._10) goto 300 +c largest non-overflowing power of 2 for real*10 + OVFLOW=2._10**(DBL_MAX_EXP-1) + UNFLOW=1._10/OVFLOW + z=OVFLOW*0._10 + if (z.ne.0._10.or.UNFLOW.eq.0._10) then + print *,'*** from wlm: DBL_MAX_EXP on your machine appears to be + * <',DBL_MAX_EXP + print *,' please modify DBL_MAX_EXP in wlm.s.f in the mangle dir + *ectory, and recompile;' + print *,' DBL_MAX_EXP may be defined in float.h somewhere on you + *r machine' + stop + endif +c cm=(zi-1)/2; cp=(zi+1)/2 +c done this way to ensure accuracy at small ri + cm=-((1._10-zi)**2+ri**2)/4._10 + cp=((1._10+zi)**2+ri**2)/4._10 + nmax1=lmax1 + if (dph.eq.TWOPI.or.dph.eq.-TWOPI) nmax1=1 + if (si.eq.0._10) nmax1=1 + mmin1=1 + mmax1=lmax1 + do 280 n1=1,nmax1 + n=n1-1 + an=n +c--------calculate spherical harmonics v(l,n) in cone frame + do l1=n1,lmax1 + al1=l1 + l=l1-1 + al=l +c........l = n = 0 + if (n.eq.0) then + if (l.eq.0) then +c zn=z(0,0) + zn=1._10/sqrt(2._10*TWOPI) + ezn=0 + ez=ezn + fn=dph +c z=z(0,0); zp=z(1,0) + z=zn + zp=ci*z +c v(0,0) + v(l1)=-fn*zp +c........l > 0, n = 0 + elseif (l.gt.0) then +c zm=z(l-1,0); z=z(l,0); zp=z(l+1,0) + qq=al1+al + zm=z + z=zp + zp=(qq*ci*z-al*zm)/al1 +c v(l,0) + v(l1)=fn/sqrt(qq)*(zm-zp) + endif +c........l = n > 0 + elseif (l.eq.n) then +c zn=z(l,l) + t=-sqrt((an-HALF)/an)*si + z=t*zn +c zn may underflow + if (abs(z).le.UNFLOW) then + zn=zn*OVFLOW + z=t*zn + ezn=ezn+1 + endif + ez=ezn + zn=z + fn=2._10*sin(an*dph/2._10)/an +c z=z(l,l); zp=z(l+1,l) + q=sqrt(al1+al) + zp=q*ci*z +c v=v(l,l) + v(l1)=-fn/al1*zp +c........l > n > 0 + elseif (l.gt.n) then +c zm=z(l-1,n); z=z(l,n); zp=z(l+1,n) + qq=al1+al + q1=q + q=sqrt((al1+an)*(al1-an)) + zm=z + z=zp + zp=(qq*ci*z-q1*zm)/q + if (ez.gt.0) then +c recover from underflow + if (abs(zp).ge.1._10 + * .and.(abs(z).ge.1._10.or.z.eq.0._10) + * .and.(abs(zm).ge.1._10.or.zm.eq.0._10)) then + ez=ez-1 + zm=zm*UNFLOW + z=z*UNFLOW + zp=zp*UNFLOW + endif + endif +c v=v(l,n) + v(l1)=fn/sqrt(qq)*(q1/al*zm-q/al1*zp) + endif +c........restore correct scaling + if (ez.gt.0) then + do iez=1,ez + v(l1)=v(l1)*UNFLOW + enddo + endif + enddo +c........skip rotation if harmonics in cone frame are all zero + do l1=lmax1,n1,-1 + if (v(l1).ne.0._10) goto 220 + enddo + goto 280 + 220 continue +c--------matrix d(l,m,n) to rotate v(l,n) about cone y-axis + cnph=cos(an*ph) + snph=sin(an*ph) +c cone axis is parallel to desired axis + if (ri.eq.0._10) then + mmin1=n1 + mmax1=n1 + endif + do m1=mmin1,mmax1 + m=m1-1 + am=m + cmphi=cos(am*phi) + smphi=sin(am*phi) + if (qphi.ne.0) then + mq=m*qphi + if (mod(mq/2,2).ne.0) then + cmphi=-cmphi + smphi=-smphi + endif + if (mod(mq,2).eq.1) then + cmp=cmphi + cmphi=-smphi + smphi=cmp + elseif (mod(mq,2).eq.-1) then + cmp=cmphi + cmphi=smphi + smphi=-cmp + endif + endif +c........m = n = 0 + if (m.eq.0) then + if (n.eq.0) then +c d0=d(0,0,0) + d0=1._10 + ed0=0 +c initialize dn, en + dn=d0 + en=d0 + edn=ed0 + een=ed0 +c........m = 0, n > 0 + elseif (n.gt.0) then +c d0=d(n,0,n)=(-)^n*d(n,0,-n) + t=sqrt((an-HALF)/an)*ri + d=d0*t +c d0 may underflow + if (abs(d).le.UNFLOW) then + d0=d0*OVFLOW + d=d0*t + ed0=ed0+1 + endif + d0=d + endif +c initialize dm, em + dm=d0 + em=d0 + edm=ed0 + eem=ed0 +c........0 < m < n + elseif (m.lt.n) then +c dm=d(n,m,n); em=(-)^n*d(n,m,-n) + t=sqrt((an-am+1._10)/(an+am))*2._10/ri +c dm + d=dm*cp*t +c dm may underflow ... + if (abs(d).le.UNFLOW.and.dm.ne.0._10) then + dm=dm*OVFLOW + d=dm*cp*t + edm=edm+1 +c ... or may recover from underflow + elseif (edm.gt.0) then + if (abs(d).ge.1._10) then + d=d*UNFLOW + edm=edm-1 + endif + endif + dm=d +c em + e=em*cm*t +c em may underflow ... + if (abs(e).le.UNFLOW.and.em.ne.0._10) then + em=em*OVFLOW + e=em*cm*t + eem=eem+1 +c ... or may recover from underflow + elseif (eem.gt.0) then + if (abs(e).ge.1._10) then + e=e*UNFLOW + eem=eem-1 + endif + endif + em=e +c........0 < m = n + elseif (m.eq.n) then +c dn=d(n,n,n); en=(-)^n*d(n,n,-n) +c dn + d=cp*dn +c dn may underflow + if (abs(d).le.UNFLOW.and.dn.ne.0._10) then + dn=dn*OVFLOW + d=cp*dn + edn=edn+1 + endif + dn=d +c en + e=cm*en +c en may underflow + if (abs(e).le.UNFLOW.and.en.ne.0._10) then + en=en*OVFLOW + e=cm*en + een=een+1 + endif + en=e +c initialize dm, em + dm=dn + em=en + edm=edn + eem=een +c........m > n + elseif (m.gt.n) then +c dm=d(m,m,n); em=(-)^n*d(m,m,-n) + t=-sqrt(am*(am-HALF)/((am+an)*(am-an)))*ri +c dm + d=t*dm +c dm may underflow ... + if (abs(d).le.UNFLOW.and.dm.ne.0._10) then + dm=dm*OVFLOW + d=t*dm + edm=edm+1 +c ... or may recover from underflow + elseif (edm.gt.0) then + if (abs(d).ge.1._10) then + d=d*UNFLOW + edm=edm-1 + endif + endif + dm=d +c em + if (n.gt.0) then + e=t*em +c em may underflow ... + if (abs(e).le.UNFLOW.and.em.ne.0._10) then + em=em*OVFLOW + e=t*em + eem=eem+1 +c ... or may recover from underflow + elseif (eem.gt.0) then + if (abs(e).ge.1._10) then + e=e*UNFLOW + eem=eem-1 + endif + endif + em=e + endif + endif +c........l >= m, n + mn=max(m,n) + mn1=mn+1 + do 240 l1=mn1,lmax1 + l=l1-1 + al=l +c d=d(l,m,n); e=(-)^n*d(l,m,-n) + if (l.eq.mn) then + lm=(l*l1)/2+m1 + q=0._10 + d1=0._10 + d=dm + ed=edm + if (n.eq.0) then + e=0._10 + ee=0 + elseif (n.gt.0) then + e1=0._10 + e=em + ee=eem + endif + elseif (l.gt.mn) then + lm=lm+l + qq=2._10*al-1._10 + q1=q + q=sqrt((al+am)*(al-am)*(al+an)*(al-an))/al + t=0._10 + if (m*n.gt.0) t=am*an/((al-1._10)*al) + d2=d1 + d1=d + d=(qq*(zi-t)*d1-q1*d2)/q +c recover d from underflow + if (ed.gt.0) then + if (abs(d).ge.1._10 + * .and.(abs(d1).ge.1._10.or.e1_10.eq.0._10) + * .and.(abs(d2).ge.1._10.or.e2_10.eq.0._10)) then + d2=d2*UNFLOW + d1=d1*UNFLOW + d=d*UNFLOW + ed=ed-1 + endif + endif + if (n.gt.0) then + e2=e1 + e1=e + e=(qq*(zi+t)*e1-q1*e2)/q +c recover e from underflow + if (ee.gt.0) then + if (abs(e).ge.1._10 + * .and.(abs(e1).ge.1._10.or.e1.eq.0._10) + * .and.(abs(e2).ge.1._10.or.e2.eq.0._10)) then + e2=e2*UNFLOW + e1=e1*UNFLOW + e=e*UNFLOW + ee=ee-1 + endif + endif + endif + endif +c--------rotate: w(l,m) = d(l,m,0)*v(l,0) + +c sum (n=1,l) [d(l,m,n)*v(l,n) + d(l,m,-n)*v(l,-n)] +c if ((l1.eq.lmax1.or.l1.eq.n1) +c * .and.(m1.eq.n1.or.m1.eq.1)) then +c write (*,'("l m n = ",3i4," d(l,m,n) = ", +c * 2g13.5,i3," (-)^n d(l,m,-n) = ",2g13.5,i3)') +c * l1-1,m1-1,n1-1,d,d*UNFLOW**ed,ed,e,e*UNFLOW**ee,ee +c endif + if (ed.eq.0) then + if (ee.eq.0) then + dpe=d+e + dme=d-e + else + dpe=d + dme=d + endif + else + if (ee.eq.0) then + dpe=e + dme=-e + else + goto 240 + endif + endif + dre=cnph*dpe*v(l1) + dim=snph*dme*v(l1) + w(1,lm)=w(1,lm)+cmphi*dre-smphi*dim + if (im.eq.2) w(2,lm)=w(2,lm)-cmphi*dim-smphi*dre + 240 continue + enddo + 280 continue +c--------done + 300 continue + return + end +c diff --git a/src/wrangle.c b/src/wrangle.c new file mode 100644 index 0000000..d8bed60 --- /dev/null +++ b/src/wrangle.c @@ -0,0 +1,75 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Write angle into string in appropriate format. + In particular, this routine supports the hms dms format for RA & Dec. + + All angles written by mangle go through this routine. + + Input: angle = angle. + unit = format in which to write angle; + this is only used to decide the format, not to rescale the + angle, which remains unchanged; + the 'h' unit signifies hms(RA) and dms(Dec); + otherwise angle is written to str as a long double. + precision = number of digits after decimal point in output angles. + Output: str = pointer to string containing the angle. + str_len = length of string. +*/ +void wrangle(long double angle, char unit, int precision, size_t str_len, char str[/*str_len*/]) +{ +/* default number of significant digits */ +#define DIGITS 9 + char sign; + int hour, min; + int width; + long double a, sec; + + if (unit == 'h') { + sign = (angle < 0.)? '-' : ' '; + a = fabsl(angle); + hour = floorl(a); + a = (a - hour) * 60.; + min = floorl(a); + a = (a - min) * 60.; + sec = a; + if (precision < 0) precision = DIGITS - 7; + width = precision + 3; + if (precision == 0) width--; + snprintf(str, str_len, "%c%02d %02d %0*.*Lf", + sign, hour, min, width, precision, sec); + } else { + switch (unit) { + case 'r': /* radians */ + default: + if (precision < 0) precision = DIGITS - 1; + width = precision + 3; + break; + case 'd': /* degrees */ + case '°': + if (precision < 0) precision = DIGITS - 3; + width = precision + 5; + break; + case 'm': /* arcminutes */ + case '\'': + case '´': + if (precision < 0) precision = DIGITS - 5; + width = precision + 7; + break; + case 's': /* arcseconds */ + case '"': + case '¨': + if (precision < 0) precision = DIGITS - 7; + width = precision + 9; + break; + } + if (precision == 0) width--; + snprintf(str, str_len, "%*.*Lf", + width, precision, angle); + } +} diff --git a/src/wrho.c b/src/wrho.c new file mode 100644 index 0000000..08fd992 --- /dev/null +++ b/src/wrho.c @@ -0,0 +1,42 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Value of summed harmonics at a specified position. + + This is a c interface to fortran function wrho. + + Input: az, el = azimuth and elevation in radians. + lmax = maximum harmonic number of harmonics to include. + mmax = include azimuthal harmonics -mmax to + mmax + = lmax normally, but other values are acceptable. + w(i, lm) = spherical transform, dimensioned w(im, nw) + w(i,lm), i=1,im, lm=l*(l+1)/2+m+1, l=0,lmax, m=0,l; + w(1,lm) is real part, w(2,lm) is imaginary part; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + lsmooth = smoothing harmonic number + = 0. (or < 0.) to skip smoothing. + esmooth = exponent of smoothing, ignored if lsmooth <= 0. + = 2. for Gaussian smoothing. + Return value: wrho = sum_lm w_lm Y_lm(az, el) if lsmooth = 0. + or + sum_lm w_lm Y_lm exp[- l(l+1) / lsmooth(lsmooth+1) ] + if lsmooth > 0. and esmooth = 2. (gaussian smoothing) + or + sum_lm w_lm Y_lm exp[- [l(l+1) / lsmooth(lsmooth+1)]^(esmooth/2) ] + if lsmooth > 0. and general esmooth. +*/ +long double wrho(long double az, long double el, int lmax, int mmax, harmonic w[/*NW*/], long double lsmooth, long double esmooth) +{ + int im, nw; + long double wrho; + + im = IM; + nw = NW; + + wrho = wrho_(&az, &el, w, &lmax, &mmax, &im, &nw, &lsmooth, &esmooth); + + return(wrho); +} diff --git a/src/wrho.s.f b/src/wrho.s.f new file mode 100644 index 0000000..1e3873d --- /dev/null +++ b/src/wrho.s.f @@ -0,0 +1,90 @@ +c----------------------------------------------------------------------- +c © A J S Hamilton 2001 +c----------------------------------------------------------------------- + real*10 function wrho(az,el,w,lmax,mmax,im,nw,lsmooth,esmooth) + integer lmax,mmax,im,nw + real*10 el,az,w(im,nw),lsmooth,esmooth +c +c parameters + real*10 HALF + parameter (HALF=1._10/2._10) + include 'pi.par' +c local variables +c integer i + integer l,lm,lmax1,l1,m,mmax1,m1 + real*10 al,al1,am,cel,cm,dwrho,lsmoot1,phi, + * sel,sm,smooth,t,tm,tp,y,z,zm,zn,zp +c * +c * Given window harmonics w_lm, returns value of window function +c * sum w_lm Y_lm exp{-[l(l+1)/lsmooth(lsmooth+1)]**(esmooth/2)]} +c * at azimuthal angle az radians, elevation el radians. +c * +c Input: az = azimuthal angle (= longitude) in radians. +c el = elevation (= latitude = pi/2 - polar angle) in radians. +c w(i,lm) = spherical transform, dimensioned w(im,nw) +c w(i,lm), i=1,im, lm=l*(l+1)/2+m+1, l=0,lmax, m=0,l; +c w(1,lm) is real part, w(2,lm) is imaginary part (if im>=2). +c lmax = maximum harmonic number of harmonics to include. +c mmax = include azimuthal harmonics -mmax to + mmax +c = lmax normally, but other values are acceptable. +c im = row dimension of harmonics w. +c nw = [(lmax+1)*(lmax+2)]/2 +c lsmooth = smoothing harmonic number +c = 0 (or < 0) to skip smoothing. +c esmooth = exponent of smoothing, ignored if lsmooth <= 0 +c = 2 for Gaussian smoothing. +c Output: wrho = sum w_lm Y_lm +c * exp{-[l(l+1)/lsmooth(lsmooth+1)]**(esmooth/2)]} +c + lmax1=lmax+1 + mmax1=mmax+1 + lsmoot1=lsmooth+1._10 + cel=cos(el) + sel=sin(el) + phi=az + wrho=0._10 + do 180 m1=1,mmax1 + m=m1-1 + am=m + if (m.eq.0) then +c zn=z(0,0) + zn=1._10/sqrt(4._10*PI) + cm=1._10 + sm=0._10 + elseif (m.gt.0) then +c zn=z(m,m) + zn=-sqrt((am-HALF)/am)*cel*zn + cm=2._10*cos(am*phi) + if (im.eq.2) sm=2._10*sin(am*phi) + endif + z=0._10 + zp=zn + lm=(m*m1)/2+1 + do 160 l1=m1,lmax1 + al1=l1 + l=l1-1 + al=l +c zm=z(l-1,m); z=z(l,m); zp=z(l+1,m) + zm=z + z=zp + t=al1+al + tm=sqrt((al+am)*(al-am)) + tp=sqrt((al1+am)*(al1-am)) + zp=(t*sel*z-tm*zm)/tp + y=z*sqrt(t) +c dwrho=w(l,m)*Y(l,m)+w(l,-m)*Y(l,-m) + lm=lm+l + dwrho=cm*w(1,lm) + if (im.eq.2) dwrho=dwrho-sm*w(2,lm) + dwrho=dwrho*y + if (lsmooth.gt.0._10) then + smooth=exp(-(al/lsmooth*al1/lsmoot1)**(esmooth/2._10)) + dwrho=dwrho*smooth + endif + wrho=wrho+dwrho +c write (*,'(2i4,i6,5g12.4)') l,m,lm,sm,cm,y,(w(i,lm),i=1,im) + 160 continue + 180 continue + return + end +c diff --git a/src/wrmask.c b/src/wrmask.c new file mode 100644 index 0000000..ac2af0b --- /dev/null +++ b/src/wrmask.c @@ -0,0 +1,1551 @@ +/*------------------------------------------------------------------------------ +(C) A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <math.h> +#include <stdio.h> +#include <string.h> +#include "inputfile.h" +#include "format.h" +#include "manglefn.h" + +#define WARNMAX 8 +#define AZEL_STR_LEN 32 + +/* suppress error messages from garea */ +const int verb = 0; + +/* initial angular tolerance within which to merge multiple intersections */ +extern long double mtol; + +/* min, max weights to keep */ +extern int is_weight_min, is_weight_max; +extern long double weight_min, weight_max; + +/* min, max areas to keep */ +extern int is_area_min, is_area_max; +extern long double area_min, area_max; + +/* min, max ids to keep */ +extern int is_id_min, is_id_max; +extern int id_min, id_max; + +/* min, max pixels to keep */ +extern int is_pixel_min, is_pixel_max; +extern int pixel_min, pixel_max; + +/*pixelization info*/ +extern int res_max; /*maximum resolution allowed for pixelization*/ +extern int polys_per_pixel; /*level of pixelization: number of polygons allowed per pixel*/ + /*set polys_per_pixel=0 to pixelize everything to max resolution*/ +extern char scheme; /*default pixelization scheme*/ +extern int pixelized; /*switch indicating whether input has been pixelized */ + +extern int snapped; /*switch indicating whether input has been snapped */ +extern int balkanized; /*switch indicating whether input has been balkanized */ + +extern char *keywords[]; + +/*------------------------------------------------------------------------------ + Write mask data. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure; + if null, defaults to polygon format. + polys = polygons to write. + npolys = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wrmask(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/]) +{ + int npoly; + + /* discard polygons with weight or area outside specified limits */ + npoly = discard_poly(npolys, polys); + + /* default polygon format */ + if (!fmt || strcmp(fmt->out, "polygon") == 0 + || strcmp(fmt->out, "spolygon") == 0) { + npoly = wr_poly(filename, fmt, npolys, polys, npoly); + + /* circle format */ + } else if (strcmp(fmt->out, keywords[BINARY_POLYGON])==0) { + npoly = wr_bin_poly(filename, fmt, npolys, polys, npoly); + } else if (strcmp(fmt->out, "circle") == 0) { + npoly = wr_circ(filename, fmt, npolys, polys, npoly); + /* edges, graphics, or vertices format */ + } else if (strcmp(fmt->out, "edges") == 0 + || strcmp(fmt->out, "graphics") == 0 + || strcmp(fmt->out, "vertices") == 0) { + npoly = wr_edge(filename, fmt, npolys, polys, npoly); + + /* rectangle format */ + } else if (strcmp(fmt->out, "rectangle") == 0) { + npoly = wr_rect(filename, fmt, npolys, polys, npoly); + + /* Region format */ + } else if (strcmp(fmt->out, "Region") == 0) { + npoly = wr_Reg(filename, fmt, npolys, polys, npoly); + + /* area format */ + } else if (strcmp(fmt->out, "area") == 0) { + npoly = wr_area(filename, fmt, npolys, polys, npoly); + + /* id format */ + } else if (strcmp(fmt->out, "id") == 0) { + npoly = wr_id(filename, npolys, polys, npoly); + + /* midpoint format */ + } else if (strcmp(fmt->out, "midpoint") == 0) { + npoly = wr_midpoint(filename, fmt, npolys, polys, npoly); + + /* weight format */ + } else if (strcmp(fmt->out, "weight") == 0) { + npoly = wr_weight(filename, fmt, npolys, polys, npoly); + + /* list format */ + } else if (strcmp(fmt->out, "list") == 0) { + npoly = wr_list(filename, fmt, npolys, polys, npoly); + } + else { + fprintf(stderr, "wrmask: format %s not recognized\n", fmt->out); + npoly = -1; + + } + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write mask data in circle format. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_circ(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + char unit; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN], th_str[AZEL_STR_LEN]; + int i, ier, ip, ipoly, nbadarea, npoly; + long double area, angle[3], tol; + FILE *file; + char *circle_fmt = "circle %d ( %d caps, %.18Lg weight, %.18Lf str):\n"; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_circ: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* write number of polygons */ + fprintf(file, "%d polygons\n", npolyw); + + /* write angular unit */ + fprintf(file, "unit %c\n", fmt->outunitp); + + if(pixelized>0){ + fprintf(file, "pixelization %d%c\n", res_max, scheme); + } + if(snapped>0){ + fprintf(file, "snapped\n"); + } + if(balkanized>0){ + fprintf(file, "balkanized\n"); + } + + npoly = 0; + nbadarea = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "wr_circ: area of polygon %d is incorrect\n", polys[ipoly]->id); + nbadarea++; + } + /* number of caps, weight, and area of polygon */ + fprintf(file, circle_fmt, + polys[ipoly]->id, polys[ipoly]->np, polys[ipoly]->weight, area); + /* write boundaries of polygon */ + for (ip = 0; ip < polys[ipoly]->np; ip++) { + rpcm_to_circ(polys[ipoly]->rp[ip], &polys[ipoly]->cm[ip], angle); + switch (fmt->outphase) { + case '+': if (angle[0] < 0.) angle[0] += TWOPI; break; + case '-': if (angle[0] > PI) angle[0] -= TWOPI; break; + } + for (i = 0; i < 3; i++) { + unit = fmt->outunitp; + if (i > 0 && fmt->outunitp == 'h') unit = 'd'; + scale(&angle[i], 'r', unit); + } + wrangle(angle[0], fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(angle[1], fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + wrangle(angle[2], (fmt->outunitp == 'h')? 'd' : fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, th_str); + fprintf(file, " %s %s %s", az_str, el_str, th_str); + } + fprintf(file, "\n"); + /* increment polygon count */ + npoly++; + } + + /* warn about polygons with incorrect area */ + if (nbadarea > 0) { + msg("%d polygons have incorrect area, but kept\n", nbadarea); + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write mask data in edges or vertices format. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_edge(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + const int per = 0; + const int nve = 2; + const char *edges_fmt = "edges %d ( %d points/edge, %d edges, %.18Lg weight, %s %s mid):\n"; + const char *graphics_fmt = "graphics %d ( %d points, %d edges, %.18Lg weight, %s %s mid):\n"; + const char *vertices_fmt = "vertices %d ( %d vertices, %.18Lg weight, %s %s mid):\n"; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int do_vcirc, i, ier, imid, ipoly, iv, ive, ivm, jv, manybounds, nbadverts, nev, nev0, npoly, npt, nv, nvm; + int *ipv, *gp, *ev; + long double azo, tol; + long double *angle; + vec *ve, *vm; + azel v; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_edge: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* whether to write vertices also for circles with no intersections */ + if (strcmp(fmt->out, "vertices") == 0) { + do_vcirc = 0; + } else { + do_vcirc = 1; + } + + /* write number of polygons */ + fprintf(file, "%d polygons\n", npolyw); + + /* write angular unit */ + fprintf(file, "unit %c\n", fmt->outunitp); + + manybounds = 0; + npoly = 0; + nbadverts = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* point somewhere in the middle of the polygon */ + tol = mtol; + ier = gverts(polys[ipoly], do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + imid = vmid(polys[ipoly], tol, nv, nve, ve, ipv, ev, &nvm, &vm); + if (imid == -1) return(-1); + /* check found a point inside the polygon */ + imid = 0; + for (ivm = 0; ivm < nvm; ivm++) { + if (vm[ivm][0] != 0. || vm[ivm][1] != 0. || vm[ivm][2] != 0.) { + imid = 1; + if (ivm > 0) for (i = 0; i < 3; i++) vm[0][i] = vm[ivm][i]; + break; + } + } + /* found a point */ + if (imid == 1) { + rp_to_azel(vm[0], &v); + switch (fmt->outphase) { + case '+': if (v.az < 0.) v.az += TWOPI; break; + case '-': if (v.az > PI) v.az -= TWOPI; break; + } + scale_azel(&v, 'r', fmt->outunitp); + } + + /* points on edges of polygon */ + tol = mtol; + ier = gverts(polys[ipoly], do_vcirc, &tol, fmt->outper, fmt->outnve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + if (ier) { + nbadverts++; + continue; + } + + /* warn about multi-boundary polygon */ + if (nev > 1) { + if (WARNMAX > 0 && manybounds == 0) { + msg("the following polygons have > 1 boundary (not simply-connected)\n"); + msg(" separate boundaries will be split over separate lines:\n"); + } + if (manybounds < WARNMAX) { + msg(" %d", polys[ipoly]->id); + } else if (manybounds == WARNMAX) { + msg(" ... more\n"); + } + manybounds++; + } + + /* count number of points */ + npt = 0; + for (iv = jv = 0; iv < nv; jv++) { + for (; iv < ev[jv]; iv++) { + for (ive = 0; ive < fmt->outnve; ive++) { + i = iv * fmt->outnve + ive; + if (ve[i][0] == 0. && ve[i][1] == 0. && ve[i][2] == 0.) break; + npt++; + } + } + } + + /* number of edges, weight, and midpoint of polygon */ + wrangle(v.az, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + if (strcmp(fmt->out, "edges") == 0) { + fprintf(file, edges_fmt, + polys[ipoly]->id, fmt->outnve, nv, polys[ipoly]->weight, az_str, el_str); + } else if (strcmp(fmt->out, "graphics") == 0) { + fprintf(file, graphics_fmt, + polys[ipoly]->id, npt, nv, polys[ipoly]->weight, az_str, el_str); + } else { + fprintf(file, vertices_fmt, + polys[ipoly]->id, nv, polys[ipoly]->weight, az_str, el_str); + } + + /* write points, splitting separate boundaries over separate lines */ + for (iv = jv = 0; iv < nv; jv++) { + for (; iv < ev[jv]; iv++) { + for (ive = 0; ive < fmt->outnve; ive++) { + i = iv * fmt->outnve + ive; + if (ve[i][0] == 0. && ve[i][1] == 0. && ve[i][2] == 0.) break; + /* convert unit vector to azel vertex */ + rp_to_azel(ve[i], &v); + /* set azimuth of first point */ + if (iv == 0 && ive == 0) { + switch (fmt->outphase) { + case '+': if (v.az < 0.) v.az += TWOPI; break; + case '-': if (v.az > PI) v.az -= TWOPI; break; + } + /* phase azimuth of each subsequent point to the previous point */ + } else { + v.az -= rint((v.az - azo) / TWOPI) * TWOPI; + } + azo = v.az; + scale_azel(&v, 'r', fmt->outunitp); + wrangle(v.az, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(file, " %s %s", az_str, el_str); + } + } + fprintf(file, "\n"); + } + /* increment polygon count */ + npoly++; + } + /* warn about multi-boundary polygon */ + if (WARNMAX > 0 && manybounds > 0 && manybounds <= WARNMAX) msg("\n"); + if (manybounds > 0) msg("%d polygons had more than one boundary (not simply-connected)\n", manybounds); + + /* warn about polygons producing fatal error */ + if (nbadverts > 0) { + msg("%d polygons producing fatal error in gvert discarded\n"); + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write mask data in list format to be read by matlab script. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_list(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + const int per = 0; + const int nve = 2; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + char az_str_first[AZEL_STR_LEN], el_str_first[AZEL_STR_LEN]; + int firstpoint; + int do_vcirc, i, ier, imid, ipoly, iv, ive, ivm, jv, manybounds, nbadverts, nev, nev0, npoly, npt, nv, nvm; + int *ipv, *gp, *ev; + long double azo, tol; + long double *angle; + vec *ve, *vm; + azel v; + FILE *file; + FILE *weightfile; + char weightfilename[100]; + + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_list: cannot open %s for writing\n", filename); + return(-1); + } + } + if(filename){ + sprintf(weightfilename,"%s.weight",filename); + } + + if (!weightfilename || strcmp(weightfilename, "-") == 0) { + weightfile = stdout; + } else { + weightfile = fopen(weightfilename, "w"); + if (!weightfile) { + fprintf(stderr, "wr_list: cannot open %s for writing\n", weightfilename); + return(-1); + } + } + + + /* whether to write vertices also for circles with no intersections */ + if (strcmp(fmt->out, "vertices") == 0) { + do_vcirc = 0; + } else { + do_vcirc = 1; + } + + /* write number of polygons */ + // fprintf(file, "%d polygons\n", npolyw); + + /* write angular unit */ + // fprintf(file, "unit %c\n", fmt->outunitp); + + manybounds = 0; + npoly = 0; + nbadverts = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* point somewhere in the middle of the polygon */ + tol=mtol; + ier = gverts(polys[ipoly], do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + imid = vmid(polys[ipoly], tol, nv, nve, ve, ipv, ev, &nvm, &vm); + if (imid == -1) return(-1); + /* check found a point inside the polygon */ + imid = 0; + for (ivm = 0; ivm < nvm; ivm++) { + if (vm[ivm][0] != 0. || vm[ivm][1] != 0. || vm[ivm][2] != 0.) { + imid = 1; + if (ivm > 0) for (i = 0; i < 3; i++) vm[0][i] = vm[ivm][i]; + break; + } + } + /* found a point */ + if (imid == 1) { + rp_to_azel(vm[0], &v); + switch (fmt->outphase) { + case '+': if (v.az < 0.) v.az += TWOPI; break; + case '-': if (v.az > PI) v.az -= TWOPI; break; + } + scale_azel(&v, 'r', fmt->outunitp); + } + + /* points on edges of polygon */ + tol = mtol; + ier = gverts(polys[ipoly], do_vcirc, &tol, fmt->outper, fmt->outnve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + if (ier) { + nbadverts++; + continue; + } + + /* warn about multi-boundary polygon */ + if (nev > 1) { + if (WARNMAX > 0 && manybounds == 0) { + msg("the following polygons have > 1 boundary (not simply-connected)\n"); + msg(" separate boundaries will be split over separate lines:\n"); + } + if (manybounds < WARNMAX) { + msg(" %d", polys[ipoly]->id); + } else if (manybounds == WARNMAX) { + msg(" ... more\n"); + } + manybounds++; + } + + /* count number of points */ + npt = 0; + for (iv = jv = 0; iv < nv; jv++) { + for (; iv < ev[jv]; iv++) { + for (ive = 0; ive < fmt->outnve; ive++) { + i = iv * fmt->outnve + ive; + if (ve[i][0] == 0. && ve[i][1] == 0. && ve[i][2] == 0.) break; + npt++; + } + } + } + + /* number of edges, weight, and midpoint of polygon */ + + wrangle(v.az, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + /* write points, splitting separate boundaries over separate lines */ + for (iv = jv = 0; iv < nv; jv++) { + firstpoint=1; + for (; iv < ev[jv]; iv++) { + for (ive = 0; ive < fmt->outnve; ive++) { + i = iv * fmt->outnve + ive; + if (ve[i][0] == 0. && ve[i][1] == 0. && ve[i][2] == 0.) break; + /* convert unit vector to azel vertex */ + rp_to_azel(ve[i], &v); + /* set azimuth of first point */ + if (iv == 0 && ive == 0) { + switch (fmt->outphase) { + case '+': if (v.az < 0.) v.az += TWOPI; break; + case '-': if (v.az > PI) v.az -= TWOPI; break; + } + /* phase azimuth of each subsequent point to the previous point */ + } else { + v.az -= rint((v.az - azo) / TWOPI) * TWOPI; + } + azo = v.az; + scale_azel(&v, 'r', fmt->outunitp); + wrangle(v.az, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(file, " %s %s\n", az_str, el_str); + if(firstpoint){ + sprintf(az_str_first, "%s", az_str); + sprintf(el_str_first, "%s", el_str); + firstpoint=0; + } + } + } + fprintf(file, " %s %s\n", az_str_first, el_str_first); + fprintf(file, "NaN NaN\n"); + fprintf(weightfile,"%d %.18Lg\n", polys[ipoly]->id,polys[ipoly]->weight); + } + //fprintf(file, "NaN NaN\n"); + + /* increment polygon count */ + npoly++; + } + /* warn about multi-boundary polygon */ + if (WARNMAX > 0 && manybounds > 0 && manybounds <= WARNMAX) msg("\n"); + if (manybounds > 0) msg("%d polygons had more than one boundary (not simply-connected)\n", manybounds); + + /* warn about polygons producing fatal error */ + if (nbadverts > 0) { + msg("%d polygons producing fatal error in gvert discarded\n"); + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + msg("polygon weights written to %s\n", + (weightfile == stdout)? "output": weightfilename); + + /* close file */ + if (file != stdout) fclose(file); + if (weightfile != stdout) fclose(weightfile); + + return(npoly); +} + + +/*------------------------------------------------------------------------------ + Write mask data in rectangle format. + Only polygons which are rectangles are written: other polygons are discarded. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_rect(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + char unit; + char azmin_str[AZEL_STR_LEN], azmax_str[AZEL_STR_LEN], elmin_str[AZEL_STR_LEN], elmax_str[AZEL_STR_LEN]; + int ier, ipoly, isrect, nbadarea, nrect; + long double area, azmin, azmax, elmin, elmax, tol; + FILE *file; + char *rect_fmt = "rectangle %d ( %d caps, %.18Lg weight, %.18Lf str):\n"; + + /* count how many polygons are rectangles */ + nrect = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + isrect = poly_to_rect(polys[ipoly], &azmin, &azmax, &elmin, &elmax); + if (isrect) nrect++; + } + + /* no rectangles */ + if (nrect == 0) { + msg("there are no rectangles among the %d polygons\n", npolyw); + return(0); + } else if (nrect < npolyw) { + msg("%d of %d polygons are rectangles; discarding %d non-rectangle polygons\n", nrect, npolyw, npolyw - nrect); + } else if (nrect == npolyw) { + msg("all %d polygons are rectangles\n", npolyw); + } + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_rect: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* write number of rectangles */ + fprintf(file, "%d rectangles\n", nrect); + + /* write angular unit */ + fprintf(file, "unit %c\n", fmt->outunitp); + + nrect = 0; + nbadarea = 0; + /* write rectangles */ + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* is polygon a rectangle? */ + isrect = poly_to_rect(polys[ipoly], &azmin, &azmax, &elmin, &elmax); + /* skip polygons that are not rectangles */ + if (!isrect) continue; + + /* set phase of azimuth */ + switch (fmt->outphase) { + case '+': if (azmax < 0.) azmin += TWOPI, azmax += TWOPI; break; + case '-': if (azmax > PI) azmin -= TWOPI, azmax -= TWOPI; break; + } + + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "wr_rect: area of polygon %d is incorrect\n", polys[ipoly]->id); + nbadarea++; + } + + /* number of caps, weight, and area of polygon */ + fprintf(file, rect_fmt, + polys[ipoly]->id, polys[ipoly]->np, polys[ipoly]->weight, area); + + /* scale angles to desired units */ + unit = fmt->outunitp; + scale(&azmin, 'r', unit); + scale(&azmax, 'r', unit); + if (fmt->outunitp == 'h') unit = 'd'; + scale(&elmin, 'r', unit); + scale(&elmax, 'r', unit); + + /* write rectangle */ + unit = fmt->outunitp; + wrangle(azmin, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, azmin_str); + wrangle(azmax, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, azmax_str); + wrangle(elmin, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, elmin_str); + wrangle(elmax, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, elmax_str); + fprintf(file, " %s %s %s %s\n", azmin_str, azmax_str, elmin_str, elmax_str); + + /* increment rectangle count */ + nrect++; + } + + /* warn about rectangles with incorrect area */ + if (nbadarea > 0) { + msg("%d rectangles have incorrect area, but kept\n", nbadarea); + } + + /* advise */ + msg("%d rectangles written to %s\n", + nrect, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(nrect); +} + +/*------------------------------------------------------------------------------ + Write mask data in polygon format. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_poly(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + int ier, ip, ipoly, nbadarea, npoly; + long double area, tol; + FILE *file; + char *poly_fmt; + char *polygon_fmt = "polygon %d ( %d caps, %.18Lg weight, %d pixel, %.18Lf str):\n"; + char *spolygon_fmt = "%d %d %.18Lg %d %.18Lf\n"; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_poly: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* format */ + if (fmt && strcmp(fmt->out, "spolygon") == 0) { + poly_fmt = spolygon_fmt; + } else { + poly_fmt = polygon_fmt; + } + + /* write number of polygons */ + fprintf(file, "%d polygons\n", npolyw); + + if(pixelized>0){ + fprintf(file, "pixelization %d%c\n", res_max, scheme); + } + if(snapped>0){ + fprintf(file, "snapped\n"); + } + if(balkanized>0){ + fprintf(file, "balkanized\n"); + } + + npoly = 0; + nbadarea = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "wr_poly: area of polygon %d is incorrect\n", polys[ipoly]->id); + nbadarea++; + } + + /* number of caps, weight, and area of polygon */ + fprintf(file, poly_fmt, + polys[ipoly]->id, polys[ipoly]->np, polys[ipoly]->weight, polys[ipoly]->pixel, area); + + /* write boundaries of polygon */ + for (ip = 0; ip < polys[ipoly]->np; ip++) { + fprintf(file, " %21.19Lf %21.19Lf %21.19Lf %.19Lg\n", + polys[ipoly]->rp[ip][0], polys[ipoly]->rp[ip][1], polys[ipoly]->rp[ip][2], polys[ipoly]->cm[ip]); + } + + /* increment polygon count */ + npoly++; + } + + /* warn about polygons with incorrect area */ + if (nbadarea > 0) { + msg("%d polygons have incorrect area, but kept\n", nbadarea); + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write mask data in Max Tegmark's Region format. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_Reg(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + int ip, ipoly, npoly; + FILE *file; + /* there are no holes in our treatment */ + int nholes = 0; + char *Region_fmt = " Region %d ( %d caps, %d holes):\n"; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_Reg: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* write number of polygons */ + fprintf(file, " %d\n", npolyw); + + /* write number of caps */ + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + fprintf(file, " %d", polys[ipoly]->np); + if ((ipoly + 1) % 40 == 0 || ipoly == npolys - 1) fprintf(file, "\n"); + } + + /* write number of holes */ + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + fprintf(file, " %d", nholes); + if ((ipoly + 1) % 40 == 0 || ipoly == npolys - 1) fprintf(file, "\n"); + } + + /* write polygons */ + npoly = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* blank line */ + fprintf(file, "\n"); + + /* id line */ + fprintf(file, Region_fmt, + polys[ipoly]->id, polys[ipoly]->np, nholes); + + /* write boundaries of polygon */ + for (ip = 0; ip < polys[ipoly]->np; ip++) { + fprintf(file, " %21.19Lf %21.19Lf %21.19Lf %21.19Lf\n", + polys[ipoly]->rp[ip][0], polys[ipoly]->rp[ip][1], polys[ipoly]->rp[ip][2], polys[ipoly]->cm[ip]); + } + + /* increment polygon count */ + npoly++; + } + + /* advise */ + msg("%d polygons written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write areas. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_area(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ +#undef PRECISION +#define PRECISION 18 + int idmin, idmax, idwidth, ier, ipoly, nbadarea, npoly, precision, width; + long double area, tol; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_area: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + if (polys[ipoly]->id < idmin) idmin = polys[ipoly]->id; + if (polys[ipoly]->id > idmax) idmax = polys[ipoly]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* width of area in steradians */ + precision = (fmt->outprecision >= 0)? fmt->outprecision : PRECISION; + width = precision + 3; + if (precision == 0) width--; + + /* write header */ + fprintf(file, "area of %d polygons\n", npolyw); + fprintf(file, "%*s %*s\n", width, "area(str)", idwidth, "id"); + + npoly = 0; + nbadarea = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + fprintf(stderr, "wr_poly: area of polygon %d is incorrect\n", polys[ipoly]->id); + nbadarea++; + } + + /* write area */ + fprintf(file, "% *.*Lf %*d\n", width, precision, area, idwidth, polys[ipoly]->id); + + /* increment polygon count */ + npoly++; + } + + /* warn about polygons with incorrect area */ + if (nbadarea > 0) { + msg("%d polygons have incorrect area, but kept\n", nbadarea); + } + + /* advise */ + msg("%d areas written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write ids. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_id(char *filename, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + int idmin, idmax, idwidth, ipoly, npoly; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_id: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + if (polys[ipoly]->id < idmin) idmin = polys[ipoly]->id; + if (polys[ipoly]->id > idmax) idmax = polys[ipoly]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* write header */ + fprintf(file, "id of %d polygons\n", npolyw); + fprintf(file, "%*s\n", idwidth, "id"); + + npoly = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* write id */ + fprintf(file, "%*d\n", idwidth, polys[ipoly]->id); + + /* increment polygon count */ + npoly++; + } + + /* advise */ + msg("%d ids written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write midpoints. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_midpoint(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ + const int per = 0; + const int nve = 2; + const int do_vcirc = 0; + char az_str[AZEL_STR_LEN], el_str[AZEL_STR_LEN]; + int i, idmin, idmax, idwidth, ier, imid, ipoly, ivm, nev, nev0, npoly, nv, nvm, width; + int *ipv, *gp, *ev; + long double tol; + long double *angle; + vec *ve, *vm; + azel v; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_midpoint: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + if (polys[ipoly]->id < idmin) idmin = polys[ipoly]->id; + if (polys[ipoly]->id > idmax) idmax = polys[ipoly]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* write header */ + wrangle(0., fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + width = strlen(az_str); + if (fmt->outunitp == 'h') { + sprintf(az_str, "az(hms)"); + sprintf(el_str, "el(dms)"); + } else { + sprintf(az_str, "az(%c)", fmt->outunitp); + sprintf(el_str, "el(%c)", fmt->outunitp); + } + fprintf(file, "midpoint of %d polygons\n", npolyw); + fprintf(file, "%*s %*s %*s\n", width, az_str, width, el_str, idwidth, "id"); + + npoly = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* point somewhere in the middle of the polygon */ + tol = mtol; + ier = gverts(polys[ipoly], do_vcirc, &tol, per, nve, &nv, &ve, &angle, &ipv, &gp, &nev, &nev0, &ev); + if (ier == -1) return(-1); + imid = vmid(polys[ipoly], tol, nv, nve, ve, ipv, ev, &nvm, &vm); + if (imid == -1) return(-1); + /* check found a point inside the polygon */ + imid = 0; + for (ivm = 0; ivm < nvm; ivm++) { + if (vm[ivm][0] != 0. || vm[ivm][1] != 0. || vm[ivm][2] != 0.) { + imid = 1; + if (ivm > 0) for (i = 0; i < 3; i++) vm[0][i] = vm[ivm][i]; + break; + } + } + /* found a point */ + if (imid == 1) { + rp_to_azel(vm[0], &v); + switch (fmt->outphase) { + case '+': if (v.az < 0.) v.az += TWOPI; break; + case '-': if (v.az > PI) v.az -= TWOPI; break; + } + scale_azel(&v, 'r', fmt->outunitp); + } + + /* write midpoint of polygon */ + wrangle(v.az, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, az_str); + wrangle(v.el, fmt->outunitp, fmt->outprecision, AZEL_STR_LEN, el_str); + fprintf(file, "%s %s %*d\n", az_str, el_str, idwidth, polys[ipoly]->id); + + /* increment polygon count */ + npoly++; + } + + /* advise */ + msg("%d midpoints written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write weights. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + polys = polygons to write. + npolys = number of polygons. + npolyw = number of polygons to write. + Return value: number of polygons written, + or -1 if error occurred. +*/ +int wr_weight(char *filename, format *fmt, int npolys, polygon *polys[/*npolys*/], int npolyw) +{ +#undef PRECISION +#define PRECISION 10 + int idmin, idmax, idwidth, ipoly, npoly, precision, width; + long double weightmax; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_weight: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* largest width of polygon id number */ + idmin = 0; + idmax = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + if (polys[ipoly]->id < idmin) idmin = polys[ipoly]->id; + if (polys[ipoly]->id > idmax) idmax = polys[ipoly]->id; + } + idmin = ((idmin < 0)? floorl(log10l((long double)-idmin)) + 2 : 1); + idmax = ((idmax > 0)? floorl(log10l((long double)idmax)) + 1 : 1); + idwidth = ((idmin > idmax)? idmin : idmax); + + /* largest width of weight */ + weightmax = 0.; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (!polys[ipoly]) continue; + if (weightmax < fabsl(polys[ipoly]->weight)) weightmax = fabsl(polys[ipoly]->weight); + } + precision = (fmt->outprecision >= 0)? fmt->outprecision : PRECISION; + // width = ((weightmax >= 10.)? floorl(log10l(weightmax)) : 0) + precision + 3; //for %f output + width = precision + 7; //for %g output + if (precision == 0) width--; + + /* write header */ + fprintf(file, "weight of %d polygons\n", npolyw); + fprintf(file, "%*s %*s\n", width, "weight", idwidth, "id"); + + npoly = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + /* discard null polygons */ + if (!polys[ipoly]) continue; + + /* write weight */ + fprintf(file, "% *.*Lg %*d\n", width, precision, polys[ipoly]->weight, idwidth, polys[ipoly]->id); + + /* increment polygon count */ + npoly++; + } + + /* advise */ + msg("%d weights written to %s\n", + npoly, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(npoly); +} + +/*------------------------------------------------------------------------------ + Write HEALPix weights. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + fmt = pointer to format structure. + numweight = number of weights in array. + weights = weights to write. + Return value: number of weights written, + or -1 if error occurred. +*/ +int wr_healpix_weight(char *filename, format *fmt, int numweight, long double weights[/*numweight*/]) +{ +#undef PRECISION +#define PRECISION 6 + int iweight, nweight, precision, width; + long double weightmax; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "wr_healpix_weight: cannot open %s for writing\n", filename); + return(-1); + } + } + + /* largest width of weight */ + weightmax = 0.; + for (iweight = 0; iweight < numweight; iweight++) { + if (!weights[iweight]) continue; + if (weightmax < fabsl(weights[iweight])) weightmax = fabsl(weights[iweight]); + } + precision = (fmt->outprecision >= 0)? fmt->outprecision : PRECISION; + width = ((weightmax >= 10.)? floorl(log10l(weightmax)) : 0) + precision + 3; + if (precision == 0) width--; + + /* write header */ + fprintf(file, "healpix_weight %d\n", numweight); + + nweight = 0; + for (iweight = 0; iweight < numweight; iweight++) { + /* discard null polygons + if (!weights[iweight]) continue; */ + + /* write weight */ + fprintf(file, "% *.*Lf\n", width, precision, weights[iweight]); + + /* increment polygon count */ + nweight++; + } + + /* advise */ + msg("%d HEALPix weights written to %s\n", + nweight, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(nweight); +} + +/*------------------------------------------------------------------------------ + Discard polygons with weight or area outside specified limits. + + Input: polys = polygons. + npolys = number of polygons. + Return value: number of polygons retained, + or -1 if error occurred. +*/ +int discard_poly(int npolys, polygon *polys[/*npolys*/]) +{ + int discard, ier, ipoly, nbadarea, noutarea, noutweight, noutid, noutpixel, npoly; + long double area, tol; + + if (is_weight_min || is_weight_max || is_area_min || is_area_max || is_id_min || is_id_max || is_pixel_min || is_pixel_max) { + noutweight = 0; + noutid = 0; + noutpixel = 0; + nbadarea = 0; + noutarea = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + discard = 0; + + /* discard polygons with weights outside interval */ + if (is_weight_min && is_weight_max) { + /* min <= max */ + if (weight_min <= weight_max) { + if (polys[ipoly]->weight < weight_min + || polys[ipoly]->weight > weight_max) { + discard = 1; + } + /* min > max */ + } else { + if (polys[ipoly]->weight < weight_min + && polys[ipoly]->weight > weight_max) { + discard = 1; + } + } + } else if (is_weight_min) { + if (polys[ipoly]->weight < weight_min) { + discard = 1; + } + } else if (is_weight_max) { + if (polys[ipoly]->weight > weight_max) { + discard = 1; + } + } + if (discard) { + noutweight++; + free_poly(polys[ipoly]); + polys[ipoly] = 0x0; + continue; + } + + /* area of polygon */ + tol = mtol; + ier = garea(polys[ipoly], &tol, verb, &area); + if (ier == -1) return(-1); + if (ier) { + nbadarea++; + + /* discard polygons with areas outside interval */ + } else if (is_area_min && is_area_max) { + /* min <= max */ + if (area_min <= area_max) { + if (area < area_min + || area > area_max) { + discard = 1; + } + /* min > max */ + } else { + if (area < area_min + && area > area_max) { + discard = 1; + } + } + } else if (is_area_min) { + if (area < area_min) { + discard = 1; + } + } else if (is_area_max) { + if (area > area_max) { + discard = 1; + } + } + if (discard) { + noutarea++; + free_poly(polys[ipoly]); + polys[ipoly] = 0x0; + continue; + } + + /* discard polygons with ids outside interval */ + if (is_id_min && is_id_max) { + /* min <= max */ + if (id_min <= id_max) { + if (polys[ipoly]->id < id_min + || polys[ipoly]->id > id_max) { + discard = 1; + } + /* min > max */ + } else { + if (polys[ipoly]->id < id_min + && polys[ipoly]->id > id_max) { + discard = 1; + } + } + } else if (is_id_min) { + if (polys[ipoly]->id < id_min) { + discard = 1; + } + } else if (is_id_max) { + if (polys[ipoly]->id > id_max) { + discard = 1; + } + } + if (discard) { + noutid++; + free_poly(polys[ipoly]); + polys[ipoly] = 0x0; + continue; + } + + /* discard polygons with pixel numbers outside interval */ + if (is_pixel_min && is_pixel_max) { + /* min <= max */ + if (pixel_min <= pixel_max) { + if (polys[ipoly]->pixel < pixel_min + || polys[ipoly]->pixel > pixel_max) { + discard = 1; + } + /* min > max */ + } else { + if (polys[ipoly]->pixel < pixel_min + && polys[ipoly]->pixel > pixel_max) { + discard = 1; + } + } + } else if (is_pixel_min) { + if (polys[ipoly]->pixel < pixel_min) { + discard = 1; + } + } else if (is_pixel_max) { + if (polys[ipoly]->pixel > pixel_max) { + discard = 1; + } + } + if (discard) { + noutpixel++; + free_poly(polys[ipoly]); + polys[ipoly] = 0x0; + continue; + } + + + } + + /* warn about discarded polygons */ + if (noutweight > 0) { + if (is_weight_min && is_weight_max) { + if (weight_min < weight_max) { + msg("%d polygons with weights outside [%Lg, %Lg] discarded\n", + noutweight, weight_min, weight_max); + } else { + msg("%d polygons with weights inside (%Lg, %Lg) discarded\n", + noutweight, weight_max, weight_min); + } + } else if (is_weight_min) { + msg("%d polygons with weights < %Lg discarded\n", + noutweight, weight_min); + } else if (is_weight_max) { + msg("%d polygons with weights > %Lg discarded\n", + noutweight, weight_max); + } + } + if (noutarea > 0) { + if (is_area_min && is_area_max) { + if (area_min < area_max) { + msg("%d polygons with areas outside [%Lg, %Lg] discarded\n", + noutarea, area_min, area_max); + } else { + msg("%d polygons with areas inside (%Lg, %Lg) discarded\n", + noutarea, area_max, area_min); + } + } else if (is_area_min) { + msg("%d polygons with areas < %Lg discarded\n", + noutarea, area_min); + } else if (is_area_max) { + msg("%d polygons with areas > %Lg discarded\n", + noutarea, area_max); + } + } + if (noutid > 0) { + if (is_id_min && is_id_max) { + if (id_min < id_max) { + msg("%d polygons with ids outside [%d, %d] discarded\n", + noutid, id_min, id_max); + } else { + msg("%d polygons with ids inside (%d, %d) discarded\n", + noutid, id_max, id_min); + } + } else if (is_id_min) { + msg("%d polygons with ids < %d discarded\n", + noutid, id_min); + } else if (is_id_max) { + msg("%d polygons with ids > %d discarded\n", + noutid, id_max); + } + } + if (noutpixel > 0) { + if (is_pixel_min && is_pixel_max) { + if (pixel_min < pixel_max) { + msg("%d polygons with pixel numbers outside [%d, %d] discarded\n", + noutpixel, pixel_min, pixel_max); + } else { + msg("%d polygons with pixel numbers inside (%d, %d) discarded\n", + noutpixel, pixel_max, pixel_min); + } + } else if (is_pixel_min) { + msg("%d polygons with pixel numbers < %d discarded\n", + noutpixel, pixel_min); + } else if (is_pixel_max) { + msg("%d polygons with pixel numbers > %d discarded\n", + noutpixel, pixel_max); + } + } + + } + + /* count non-null polygons */ + npoly = 0; + for (ipoly = 0; ipoly < npolys; ipoly++) { + if (polys[ipoly]) npoly++; + } + + return(npoly); +} diff --git a/src/wrrrcoeffs.c b/src/wrrrcoeffs.c new file mode 100644 index 0000000..5f2de22 --- /dev/null +++ b/src/wrrrcoeffs.c @@ -0,0 +1,73 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Write first few coefficients rrcoeff[i] + of the power series expansion in sinl(th/2) + of the self-correlation of mask W at angular separation th + + // + <W W> = || W(n) W(n') delta(n.n' - cos th) do do' + // + i + = sum rrcoeff[i] [sinl(th/2)] + i + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + area = area of mask in steradians. + bound, vert = coefficients computed by subroutine gspher.s.f for each polygon, + with corrections from gphbv.s.f for polygons that abut along a finite boundary, + and further corrections NOT YET IMPLEMENTED for polygons that touch at isolated points. + Return value: number of coefficients written, + or -1 if error occurred. +*/ +int wrrrcoeffs(char *filename, long double area, long double bound[2], long double vert[2]) +{ +/* precision with which harmonics are written */ +#define PRECISION 16 +/* number of coefficients */ +#define NCOEFF 4 + int icoeff, width; + long double rrcoeff[NCOEFF]; + FILE *file; + + /* first 4 coefficients of power series expansion of <RR> */ + rrcoeff[0] = area * 2. * PI; + rrcoeff[1] = - bound[0] * 4.; + rrcoeff[2] = vert[0] * 2.; + rrcoeff[3] = bound[1] * 2./3. + vert[1] * 8./9.; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "cannot open %s for writing\n", filename); + return(-1); + } + } + + /* width of each number */ + width = PRECISION + 7; + + /* write */ + fprintf(file, "%*s\n", PRECISION, "WWcoeffs"); + for (icoeff = 0; icoeff < NCOEFF; icoeff++) { + fprintf(file, "%- #*.*Lg\n", width, PRECISION, rrcoeff[icoeff]); + } + + /* advise */ + msg("%d coefficients of series expansion of <WW> written to %s\n", + NCOEFF, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(NCOEFF); +} diff --git a/src/wrspher.c b/src/wrspher.c new file mode 100644 index 0000000..31fb96e --- /dev/null +++ b/src/wrspher.c @@ -0,0 +1,57 @@ +/*------------------------------------------------------------------------------ +© A J S Hamilton 2001 +------------------------------------------------------------------------------*/ +#include <stdio.h> +#include <string.h> +#include "manglefn.h" + +/*------------------------------------------------------------------------------ + Write spherical harmonics. + + Input: filename = name of file to write to; + "" or "-" means write to standard output. + lmax = maximum harmonic number. + w = array containing harmonics; + NW = ((lmax + 1)(lmax + 2))/ 2 is defined in harmonics.h. + Return value: number of (complex) harmonics written, + or -1 if error occurred. +*/ +int wrspher(char *filename, int lmax, harmonic w[/*NW*/]) +{ +/* precision with which harmonics are written */ +#define PRECISION 16 + int i, iw, width; + FILE *file; + + /* open filename for writing */ + if (!filename || strcmp(filename, "-") == 0) { + file = stdout; + } else { + file = fopen(filename, "w"); + if (!file) { + fprintf(stderr, "cannot open %s for writing\n", filename); + return(-1); + } + } + + /* width of each number */ + width = PRECISION + 7; + + /* write */ + fprintf(file, "%12d %12d %12d\n", lmax, IM, NW); + for (iw = 0; iw < NW; iw++) { + for (i = 0; i < IM; i++) { + fprintf(file, " %- #*.*Lg", width, PRECISION, w[iw][i]); + } + fprintf(file, "\n"); + } + + /* advise */ + msg("%d x %d harmonics up to lmax = %d written to %s\n", + IM, NW, lmax, (file == stdout)? "output": filename); + + /* close file */ + if (file != stdout) fclose(file); + + return(NW); +}